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

implement saving of repository settings

Browse source
This commit is contained in:
Joey Hess 2012-10-10 19:13:49 -04:00
parent 13cf60f0f7
commit 7aef34f501
2 changed files with 23 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -17,6 +17,7 @@ import Utility.Yesod
import qualified Remote import qualified Remote
import Logs.UUID import Logs.UUID
import Logs.Group import Logs.Group
import Logs.PreferredContent
import Types.StandardGroups import Types.StandardGroups
import Yesod import Yesod
@ -34,6 +35,24 @@ data RepoConfig = RepoConfig
} }
deriving (Show) deriving (Show)
getRepoConfig :: UUID -> Annex RepoConfig
getRepoConfig uuid = RepoConfig
<$> (T.pack . fromMaybe "" . M.lookup uuid <$> uuidMap)
<*> getrepogroup
where
getrepogroup = do
groups <- lookupGroups uuid
return $
maybe (RepoGroupCustom $ unwords $ S.toList groups) RepoGroupStandard
(getStandardGroup groups)
setRepoConfig :: UUID -> RepoConfig -> Annex ()
setRepoConfig uuid c = do
describeUUID uuid $ T.unpack $ repoDescription c
case repoGroup c of
RepoGroupStandard g -> setStandardGroup uuid g
RepoGroupCustom s -> groupSet uuid $ S.fromList $ words s
editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
editRepositoryAForm def = RepoConfig editRepositoryAForm def = RepoConfig
<$> areq textField "Description" (Just $ repoDescription def) <$> areq textField "Description" (Just $ repoDescription def)
@ -47,17 +66,6 @@ editRepositoryAForm def = RepoConfig
RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)] RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]
_ -> [] _ -> []
getRepoConfig :: UUID -> Annex RepoConfig
getRepoConfig uuid = RepoConfig
<$> (T.pack . fromMaybe "" . M.lookup uuid <$> uuidMap)
<*> getrepogroup
where
getrepogroup = do
groups <- lookupGroups uuid
return $
maybe (RepoGroupCustom $ unwords $ S.toList groups) RepoGroupStandard
(getStandardGroup groups)
getEditRepositoryR :: UUID -> Handler RepHtml getEditRepositoryR :: UUID -> Handler RepHtml
getEditRepositoryR uuid = bootstrap (Just Config) $ do getEditRepositoryR uuid = bootstrap (Just Config) $ do
sideBarDisplay sideBarDisplay
@ -67,8 +75,9 @@ getEditRepositoryR uuid = bootstrap (Just Config) $ do
((result, form), enctype) <- lift $ ((result, form), enctype) <- lift $
runFormGet $ renderBootstrap $ editRepositoryAForm curr runFormGet $ renderBootstrap $ editRepositoryAForm curr
case result of case result of
FormSuccess input -> do FormSuccess input -> lift $ do
error (show input) runAnnex undefined $ setRepoConfig uuid input
redirect RepositoriesR
_ -> showform form enctype _ -> showform form enctype
where where
showform form enctype = do showform form enctype = do

2
Logs/Group.hs
View file

@ -10,7 +10,7 @@ module Logs.Group (
groupSet, groupSet,
lookupGroups, lookupGroups,
groupMap, groupMap,
getStandardGroup getStandardGroup,
) where ) where
import qualified Data.Map as M import qualified Data.Map as M