{-# LANGUAGE LambdaCase #-}
-- | Evaluates a ruby template from what's generated by "Erb.Parser".
module Erb.Evaluate (rubyEvaluate, getVariable, extractFromState) where

import Puppet.PP
import qualified Text.PrettyPrint.ANSI.Leijen as P
import Puppet.Interpreter.PrettyPrinter()
import Puppet.Interpreter.Types
import Puppet.Interpreter.Resolve
import Erb.Ruby
import qualified Data.Text as T
import Puppet.Utils
import Control.Lens
import qualified Data.Vector as V
import Data.Char (isSpace)
import Data.Aeson.Lens
import Data.Tuple.Strict
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromMaybe)

extractFromState :: InterpreterState -> Maybe (T.Text, Container ScopeInformation)
extractFromState stt =
    let cs = stt ^. curScope
    in  if null cs
            then Nothing
            else let scp = scopeName (head cs)
                     classes = (PArray . V.fromList . map PString . HM.keys) (stt ^. loadedClasses)
                     scps = stt ^. scopes
                     cd = fromMaybe ContRoot (scps ^? ix scp . scopeContainer . cctype) -- get the current containder description
                     cscps = scps & ix scp . scopeVariables . at "classes" ?~ ( classes :!: dummypos :!: cd )
                 in  Just (scp, cscps)

rubyEvaluate :: Container ScopeInformation -> T.Text -> [RubyStatement] -> Either Doc T.Text
rubyEvaluate vars ctx = foldl (evalruby vars ctx) (Right "") . optimize
    where
        optimize [] = []
        optimize (Puts x : DropPrevSpace' : xs) = optimize $ DropPrevSpace (Puts x) : xs
        optimize (x:xs) = x : optimize xs

spaceNotCR :: Char -> Bool
spaceNotCR c = isSpace c && c /= '\n' && c /= '\r'

evalruby :: Container ScopeInformation -> T.Text -> Either Doc T.Text -> RubyStatement -> Either Doc T.Text
evalruby _  _   (Left err)     _        = Left err
evalruby _ _  (Right _) (DropPrevSpace') = Left "Could not evaluate a non optimize DropPrevSpace'"
evalruby mp ctx (Right curstr) (DropNextSpace x) = case evalruby mp ctx (Right curstr) x of
                                                       Left err -> Left err
                                                       Right y -> Right (T.dropWhile spaceNotCR y)
evalruby mp ctx (Right curstr) (DropPrevSpace x) = case evalruby mp ctx (Right curstr) x of
                                                       Left err -> Left err
                                                       Right y -> Right (T.dropWhileEnd spaceNotCR y)
evalruby mp ctx (Right curstr) (Puts e) = case evalExpression mp ctx e of
    Left err -> Left err
    Right ex -> Right (curstr <> ex)

evalExpression :: Container ScopeInformation -> T.Text -> Expression -> Either Doc T.Text
evalExpression mp ctx (LookupOperation varname varindex) = do
    rvname <- evalExpression mp ctx varname
    rvindx <- evalExpression mp ctx varindex
    getVariable mp ctx rvname >>= \case
        PArray arr ->
            case a2i rvindx of
                Nothing -> Left $ "Can't convert index to integer when resolving" <+> ttext rvname P.<> brackets (ttext rvindx)
                Just  i -> if fromIntegral (V.length arr) <= i
                    then Left $ "Array out of bound" <+> ttext rvname P.<> brackets (ttext rvindx)
                    else evalValue (arr V.! fromIntegral i)
        PHash hs -> case hs ^. at rvindx of
                        Just x -> evalValue x
                        _ -> Left $ "Can't index variable" <+> ttext rvname <+> ", it is " <+> pretty (PHash hs)
        varvalue -> Left $ "Can't index variable" <+> ttext rvname <+> ", it is " <+> pretty varvalue
evalExpression _  _   (Value (Literal x))          = Right x
evalExpression mp ctx (Object (Value (Literal x))) = getVariable mp ctx x >>= evalValue
evalExpression _  _   x = Left $ "Can't evaluate" <+> pretty x

evalValue :: PValue -> Either Doc T.Text
evalValue (PString x) = Right x
evalValue (PNumber x) = Right (scientific2text x)
evalValue x = Right $ T.pack $ show x

a2i :: T.Text -> Maybe Integer
a2i x = case text2Scientific x of
            Just y -> y ^? _Integer
            _ -> Nothing