diff options
Diffstat (limited to 'Assistant/Threads/WebApp.hs')
-rw-r--r-- | Assistant/Threads/WebApp.hs | 31 |
1 files changed, 26 insertions, 5 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 1d9d3cc2f..f3f13c5a0 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -10,10 +10,12 @@ module Assistant.Threads.WebApp where import Assistant.Common +import Assistant.ThreadedMonad import Assistant.DaemonStatus import Utility.WebApp import Yesod +import Network.Socket (PortNumber) data WebApp = WebApp DaemonStatusHandle @@ -30,14 +32,33 @@ getHomeR = defaultLayout [whamlet|Hello, World<p><a href=@{ConfigR}>config|] getConfigR :: Handler RepHtml getConfigR = defaultLayout [whamlet|<a href=@{HomeR}>main|] -webAppThread :: DaemonStatusHandle -> IO () -webAppThread dstatus = do +webAppThread :: ThreadState -> DaemonStatusHandle -> IO () +webAppThread st dstatus = do app <- toWaiApp (WebApp dstatus) app' <- ifM debugEnabled ( return $ httpDebugLogger app , return app ) - runWebApp app' browser + runWebApp app' $ \p -> runThreadState st $ writeHtmlShim p + +{- Creates a html shim file that's used to redirect into the webapp. -} +writeHtmlShim :: PortNumber -> Annex () +writeHtmlShim port = do + htmlshim <- fromRepo gitAnnexHtmlShim + liftIO $ writeFile htmlshim $ genHtmlShim port + +{- TODO: generate this static file using Yesod. -} +genHtmlShim :: PortNumber -> String +genHtmlShim port = unlines + [ "<html>" + , "<head>" + , "<meta http-equiv=\"refresh\" content=\"0; URL=" ++ url ++ "\">" + , "</head>" + , "<body>" + , "<p>" + , "<a href=\"" ++ url ++ "\">Starting webapp...</a>" + , "</p>" + , "</body>" + ] where - browser p = void $ - runBrowser $ "http://" ++ localhost ++ ":" ++ show p + url = "http://localhost:" ++ show port ++ "/" |