better liftAnnex, avoid using runAnnex undefined
This commit is contained in:
parent
5274713305
commit
907b0c0d78
15 changed files with 61 additions and 59 deletions
|
@ -11,7 +11,7 @@ import Assistant.Common
|
|||
import Assistant.Pairing
|
||||
import Assistant.Pairing.Network
|
||||
import Assistant.Pairing.MakeRemote
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp (UrlRenderer, renderUrl)
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.Alert
|
||||
import Assistant.DaemonStatus
|
||||
|
|
|
@ -10,7 +10,8 @@
|
|||
module Assistant.WebApp where
|
||||
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.Common
|
||||
import Assistant.Common hiding (liftAnnex)
|
||||
import qualified Assistant.Monad as Assistant
|
||||
import Utility.NotificationBroadcaster
|
||||
import Utility.Yesod
|
||||
|
||||
|
@ -25,9 +26,6 @@ inFirstRun = isNothing . relDir <$> getYesod
|
|||
newWebAppState :: IO (TMVar WebAppState)
|
||||
newWebAppState = atomically $ newTMVar $ WebAppState { showIntro = True }
|
||||
|
||||
liftAssistant :: forall sub a. (Assistant a) -> GHandler sub WebApp a
|
||||
liftAssistant a = liftIO . flip runAssistant a =<< assistantData <$> getYesod
|
||||
|
||||
getWebAppState :: forall sub. GHandler sub WebApp WebAppState
|
||||
getWebAppState = liftIO . atomically . readTMVar =<< webAppState <$> getYesod
|
||||
|
||||
|
@ -43,12 +41,18 @@ modifyWebAppState a = go =<< webAppState <$> getYesod
|
|||
- When the webapp is run outside a git-annex repository, the fallback
|
||||
- value is returned.
|
||||
-}
|
||||
runAnnex :: forall sub a. a -> Annex a -> GHandler sub WebApp a
|
||||
runAnnex fallback a = ifM (noAnnex <$> getYesod)
|
||||
liftAnnexOr :: forall sub a. a -> Annex a -> GHandler sub WebApp a
|
||||
liftAnnexOr fallback a = ifM (noAnnex <$> getYesod)
|
||||
( return fallback
|
||||
, liftAssistant $ liftAnnex a
|
||||
, liftAssistant $ Assistant.liftAnnex a
|
||||
)
|
||||
|
||||
liftAnnex :: forall sub a. Annex a -> GHandler sub WebApp a
|
||||
liftAnnex = liftAnnexOr $ error "internal runAnnex"
|
||||
|
||||
liftAssistant :: forall sub a. (Assistant a) -> GHandler sub WebApp a
|
||||
liftAssistant a = liftIO . flip runAssistant a =<< assistantData <$> getYesod
|
||||
|
||||
waitNotifier :: forall sub. (Assistant NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp ()
|
||||
waitNotifier getbroadcaster nid = liftAssistant $ do
|
||||
b <- getbroadcaster
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Assistant.WebApp.Common (module X) where
|
||||
|
||||
import Assistant.Common as X
|
||||
import Assistant.Common as X hiding (liftAnnex)
|
||||
import Assistant.WebApp as X
|
||||
import Assistant.WebApp.Page as X
|
||||
import Assistant.WebApp.Form as X
|
||||
|
|
|
@ -33,7 +33,7 @@ getConfigurationR = ifM (inFirstRun)
|
|||
( getFirstRepositoryR
|
||||
, page "Configuration" (Just Configuration) $ do
|
||||
#ifdef WITH_XMPP
|
||||
xmppconfigured <- lift $ runAnnex False $ isJust <$> getXMPPCreds
|
||||
xmppconfigured <- lift $ liftAnnex $ isJust <$> getXMPPCreds
|
||||
#else
|
||||
let xmppconfigured = False
|
||||
#endif
|
||||
|
@ -136,7 +136,7 @@ repoList reposelector
|
|||
configured = do
|
||||
rs <- filter wantedrepo . syncRemotes
|
||||
<$> liftAssistant getDaemonStatus
|
||||
runAnnex [] $ do
|
||||
liftAnnex $ do
|
||||
let us = map Remote.uuid rs
|
||||
let l = zip us $ map mkSyncingRepoActions us
|
||||
if includeHere reposelector
|
||||
|
@ -149,7 +149,7 @@ repoList reposelector
|
|||
let here = (u, hereactions)
|
||||
return $ here : l
|
||||
else return l
|
||||
rest = runAnnex [] $ do
|
||||
rest = liftAnnex $ do
|
||||
m <- readRemoteLog
|
||||
unconfigured <- map snd . catMaybes . filter wantedremote
|
||||
. map (findinfo m)
|
||||
|
@ -181,7 +181,7 @@ repoList reposelector
|
|||
_ -> Nothing
|
||||
where
|
||||
val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
|
||||
list l = runAnnex [] $ do
|
||||
list l = liftAnnex $ do
|
||||
let l' = nubBy (\x y -> fst x == fst y) l
|
||||
zip3
|
||||
<$> pure counter
|
||||
|
@ -197,6 +197,6 @@ getDisableSyncR = flipSync False
|
|||
|
||||
flipSync :: Bool -> UUID -> Handler ()
|
||||
flipSync enable uuid = do
|
||||
mremote <- runAnnex undefined $ Remote.remoteFromUUID uuid
|
||||
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
|
||||
changeSyncable mremote enable
|
||||
redirect RepositoriesR
|
||||
|
|
|
@ -123,7 +123,7 @@ getAddS3R = awsConfigurator $ do
|
|||
]
|
||||
_ -> $(widgetFile "configurators/adds3")
|
||||
where
|
||||
setgroup r = runAnnex () $
|
||||
setgroup r = liftAnnex $
|
||||
setStandardGroup (Remote.uuid r) TransferGroup
|
||||
#else
|
||||
getAddS3R = error "S3 not supported by this build"
|
||||
|
@ -143,7 +143,7 @@ getAddGlacierR = glacierConfigurator $ do
|
|||
]
|
||||
_ -> $(widgetFile "configurators/addglacier")
|
||||
where
|
||||
setgroup r = runAnnex () $
|
||||
setgroup r = liftAnnex $
|
||||
setStandardGroup (Remote.uuid r) SmallArchiveGroup
|
||||
|
||||
getEnableS3R :: UUID -> Handler RepHtml
|
||||
|
@ -162,20 +162,20 @@ enableAWSRemote remotetype uuid = do
|
|||
runFormGet $ renderBootstrap awsCredsAForm
|
||||
case result of
|
||||
FormSuccess creds -> lift $ do
|
||||
m <- runAnnex M.empty readRemoteLog
|
||||
m <- liftAnnex readRemoteLog
|
||||
let name = fromJust $ M.lookup "name" $
|
||||
fromJust $ M.lookup uuid m
|
||||
makeAWSRemote remotetype creds name (const noop) M.empty
|
||||
_ -> do
|
||||
description <- lift $ runAnnex "" $
|
||||
description <- lift $ liftAnnex $
|
||||
T.pack . concat <$> Remote.prettyListUUIDs [uuid]
|
||||
$(widgetFile "configurators/enableaws")
|
||||
|
||||
makeAWSRemote :: RemoteType -> AWSCreds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
|
||||
makeAWSRemote remotetype (AWSCreds ak sk) name setup config = do
|
||||
remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
|
||||
remotename <- liftAnnex $ fromRepo $ uniqueRemoteName name 0
|
||||
liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)
|
||||
r <- liftAssistant $ liftAnnex $ addRemote $ do
|
||||
r <- liftAnnex $ addRemote $ do
|
||||
makeSpecialRemote hostname remotetype config
|
||||
return remotename
|
||||
setup r
|
||||
|
|
|
@ -60,17 +60,17 @@ getRepoConfig uuid mremote = RepoConfig
|
|||
|
||||
setRepoConfig :: UUID -> Maybe Remote -> RepoConfig -> RepoConfig -> Handler ()
|
||||
setRepoConfig uuid mremote oldc newc = do
|
||||
when (repoDescription oldc /= repoDescription newc) $ runAnnex undefined $ do
|
||||
when (repoDescription oldc /= repoDescription newc) $ liftAnnex $ do
|
||||
maybe noop (describeUUID uuid . T.unpack) (repoDescription newc)
|
||||
void uuidMapLoad
|
||||
when (repoGroup oldc /= repoGroup newc) $ runAnnex undefined $
|
||||
when (repoGroup oldc /= repoGroup newc) $ liftAnnex $
|
||||
case repoGroup newc of
|
||||
RepoGroupStandard g -> setStandardGroup uuid g
|
||||
RepoGroupCustom s -> groupSet uuid $ S.fromList $ words s
|
||||
when (repoSyncable oldc /= repoSyncable newc) $
|
||||
changeSyncable mremote (repoSyncable newc)
|
||||
when (isJust mremote && makeLegalName (T.unpack $ repoName oldc) /= makeLegalName (T.unpack $ repoName newc)) $ do
|
||||
runAnnex undefined $ do
|
||||
liftAnnex $ do
|
||||
name <- fromRepo $ uniqueRemoteName (T.unpack $ repoName newc) 0
|
||||
{- git remote rename expects there to be a
|
||||
- remote.<name>.fetch, and exits nonzero if
|
||||
|
@ -119,8 +119,8 @@ getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
|
|||
|
||||
editForm :: Bool -> UUID -> Handler RepHtml
|
||||
editForm new uuid = page "Configure repository" (Just Configuration) $ do
|
||||
mremote <- lift $ runAnnex undefined $ Remote.remoteFromUUID uuid
|
||||
curr <- lift $ runAnnex undefined $ getRepoConfig uuid mremote
|
||||
mremote <- lift $ liftAnnex $ Remote.remoteFromUUID uuid
|
||||
curr <- lift $ liftAnnex $ getRepoConfig uuid mremote
|
||||
lift $ checkarchivedirectory curr
|
||||
((result, form), enctype) <- lift $
|
||||
runFormGet $ renderBootstrap $ editRepositoryAForm curr
|
||||
|
@ -145,6 +145,6 @@ editForm new uuid = page "Configure repository" (Just Configuration) $ do
|
|||
| repoGroup cfg == RepoGroupStandard FullArchiveGroup = go
|
||||
| otherwise = noop
|
||||
where
|
||||
go = runAnnex undefined $ inRepo $ \g ->
|
||||
go = liftAnnex $ inRepo $ \g ->
|
||||
createDirectoryIfMissing True $
|
||||
Git.repoPath g </> "archive"
|
||||
|
|
|
@ -153,7 +153,7 @@ getNewRepositoryR = page "Add another repository" (Just Configuration) $ do
|
|||
let path = T.unpack p
|
||||
liftIO $ makeRepo path False
|
||||
u <- liftIO $ initRepo True path Nothing
|
||||
lift $ runAnnex () $ setStandardGroup u ClientGroup
|
||||
lift $ liftAnnexOr () $ setStandardGroup u ClientGroup
|
||||
liftIO $ addAutoStartFile path
|
||||
liftIO $ startAssistant path
|
||||
askcombine u path
|
||||
|
@ -211,7 +211,7 @@ getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
|
|||
liftIO $ makerepo dir
|
||||
u <- liftIO $ initRepo False dir $ Just remotename
|
||||
r <- combineRepos dir remotename
|
||||
runAnnex () $ setStandardGroup u TransferGroup
|
||||
liftAnnex $ setStandardGroup u TransferGroup
|
||||
syncRemote r
|
||||
return u
|
||||
where
|
||||
|
@ -230,7 +230,7 @@ getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
|
|||
{- Each repository is made a remote of the other.
|
||||
- Next call syncRemote to get them in sync. -}
|
||||
combineRepos :: FilePath -> String -> Handler Remote
|
||||
combineRepos dir name = runAnnex undefined $ do
|
||||
combineRepos dir name = liftAnnex $ do
|
||||
hostname <- maybe "host" id <$> liftIO getHostname
|
||||
hostlocation <- fromRepo Git.repoLocation
|
||||
liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
|
||||
|
@ -238,7 +238,7 @@ combineRepos dir name = runAnnex undefined $ do
|
|||
|
||||
getEnableDirectoryR :: UUID -> Handler RepHtml
|
||||
getEnableDirectoryR uuid = page "Enable a repository" (Just Configuration) $ do
|
||||
description <- lift $ runAnnex "" $
|
||||
description <- lift $ liftAnnex $
|
||||
T.pack . concat <$> prettyListUUIDs [uuid]
|
||||
$(widgetFile "configurators/enabledirectory")
|
||||
|
||||
|
|
|
@ -51,7 +51,7 @@ import qualified Data.Set as S
|
|||
|
||||
getStartXMPPPairR :: Handler RepHtml
|
||||
#ifdef WITH_XMPP
|
||||
getStartXMPPPairR = ifM (isJust <$> runAnnex Nothing getXMPPCreds)
|
||||
getStartXMPPPairR = ifM (isJust <$> liftAnnex getXMPPCreds)
|
||||
( do
|
||||
{- Ask buddies to send presence info, to get
|
||||
- the buddy list populated. -}
|
||||
|
@ -76,13 +76,12 @@ getRunningXMPPPairR bid = do
|
|||
go $ S.toList . buddyAssistants <$> buddy
|
||||
where
|
||||
go (Just (clients@((Client exemplar):_))) = do
|
||||
creds <- runAnnex Nothing getXMPPCreds
|
||||
creds <- liftAnnex getXMPPCreds
|
||||
let ourjid = fromJust $ parseJID =<< xmppJID <$> creds
|
||||
let samejid = baseJID ourjid == baseJID exemplar
|
||||
liftAssistant $ do
|
||||
u <- liftAnnex getUUID
|
||||
forM_ clients $ \(Client c) -> sendNetMessage $
|
||||
PairingNotification PairReq (formatJID c) u
|
||||
u <- liftAnnex getUUID
|
||||
liftAssistant $ forM_ clients $ \(Client c) -> sendNetMessage $
|
||||
PairingNotification PairReq (formatJID c) u
|
||||
xmppPairEnd True $ if samejid then Nothing else Just exemplar
|
||||
-- A buddy could have logged out, or the XMPP client restarted,
|
||||
-- and there be no clients to message; handle unforseen by going back.
|
||||
|
@ -109,7 +108,7 @@ noLocalPairing = noPairing "local"
|
|||
getFinishLocalPairR :: PairMsg -> Handler RepHtml
|
||||
#ifdef WITH_PAIRING
|
||||
getFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do
|
||||
repodir <- lift $ repoPath <$> runAnnex undefined gitRepo
|
||||
repodir <- lift $ repoPath <$> liftAnnex gitRepo
|
||||
liftIO $ setup repodir
|
||||
startLocalPairing PairAck (cleanup repodir) alert uuid "" secret
|
||||
where
|
||||
|
@ -138,8 +137,8 @@ getFinishXMPPPairR :: PairKey -> Handler RepHtml
|
|||
getFinishXMPPPairR (PairKey theiruuid t) = case parseJID t of
|
||||
Nothing -> error "bad JID"
|
||||
Just theirjid -> do
|
||||
selfuuid <- liftAnnex getUUID
|
||||
liftAssistant $ do
|
||||
selfuuid <- liftAnnex getUUID
|
||||
sendNetMessage $
|
||||
PairingNotification PairAck (formatJID theirjid) selfuuid
|
||||
finishXMPPPairing theirjid theiruuid
|
||||
|
|
|
@ -84,11 +84,11 @@ storePrefs p = do
|
|||
getPreferencesR :: Handler RepHtml
|
||||
getPreferencesR = page "Preferences" (Just Configuration) $ do
|
||||
((result, form), enctype) <- lift $ do
|
||||
current <- runAnnex undefined getPrefs
|
||||
current <- liftAnnex getPrefs
|
||||
runFormGet $ renderBootstrap $ prefsAForm current
|
||||
case result of
|
||||
FormSuccess new -> lift $ do
|
||||
runAnnex undefined $ storePrefs new
|
||||
liftAnnex $ storePrefs new
|
||||
redirect ConfigurationR
|
||||
_ -> $(widgetFile "configurators/preferences")
|
||||
|
||||
|
|
|
@ -114,7 +114,7 @@ getAddSshR = sshConfigurator $ do
|
|||
-}
|
||||
getEnableRsyncR :: UUID -> Handler RepHtml
|
||||
getEnableRsyncR u = do
|
||||
m <- fromMaybe M.empty . M.lookup u <$> runAnnex M.empty readRemoteLog
|
||||
m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog
|
||||
case (parseSshRsyncUrl =<< M.lookup "rsyncurl" m, M.lookup "name" m) of
|
||||
(Just sshinput, Just reponame) -> sshConfigurator $ do
|
||||
((result, form), enctype) <- lift $
|
||||
|
@ -133,7 +133,7 @@ getEnableRsyncR u = do
|
|||
_ -> redirect AddSshR
|
||||
where
|
||||
showform form enctype status = do
|
||||
description <- lift $ runAnnex "" $
|
||||
description <- lift $ liftAnnex $
|
||||
T.pack . concat <$> prettyListUUIDs [u]
|
||||
$(widgetFile "configurators/ssh/enable")
|
||||
enable sshdata = lift $ redirect $ ConfirmSshR $
|
||||
|
@ -350,4 +350,4 @@ isRsyncNet Nothing = False
|
|||
isRsyncNet (Just host) = ".rsync.net" `T.isSuffixOf` T.toLower host
|
||||
|
||||
setupGroup :: Remote -> Handler ()
|
||||
setupGroup r = runAnnex () $ setStandardGroup (Remote.uuid r) TransferGroup
|
||||
setupGroup r = liftAnnex $ setStandardGroup (Remote.uuid r) TransferGroup
|
||||
|
|
|
@ -77,7 +77,7 @@ getAddBoxComR = boxConfigurator $ do
|
|||
]
|
||||
_ -> $(widgetFile "configurators/addbox.com")
|
||||
where
|
||||
setgroup r = runAnnex () $
|
||||
setgroup r = liftAnnex $
|
||||
setStandardGroup (Remote.uuid r) TransferGroup
|
||||
#else
|
||||
getAddBoxComR = error "WebDAV not supported by this build"
|
||||
|
@ -86,11 +86,11 @@ getAddBoxComR = error "WebDAV not supported by this build"
|
|||
getEnableWebDAVR :: UUID -> Handler RepHtml
|
||||
#ifdef WITH_WEBDAV
|
||||
getEnableWebDAVR uuid = do
|
||||
m <- runAnnex M.empty readRemoteLog
|
||||
m <- liftAnnex readRemoteLog
|
||||
let c = fromJust $ M.lookup uuid m
|
||||
let name = fromJust $ M.lookup "name" c
|
||||
let url = fromJust $ M.lookup "url" c
|
||||
mcreds <- runAnnex Nothing $
|
||||
mcreds <- liftAnnex $
|
||||
getRemoteCredPairFor "webdav" c (WebDAV.davCreds uuid)
|
||||
case mcreds of
|
||||
Just creds -> webDAVConfigurator $ lift $
|
||||
|
@ -108,7 +108,7 @@ getEnableWebDAVR uuid = do
|
|||
FormSuccess input -> lift $
|
||||
makeWebDavRemote name (toCredPair input) (const noop) M.empty
|
||||
_ -> do
|
||||
description <- lift $ runAnnex "" $
|
||||
description <- lift $ liftAnnex $
|
||||
T.pack . concat <$> Remote.prettyListUUIDs [uuid]
|
||||
$(widgetFile "configurators/enablewebdav")
|
||||
#else
|
||||
|
@ -118,9 +118,9 @@ getEnableWebDAVR _ = error "WebDAV not supported by this build"
|
|||
#ifdef WITH_WEBDAV
|
||||
makeWebDavRemote :: String -> CredPair -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
|
||||
makeWebDavRemote name creds setup config = do
|
||||
remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
|
||||
remotename <- liftAnnex $ fromRepo $ uniqueRemoteName name 0
|
||||
liftIO $ WebDAV.setCredsEnv creds
|
||||
r <- liftAssistant $ liftAnnex $ addRemote $ do
|
||||
r <- liftAnnex $ addRemote $ do
|
||||
makeSpecialRemote name WebDAV.remote config
|
||||
return remotename
|
||||
setup r
|
||||
|
|
|
@ -33,7 +33,7 @@ import Control.Exception (SomeException)
|
|||
{- Displays an alert suggesting to configure XMPP, with a button. -}
|
||||
xmppNeeded :: Handler ()
|
||||
#ifdef WITH_XMPP
|
||||
xmppNeeded = whenM (isNothing <$> runAnnex Nothing getXMPPCreds) $ do
|
||||
xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do
|
||||
urlrender <- getUrlRender
|
||||
void $ liftAssistant $ do
|
||||
close <- asIO1 removeAlert
|
||||
|
@ -50,7 +50,7 @@ xmppNeeded = return ()
|
|||
getXMPPR :: Handler RepHtml
|
||||
getXMPPR = xmppPage $ do
|
||||
((result, form), enctype) <- lift $ do
|
||||
oldcreds <- runAnnex Nothing getXMPPCreds
|
||||
oldcreds <- liftAnnex getXMPPCreds
|
||||
runFormGet $ renderBootstrap $ xmppAForm $
|
||||
creds2Form <$> oldcreds
|
||||
let showform problem = $(widgetFile "configurators/xmpp")
|
||||
|
@ -60,7 +60,7 @@ getXMPPR = xmppPage $ do
|
|||
_ -> showform Nothing
|
||||
where
|
||||
storecreds creds = do
|
||||
void $ runAnnex undefined $ setXMPPCreds creds
|
||||
void $ liftAnnex $ setXMPPCreds creds
|
||||
liftAssistant notifyNetMessagerRestart
|
||||
redirect StartXMPPPairR
|
||||
#else
|
||||
|
|
|
@ -52,7 +52,7 @@ getRestartThreadR name = do
|
|||
|
||||
getLogR :: Handler RepHtml
|
||||
getLogR = page "Logs" Nothing $ do
|
||||
logfile <- lift $ runAnnex undefined $ fromRepo gitAnnexLogFile
|
||||
logfile <- lift $ liftAnnex $ fromRepo gitAnnexLogFile
|
||||
logs <- liftIO $ listLogs logfile
|
||||
logcontent <- liftIO $ concat <$> mapM readFile logs
|
||||
$(widgetFile "control/log")
|
||||
|
|
|
@ -117,8 +117,7 @@ getFileBrowserR = whenM openFileBrowser $ redirectBack
|
|||
- blocking the response to the browser on it. -}
|
||||
openFileBrowser :: Handler Bool
|
||||
openFileBrowser = do
|
||||
path <- runAnnex (error "no configured repository") $
|
||||
fromRepo Git.repoPath
|
||||
path <- liftAnnex $ fromRepo Git.repoPath
|
||||
ifM (liftIO $ inPath cmd <&&> inPath cmd)
|
||||
( do
|
||||
void $ liftIO $ forkIO $ void $
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Assistant.WebApp.Utility where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.Common hiding (liftAnnex)
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.DaemonStatus
|
||||
|
@ -34,10 +34,10 @@ import System.Posix.Process (getProcessGroupIDOf)
|
|||
{- Use Nothing to change autocommit setting; or a remote to change
|
||||
- its sync setting. -}
|
||||
changeSyncable :: (Maybe Remote) -> Bool -> Handler ()
|
||||
changeSyncable Nothing enable = liftAssistant $ do
|
||||
changeSyncable Nothing enable = do
|
||||
liftAnnex $ Config.setConfig key (boolConfig enable)
|
||||
liftIO . maybe noop (`throwTo` signal)
|
||||
=<< namedThreadId watchThread
|
||||
=<< liftAssistant (namedThreadId watchThread)
|
||||
where
|
||||
key = Config.annexConfig "autocommit"
|
||||
signal
|
||||
|
@ -59,7 +59,7 @@ changeSyncable (Just r) False = do
|
|||
tofrom t = transferUUID t == Remote.uuid r
|
||||
|
||||
changeSyncFlag :: Remote -> Bool -> Handler ()
|
||||
changeSyncFlag r enabled = runAnnex undefined $ do
|
||||
changeSyncFlag r enabled = liftAnnex $ do
|
||||
Config.setConfig key (boolConfig enabled)
|
||||
void $ Remote.remoteListRefresh
|
||||
where
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue