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?
This commit is contained in:
Joey Hess 2012-07-26 02:45:01 -04:00
parent 6a8540c1a2
commit 3ac2cf09e5
5 changed files with 74 additions and 15 deletions

View file

@ -13,38 +13,69 @@ import Assistant.Common
import Assistant.ThreadedMonad import Assistant.ThreadedMonad
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Utility.WebApp import Utility.WebApp
import Utility.Yesod
import Git
import Yesod import Yesod
import Yesod.Static
import Text.Hamlet import Text.Hamlet
import Network.Socket (PortNumber) import Network.Socket (PortNumber)
import Text.Blaze.Renderer.Utf8 import Text.Blaze.Renderer.Utf8
import Data.ByteString.Lazy as L import Data.ByteString.Lazy as L
data WebApp = WebApp DaemonStatusHandle data WebApp = WebApp
{ daemonStatus :: DaemonStatusHandle
, baseTitle :: String
, getStatic :: Static
}
staticFiles "static"
mkYesod "WebApp" [parseRoutes| mkYesod "WebApp" [parseRoutes|
/static StaticR Static getStatic
/ HomeR GET / HomeR GET
/config ConfigR 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 :: 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 :: Handler RepHtml
getConfigR = defaultLayout [whamlet|<a href=@{HomeR}>main|] getConfigR = defaultLayout $ do
setTitle "configuration"
[whamlet|<a href=@{HomeR}>main|]
webAppThread :: ThreadState -> DaemonStatusHandle -> IO () webAppThread :: ThreadState -> DaemonStatusHandle -> IO ()
webAppThread st dstatus = do webAppThread st dstatus = do
webapp <- mkWebApp st dstatus
app <- toWaiApp webapp app <- toWaiApp webapp
app' <- ifM debugEnabled app' <- ifM debugEnabled
( return $ httpDebugLogger app ( return $ httpDebugLogger app
, return app , return app
) )
runWebApp app' $ \port -> runThreadState st $ writeHtmlShim port 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. -} {- Creates a html shim file that's used to redirect into the webapp. -}
writeHtmlShim :: PortNumber -> Annex () writeHtmlShim :: PortNumber -> Annex ()
@ -54,14 +85,6 @@ 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 $(shamletFile $ hamletTemplate "htmlshim")
$doctype 5
<html>
<head>
<meta http-equiv="refresh" content="0; URL=#{url}">
<body>
<p>
<a href=#{url}">Starting webapp...
|]
where where
url = "http://localhost:" ++ show port ++ "/" url = "http://localhost:" ++ show port ++ "/"

18
Utility/Yesod.hs Normal file
View file

@ -0,0 +1,18 @@
{- Yesod stuff
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- 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"

BIN
static/favicon.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 405 B

View file

@ -0,0 +1,11 @@
$doctype 5
<html>
<head>
<title>#{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}

View file

@ -0,0 +1,7 @@
$doctype 5
<html>
<head>
<meta http-equiv="refresh" content="0; URL=#{url}">
<body>
<p>
<a href=#{url}">Starting webapp...