module Yu.Core.View.Internal
( Hamletic(..)
, yuLayout
, yuErrorHandler
, layoutBootstrap
) where
import Yesod.Core
import Yesod.Core.Handler
import Yesod.Core.Json
import Yu.Core.Model
import Yu.Import.Text (Text)
import qualified Yu.Import.Text as T
import Yu.Utils.Handler
class (MonadHandler m, Mongodic a m) => Hamletic a m | m -> a where
getTitle :: m Text
getFramePrefix :: m Text
getVersion :: m Text
getRaw :: m Bool
type YuLayout site = ( PageContent (Route site)
-> Html
-> Text
-> Html
-> Html
-> Html
-> ((Route site -> [(Text, Text)] -> Text) -> Html)
)
layoutBootstrap :: Yesod site => YuLayout site
layoutBootstrap pageContent hd title nav top bottom = [hamlet|
$newline never
$doctype 5
<html>
<head>
<title> #{pageTitle pageContent} #{title}
<meta charset=utf8>
<script src=prelude.js>
<meta name=viewport content="width=device-width,initial-scale=1.0,maximum-scale=1.0,user-scalable=no">
#{hd}
^{pageHead pageContent}
<body>
#{nav}
<div id="container">
#{top}
<div id="main-part">
^{pageBody pageContent}
#{bottom}
|]
yuLayout :: (Hamletic a (HandlerT a IO),Yesod a)
=> YuLayout a
-> WidgetT a IO ()
-> HandlerT a IO Html
yuLayout layout w = do
framePrefix <- getFramePrefix
title <- getTitle
pageContent <- widgetToPageContent w
htmls <- runDbDefault $ do
topHtml <- fetchMaybeI fetchFrame [framePrefix,"top"]
bottomHtml <- fetchMaybeI fetchFrame [framePrefix,"bottom"]
navHtml <- fetchMaybeI fetchFrame [framePrefix,"nav"]
header <- fetchMaybeI fetchFrame [framePrefix,"header"]
case (topHtml,bottomHtml,navHtml,header) of
(Just top, Just bottom, Just nav, Just hd) -> return $ Right (top,bottom,nav,hd)
_ -> return $ Left "cannot launch frames"
case htmls of
Left err -> error err
Right (top,bottom,nav,hd) -> withUrlRenderer $ layout pageContent hd title nav top bottom
yuErrorHandler :: Yesod site
=> ErrorResponse
-> HandlerT site IO TypedContent
yuErrorHandler er = selectRep $ do
provideJson er
provideRep $
defaultLayout [whamlet|
<h1> error
<p> #{T.show er}
|]