summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-29 14:30:10 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-29 14:30:10 -0400
commit48cb08ed2237e0630459e4a70341e129426bded9 (patch)
tree6c8e875628cf797963a367aba81232d858a573b8 /Assistant
parent0b808465e21d667c0826f454bbe88abff79389b7 (diff)
tweak
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Threads/MountWatcher.hs12
-rw-r--r--Assistant/Threads/WebApp.hs41
2 files changed, 26 insertions, 27 deletions
diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs
index cb08071f5..8814f7a86 100644
--- a/Assistant/Threads/MountWatcher.hs
+++ b/Assistant/Threads/MountWatcher.hs
@@ -88,7 +88,7 @@ checkMountMonitor client = do
running <- filter (`elem` usableservices)
<$> liftIO (listServiceNames client)
case running of
- [] -> liftIO $ startOneService client startableservices
+ [] -> startOneService client startableservices
(service:_) -> do
debug [ "Using running DBUS service"
, service
@@ -101,15 +101,15 @@ checkMountMonitor client = do
gvfs = "org.gtk.Private.GduVolumeMonitor"
kde = "org.kde.DeviceNotifications"
-startOneService :: Client -> [ServiceName] -> IO Bool
+startOneService :: Client -> [ServiceName] -> Assistant Bool
startOneService _ [] = return False
startOneService client (x:xs) = do
- _ <- callDBus client "StartServiceByName"
+ _ <- liftIO $ callDBus client "StartServiceByName"
[toVariant x, toVariant (0 :: Word32)]
- ifM (elem x <$> listServiceNames client)
+ ifM (liftIO $ elem x <$> listServiceNames client)
( do
- brokendebug thisThread [ "Started DBUS service"
- , x
+ debug
+ [ "Started DBUS service", x
, "to monitor mount events."
]
return True
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 02911bab9..126c78166 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -75,30 +75,29 @@ webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $
htmlshim <- runThreadState st $ fromRepo gitAnnexHtmlShim
urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile
go port webapp htmlshim (Just urlfile)
- where
- thread = NamedThread thisThread
- getreldir
- | noannex = return Nothing
- | otherwise = Just <$>
- (relHome =<< absPath
- =<< runThreadState (threadState assistantdata) (fromRepo repoPath))
- go port webapp htmlshim urlfile = do
- brokendebug thisThread ["running on port", show port]
- let url = myUrl webapp port
- maybe noop (`writeFile` url) urlfile
- writeHtmlShim url htmlshim
- maybe noop (\a -> a url htmlshim) onstartup
+ where
+ thread = NamedThread thisThread
+ getreldir
+ | noannex = return Nothing
+ | otherwise = Just <$>
+ (relHome =<< absPath
+ =<< runThreadState (threadState assistantdata) (fromRepo repoPath))
+ go port webapp htmlshim urlfile = do
+ let url = myUrl webapp port
+ maybe noop (`writeFile` url) urlfile
+ writeHtmlShim url htmlshim
+ maybe noop (\a -> a url htmlshim) onstartup
{- Creates a html shim file that's used to redirect into the webapp,
- to avoid exposing the secretToken when launching the web browser. -}
writeHtmlShim :: String -> FilePath -> IO ()
writeHtmlShim url file = viaTmp go file $ genHtmlShim url
- where
- go tmpfile content = do
- h <- openFile tmpfile WriteMode
- modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
- hPutStr h content
- hClose h
+ where
+ go tmpfile content = do
+ h <- openFile tmpfile WriteMode
+ modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
+ hPutStr h content
+ hClose h
{- TODO: generate this static file using Yesod. -}
genHtmlShim :: String -> String
@@ -117,5 +116,5 @@ genHtmlShim url = unlines
myUrl :: WebApp -> PortNumber -> Url
myUrl webapp port = unpack $ yesodRender webapp urlbase HomeR []
- where
- urlbase = pack $ "http://localhost:" ++ show port
+ where
+ urlbase = pack $ "http://localhost:" ++ show port