packages feed

language-puppet-1.3.13: src/Erb/Evaluate.hs

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

import           Puppet.Prelude

import           Data.Aeson.Lens
import qualified Data.Char                    as Char
import qualified Data.HashMap.Strict          as HM
import qualified Data.List                    as List
import           Data.Maybe                   (fromMaybe)
import qualified Data.Text                    as Text
import           Data.Tuple.Strict            (Pair (..))
import qualified Data.Vector                  as V

import           Erb.Ruby
import           Puppet.Interpreter.Resolve
import           Puppet.Interpreter.Types
import           Puppet.Interpreter.Utils
import           Puppet.Parser.Utils
import           Puppet.PP
import qualified Text.PrettyPrint.ANSI.Leijen as P

extractFromState :: InterpreterState -> Maybe (Text, Container ScopeInformation)
extractFromState stt =
    let cs = stt ^. curScope
    in  if null cs
            then Nothing
            else let scp = scopeName (List.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 -> 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" <+> 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 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