diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-07-26 02:45:01 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-07-26 02:45:01 -0400 |
| commit | 3ac2cf09e56cb1918312a31e0884d56829a14c32 (patch) | |
| tree | 09861831ebcb33a0ae7fe28cd3e2d62cb9ab1f03 /Assistant | |
| parent | 6a8540c1a2ae61d81e06eae2865ac00c6c759ed5 (diff) | |
added a custom defaultLayout, static site, and favicon
Broke hamlet out into standalone files.
I don't like the favicon display; it should be served from /favicon.ico,
but I could only get the static site to serve /static/favicon.ico, so
I had to use a <link rel=icon> to pull it in. I looked at
Yesod.Default.Handlers.getFaviconR, but it doesn't seem to embed
the favicon into the binary?
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 53 |
1 files changed, 38 insertions, 15 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index d9b648831..4e6fea6b1 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -13,38 +13,69 @@ import Assistant.Common import Assistant.ThreadedMonad import Assistant.DaemonStatus import Utility.WebApp +import Utility.Yesod +import Git import Yesod +import Yesod.Static import Text.Hamlet import Network.Socket (PortNumber) import Text.Blaze.Renderer.Utf8 import Data.ByteString.Lazy as L -data WebApp = WebApp DaemonStatusHandle +data WebApp = WebApp + { daemonStatus :: DaemonStatusHandle + , baseTitle :: String + , getStatic :: Static + } + +staticFiles "static" mkYesod "WebApp" [parseRoutes| +/static StaticR Static getStatic / HomeR GET /config ConfigR GET |] -instance Yesod WebApp +instance Yesod WebApp where + defaultLayout contents = do + page <- widgetToPageContent contents + mmsg <- getMessage + webapp <- getYesod + hamletToRepHtml $(hamletFile $ hamletTemplate "default-layout") getHomeR :: Handler RepHtml -getHomeR = defaultLayout [whamlet|Hello, World<p><a href=@{ConfigR}>config|] +getHomeR = defaultLayout $ do + [whamlet|Hello, World<p><a href=@{ConfigR}>config|] getConfigR :: Handler RepHtml -getConfigR = defaultLayout [whamlet|<a href=@{HomeR}>main|] +getConfigR = defaultLayout $ do + setTitle "configuration" + [whamlet|<a href=@{HomeR}>main|] webAppThread :: ThreadState -> DaemonStatusHandle -> IO () webAppThread st dstatus = do + webapp <- mkWebApp st dstatus app <- toWaiApp webapp app' <- ifM debugEnabled ( return $ httpDebugLogger app , return app ) runWebApp app' $ \port -> runThreadState st $ writeHtmlShim port - where - webapp = WebApp dstatus + +mkWebApp :: ThreadState -> DaemonStatusHandle -> IO WebApp +mkWebApp st dstatus = do + dir <- absPath =<< runThreadState st (fromRepo repoPath) + home <- myHomeDir + let reldir = if dirContains home dir + then relPathDirToFile home dir + else dir + let s = $(embed "static") + return $ WebApp + { daemonStatus = dstatus + , baseTitle = reldir + , getStatic = s + } {- Creates a html shim file that's used to redirect into the webapp. -} writeHtmlShim :: PortNumber -> Annex () @@ -54,14 +85,6 @@ writeHtmlShim port = do {- TODO: generate this static file using Yesod. -} genHtmlShim :: PortNumber -> L.ByteString -genHtmlShim port = renderHtml [shamlet| -$doctype 5 -<html> - <head> - <meta http-equiv="refresh" content="0; URL=#{url}"> - <body> - <p> - <a href=#{url}">Starting webapp... -|] +genHtmlShim port = renderHtml $(shamletFile $ hamletTemplate "htmlshim") where url = "http://localhost:" ++ show port ++ "/" |