diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-29 14:30:10 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-29 14:30:10 -0400 |
commit | 48cb08ed2237e0630459e4a70341e129426bded9 (patch) | |
tree | 6c8e875628cf797963a367aba81232d858a573b8 /Assistant | |
parent | 0b808465e21d667c0826f454bbe88abff79389b7 (diff) |
tweak
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Threads/MountWatcher.hs | 12 | ||||
-rw-r--r-- | Assistant/Threads/WebApp.hs | 41 |
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 |