module Data.EasyTpl.Render where

import Data.Aeson (Value(..))
import qualified Data.Aeson.Encode as JE
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 qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LTB
import qualified Data.Text.Encoding as TE
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import qualified Data.Vector as V

import Data.Attoparsec.ByteString.Char8
import qualified Data.Attoparsec.Text as AT

#ifdef WITH_REGEX
import Text.Regex (Regex)
import qualified Text.Regex as RE
#endif

import Data.Fixed (mod')
import Prelude hiding (takeWhile)

import Data.EasyTpl.Types
import Data.EasyTpl.Parser

-- | Internal render template using hash with variables.
renderTemplate' :: Template -> HashMap Text Value -> ByteString
renderTemplate' tpl env = renderTemplate tpl $ Object env

-- | Internal render template using value as variables.
renderTemplate :: Template -> Value -> ByteString
renderTemplate (Template tokens) env = BS.concat $ map (flip renderToken env) tokens

-- | Internal render token.
renderToken :: TemplateToken -> Value -> ByteString

renderToken (ContentToken text) _ = text

renderToken (LiteralToken expr) env = getString $ toString $ evalExpression expr env
  where
    getString (String text) = TE.encodeUtf8 text
    getString _ = ""

renderToken (ControlToken ctl tpl) env = renderControl ctl tpl env

renderControl :: Control -> Template -> Value -> ByteString

renderControl (Condition expr) tpl env@(Object _) = applyCondition $ toBoolean $ evalExpression expr env
  where
    applyCondition :: Value -> ByteString
    applyCondition (Bool True) = renderTemplate tpl env
    applyCondition _ = ""

renderControl (Iteration (keyVar, valVar) expr) tpl env'@(Object henv) = BS.concat $ applyIteration $ evalExpression expr env'
  where
    applyIteration :: Value -> [ByteString]
    applyIteration (Array list) = V.toList $ V.imap applyIndex list
    applyIteration (Object hash) = map applyField $ H.toList hash
    applyIteration _ = []

    addLocal :: Text -> Value -> HashMap Text Value -> HashMap Text Value
    addLocal var val env = if T.null var then env else H.insert var val env

    applyElement :: Value -> Value -> ByteString
    applyElement key val = renderTemplate' tpl $ addLocal keyVar key $ addLocal valVar val henv
    
    applyIndex :: Int -> Value -> ByteString
    applyIndex key val = applyElement (Number (fromIntegral key)) val
    
    applyField :: (Text, Value) -> ByteString
    applyField (key, val) = applyElement (String key) val

renderControl _ _ _ = ""

-- | Internal evaluate expression.
evalExpression :: Expression -> Value -> Value

evalExpression (Constant val) _ = val

evalExpression (Variable var) (Object henv) = maybe Null id $ H.lookup var henv
evalExpression (Variable _) _ = Null

evalExpression (Range from' to' step') env = genRange (toNumber $ evalExpression from' env)
                                                      (toNumber $ evalExpression to' env)
                                                      (toNumber $ evalExpression step' env)
  where
    genRange :: Value -> Value -> Value -> Value
    genRange (Number from) (Number to) (Number step) =
      Array $ V.fromList $ range from to step
    genRange _ _ _ = Null
    
    range from to step | from > to = []
                       | otherwise = Number from : range (from + step) to step

evalExpression (UnaryOperation op' a') env = unary op' (evalExpression a' env)
  where
    unary :: UnaryOperator -> Value -> Value
    
    unary GetLength = getLength
    unary Stringify = stringify
    unary Evaluate = either (String . T.pack . ("Error: " ++)) (flip evalExpression env) . parseOnly parseExpression . toByteString
    unary LogicNot = booleanOp not
    unary Negate = numericOp (0 -)
    unary ToNumber = numericOp id
    unary NotNull = Bool . notNull

    notNull :: Value -> Bool
    notNull Null = False
    notNull _ = True

    booleanOp :: (Bool -> Bool) -> Value -> Value
    booleanOp op a = case toBoolean a of
                      Bool b -> Bool $ op b
                      _ -> Null
    
    numericOp op a = case toNumber a of
                      Number n -> Number $ op n
                      _ -> Null

    toByteString a = case toString a of
                      String s -> TE.encodeUtf8 s
                      _ -> ""
    
#ifdef WITH_REGEX
evalExpression (BinaryOperation op' a' (Regexp re ml cs)) env = apply op' $ toString $ evalExpression a' env
  where
    apply RegexTest  (String s) = Bool $ maybe False (\_ -> True) $ match s
    apply RegexMatch (String s) = maybe Null (Array . V.fromList . map (String . T.pack)) $ match s
    apply RegexSplit (String s) = Array $ V.fromList $ map String $ split s
    apply _ _ = Null
    
    match :: Text -> Maybe [String]
    match = RE.matchRegex regex . T.unpack

    split :: Text -> [Text]
    split = map T.pack . RE.splitRegex regex . T.unpack
    
    regex :: Regex
    regex = RE.mkRegexWithOpts (BSC.unpack re) ml cs

-- regexps is non-evaluatable
evalExpression (Regexp _ _ _) _ = Null
#endif

evalExpression (BinaryOperation op' a' b') env = binary op' (evalExpression a' env) (evalExpression b' env)
  where
    binary :: BinaryOperator -> Value -> Value -> Value
    
    binary Equal a = Bool . (a ==)
    binary NotEqual a = Bool . (a /=)
    
    binary Append (String a) = applyToString $ String . T.append a
    binary Multiply (String a) = applyToInteger $ String . flip T.replicate a
    binary IntDivide (String a) = applyToString $ Array . V.fromList . map String . flip T.splitOn a
    binary LessThan (String a) = applyToString $ Bool . (a <)
    binary GreatThan (String a) = applyToString $ Bool . (a >)
    binary LessEqual (String a) = applyToString $ Bool . (a <=)
    binary GreatEqual (String a) = applyToString $ Bool . (a >=)
    
    binary GetField (String s) = applyToInteger (\i -> if i >= 0 && i < T.length s then String $ T.singleton $ T.index s i else Null)
    
    binary LessThan (Number a) = applyToNumber $ Bool . (a <)
    binary GreatThan (Number a) = applyToNumber $ Bool . (a >)
    binary LessEqual (Number a) = applyToNumber $ Bool . (a <=)
    binary GreatEqual (Number a) = applyToNumber $ Bool . (a >=)
    
    binary GetField (Array a) = applyToInteger (maybe Null id . (V.!?) a)
    binary GetField (Object a) = applyToString (maybe Null id . flip H.lookup a)
    
    binary op a = binary' op a
    
    binary' LogicOr  = booleanOp (||)
    binary' LogicAnd = booleanOp (&&)
    
    binary' Substract = numericOp (-)
    binary' Append = numericOp (+)
    binary' Multiply = numericOp (*)
    binary' Divide = numericOp (/)
    binary' IntDivide = numericOp' (/)
    binary' Module = numericOp mod'
    --binary' Power = numericOp pow
    binary' _ = \_ _ -> Null
    
    numericOp op a b = case (toNumber a, toNumber b) of
                        (Number na, Number nb) -> Number $ op na nb
                        _ -> Null

    numericOp' op a b = case (toNumber a, toNumber b) of
                         (Number na, Number nb) -> Number $ fromIntegral ((round $ op na nb) :: Integer)
                         _ -> Null
    
    booleanOp op a b = case (toBoolean a, toBoolean b) of
                        (Bool ba, Bool bb) -> Bool $ op ba bb
                        _ -> Null
    
    applyToString fn v = case toString v of
                          String s -> fn s
                          _ -> Null

    applyToNumber fn v = case toNumber v of
                          Number n -> fn $ n
                          _ -> Null
    
    applyToInteger fn = applyToNumber (fn . round)

-- | Generic get length.
getLength :: Value -> Value
getLength (String text) = Number $ fromIntegral $ T.length text
getLength (Array list) = Number $ fromIntegral $ V.length list
getLength (Object hash) = Number $ fromIntegral $ H.size hash
getLength _ = Null

-- | Cast value to boolean.
toBoolean :: Value -> Value
toBoolean bool@(Bool _) = bool
#if MIN_VERSION_attoparsec(0,12,0)
toBoolean (Number val) = Bool $ val /= 0
#else
toBoolean (Number val) = Bool $ val /= I 0
#endif
toBoolean (String text) = Bool $ not $ T.null text
toBoolean Null = Bool False
toBoolean (Object hash) = Bool $ not $ H.null hash
toBoolean (Array list)  = Bool $ not $ V.null list

-- | Cast any value to number.
--   Returns null if non-castable.
toNumber :: Value -> Value
toNumber val@(Number _) = val
toNumber (Bool bool) = Number $ if bool then 1 else 0
#if MIN_VERSION_attoparsec(0,12,0)
toNumber (String text) = getNumber' $ AT.parse AT.scientific text
  where
    getNumber' (AT.Done _ val) = Number val
    getNumber' _ = Null
#else
toNumber (String text) = getNumber' $ AT.parse AT.number text
  where
    getNumber' (AT.Done _ val) = Number val
    getNumber' _ = Null
#endif
toNumber _ = Null

-- | Cast any value to string.
toString :: Value -> Value
toString text@(String _) = text
toString (Number val) = String $ T.pack $ show val
toString Null = String "[null]"
toString (Bool _) = String "[bool]"
toString (Object _) = String "[object]"
toString (Array _) = String "[array]"

-- | Stringify value to JSON.
--   Stringify any value using JSON format by AESON encode.
stringify :: Value -> Value
stringify = String . LT.toStrict . LTB.toLazyText . JE.fromValue