module Plat.Rendering
(
render,
RenderErr(..),
ContextType(..),
renderErr
) where
import Control.Monad.Reader
import Control.Monad.State
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as B
import qualified Data.Map as M
import Plat.Context
import Plat.Errors
import Plat.Rendering.Errors
import Plat.Template
emptyStr = B.fromString "empty"
notStr = B.fromString "not"
fromStrict :: B.ByteString -> L.ByteString
fromStrict = L.fromChunks . return
render :: Template -> Context a -> Either RenderErr L.ByteString
render t c = runErrors $ renderSuffix (context c) t
type RenderM = StateT [B.ByteString] (ReaderT Pos (Errors RenderErr))
runListReader :: a -> ReaderT ([b], a) m c -> m c
runListReader x r = runReaderT r ([], x)
renderSuffix :: Ctx -> Template -> Errors RenderErr L.ByteString
renderSuffix c (Template elts) = liftM L.concat $ mapM (renderElement c) elts
renderElement :: Ctx -> TemplateElement -> Errors RenderErr L.ByteString
renderElement _ (StringTemplate s) = return s
renderElement c (ExprTemplate pos ss) =
runReaderT (evalStateT (evalExpr c ss >>= getString) []) pos
renderElement c (LoopTemplate (start, end) ss v t) =
runReaderT (evalStateT (evalExpr c ss >>= loopOver c v t) []) start
renderElement c (OptionTemplate loc ts) =
mapE (ErrorOption loc) $ msum $ map (mapE return . renderSuffix c) ts
renderElement c (CheckTemplate pos ss) =
runReaderT (evalStateT (evalExpr c ss >>= checkVal >> return L.empty) []) pos
evalExpr :: Ctx -> [B.ByteString] -> RenderM ContextElement
evalExpr c =
foldM (\c' nm -> modify (nm:) >> getSubElement c' nm) (SubContext c)
makeError :: (Pos -> [B.ByteString] -> RenderErr) -> RenderM a
makeError h =
do bs <- get
p <- ask
lift $ lift $ throwE $ h p bs
getSubElement :: ContextElement -> B.ByteString -> RenderM ContextElement
getSubElement (StringContext _) name = makeError $ ErrorField CtxString
getSubElement (ListContext elts) name
| name == emptyStr = return (BoolContext (null elts))
| otherwise = makeError $ ErrorField CtxArray
getSubElement (SubContext (Ctx c)) name =
case M.lookup name c of
Nothing -> makeError $ ErrorField CtxRecord
Just newElt -> return newElt
getSubElement (BoolContext b) name
| name == notStr = return (BoolContext (not b))
| otherwise = makeError $ ErrorField CtxBool
getString :: ContextElement -> RenderM L.ByteString
getString (StringContext s) = return $ fromStrict s
getString (ListContext _) = makeError $ ErrorType CtxArray CtxString
getString (SubContext _) = makeError $ ErrorType CtxRecord CtxString
getString (BoolContext _) = makeError $ ErrorType CtxBool CtxString
loopOver :: Ctx -> B.ByteString -> Template -> ContextElement -> RenderM L.ByteString
loopOver _ _ _ (StringContext _) = makeError $ ErrorType CtxString CtxArray
loopOver c v t (ListContext elts) =
liftM L.concat $ mapM (lift . lift . renderBind c t v) elts
loopOver _ _ _ (SubContext _) = makeError $ ErrorType CtxRecord CtxArray
loopOver _ _ _ (BoolContext _) = makeError $ ErrorType CtxBool CtxArray
renderBind ::
Ctx -> Template -> B.ByteString -> ContextElement -> Errors RenderErr L.ByteString
renderBind (Ctx c) t v elt = renderSuffix (Ctx $ M.insert v elt c) t
checkVal :: ContextElement -> RenderM ()
checkVal (StringContext _) = makeError $ ErrorType CtxString CtxBool
checkVal (ListContext _) = makeError $ ErrorType CtxArray CtxBool
checkVal (SubContext _) = makeError $ ErrorType CtxRecord CtxBool
checkVal (BoolContext True) = return ()
checkVal (BoolContext False) = makeError $ ErrorCheck