module Plat.Template
(
 CharNumber,
 LineNumber,
 Pos,
 Template(..),
 TemplateErrLeft(..),
 TemplateErrRight(..),
 TemplateErr(..),
 TemplateElement(..),
 posContext,
 template,
 templateErr,
 templateE
) where
import Control.Arrow
import Control.Monad.Error
import Control.Monad.State
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.UTF8 as LU
import Data.Char
import Plat.Template.Command
import Plat.Template.Errors
import Plat.Utils

-- | Before using the template, it should be compiled, so that compilation would not
-- happen each time the template is used. This is the type of the compiled template.
-- It's internals aren't exported, as they are subject to change in future versions.

newtype Template = Template [TemplateElement]
data TemplateElement =
    StringTemplate L.ByteString |
    ExprTemplate Pos [B.ByteString] |
    LoopTemplate (Pos, Pos) [B.ByteString] B.ByteString Template |
    OptionTemplate (Pos, Pos) [Template] |
    CheckTemplate Pos [B.ByteString]
data Partial = Partial [([TemplateElement], Pos, ReadingState)] [TemplateElement]
data ReadingState = ReadingLoop [B.ByteString] B.ByteString | ReadingOption [Template]
addCommand :: (Partial, LineNumber) -> Command -> (Either TemplateErr) (Partial, LineNumber)
addCommand (Partial rs elts, ln) (SimpleCmd (StringCmd str)) =
    return (Partial rs $ elts ++ [StringTemplate str], ln)
addCommand pn (SimpleCmd NopCmd) = return pn 
addCommand (Partial rs elts, ln) (SimpleCmd AtCmd) =
    return (Partial rs $ elts ++ [StringTemplate $ LU.fromString "@"], ln)
addCommand (Partial rs elts, ln) (ControlCmd pos TryCmd) =
    return (Partial ((elts, (ln, pos), ReadingOption []) : rs) [], ln)
addCommand (Partial rs elts, ln) (ControlCmd pos EndTryCmd) =
    case rs of
      [] -> Left $ NoLeftTag TryRightTag (ln, pos)
      (_, p, ReadingLoop _ _) : _ ->
          Left $ MismatchedTags LoopLeftTag p TryRightTag (ln, pos)
      (elts', p, ReadingOption tmps) : rs' ->
          let newElt = OptionTemplate (p, (ln, pos)) $ tmps ++ [Template elts]
          in return (Partial rs' $ elts' ++ [newElt], ln)
addCommand (Partial rs elts, ln) (ControlCmd pos OrCmd) =
    case rs of
      [] -> Left $ NoLeftTag OrRightTag (ln, pos)
      (_, p, ReadingLoop _ _) : _ ->
          Left $ MismatchedTags LoopLeftTag p OrRightTag (ln, pos)
      (elts', p, ReadingOption tmps) : rs' ->
          let newSt = ReadingOption $ tmps ++ [Template elts]
          in return (Partial ((elts', p, newSt) : rs') [], ln)
addCommand (Partial rs elts, ln) (ControlCmd pos (GuardCmd expr)) =
    return (Partial rs $ elts ++ [CheckTemplate (ln, pos) expr], ln)
addCommand (Partial rs elts, ln) (ControlCmd pos (LoopCmd expr var)) =
    return (Partial ((elts, (ln, pos), ReadingLoop expr var) : rs) [], ln)
addCommand (Partial rs elts, ln) (ControlCmd pos EndLoopCmd) =
    case rs of
      [] -> Left $ NoLeftTag LoopRightTag (ln, pos)
      (elts', p, ReadingLoop expr var) : rs' ->
          let newElt = LoopTemplate (p, (ln, pos)) expr var $ Template elts
          in return (Partial rs' $ elts' ++ [newElt], ln)
      (_, p, ReadingOption _) : _ ->
          Left $ MismatchedTags TryLeftTag p LoopRightTag (ln, pos)
addCommand (Partial rs elts, ln) (SubstCmd pos expr) =
    return (Partial rs $ elts ++ [ExprTemplate (ln, pos) expr], ln)
addCommand (p, _) (LineCmd line) = return (p, line)

-- | This is a compilation function. It returns error message if the input string
-- has syntax errors.

templateE :: L.ByteString -> Either TemplateErr Template
templateE s =
    do (Partial rs elts, _) <- foldM addCommand (Partial [] [], 0) $ commands s
       case rs of
         [] -> return $ Template elts
         (_, p, ReadingLoop _ _) : _ -> Left $ NoRightTag LoopLeftTag p
         (_, p, ReadingOption _) : _ -> Left $ NoRightTag TryLeftTag p

-- | This function is provided for convenience only. It does the same as the
-- 'templateE' function, except that instead of returning an error message
-- it just throws a run-time error with the textual representation of that message.

template :: L.ByteString -> Template
template s =
    case templateE s of
      Left err -> error $ show err
      Right t -> t