module Data.EasyTpl.Parser where

import Data.Aeson (Value(..))
import Data.Aeson.Parser (value')
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Text (Text)
import qualified Data.Text as T

import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.Expr

import Data.Tuple (swap)

import Control.Applicative ((<$>), (<*>), (<*), (*>), (<|>))

import Data.EasyTpl.Types

-- | Template parser function.
--   Use this for parsing templates.
parseTemplate :: Parser Template
parseTemplate = Template <$> parseTokens
  where
    parseTokens = do
      end <- atEnd
      case end of
       True -> return []
       _ -> (:) <$> parseToken <*> parseTokens

-- | Less template parser.
--   Used internally for parsing subtemplates.
parseTemplate' :: Parser Template
parseTemplate' = Template <$> many' parseToken

-- | Template token parser.
parseToken :: Parser TemplateToken
parseToken = parseControl <|> parseLiteral <|> parseContent

-- | Control token parser.
parseControl :: Parser TemplateToken
parseControl = ControlToken <$> blockOpen <*> parseTemplate' <* blockClose
  where
    blockOpen = "<%" *> spaces *> parseAction <* spaces <* "%>"
    blockClose = "<%" >> spaces >> "end" >> spaces >> "%>"
    
    parseAction = parseCondition <|> parseIteration

-- | Literal token parser.
parseLiteral :: Parser TemplateToken
parseLiteral = LiteralToken <$> ("<%=" *> parseExpression <* "%>") <?> "Invalid literal"

-- | Content token parser.
parseContent :: Parser TemplateToken
parseContent = many1' getChunk >>= return . ContentToken . BS.concat
  where
    getChunk :: Parser ByteString
    getChunk = (takeWhile1 (/= '<')) <|>
               ((cat2 <$> char '<' <*> notChar '%') <|>
                (cat2 <$> char '<' <* char '\\' <*> char '%') >>=
                return . BSC.pack)

    cat2 a b = a:[b]

-- | Condition control parser.
--   `if ` expression => Condition expression
parseCondition :: Parser Control
parseCondition =  Condition <$> ("if" *> spaces1 *> parseExpression)

-- | Iteration control parser.
--   `for ` ( value [`,` index] ` in` | field [`,` value] ` of` )
parseIteration :: Parser Control
parseIteration = Iteration <$> ("for" *> spaces1 *> (valueIndex <|> fieldValue))
                           <*> (spaces1 *> parseExpression)
  where
    valueIndex = swap <$> pair <* spaces1 <* "in"
    fieldValue = pair <* spaces1 <* "of"
    
    pair = (,) <$> option "" parseIdentifier
               <*> option "" (spaces *> char ',' *> spaces *> parseIdentifier)

-- | Expression parser.
--   Use this for parsing expressions.
parseExpression :: Parser Expression
parseExpression = spaces *> buildExpressionParser operatorTable parsePrimary <* spaces
  where
    operatorTable :: OperatorTable ByteString Expression
    operatorTable = [ {-[ field '.' parseFieldName GetField
                      , block '[' ']' parseExpression GetField
                      ]
                    , -}
                      [ unary '?'    True  NotNull
                      ]
                    , [ unary '#'    False GetLength
                      , unary '!'    False LogicNot
                      , unary '-'    False Negate
                      , unary '+'    False ToNumber
                      ]
                    , [ binary  '^'  AssocRight Power
                      ]
                    , [ binary  '*'  AssocLeft  Multiply 
                      , binary  '/'  AssocLeft  Divide
                      , binary  ':'  AssocLeft  IntDivide
                      , binary  '%'  AssocLeft  Module
                      ]
                    , [ binary  '-'  AssocLeft  Substract
                      , binary  '+'  AssocLeft  Append
                      ]
                    , [ binary' "~>" AssocNone  RegexMatch -- !important: before ~
                      , binary' "~:" AssocNone  RegexSplit -- !important: before ~
                      , binary  '~'  AssocNone  RegexTest
                      ]
                    , [ binary' "==" AssocLeft  Equal
                      , binary' "!=" AssocLeft  NotEqual
                      , binary' "<=" AssocLeft  LessEqual  -- !important: before <
                      , binary' ">=" AssocLeft  GreatEqual -- !important: before >
                      , binary  '<'  AssocLeft  LessThan
                      , binary  '>'  AssocLeft  GreatThan
                      ]
                    , [ binary' "||" AssocLeft  LogicOr
                      , binary' "&&" AssocLeft  LogicAnd
                      ]
                    , [ unary '='    True  Evaluate
                      ]
                    , [ unary '@'    False Stringify
                      ]
                    ]
    {-
    parseFieldName :: Parser Expression
    parseFieldName = (Constant . String) <$> parseIdentifier

    field :: Char -> Parser Expression -> BinaryOperator -> Operator ByteString Expression
    field op ex tp = Postfix (spaces *> char op *> spaces *> ex <* spaces >>=
                              return . flip (BinaryOperation tp))

    block :: Char -> Char -> Parser Expression -> BinaryOperator -> Operator ByteString Expression
    block op cl ex tp = Postfix (spaces *> char op *> ex <* char cl <* spaces >>=
                                 return . flip (BinaryOperation tp))
    -}
    unary :: Char -> Bool -> UnaryOperator -> Operator ByteString Expression
    unary op po tp = (if po then Postfix else Prefix)
                     (spaces >> char op >> spaces >>
                      return (UnaryOperation tp))
    
    binary :: Char -> Assoc -> BinaryOperator -> Operator ByteString Expression
    binary op ac tp = Infix (spaces >> char op >> spaces >>
                             return (BinaryOperation tp)) ac

    binary' :: Parser ByteString -> Assoc -> BinaryOperator -> Operator ByteString Expression
    binary' op ac tp = Infix (spaces >> op >> spaces >>
                              return (BinaryOperation tp)) ac

-- | Primary expression parser.
--   A sequence of .field/[index] operations can be applied to primary expressions (excluding regular expressions).
parsePrimary :: Parser Expression
parsePrimary = ((parseParens
                 <|> parseVariable
                 <|> parseRange
                 <|> parseConstant) >>= parseFields)
#ifdef WITH_REGEX
               <|> parseRegex
#endif

-- | Parens primary expression.
--   `(` expression `)` => expression
parseParens :: Parser Expression
parseParens = char '(' *> parseExpression <* char ')'

-- | Variable primary expression.
--   identifier => Variable identifier
parseVariable :: Parser Expression
parseVariable = Variable <$> parseIdentifier

-- | Sequence of field/index operations
--   `.` key@identifier | `[` key@expression `]` => BinaryOperation GetField topexpr key
parseFields :: Expression -> Parser Expression
parseFields prev = option prev ((parseField <|> parseIndex) >>= parseFields . BinaryOperation GetField prev)
  where
    parseField :: Parser Expression
    parseField = spaces *> char '.' *> parseIdentifier <* spaces >>= return . Constant . String
    
    parseIndex :: Parser Expression
    parseIndex = spaces *> char '[' *> parseExpression <* char ']' <* spaces

-- | Range expression (array generator).
--   `[` [from] `..` to [`,` step] `]` => Range from to step
parseRange :: Parser Expression
parseRange = char '[' *> (Range <$> option defaultFrom parseExpression <* ".." <*>
                          parseExpression <*> option defaultStep (char ',' *> parseExpression)) <* char ']'
  where
    defaultFrom = Constant $ Number 0
    defaultStep = Constant $ Number 1

#ifdef WITH_REGEX
-- | Regular expression (posix regex).
--   `/` regex `/` [caseInsensitive@`i`] [multiLine@`m`] => Regexp regex !caseInsensitive multiLine
parseRegex :: Parser Expression
parseRegex = Regexp <$> (char '/' *> regexpBody <* char '/') <*> caseSensitive <*> multiLine
  where
    regexpBody :: Parser ByteString
    regexpBody = many1' getChunk >>= return . BS.concat
    
    getChunk :: Parser ByteString
    getChunk = (takeWhile1 (\c -> c /= '/' && c /= '\\')) <|>
               (char '\\' >> char '/' >> return "/") <|>
               (char '\\' >> return "\\")

    caseSensitive :: Parser Bool
    caseSensitive = option True $ char 'i' >> return False

    multiLine :: Parser Bool
    multiLine = option False $ char 'm' >> return True
#endif

-- | Constant expression (environment independent).
--   It's just a JSON value parsed by AESON.
parseConstant :: Parser Expression
parseConstant = Constant <$> value'

-- | Identifier
--   Identifiers starts from `a-zA-Z` (alphabetic character), `_` (underscore) or `$` (dollar) and consists of `a-zA-Z0-9`, `_` or `$`.
parseIdentifier :: Parser Text
parseIdentifier = do
  first <- firstChar
  rest <- many' otherChar
  return $ T.pack $ first : rest
  where
    firstChar = satisfy isAlpha_ascii <|> satisfy (inClass "_$")
    otherChar = firstChar <|> satisfy isDigit

-- | Skip zero or more spaces
--  `space`*
spaces :: Parser ()
spaces = skipWhile isSpace

-- | Skip one or more spaces
--   `space`+
spaces1 :: Parser ()
spaces1 = skipSpace >> spaces