module Web.Simple.Templates
( HasTemplates(..), render, renderPlain, renderLayout, renderLayoutTmpl
, defaultGetTemplate, defaultFunctionMap, defaultLayoutObject
, H.fromList
, Function(..), ToFunction(..), FunctionMap
) where
import Control.Monad.IO.Class
import Data.Aeson
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.Vector as V
import Network.Mime
import System.FilePath
import Web.Simple.Controller.Trans (ControllerT, respond)
import Web.Simple.Responses (ok)
import Web.Simple.Templates.Language
class Monad m => HasTemplates m hs where
defaultLayout :: ControllerT hs m (Maybe Template)
defaultLayout = return Nothing
viewDirectory :: ControllerT hs m FilePath
viewDirectory = return "views"
functionMap :: ControllerT hs m FunctionMap
functionMap = return defaultFunctionMap
getTemplate :: FilePath -> ControllerT hs m Template
default getTemplate :: MonadIO m => FilePath -> ControllerT hs m Template
getTemplate = defaultGetTemplate
layoutObject :: (ToJSON pageContent, ToJSON pageVal)
=> pageContent -> pageVal -> ControllerT hs m Value
layoutObject = defaultLayoutObject
defaultLayoutObject :: (HasTemplates m hs, ToJSON pageContent, ToJSON pageVal)
=> pageContent -> pageVal -> ControllerT hs m Value
defaultLayoutObject pageContent pageVal = return $
object ["yield" .= pageContent, "page" .= pageVal]
renderLayout :: (HasTemplates m hs, ToJSON a)
=> FilePath -> FilePath -> a -> ControllerT hs m ()
renderLayout lfp fp val = do
layout <- getTemplate lfp
viewDir <- viewDirectory
view <- getTemplate (viewDir </> fp)
let mime = defaultMimeLookup $ T.pack $ takeFileName fp
renderLayoutTmpl layout view val mime
renderLayoutTmpl :: (HasTemplates m hs, ToJSON a)
=> Template -> Template -> a
-> S.ByteString -> ControllerT hs m ()
renderLayoutTmpl layout view val mime = do
fm <- functionMap
let pageContent = renderTemplate view fm $ toJSON val
value <- layoutObject pageContent val
let result = renderTemplate layout fm value
respond $ ok mime $ L.fromChunks . (:[]) . encodeUtf8 $ result
render :: (HasTemplates m hs , Monad m, ToJSON a)
=> FilePath
-> a
-> ControllerT hs m ()
render fp val = do
mlayout <- defaultLayout
case mlayout of
Nothing -> renderPlain fp val
Just layout -> do
viewDir <- viewDirectory
view <- getTemplate (viewDir </> fp)
let mime = defaultMimeLookup $ T.pack $ takeFileName fp
renderLayoutTmpl layout view val mime
renderPlain :: (HasTemplates m hs, ToJSON a)
=> FilePath
-> a
-> ControllerT hs m ()
renderPlain fp val = do
fm <- functionMap
dir <- viewDirectory
tmpl <- getTemplate (dir </> fp)
let pageContent =
L.fromChunks . (:[]) . encodeUtf8 $
renderTemplate tmpl fm $ toJSON val
let mime = defaultMimeLookup $ T.pack $ takeFileName fp
respond $ ok mime pageContent
defaultGetTemplate :: (HasTemplates m hs, MonadIO m)
=> FilePath -> ControllerT hs m Template
defaultGetTemplate fp = do
contents <- liftIO $ S.readFile fp
case compileTemplate . decodeUtf8 $ contents of
Left str -> fail str
Right tmpl -> return tmpl
defaultFunctionMap :: FunctionMap
defaultFunctionMap = H.fromList
[ ("length", toFunction valueLength)
, ("null", toFunction valueNull)]
valueLength :: Value -> Value
valueLength (Array arr) = toJSON $ V.length arr
valueLength (Object obj) = toJSON $ H.size obj
valueLength (String str) = toJSON $ T.length str
valueLength Null = toJSON (0 :: Int)
valueLength _ = error "length only valid for arrays, objects and strings"
valueNull :: Value -> Value
valueNull (Array arr) = toJSON $ V.null arr
valueNull (Object obj) = toJSON $ H.null obj
valueNull (String str) = toJSON $ T.null str
valueNull Null = toJSON True
valueNull _ = error "null only valid for arrays, objects and strings"