From 3ac2cf09e56cb1918312a31e0884d56829a14c32 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 26 Jul 2012 02:45:01 -0400 Subject: 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 to pull it in. I looked at Yesod.Default.Handlers.getFaviconR, but it doesn't seem to embed the favicon into the binary? --- Assistant/Threads/WebApp.hs | 53 ++++++++++++++++++++++++++++++++------------- 1 file changed, 38 insertions(+), 15 deletions(-) (limited to 'Assistant') 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

config|] +getHomeR = defaultLayout $ do + [whamlet|Hello, World

config|] getConfigR :: Handler RepHtml -getConfigR = defaultLayout [whamlet|main|] +getConfigR = defaultLayout $ do + setTitle "configuration" + [whamlet|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 - - - - -

- Starting webapp... -|] +genHtmlShim port = renderHtml $(shamletFile $ hamletTemplate "htmlshim") where url = "http://localhost:" ++ show port ++ "/" -- cgit v1.2.3