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

set/unset annex-sync, rather than annex-ignore

Browse source 
This reserves annex.ignore for repos that should not be visible at all;
repos with syncing disabled are now skipped by the assistant, but are
displayed in the list and can be configured.
This commit is contained in:
Joey Hess 2012-10-11 19:22:29 -04:00
parent 2602c8f877
commit 0b266f970f
4 changed files with 43 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -27,7 +27,7 @@ import Logs.Group
import Logs.PreferredContent
import Logs.Transfer
import Types.StandardGroups
import Config
import qualified Config
import Annex.UUID
import Yesod
@ -42,7 +42,7 @@ data RepoGroup = RepoGroupCustom String | RepoGroupStandard StandardGroup
data RepoConfig = RepoConfig
{ repoDescription :: Text
, repoGroup :: RepoGroup
, repoEnabled :: Bool
, repoSyncable :: Bool
}
deriving (Show)
@ -50,18 +50,16 @@ getRepoConfig :: Remote -> Annex RepoConfig
getRepoConfig r = RepoConfig
<$> (T.pack . fromMaybe "" . M.lookup uuid <$> uuidMap)
<*> getrepogroup
<*> (thisrepo <||> (elem r <$> Remote.enabledRemoteList))
<*> Config.repoSyncable (Remote.repo r)
where
getrepogroup = do
groups <- lookupGroups uuid
return $
maybe (RepoGroupCustom $ unwords $ S.toList groups) RepoGroupStandard
(getStandardGroup groups)
thisrepo = (==) uuid <$> getUUID
uuid = Remote.uuid r
{- Returns Just False if the repository has been disabled,
- or Just True when enabled. -}
{- Returns Just False if syncing has been disabled, or Just True when enabled. -}
setRepoConfig :: Remote -> RepoConfig -> Annex (Maybe Bool)
setRepoConfig r c = do
describeUUID uuid $ T.unpack $ repoDescription c
@ -71,27 +69,27 @@ setRepoConfig r c = do
ifM ((==) uuid <$> getUUID)
( return Nothing
, do
enabled <- elem r <$> Remote.enabledRemoteList
if (enabled /= repoEnabled c)
syncable <- Config.repoSyncable $ Remote.repo r
if (syncable /= repoSyncable c)
then do
setConfig annex_ignore $
if enabled then "true" else "false"
let key = Config.remoteConfig (Remote.repo r) "sync"
Config.setConfig key $
if syncable then "false" else "true"
void $ Remote.remoteListRefresh
return $ Just $ repoEnabled c
return $ Just $ repoSyncable c
else return Nothing
)
where
uuid = Remote.uuid r
annex_ignore = remoteConfig (Remote.repo r) "ignore"
changeEnabled :: Remote -> Bool -> Handler ()
changeEnabled r True = syncRemote r
changeEnabled r False = do
changeSyncable :: Remote -> Bool -> Handler ()
changeSyncable r True = syncRemote r
changeSyncable r False = do
webapp <- getYesod
let dstatus = daemonStatus webapp
let st = fromJust $ threadState webapp
liftIO $ runThreadState st $ updateKnownRemotes dstatus
{- Stop all transfers to or from this disabled remote.
{- Stop all transfers to or from this remote.
- XXX Can't stop any ongoing scan, or git syncs. -}
void $ liftIO $ dequeueTransfers (transferQueue webapp) dstatus tofrom
mapM_ (cancelTransfer False) =<<
@ -104,7 +102,7 @@ editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
editRepositoryAForm def = RepoConfig
<$> areq textField "Description" (Just $ repoDescription def)
<*> areq (selectFieldList $ customgroups++standardgroups) "Repository group" (Just $ repoGroup def)
<*> areq checkBoxField "Syncing enabled" (Just $ repoEnabled def)
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
where
standardgroups :: [(Text, RepoGroup)]
standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g))
@ -132,7 +130,7 @@ editForm new uuid = bootstrap (Just Config) $ do
runFormGet $ renderBootstrap $ editRepositoryAForm curr
case result of
FormSuccess input -> lift $ do
maybe noop (changeEnabled r) =<<
maybe noop (changeSyncable r) =<<
runAnnex undefined (setRepoConfig r input)
redirect RepositoriesR
_ -> showform form enctype curr