{-# 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