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

-- |This is the rendering functions. It substitutes values from the given 'Context'
-- into the 'Template', returning result as 'L.ByteString' or indicating a failure.

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