module Web.Simple.Templates
( HasTemplates(..)
, defaultGetTemplate, defaultRender, defaultFunctionMap
, H.fromList
, Function(..), ToFunction(..), FunctionMap
) where
import Control.Applicative
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 (Controller, respond)
import Web.Simple.Responses (ok)
import Web.Simple.Templates.Language
class HasTemplates hs where
defaultLayout :: Controller hs (Maybe Template)
defaultLayout = return Nothing
viewDirectory :: Controller hs FilePath
viewDirectory = return "views"
functionMap :: Controller hs FunctionMap
functionMap = return defaultFunctionMap
getTemplate :: FilePath -> Controller hs Template
getTemplate = defaultGetTemplate
render :: ToJSON a => FilePath -> a -> Controller hs ()
render = defaultRender
renderPlain :: ToJSON a => FilePath -> a -> Controller 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 -> Controller hs ()
renderLayout lfp fp val = do
layout <- getTemplate lfp
renderLayout' layout fp val
renderLayout' :: ToJSON a => Template -> FilePath -> a -> Controller 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 hs => FilePath -> Controller hs Template
defaultGetTemplate fp = do
eres <- compileTemplate . decodeUtf8 <$>
liftIO (S.readFile fp)
case eres of
Left str -> fail str
Right tmpl -> return tmpl
defaultRender :: (HasTemplates hs , ToJSON a)
=> FilePath -> a -> Controller 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"