---------------------------------------------------------------------------------------------------
-- |
-- Module      :  Text.Bravo.Parser
-- Copyright   :  Matthias Reisner
-- License     :  BSD3
--
-- Maintainer  :  Matthias Reisner <matthias.reisner@googlemail.com>
-- Stability   :  experimental
-- Portability :  unknown
--
-- Bravo template parsers.
--
---------------------------------------------------------------------------------------------------

module Text.Bravo.Parser (
        template,
        templates
    )
where


import Control.Monad

import Language.Haskell.Exts.Parser hiding (parse)
import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.Extension

import Text.Bravo.Syntax
import Text.Bravo.Util
import Text.ParserCombinators.Parsec


{-

    tpl     ::=  tbegin tpls* tend
    tpls    ::=  tcond | texpr | tcomm | ttext

    tbegin  ::=  '{{' spc* 'tpl'      spc+ ident spc* '}}'
    tend    ::=  '{{' spc* 'endtpl'   spc*            '}}'
    tif     ::=  '{{' spc* 'if'       spc+ cexpr spc* '}}'
    telsif  ::=  '{{' spc* 'elseif'   spc+ cexpr spc* '}}'
    telse   ::=  '{{' spc* 'else'     spc*            '}}'
    tendif  ::=  '{{' spc* 'endif'    spc*            '}}'
    tcond   ::=  tif tpls* (telsif tpls*)* (telse tpls*)? tendif

    texpr   ::=  '{{' ':' spc* expr spc*     '}}'
    tcomm   ::=  '{{' '-' any*           '-' '}}'
    ttext   ::=  any+

    expr    ::=  hs_expr :: String
    cexpr   ::=  hs_expr :: Bool

    ident   ::=  lower alphaNum*
    spc     ::=  ' ' | '\t' | '\n' | '\r'

-}


keywords :: [String]
keywords = ["if", "elseif", "else", "endif", "tpl", "endtpl"]

parseExts :: [Extension]
parseExts = [TemplateHaskell]


-- * CFG parsers

-- | Parser for a single template. No comments or whitespace are allowed before the template.
template :: Parser Template
template = tpl

-- | Parser for multiple templates with comments or whitespace before and after each template.
templates :: Parser [Template]
templates = option "" ttext' >> many (tpl << option "" ttext')


tpl :: Parser Template
tpl = liftM2 Template tbegin (many (try tpls) << tend) <?> "tpl"

tpls :: Parser TemplateSplice
tpls = try texpr <|> try tcond <|> try tcomm <|> ttext <?> "tpls"

tcond :: Parser TemplateSplice
tcond = do
    i <- tif
    ts <- many $ try tpls
    eis <- many $ liftM2 (,) (try telsif) (many $ try tpls)
    e <- option [] (try telse >> many (try tpls))
    tendif
    return $ TConditions (((i, ts):eis) ++ [(Con $ UnQual $ Ident "True", e)])
    <?> "tcond"

tbegin :: Parser String
tbegin = (string "{{" >> many spc >> string "tpl" >> many1 spc >>
    ident << many spc << string "}}") <?> "tbegin"

tend :: Parser ()
tend = (skip $ string "{{" >> many spc >> string "endtpl" >> many spc >> string "}}") <?> "tend"

tif :: Parser Exp
tif = (string "{{" >> many spc >> string "if" >> many1 spc >>
          cexpr << many spc << string "}}") <?> "tif"

telsif :: Parser Exp
telsif = (string "{{" >> many spc >> string "elseif" >> many1 spc >>
             cexpr << many spc << string "}}") <?> "telseif"

telse :: Parser ()
telse = skip (string "{{" >> many spc >> string "else" >> many spc >> string "}}") <?> "telse"

tendif :: Parser ()
tendif = skip (string "{{" >> many spc >> string "endif" >> many spc >> string "}}") <?> "tendif"

texpr :: Parser TemplateSplice
texpr = liftM TExpr (string "{{:" >> many spc >> expr << many spc << string "}}") <?> "texpr"

tcomm :: Parser TemplateSplice
tcomm = (liftM TComment $ string "{{-" >> manyTill anyChar (try $ string "-}}")) <?> "tcomm"

ttext :: Parser TemplateSplice
ttext = liftM TText ttext' <?> "ttext"

ttext' :: Parser String
ttext' = manyNotMultiple '{'

expr :: Parser Exp
expr = do
    s <- manyNotMultiple '}'
    case parseExpWithMode defaultParseMode { extensions = parseExts } s of
        ParseFailed _ err -> fail $ "expr: " ++ err
        ParseOk e         -> return e

cexpr :: Parser Exp
cexpr = expr

-- * Token parsers

ident :: Parser String
ident = do
    s <- liftM2 (:) lower (many alphaNum)
    if elem s keywords then unexpected "keyword" else return s
    <?> "ident"

spc :: Parser Char
spc = oneOf " \t\n\r" <?> "spc"


-- * Utility parsers

notChar :: Char -> Parser Char
notChar = satisfy . (/=)

manyNotMultiple :: Char -> Parser String
manyNotMultiple c = liftM2 (++) (many1 $ notChar c)
                        (option [] $ try $ liftM2 (:) (char c) (manyNotMultiple c))