clean up urlrenderer handling when the webapp is not built

This commit is contained in:
Joey Hess 2013-04-03 17:44:34 -04:00
parent 9a5f421768
commit 021c564319
7 changed files with 55 additions and 27 deletions

View file

@ -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

View file

@ -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

View file

@ -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 -> 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 $
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 }

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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)