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 /Assistant.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 'Assistant.hs')
-rw-r--r-- | Assistant.hs | 46 |
1 files changed, 22 insertions, 24 deletions
diff --git a/Assistant.hs b/Assistant.hs index ade4621e5..bdca20fef 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -120,13 +120,6 @@ module Assistant where import Assistant.Common import Assistant.ThreadedMonad import Assistant.DaemonStatus -import Assistant.Changes -import Assistant.Commits -import Assistant.Pushes -import Assistant.ScanRemotes -import Assistant.BranchChange -import Assistant.TransferQueue -import Assistant.TransferSlots import Assistant.Threads.DaemonStatus import Assistant.Threads.Watcher import Assistant.Threads.Committer @@ -180,24 +173,28 @@ startAssistant :: Bool -> (IO () -> IO ()) -> Maybe (String -> FilePath -> IO () startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do checkCanWatch dstatus <- startDaemonStatus - liftIO $ daemonize $ run dstatus st + liftIO $ daemonize $ + runAssistant go =<< newAssistantData st dstatus where - run dstatus st = do - changechan <- newChangeChan - commitchan <- newCommitChan - pushmap <- newFailedPushMap - transferqueue <- newTransferQueue - transferslots <- newTransferSlots - scanremotes <- newScanRemoteMap - branchhandle <- newBranchChangeHandle - pushnotifier <- newPushNotifier + go = do + d <- getAssistant id + st <- getAssistant threadState + dstatus <- getAssistant daemonStatus + changechan <- getAssistant changeChan + commitchan <- getAssistant commitChan + pushmap <- getAssistant failedPushMap + transferqueue <- getAssistant transferQueue + transferslots <- getAssistant transferSlots + scanremotes <- getAssistant scanRemoteMap + branchhandle <- getAssistant branchChangeHandle + pushnotifier <- getAssistant pushNotifier #ifdef WITH_WEBAPP - urlrenderer <- newUrlRenderer + urlrenderer <- liftIO $ newUrlRenderer #endif - mapM_ (startthread dstatus) + mapM_ (startthread d) [ watch $ commitThread st changechan commitchan transferqueue dstatus #ifdef WITH_WEBAPP - , assist $ webAppThread (Just st) dstatus scanremotes transferqueue transferslots pushnotifier commitchan urlrenderer Nothing webappwaiter + , assist $ webAppThread d urlrenderer False Nothing webappwaiter #ifdef WITH_PAIRING , assist $ pairListenerThread st dstatus scanremotes urlrenderer #endif @@ -220,11 +217,12 @@ startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do #endif , watch $ watchThread st dstatus transferqueue changechan ] - waitForTermination + liftIO waitForTermination watch a = (True, a) assist a = (False, a) - startthread dstatus (watcher, t) - | watcher || assistant = void $ forkIO $ - runNamedThread dstatus t + startthread d (watcher, t) + | watcher || assistant = void $ liftIO $ forkIO $ + flip runAssistant d $ + runNamedThread t | otherwise = noop |