language-puppet-1.3.14: src/Puppet/Runner/Erb/Evaluate.hs
-- | Private module. Evaluates a ruby template from what's generated by "Erb.Parser".
module Puppet.Runner.Erb.Evaluate (
rubyEvaluate
) where
import XPrelude
import Data.Aeson.Lens
import qualified Data.Char as Char
import qualified Data.Text as Text
import qualified Data.Vector as V
import Erb.Ruby
import Puppet.Interpreter
rubyEvaluate :: Container ScopeInformation -> Text -> [RubyStatement] -> Either Doc 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 = Char.isSpace c && c /= '\n' && c /= '\r'
evalruby :: Container ScopeInformation -> Text -> Either Doc Text -> RubyStatement -> Either Doc 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 (Text.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 (Text.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 -> Text -> Expression -> Either Doc 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" <+> ppline rvname <> brackets (ppline rvindx)
Just i -> if fromIntegral (V.length arr) <= i
then Left $ "Array out of bound" <+> ppline rvname <> brackets (ppline rvindx)
else evalValue (arr V.! fromIntegral i)
PHash hs -> case hs ^. at rvindx of
Just x -> evalValue x
_ -> Left $ "Can't index variable" <+> ppline rvname <+> ", it is " <+> pretty (PHash hs)
varvalue -> Left $ "Can't index variable" <+> ppline 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 Text
evalValue (PString x) = Right x
evalValue (PNumber x) = Right (scientific2text x)
evalValue x = Right $ show x
a2i :: Text -> Maybe Integer
a2i x = case text2Scientific x of
Just y -> y ^? _Integer
_ -> Nothing