mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

make repo description optional

Browse source
This commit is contained in:
Joey Hess 2012-10-14 16:32:55 -04:00
parent 2d9682f3c6
commit 08e1efb278
3 changed files with 7 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Assistant/MakeRemote.hs
View file

@ -93,6 +93,7 @@ makeRemote basename location a = do
g <- gitRepo g <- gitRepo
if not (any samelocation $ Git.remotes g) if not (any samelocation $ Git.remotes g)
then do then do
let name = uniqueRemoteName basename 0 g let name = uniqueRemoteName basename 0 g
a name a name
return name return name

8
Assistant/WebApp/Configurators/Edit.hs
View file

@ -34,7 +34,7 @@ data RepoGroup = RepoGroupCustom String | RepoGroupStandard StandardGroup
deriving (Show, Eq) deriving (Show, Eq)
data RepoConfig = RepoConfig data RepoConfig = RepoConfig
{ repoDescription :: Text { repoDescription :: Maybe Text
, repoGroup :: RepoGroup , repoGroup :: RepoGroup
, repoSyncable :: Bool , repoSyncable :: Bool
} }
@ -42,7 +42,7 @@ data RepoConfig = RepoConfig
getRepoConfig :: UUID -> Git.Repo -> Annex RepoConfig getRepoConfig :: UUID -> Git.Repo -> Annex RepoConfig
getRepoConfig uuid r = RepoConfig getRepoConfig uuid r = RepoConfig
<$> (T.pack . fromMaybe "" . M.lookup uuid <$> uuidMap) <$> (maybe Nothing (Just . T.pack) . M.lookup uuid <$> uuidMap)
<*> getrepogroup <*> getrepogroup
<*> Config.repoSyncable r <*> Config.repoSyncable r
where where
@ -56,7 +56,7 @@ getRepoConfig uuid r = RepoConfig
- Nothing when it is not changed. -} - Nothing when it is not changed. -}
setRepoConfig :: UUID -> Git.Repo -> RepoConfig -> Annex (Maybe Bool) setRepoConfig :: UUID -> Git.Repo -> RepoConfig -> Annex (Maybe Bool)
setRepoConfig uuid r c = do setRepoConfig uuid r c = do
describeUUID uuid $ T.unpack $ repoDescription c maybe noop (describeUUID uuid . T.unpack) (repoDescription c)
case repoGroup c of case repoGroup c of
RepoGroupStandard g -> setStandardGroup uuid g RepoGroupStandard g -> setStandardGroup uuid g
RepoGroupCustom s -> groupSet uuid $ S.fromList $ words s RepoGroupCustom s -> groupSet uuid $ S.fromList $ words s
@ -71,7 +71,7 @@ setRepoConfig uuid r c = do
editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
editRepositoryAForm def = RepoConfig editRepositoryAForm def = RepoConfig
<$> areq textField "Description" (Just $ repoDescription def) <$> aopt textField "Description" (Just $ repoDescription def)
<*> areq (selectFieldList $ customgroups++standardgroups) "Repository group" (Just $ repoGroup def) <*> areq (selectFieldList $ customgroups++standardgroups) "Repository group" (Just $ repoGroup def)
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def) <*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
where where

6
Assistant/WebApp/Configurators/Local.hs
View file

@ -31,7 +31,6 @@ import Remote (prettyListUUIDs)
import Annex.UUID import Annex.UUID
import Types.StandardGroups import Types.StandardGroups
import Logs.PreferredContent import Logs.PreferredContent
import Logs.UUID
import Yesod import Yesod
import Data.Text (Text) import Data.Text (Text)
@ -195,7 +194,7 @@ getAddDriveR = bootstrap (Just Config) $ do
make mountpoint = do make mountpoint = do
liftIO $ makerepo dir liftIO $ makerepo dir
u <- liftIO $ initRepo dir $ Just remotename u <- liftIO $ initRepo dir $ Just remotename
r <- addremote u dir remotename r <- addremote dir remotename
runAnnex () $ setStandardGroup u TransferGroup runAnnex () $ setStandardGroup u TransferGroup
syncRemote r syncRemote r
return u return u
@ -212,8 +211,7 @@ getAddDriveR = bootstrap (Just Config) $ do
createDirectoryIfMissing True dir createDirectoryIfMissing True dir
makeRepo dir True makeRepo dir True
{- Each repository is made a remote of the other. -} {- Each repository is made a remote of the other. -}
addremote u dir name = runAnnex undefined $ do addremote dir name = runAnnex undefined $ do
describeUUID u name
hostname <- maybe "host" id <$> liftIO getHostname hostname <- maybe "host" id <$> liftIO getHostname
hostlocation <- fromRepo Git.repoLocation hostlocation <- fromRepo Git.repoLocation
liftIO $ inDir dir $ liftIO $ inDir dir $