This commit is contained in:
Joey Hess 2012-07-26 00:39:25 -04:00
parent 805d50c69d
commit 6a8540c1a2

View file

@ -37,12 +37,14 @@ getConfigR = defaultLayout [whamlet|<a href=@{HomeR}>main|]
webAppThread :: ThreadState -> DaemonStatusHandle -> IO () webAppThread :: ThreadState -> DaemonStatusHandle -> IO ()
webAppThread st dstatus = do webAppThread st dstatus = do
app <- toWaiApp (WebApp dstatus) app <- toWaiApp webapp
app' <- ifM debugEnabled app' <- ifM debugEnabled
( return $ httpDebugLogger app ( return $ httpDebugLogger app
, return app , return app
) )
runWebApp app' $ \p -> runThreadState st $ writeHtmlShim p runWebApp app' $ \port -> runThreadState st $ writeHtmlShim port
where
webapp = WebApp dstatus
{- Creates a html shim file that's used to redirect into the webapp. -} {- Creates a html shim file that's used to redirect into the webapp. -}
writeHtmlShim :: PortNumber -> Annex () writeHtmlShim :: PortNumber -> Annex ()
@ -53,13 +55,13 @@ writeHtmlShim port = do
{- TODO: generate this static file using Yesod. -} {- TODO: generate this static file using Yesod. -}
genHtmlShim :: PortNumber -> L.ByteString genHtmlShim :: PortNumber -> L.ByteString
genHtmlShim port = renderHtml [shamlet| genHtmlShim port = renderHtml [shamlet|
!!! $doctype 5
<html> <html>
<head> <head>
<meta http-equiv="refresh" content="0; URL=#{url}"> <meta http-equiv="refresh" content="0; URL=#{url}">
<body> <body>
<p> <p>
<a href="#{url}">Starting webapp... <a href=#{url}">Starting webapp...
|] |]
where where
url = "http://localhost:" ++ show port ++ "/" url = "http://localhost:" ++ show port ++ "/"