{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module: Layout.Bootstrap.Starter -- -- Bootstrap-starter template. Not a real thing yet. -- ----------------------------------------------------------------------------- module Layout.Bootstrap.Starter where import Prelude import qualified Prelude as P import Data.Monoid (mempty) import Control.Monad (msum) import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Map as HM import Text.Blaze.Html5 import qualified Text.Blaze.Html5 as H import Text.Blaze.Html5.Attributes import qualified Text.Blaze.Html5.Attributes as A -- | Template configuration goes here. type Context = HM.Map T.Text T.Text -- | Render a basic wrapper wich loads styles and js. template :: Context -> Html -> Html template context templateBody = let ctx key = fromMaybe "" $ HM.lookup key context static kind path = toValue $ T.concat [ctx "STATIC_URL", kind, "/", path] css = static "css" img = static "img" script srcURL = H.script ! src (static "js" srcURL) $ mempty in do docType html ! lang "en" $ do H.head $ do meta ! charset "utf-8" H.title $ toHtml $ ctx "title" meta ! name "description" ! content "" meta ! name "author" ! content "" -- Le HTML5 shim, for IE6-8 support of HTML elements -- [if lt IE 9]> -- --