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:
parent
6a8540c1a2
commit
3ac2cf09e5
5 changed files with 74 additions and 15 deletions
|
@ -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
18
Utility/Yesod.hs
Normal 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
BIN
static/favicon.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 405 B |
11
templates/default-layout.hamlet
Normal file
11
templates/default-layout.hamlet
Normal 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}
|
7
templates/htmlshim.hamlet
Normal file
7
templates/htmlshim.hamlet
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
$doctype 5
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="refresh" content="0; URL=#{url}">
|
||||||
|
<body>
|
||||||
|
<p>
|
||||||
|
<a href=#{url}">Starting webapp...
|
Loading…
Reference in a new issue