summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-29 00:15:43 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-29 00:15:43 -0400
commit040f68d628120e112e22bfb7100f9650dec940c8 (patch)
tree7b0945f04cb23f09e8f2a77cf1c409cb058af84f /Command
parent9dd50063b98020add52672864922308ebb479280 (diff)
Assistant monad, stage 1
This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
Diffstat (limited to 'Command')
-rw-r--r--Command/WebApp.hs26
1 files changed, 11 insertions, 15 deletions
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index 5a372f94d..aff760ee4 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -12,11 +12,6 @@ import Command
import Assistant
import Assistant.Common
import Assistant.DaemonStatus
-import Assistant.ScanRemotes
-import Assistant.TransferQueue
-import Assistant.TransferSlots
-import Assistant.Pushes
-import Assistant.Commits
import Assistant.Threads.WebApp
import Assistant.WebApp
import Assistant.Install
@@ -101,20 +96,21 @@ autoStart autostartfile = do
-}
firstRun :: IO ()
firstRun = do
+ {- Without a repository, we cannot have an Annex monad, so cannot
+ - get a ThreadState. Using undefined is only safe because the
+ - webapp checks its noAnnex field before accessing the
+ - threadstate. -}
+ let st = undefined
+ {- Get a DaemonStatus without running in the Annex monad. -}
dstatus <- atomically . newTMVar =<< newDaemonStatus
- scanremotes <- newScanRemoteMap
- transferqueue <- newTransferQueue
- transferslots <- newTransferSlots
+ d <- newAssistantData st dstatus
urlrenderer <- newUrlRenderer
- pushnotifier <- newPushNotifier
- commitchan <- newCommitChan
v <- newEmptyMVar
let callback a = Just $ a v
- void $ runNamedThread dstatus $
- webAppThread Nothing dstatus scanremotes
- transferqueue transferslots pushnotifier commitchan
- urlrenderer
- (callback signaler) (callback mainthread)
+ void $ flip runAssistant d $ runNamedThread $
+ webAppThread d urlrenderer True
+ (callback signaler)
+ (callback mainthread)
where
signaler v = do
putMVar v ""