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.
This commit is contained in:
Joey Hess 2012-10-29 00:15:43 -04:00
parent ec0bac9d73
commit 4e765327ca
18 changed files with 259 additions and 210 deletions

View file

@ -72,6 +72,12 @@ newWebAppState = do
{ showIntro = True
, otherRepos = otherrepos }
getAssistantY :: forall sub a. (AssistantData -> a) -> GHandler sub WebApp a
getAssistantY f = f <$> (assistantData <$> getYesod)
getDaemonStatusY :: forall sub. GHandler sub WebApp DaemonStatus
getDaemonStatusY = liftIO . getDaemonStatus =<< getAssistantY daemonStatus
getWebAppState :: forall sub. GHandler sub WebApp WebAppState
getWebAppState = liftIO . atomically . readTMVar =<< webAppState <$> getYesod
@ -88,7 +94,10 @@ modifyWebAppState a = go =<< webAppState <$> getYesod
- value is returned.
-}
runAnnex :: forall sub a. a -> Annex a -> GHandler sub WebApp a
runAnnex fallback a = maybe (return fallback) go =<< threadState <$> getYesod
runAnnex fallback a = ifM (noAnnex <$> getYesod)
( return fallback
, go =<< getAssistantY threadState
)
where
go st = liftIO $ runThreadState st a
@ -103,9 +112,7 @@ newNotifier selector = do
liftIO $ notificationHandleToId <$> newNotificationHandle notifier
getNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> GHandler sub WebApp NotificationBroadcaster
getNotifier selector = do
webapp <- getYesod
liftIO $ selector <$> getDaemonStatus (daemonStatus webapp)
getNotifier selector = selector <$> getDaemonStatusY
{- Adds the auth parameter as a hidden field on a form. Must be put into
- every form. -}