diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index d9b648831a..4e6fea6b11 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 ++ "/" diff --git a/Utility/Yesod.hs b/Utility/Yesod.hs new file mode 100644 index 0000000000..05f684490a --- /dev/null +++ b/Utility/Yesod.hs @@ -0,0 +1,18 @@ +{- Yesod stuff + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Yesod where + +import System.FilePath + +{- Filename of a template, in the templates/ directory. -} +template :: FilePath -> FilePath +template f = "templates" f + +{- A hamlet template file. -} +hamletTemplate :: FilePath -> FilePath +hamletTemplate f = template f ++ ".hamlet" diff --git a/static/favicon.ico b/static/favicon.ico new file mode 100644 index 0000000000..5bb405931f Binary files /dev/null and b/static/favicon.ico differ diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet new file mode 100644 index 0000000000..e07addc8e0 --- /dev/null +++ b/templates/default-layout.hamlet @@ -0,0 +1,11 @@ +$doctype 5 + + + #{baseTitle webapp} #{pageTitle page} + <link rel="icon" href=@{StaticR favicon_ico} type="image/x-icon"> + + ^{pageHead page} + <body> + $maybe msg <- mmsg + <div #message>#{msg} + ^{pageBody page} diff --git a/templates/htmlshim.hamlet b/templates/htmlshim.hamlet new file mode 100644 index 0000000000..c10042c999 --- /dev/null +++ b/templates/htmlshim.hamlet @@ -0,0 +1,7 @@ +$doctype 5 +<html> + <head> + <meta http-equiv="refresh" content="0; URL=#{url}"> + <body> + <p> + <a href=#{url}">Starting webapp...