module Plat.Template.Command 
(
 CharNumber,
 Command(..),
 ControlCommand(..),
 LineNumber,
 SimpleCommand(..),
 commands) where
import Control.Monad.State
import Control.Monad.Writer
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString.Lazy.UTF8 as LU
import Data.Char
import Data.Maybe
import Plat.Utils
toStrict :: L.ByteString -> B.ByteString
toStrict = B.concat . L.toChunks
data Command =
    SimpleCmd SimpleCommand |
    ControlCmd CharNumber ControlCommand |
    SubstCmd CharNumber [B.ByteString] |
    LineCmd LineNumber
data SimpleCommand =
    StringCmd L.ByteString |
    NopCmd |
    AtCmd
data ControlCommand =
    TryCmd |
    EndTryCmd |
    OrCmd |
    GuardCmd [B.ByteString] |
    LoopCmd [B.ByteString] B.ByteString |
    EndLoopCmd
isControlCommand :: Command -> Bool
isControlCommand (SimpleCmd _) = False
isControlCommand (ControlCmd _ _) = True
isControlCommand (SubstCmd _ _) = False
isControlCommand (LineCmd _) = False
trim :: L.ByteString -> L.ByteString
trim = LC.dropWhile isSpace
dots :: L.ByteString -> [B.ByteString]
dots s =
    let (s1, s2) = LU.span ('.' /=) s
    in toStrict s1 : if L.null s2 then [] else dots (L.tail s2)
type TemplateMonad a = WriterT [Command] (StateT (L.ByteString, CharNumber) Maybe) a
char :: Char -> TemplateMonad ()
char c =
    do (bs, n) <- get
       case LU.uncons bs of
         Just (c', bs') | c' == c -> put (bs', n+1)
         _ -> fail $ "expected " ++ [c]
pos :: TemplateMonad CharNumber
pos = gets snd
consume :: (Char -> Bool) -> TemplateMonad L.ByteString
consume pred =
    do (bs, n) <- get
       let (s1, s2) = LU.span pred bs
       put (s2, n + LU.length s1)
       return s1
exprChar :: Char -> Bool
exprChar '.' = True
exprChar c = isAlpha c
eol :: TemplateMonad Bool
eol = gets $ L.null . fst
oneCommand :: LineNumber -> TemplateMonad ()
oneCommand p =
    msum [char '.' >> tell [SimpleCmd NopCmd]
         ,char '@' >> tell [SimpleCmd AtCmd]
         ,char '#' >> consume (const True) >> return ()
         ,char '{' >> tell [ControlCmd p TryCmd]
         ,char '}' >> tell [ControlCmd p EndTryCmd]
         ,char '|' >> tell [ControlCmd p OrCmd]
         ,do char '!'
             expr <- consume exprChar
             tell [ControlCmd p $ GuardCmd $ dots expr]
         ,char ']' >> tell [ControlCmd p EndLoopCmd]
         ,do s <- consume exprChar
             msum [do char '['
                      var <- consume isAlpha
                      tell [ControlCmd p $ LoopCmd (dots s) (toStrict var)]
                  ,tell [SubstCmd p $ dots s]
                  ]
         ]
allCommands :: TemplateMonad ()
allCommands =
    do e <- eol
       unless e $ do
         msum [do p <- pos
                  char '@'
                  oneCommand p
              ,do s <- consume ('@' /=)
                  tell [SimpleCmd (StringCmd s)]
              ]
         allCommands
templateCommands :: L.ByteString -> [Command]
templateCommands bs = fromJust $ evalStateT (execWriterT allCommands) (bs, 0)
trimCommands :: [Command] -> [Command]
trimCommands (SimpleCmd (StringCmd s) : cmds) =
    let s' = trim s 
    in if L.null s' 
       then trimCommands cmds 
       else SimpleCmd (StringCmd s') : cmds
trimCommands cmds = cmds
data LineState = BlankLine | CommandLine | RegularLine
lineState :: [Command] -> LineState
lineState = foldr advance BlankLine where
    advance (SimpleCmd (StringCmd s)) BlankLine
        | LC.all isSpace s = BlankLine
        | otherwise = RegularLine
    advance cmd BlankLine
        | isControlCommand cmd = CommandLine
        | otherwise = RegularLine
    advance (SimpleCmd (StringCmd s)) CommandLine
        | LC.all isSpace s = CommandLine
        | otherwise = RegularLine
    advance cmd CommandLine
        | isControlCommand cmd = CommandLine
        | otherwise = RegularLine
    advance _ RegularLine = RegularLine
fixCommands :: LineNumber -> [Command] -> [Command]
fixCommands ln cmds =
    LineCmd ln :
    case lineState cmds of
      CommandLine -> trimCommands cmds
      _ -> cmds ++ [SimpleCmd $ StringCmd $ LU.fromString "\n"]
commands :: L.ByteString -> [Command]
commands =
    concat . zipWith (\n l -> fixCommands n $ templateCommands l) [0..] . LU.lines