language-puppet-1.1.5: Erb/Evaluate.hs

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

import           Control.Lens
import           Data.Aeson.Lens
import           Data.Char                        (isSpace)
import qualified Data.HashMap.Strict              as HM
import           Data.Maybe                       (fromMaybe)
import qualified Data.Text                        as T
import           Data.Tuple.Strict
import qualified Data.Vector                      as V
import           Erb.Ruby

import           Puppet.Interpreter.PrettyPrinter ()
import           Puppet.Interpreter.Resolve
import           Puppet.Interpreter.Types
import           Puppet.Interpreter.Utils
import           Puppet.Parser.Utils
import           Puppet.PP
import           Puppet.Utils
import qualified Text.PrettyPrint.ANSI.Leijen     as P

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 :!: dummyppos :!: 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