haskweb/Template.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS -Wall #-}

module Template (
    initTemplates, render, Context
) where

import Control.Monad.State
import Data.ByteString.Char8 (pack)
import Data.Binary.Builder
import Control.Lens (set)
import Data.ByteString.Lazy (toStrict)
import qualified Data.Text as T (pack, unpack)
import Data.Text.Encoding

import Heist
import Heist.Interpreted

import AppMonad
import Database

type TemplateName = String

type Context = [(String, String)]

basePath :: FilePath
basePath = "/home/christian/work/haskell/haskweb/"

heistConfig :: HeistConfig App
heistConfig =
    (set hcNamespace "") $
    (set hcLoadTimeSplices defaultLoadTimeSplices) $
    (set hcTemplateLocations [loadTemplates $ basePath ++ "templates"]) $
    emptyHeistConfig

initTemplates :: App ()
initTemplates = do
    heistState <- liftIO $ either (error . concat) id
        <$> initHeist heistConfig
    modify $ setHeistState heistState

render :: TemplateName -> Context -> App String
render tpl oldContext = do
    hs <- maybe (error "Template engine not initialized!") id <$> gets heist
    loginStatus <- isLoggedIn
    let context = ("login_path", if loginStatus then "/logout" else "/login") :
                  ("login_name", if loginStatus then "Abmelden" else "Anmelden") :
                  oldContext
        hs' = foldr (\(k, v) h -> bindString (T.pack k) (T.pack v) h) hs context
    mayBuilder <- renderTemplate hs' (pack tpl)
    case mayBuilder of
        Just (builder, _) ->
            return . T.unpack . decodeUtf8 . toStrict . toLazyByteString $ builder
        Nothing -> return $ "Could not load template!"