Evaluate.hs

-- | Private module. Evaluates a ruby template from what's generated by "Erb.Parser".
module Puppet.Runner.Erb.Evaluate
  ( rubyEvaluate,
  )
where

import qualified Data.Char as Char
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as Text
import qualified Data.Vector as V
import Erb.Ruby
import Puppet.Interpreter
import XPrelude

type ScopeName = Text

-- | Evaluate a list of ruby statements.
rubyEvaluate ::
  Container ScopeInformation ->
  ScopeName ->
  [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 -> ScopeName -> 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 >>= evalValue of
    Left err -> Left err
    Right ex -> Right (curstr <> ex)

evalExpression :: Container ScopeInformation -> ScopeName -> Expression -> Either Doc PValue
evalExpression mp ctx (LookupOperation expvar expidx) = do
  val <- evalExpression mp ctx expvar
  idx <- evalExpression mp ctx expidx
  case val of
    PArray arr ->
      case idx ^? _PValueInteger of
        Nothing -> Left $ "Can't convert index to integer when resolving" <+> pretty val <> brackets (pretty idx)
        Just i ->
          if fromIntegral (V.length arr) <= i
            then Left $ "Array out of bound" <+> pretty val <> brackets (pretty idx)
            else Right (arr V.! fromIntegral i)
    PHash hs ->
      case idx of
        PString idx' ->
          case hs ^. at idx' of
            Just x' -> Right x'
            _ -> Left $ "Can't index variable" <+> pretty val <+> ", it is " <+> pretty (PHash hs)
        _ -> Left $ "Can't index variable" <+> pretty val <+> ", it is " <+> pretty (PHash hs)
    unexpectedval -> Left $ "Can't index variable" <+> pretty val <+> ", it is " <+> pretty unexpectedval
evalExpression _ _ (Value (Literal x)) = Right (PString x)
evalExpression mp ctx (ScopeObject (Value (Literal x))) = getVariable mp ctx x
evalExpression mp ctx (Object (Value (Literal x))) = do
  case Text.stripPrefix "@" x of
    Nothing -> Left $ "Erb variables '" <> ppline x <> "' should be prefixed by '@' in puppet version 4 and above."
    Just x' -> getVariable mp ctx x'
evalExpression _ _ x = Left $ "Can't evaluate" <+> pretty x

evalValue :: PValue -> Either Doc Text
evalValue = go False
  where
    go escaped p = case p of
      PString x -> Right $ if escaped then show x else x
      PNumber x -> Right (scientific2text x)
      PUndef -> Right "nil"
      PBoolean True -> Right "true"
      PBoolean False -> Right "false"
      PArray lst -> fmap (\c -> "[" <> Text.intercalate ", " c <> "]") (mapM (go True) (V.toList lst))
      PHash hash -> fmap (\l -> "{" <> Text.intercalate ", " (map (\(k, v) -> show k <> "=>" <> v) l) <> "}") (mapM (traverse (go True)) (HM.toList hash))
      _ -> Left ("Can't display the ruby equivalent of" <+> pretty p)