aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-04-03 17:44:34 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-04-03 17:48:54 -0400
commit72b25b61e9c91668e0c05a17c50462b822885eb8 (patch)
tree73a82d2033d792c0a216ce6c0e45bd1fa126b8ff
parentf768f16999d997077be98c0d8eabd3d85fd8caa5 (diff)
clean up urlrenderer handling when the webapp is not built
-rw-r--r--Assistant.hs12
-rw-r--r--Assistant/DeleteRemote.hs9
-rw-r--r--Assistant/NamedThread.hs27
-rw-r--r--Assistant/Threads/TransferScanner.hs2
-rw-r--r--Assistant/Types/UrlRenderer.hs26
-rw-r--r--Command/WebApp.hs2
-rw-r--r--Limit.hs4
7 files changed, 55 insertions, 27 deletions
diff --git a/Assistant.hs b/Assistant.hs
index ba2916fbf..a436070b3 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -154,6 +154,7 @@ import Assistant.Threads.XMPPClient
#warning Building without the webapp. You probably need to install Yesod..
#endif
import Assistant.Environment
+import Assistant.Types.UrlRenderer
import qualified Utility.Daemon
import Utility.LogFile
import Utility.ThreadScheduler
@@ -205,15 +206,16 @@ startDaemon assistant foreground startbrowser = do
flip runAssistant (go webappwaiter)
=<< newAssistantData st dstatus
- go webappwaiter = do
- notice ["starting", desc, "version", SysConfig.packageversion]
+
#ifdef WITH_WEBAPP
+ go webappwaiter = do
d <- getAssistant id
- urlrenderer <- liftIO newUrlRenderer
- mapM_ (startthread $ Just urlrenderer)
#else
- mapM_ (startthread Nothing)
+ go _webappwaiter = do
#endif
+ notice ["starting", desc, "version", SysConfig.packageversion]
+ urlrenderer <- liftIO newUrlRenderer
+ mapM_ (startthread urlrenderer)
[ watch $ commitThread
#ifdef WITH_WEBAPP
, assist $ webAppThread d urlrenderer False Nothing webappwaiter
diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs
index 59aff57fe..a23eeaa8e 100644
--- a/Assistant/DeleteRemote.hs
+++ b/Assistant/DeleteRemote.hs
@@ -5,13 +5,18 @@
- Licensed under the GNU GPL version 3 or higher.
-}
+{-# LANGUAGE CPP #-}
+
module Assistant.DeleteRemote where
import Assistant.Common
-import Assistant.WebApp
+#ifdef WITH_WEBAPP
import Assistant.WebApp.Types
+import Assistant.WebApp
+#endif
import Assistant.Alert
import Assistant.DaemonStatus
+import Assistant.Types.UrlRenderer
import qualified Remote
import Remote.List
import qualified Git.Command
@@ -42,6 +47,7 @@ finishRemovingRemote urlrenderer uuid = do
void $ removeRemote uuid
liftAnnex $ trustSet uuid DeadTrusted
+#ifdef WITH_WEBAPP
desc <- liftAnnex $ Remote.prettyUUID uuid
url <- liftIO $ renderUrl urlrenderer (FinishedDeletingRepositoryContentsR uuid) []
close <- asIO1 removeAlert
@@ -50,3 +56,4 @@ finishRemovingRemote urlrenderer uuid = do
, buttonUrl = url
, buttonAction = Just close
}
+#endif
diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs
index 33af2c304..1d291ba74 100644
--- a/Assistant/NamedThread.hs
+++ b/Assistant/NamedThread.hs
@@ -13,6 +13,7 @@ import Common.Annex
import Assistant.Types.NamedThread
import Assistant.Types.ThreadName
import Assistant.Types.DaemonStatus
+import Assistant.Types.UrlRenderer
import Assistant.DaemonStatus
import Assistant.Monad
@@ -32,13 +33,8 @@ import qualified Data.Text as T
-
- Named threads are run by a management thread, so if they crash
- an alert is displayed, allowing the thread to be restarted. -}
-#ifdef WITH_WEBAPP
-startNamedThread :: Maybe UrlRenderer -> NamedThread -> Assistant ()
-startNamedThread urlrenderer namedthread@(NamedThread name a) = do
-#else
-startNamedThread :: Maybe Bool -> NamedThread -> Assistant ()
+startNamedThread :: UrlRenderer -> NamedThread -> Assistant ()
startNamedThread urlrenderer namedthread@(NamedThread name a) = do
-#endif
m <- startedThreads <$> getDaemonStatus
case M.lookup name m of
Nothing -> start
@@ -69,17 +65,14 @@ startNamedThread urlrenderer namedthread@(NamedThread name a) = do
]
hPutStrLn stderr msg
#ifdef WITH_WEBAPP
- button <- runAssistant d $
- case urlrenderer of
- Nothing -> return Nothing
- Just renderer -> do
- close <- asIO1 removeAlert
- url <- liftIO $ renderUrl renderer (RestartThreadR name) []
- return $ Just $ AlertButton
- { buttonLabel = T.pack "Restart Thread"
- , buttonUrl = url
- , buttonAction = Just close
- }
+ button <- runAssistant d $ do
+ close <- asIO1 removeAlert
+ url <- liftIO $ renderUrl urlrenderer (RestartThreadR name) []
+ return $ Just $ AlertButton
+ { buttonLabel = T.pack "Restart Thread"
+ , buttonUrl = url
+ , buttonAction = Just close
+ }
runAssistant d $ void $
addAlert $ (warningAlert (fromThreadName name) msg)
{ alertButton = button }
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index e0e42977a..01ea3c22b 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -8,7 +8,6 @@
module Assistant.Threads.TransferScanner where
import Assistant.Common
-import Assistant.WebApp
import Assistant.Types.ScanRemotes
import Assistant.ScanRemotes
import Assistant.TransferQueue
@@ -16,6 +15,7 @@ import Assistant.DaemonStatus
import Assistant.Drop
import Assistant.Sync
import Assistant.DeleteRemote
+import Assistant.Types.UrlRenderer
import Logs.Transfer
import Logs.Location
import Logs.Group
diff --git a/Assistant/Types/UrlRenderer.hs b/Assistant/Types/UrlRenderer.hs
new file mode 100644
index 000000000..521905bf3
--- /dev/null
+++ b/Assistant/Types/UrlRenderer.hs
@@ -0,0 +1,26 @@
+{- webapp url renderer access from the assistant
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Assistant.Types.UrlRenderer (
+ UrlRenderer,
+ newUrlRenderer
+) where
+
+#ifdef WITH_WEBAPP
+
+import Assistant.WebApp (UrlRenderer, newUrlRenderer)
+
+#else
+
+data UrlRenderer = UrlRenderer -- dummy type
+
+newUrlRenderer :: IO UrlRenderer
+newUrlRenderer = return UrlRenderer
+
+#endif
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index 0d232fcdf..33d6f536a 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -103,7 +103,7 @@ firstRun = do
v <- newEmptyMVar
let callback a = Just $ a v
runAssistant d $ do
- startNamedThread (Just urlrenderer) $
+ startNamedThread urlrenderer $
webAppThread d urlrenderer True
(callback signaler)
(callback mainthread)
diff --git a/Limit.hs b/Limit.hs
index 745f2cd22..9ce9d591e 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -146,7 +146,7 @@ addCopies = addLimit . limitCopies
limitCopies :: MkLimit
limitCopies want = case split ":" want of
[v, n] -> case parsetrustspec v of
- Just pred -> go n $ checktrust pred
+ Just checker -> go n $ checktrust checker
Nothing -> go n $ checkgroup v
[n] -> go n $ const $ return True
_ -> Left "bad value for copies"
@@ -160,7 +160,7 @@ limitCopies want = case split ":" want of
us <- filter (`S.notMember` notpresent)
<$> (filterM good =<< Remote.keyLocations key)
return $ length us >= n
- checktrust pred u = pred <$> lookupTrust u
+ checktrust checker u = checker <$> lookupTrust u
checkgroup g u = S.member g <$> lookupGroups u
parsetrustspec s
| "+" `isSuffixOf` s = (>=) <$> readTrustLevel (beginning s)