clean up urlrenderer handling when the webapp is not built

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

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

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 :: UrlRenderer -> NamedThread -> Assistant ()
-startNamedThread :: Maybe UrlRenderer -> NamedThread -> Assistant ()
 startNamedThread urlrenderer namedthread@(NamedThread name a) = do
-#else
-startNamedThread :: Maybe Bool -> 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 $
+				button <- runAssistant d $ do
-					case urlrenderer of
+					close <- asIO1 removeAlert
-						Nothing -> return Nothing
+					url <- liftIO $ renderUrl urlrenderer (RestartThreadR name) []
-						Just renderer -> do
+					return $ Just $ AlertButton
-							close <- asIO1 removeAlert
+						{ buttonLabel = T.pack "Restart Thread"
-							url <- liftIO $ renderUrl renderer (RestartThreadR name) []
+						, buttonUrl = url
-							return $ Just $ AlertButton
+						, buttonAction = Just close
-								{ buttonLabel = T.pack "Restart Thread"
+						}
-								, buttonUrl = url
-								, buttonAction = Just close
-								}
 				runAssistant d $ void $
 					addAlert $ (warningAlert (fromThreadName name) msg)
 						{ alertButton = button }

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

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

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)

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)