Assistant monad, stage 2.5
Converted several threads to run in the monad. Added a lot of useful combinators for working with the monad. Now the monad includes the name of the thread. Some debugging messages are disabled pending converting other threads.
This commit is contained in:
parent
4e765327ca
commit
4dbdc2b666
29 changed files with 299 additions and 280 deletions
|
@ -69,7 +69,7 @@ setRepoConfig uuid mremote oldc newc = do
|
|||
when (repoSyncable oldc /= repoSyncable newc) $
|
||||
changeSyncable mremote (repoSyncable newc)
|
||||
when (isJust mremote && repoName oldc /= repoName newc) $ do
|
||||
dstatus <- getAssistantY daemonStatus
|
||||
dstatus <- getAssistantY daemonStatusHandle
|
||||
runAnnex undefined $ do
|
||||
name <- fromRepo $ uniqueRemoteName (T.unpack $ repoName newc) 0
|
||||
inRepo $ Git.Command.run "remote"
|
||||
|
|
|
@ -87,7 +87,7 @@ getInprogressPairR _ = noPairing
|
|||
-}
|
||||
startPairing :: PairStage -> IO () -> (AlertButton -> Alert) -> Maybe UUID -> Text -> Secret -> Widget
|
||||
startPairing stage oncancel alert muuid displaysecret secret = do
|
||||
dstatus <- lift $ getAssistantY daemonStatus
|
||||
dstatus <- lift $ getAssistantY daemonStatusHandle
|
||||
urlrender <- lift getUrlRender
|
||||
reldir <- fromJust . relDir <$> lift getYesod
|
||||
|
||||
|
|
|
@ -124,5 +124,5 @@ makeS3Remote (S3Creds ak sk) name setup config = do
|
|||
makeSpecialRemote name S3.remote config
|
||||
return remotename
|
||||
setup r
|
||||
liftIO $ syncNewRemote st (daemonStatus d) (scanRemoteMap d) r
|
||||
liftIO $ syncNewRemote st (daemonStatusHandle d) (scanRemoteMap d) r
|
||||
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
|
||||
|
|
|
@ -286,7 +286,7 @@ makeSshRepo forcersync setup sshdata = do
|
|||
d <- getAssistantY id
|
||||
r <- liftIO $ makeSshRemote
|
||||
(threadState d)
|
||||
(daemonStatus d)
|
||||
(daemonStatusHandle d)
|
||||
(scanRemoteMap d)
|
||||
forcersync sshdata
|
||||
setup r
|
||||
|
|
|
@ -34,7 +34,7 @@ import qualified Data.Text as T
|
|||
{- Displays an alert suggesting to configure XMPP, with a button. -}
|
||||
xmppNeeded :: Handler ()
|
||||
xmppNeeded = whenM (isNothing <$> runAnnex Nothing getXMPPCreds) $ do
|
||||
dstatus <- getAssistantY daemonStatus
|
||||
dstatus <- getAssistantY daemonStatusHandle
|
||||
urlrender <- getUrlRender
|
||||
void $ liftIO $ addAlert dstatus $ xmppNeededAlert $ AlertButton
|
||||
{ buttonLabel = "Configure a Jabber account"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue