module Web.Simple.Templates
( HasTemplates(..)
, defaultGetTemplate, defaultRender, defaultFunctionMap
, 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 m hs (Maybe Template)
defaultLayout = return Nothing
viewDirectory :: ControllerT m hs FilePath
viewDirectory = return "views"
functionMap :: ControllerT m hs FunctionMap
functionMap = return defaultFunctionMap
getTemplate :: FilePath -> ControllerT m hs Template
default getTemplate :: MonadIO m => FilePath -> ControllerT m hs Template
getTemplate = defaultGetTemplate
render :: ToJSON a => FilePath -> a -> ControllerT m hs ()
render = defaultRender
renderPlain :: ToJSON a => FilePath -> a -> ControllerT m hs ()
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
renderLayout :: ToJSON a => FilePath -> FilePath -> a -> ControllerT m hs ()
renderLayout lfp fp val = do
layout <- getTemplate lfp
renderLayout' layout fp val
renderLayout' :: ToJSON a => Template -> FilePath -> a -> ControllerT m hs ()
renderLayout' layout fp val = do
fm <- functionMap
dir <- viewDirectory
tmpl <- getTemplate (dir </> fp)
let pageContent = renderTemplate tmpl fm $ toJSON val
let mime = defaultMimeLookup $ T.pack $ takeFileName fp
respond $ ok mime $ L.fromChunks . (:[]) . encodeUtf8 $
renderTemplate layout fm $ object ["yield" .= pageContent, "page" .= val]
defaultGetTemplate :: (HasTemplates m hs, MonadIO m)
=> FilePath -> ControllerT m hs Template
defaultGetTemplate fp = do
contents <- liftIO $ S.readFile fp
case compileTemplate . decodeUtf8 $ contents of
Left str -> fail str
Right tmpl -> return tmpl
defaultRender :: (HasTemplates m hs , Monad m, ToJSON a)
=> FilePath -> a -> ControllerT m hs ()
defaultRender fp val = do
mlayout <- defaultLayout
case mlayout of
Nothing -> renderPlain fp val
Just layout -> renderLayout' layout fp val
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"