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

webapp: put new repos in standard groups

Browse source 
I'm using transfer for most things, both removable drives and cloud
storage, because it's the safest choice. We'll see if it makes sense
to prompt for the group when setting this up, or let the user pick
something else after the fact.
This commit is contained in:
Joey Hess 2012-10-10 15:27:25 -04:00
parent f9b81c7a75
commit 3490977d97
5 changed files with 18 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -28,13 +28,12 @@ import Utility.DiskFree
import Utility.DataUnits
import Utility.Network
import Remote (prettyListUUIDs)
import Logs.Group
import Annex.UUID
import Annex.StandardGroups
import Yesod
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Set as S
import Data.Char
import System.Posix.Directory
import qualified Control.Exception as E
@ -147,7 +146,7 @@ getNewRepositoryR = bootstrap (Just Config) $ do
let path = T.unpack p
liftIO $ makeRepo path False
u <- liftIO $ initRepo path Nothing
runAnnex () $ groupSet u (S.singleton "clients")
runAnnex () $ setStandardGroup u ClientGroup
liftIO $ addAutoStart path
redirect $ SwitchToRepositoryR path
_ -> $(widgetFile "configurators/newrepository")
@ -196,7 +195,7 @@ getAddDriveR = bootstrap (Just Config) $ do
liftIO $ makerepo dir
u <- liftIO $ initRepo dir $ Just remotename
r <- addremote dir remotename
runAnnex () $ groupSet u (S.singleton "drives")
runAnnex () $ setStandardGroup u TransferGroup
syncRemote r
where
dir = mountpoint </> gitAnnexAssistantDefaultDir
@ -266,7 +265,7 @@ startFullAssistant path = do
webapp <- getYesod
liftIO $ makeRepo path False
u <- liftIO $ initRepo path Nothing
runAnnex () $ groupSet u (S.singleton "clients")
runAnnex () $ setStandardGroup u ClientGroup
url <- liftIO $ do
addAutoStart path
changeWorkingDirectory path