diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-10-29 00:15:43 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-10-29 00:15:43 -0400 |
| commit | 040f68d628120e112e22bfb7100f9650dec940c8 (patch) | |
| tree | 7b0945f04cb23f09e8f2a77cf1c409cb058af84f /Command/WebApp.hs | |
| parent | 9dd50063b98020add52672864922308ebb479280 (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/WebApp.hs')
| -rw-r--r-- | Command/WebApp.hs | 26 |
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 "" |