summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-31 11:19:40 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-31 11:19:40 -0400
commitb9b009787662cda4948b3c9706b8897587d05d8a (patch)
tree6842d1f714f4e0f1a8cddb556bf9336cf8a7de5c /Assistant
parente9d9d9d5ea36c9d20913470079db9ea8ac0db994 (diff)
tweak types so the webapp can run without a threadstate when outside an annex
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Threads/WebApp.hs2
-rw-r--r--Assistant/WebApp.hs12
-rw-r--r--Assistant/WebApp/Configurators.hs3
-rw-r--r--Assistant/WebApp/DashBoard.hs3
4 files changed, 14 insertions, 6 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index ca81498f4..9cdbae451 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -59,7 +59,7 @@ webAppThread st dstatus transferqueue onstartup = do
token <- genRandomToken
s <- newWebAppState
return $ WebApp
- { threadState = st
+ { threadState = Just st
, daemonStatus = dstatus
, transferQueue = transferqueue
, secretToken = pack token
diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs
index fc40ca5bf..f7fb7bb6e 100644
--- a/Assistant/WebApp.hs
+++ b/Assistant/WebApp.hs
@@ -30,7 +30,7 @@ staticFiles "static"
mkYesodData "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
data WebApp = WebApp
- { threadState :: ThreadState
+ { threadState :: Maybe ThreadState
, daemonStatus :: DaemonStatusHandle
, transferQueue :: TransferQueue
, secretToken :: Text
@@ -104,6 +104,16 @@ modifyWebAppState a = go =<< webAppState <$> getYesod
v <- takeTMVar s
putTMVar s $ a v
+{- Runs an Annex action from the webapp.
+ -
+ - When the webapp is run outside a git-annex repository, the fallback
+ - value is returned.
+ -}
+runAnnex :: forall sub a. a -> Annex a -> GHandler sub WebApp a
+runAnnex fallback a = maybe (return fallback) go =<< threadState <$> getYesod
+ where
+ go st = liftIO $ runThreadState st a
+
waitNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp ()
waitNotifier selector nid = do
notifier <- getNotifier selector
diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs
index 0930741e2..ee3209ce2 100644
--- a/Assistant/WebApp/Configurators.hs
+++ b/Assistant/WebApp/Configurators.hs
@@ -12,7 +12,6 @@ module Assistant.WebApp.Configurators where
import Assistant.Common
import Assistant.WebApp
import Assistant.WebApp.SideBar
-import Assistant.ThreadedMonad
import Utility.Yesod
import qualified Remote
import Logs.Web (webUUID)
@@ -27,7 +26,7 @@ introDisplay :: Text -> Widget
introDisplay ident = do
webapp <- lift getYesod
let reldir = relDir webapp
- l <- liftIO $ runThreadState (threadState webapp) $ do
+ l <- lift $ runAnnex [] $ do
u <- getUUID
rs <- map Remote.uuid <$> Remote.remoteList
rs' <- snd <$> trustPartition DeadTrusted rs
diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs
index f80fb8787..9a9fccdaa 100644
--- a/Assistant/WebApp/DashBoard.hs
+++ b/Assistant/WebApp/DashBoard.hs
@@ -14,7 +14,6 @@ import Assistant.WebApp
import Assistant.WebApp.SideBar
import Assistant.WebApp.Notifications
import Assistant.WebApp.Configurators
-import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.TransferQueue
import Utility.NotificationBroadcaster
@@ -35,7 +34,7 @@ import qualified Data.Map as M
transfersDisplay :: Bool -> Widget
transfersDisplay warnNoScript = do
webapp <- lift getYesod
- current <- liftIO $ runThreadState (threadState webapp) $
+ current <- lift $ runAnnex [] $
M.toList . currentTransfers
<$> liftIO (getDaemonStatus $ daemonStatus webapp)
queued <- liftIO $ getTransferQueue $ transferQueue webapp