{-# LANGUAGE FlexibleInstances, FlexibleContexts, QuasiQuotes, TypeFamilies, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Happstack.Server.HSP.HTML
( defaultTemplate
) where
import Control.Monad.Trans (MonadIO(), liftIO)
import Data.Monoid ((<>))
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy.Builder as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy (Text)
import Language.Haskell.HSX.QQ (hsx)
import Control.Monad (liftM)
import Happstack.Server
( ToMessage(toMessage, toContentType, toResponse)
, Response
)
import HSP
import HSP.HTML4
instance ToMessage (Maybe XMLMetaData, XML) where
toContentType (Just md,_) = T.encodeUtf8 $ TL.toStrict (contentType md)
toContentType _ = "text/html;charset=utf-8"
toMessage (Just (XMLMetaData (showDt, dt) _ pr), xml) =
TL.encodeUtf8 $ TL.toLazyText ((if showDt then ((TL.fromLazyText dt) <>) else id) (pr xml))
toMessage (Nothing, xml) =
TL.encodeUtf8 (renderAsHTML xml)
instance ToMessage XML where
toContentType _ = "text/html;charset=utf-8"
toMessage xml = toMessage (html4Strict, xml)
defaultTemplate :: ( XMLGenerator m, EmbedAsChild m headers
, EmbedAsChild m body, StringType m ~ Text) =>
TL.Text
-> headers
-> body
-> m (XMLType m)
defaultTemplate title headers body =
unXMLGenT $ [hsx|
<html>
<head>
<title><% title %></title>
<% headers %>
</head>
<body>
<% body %>
</body>
</html>
|]