content: {-# LANGUAGE GADTs #-}
  {-# LANGUAGE RankNTypes #-}
  
  module Puppet.Interpreter
    ( interpretCatalog,
      computeCatalog,
      evaluateStatement,
  
      -- * Utils
      initialState,
      extractScope,
      containerModName,
      askFact,
      module Puppet.Interpreter.Types,
      module Puppet.Interpreter.Resolve,
      module Puppet.Interpreter.IO,
    )
  where
  
  import Control.Monad.Operational hiding (view)
  import qualified Data.Char as Char
  import qualified Data.Graph as Graph
  import qualified Data.HashMap.Strict as Map
  import qualified Data.HashSet as Set
  import qualified Data.List as List
  import qualified Data.Maybe.Strict as S
  import Data.Semigroup (Max (..))
  import qualified Data.Text as Text
  import qualified Data.Tree as Tree
  import qualified Data.Vector as V
  import Facter
  import Hiera.Server
  import Puppet.Interpreter.Helpers
  import Puppet.Interpreter.IO
  import Puppet.Interpreter.PrettyPrinter ()
  import Puppet.Interpreter.Resolve
  import Puppet.Interpreter.Types
  import Puppet.Parser
  import qualified System.Log.Logger as Log
  import XPrelude.Extra
  import XPrelude.PP
  
  -- | Call the operational 'interpretMonad' function to compute the catalog.
  --    Returns either an error, or a tuple containing all the resources,
  --    dependency map, exported resources, and defined resources alongside with
  --    all messages that have been generated by the compilation process.
  --
  --    The later defined resources (eg. all class declarations) are pulled out of the
  --    'InterpreterState' and might not be up to date.
  --    There are only useful for coverage testing (checking dependencies for instance).
  interpretCatalog ::
    (Monad m) =>
    -- | The whole environment required for computing catalog.
    InterpreterReader m ->
    NodeName ->
    Facts ->
    -- | Server settings
    Container Text ->
    m (Pair (Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) [Pair Log.Priority Doc])
  interpretCatalog r node facts settings = do
    (output, _, warnings) <- interpretMonad r (initialState facts settings) (computeCatalog node)
    pure (output :!: warnings)
  
  isParent :: Text -> CurContainerDesc -> InterpreterMonad Bool
  isParent cur (ContClass possibleparent) =
    preuse (scopes . ix cur . scopeParent) >>= \case
      Nothing -> throwPosError ("Internal error: could not find scope" <+> ppline cur <+> "possible parent" <+> ppline possibleparent)
      Just S.Nothing -> pure False
      Just (S.Just p) ->
        if p == possibleparent
          then pure True
          else isParent p (ContClass possibleparent)
  isParent _ _ = pure False
  
  -- | Apply resource defaults, references overrides and expand defines
  finalize :: [Resource] -> InterpreterMonad [Resource]
  finalize rx = do
    scp <- getScopeName
    resdefaults <- use (scopes . ix scp . scopeResDefaults)
    let getOver = use (scopes . ix scp . scopeOverrides) -- retrieves current overrides
        addResDefaults r = ifoldlM (addAttribute CantReplace) r resdefval
          where
            resdefval = resdefaults ^. ix (r ^. rid . itype) . resDefValues
        addOverrides r = getOver >>= foldlM addOverrides' r . view (at (r ^. rid))
        addOverrides' r (ResRefOverride _ prms p) = do
          -- we used this override, so we discard it
          scopes . ix scp . scopeOverrides . at (r ^. rid) .= Nothing
          let forb msg =
                throwPosError
                  ( "Override of parameters ("
                      <> list (map (ppline . fst) $ itoList prms)
                      <> ") of the following resource is forbidden in the current context:"
                      </> pretty r
                      <+> showPPos p
                      </> ":"
                      <+> msg
                  )
          s <- getScope
          overrideType <- case r ^. rscope of
            [] -> forb "Could not find the current resource context" -- we could not get the current resource context
            (x : _) ->
              if x == s
                then pure CantOverride -- we are in the same context : can't replace, but add stuff
                else
                  isParent (scopeName s) x >>= \i ->
                    if i || (r ^. rid . itype == "class")
                      then pure Replace -- we can override what's defined in a parent
                      else forb "Can't override something that was not defined in the parent."
          ifoldlM (addAttribute overrideType) r prms
    -- step 1, apply resDefaults and resRefOverride
    withDefaults <- mapM (addOverrides >=> addResDefaults) rx
    -- There might be some overrides that could not be applied. The only
    -- valid reason is that they override something in exported resources.
    --
    -- it probably do something unexpected on defines, but let's keep it that way for now.
    let keepforlater (ResRefOverride resid resprms ropos) = resModifiers %= (appended :)
          where
            appended = ResourceModifier (resid ^. itype) ModifierMustMatch DontRealize (REqualitySearch "title" (PString (resid ^. iname))) overrider ropos
            overrider r = do
              -- we must define if we can override the value
              let canOverride = CantOverride -- TODO check inheritance
              ifoldlM (addAttribute canOverride) r resprms
    getOver >>= mapM_ keepforlater
    let expandableDefine r = do
          n <- isNativeType (r ^. rid . itype)
          -- if we have a native type, or a virtual/exported resource it
          -- should not be expanded !
          if n || r ^. rvirtuality /= Normal
            then pure [r]
            else expandDefine r
    -- Now that all defaults / override have been applied, the defines can
    -- finally be expanded.
    -- The reason it has to be there is that parameters of the define could
    -- be affected.
    concat <$> mapM expandableDefine withDefaults
    where
      expandDefine :: Resource -> InterpreterMonad [Resource]
      expandDefine r =
        let modulename = getModulename (r ^. rid)
         in isIgnoredModule modulename >>= \case
              True -> pure mempty
              False -> do
                let deftype = dropInitialColons (r ^. rid . itype)
                    defname = r ^. rid . iname
                    curContType = ContDefine deftype defname (r ^. rpos)
                p <- use curPos
                -- we add the relations of this define to the global list of relations
                -- before dropping it, so that they are stored for the final
                -- relationship resolving
                let extr = do
                      (dstid, linkset) <- itoList (r ^. rrelations)
                      linktype <- toList linkset
                      pure (LinkInformation (r ^. rid) dstid linktype p)
                extraRelations <>= extr
                void $ enterScope SENormal curContType modulename p
                (spurious, stmt) <- interpretTopLevel TopDefine deftype
                DefineDecl _ defineParams stmts cp <- extractPrism "expandDefine" _DefineDecl stmt
                let isImported (ContImported _) = True
                    isImported _ = False
                isImportedDefine <- isImported <$> getScope
                curPos .= r ^. rpos
                curscp <- getScope
                when isImportedDefine (pushScope (ContImport (r ^. rnode) curscp))
                pushScope curContType
                loadVariable "title" (PString defname)
                loadVariable "name" (PString defname)
                -- not done through loadvariable because of override errors
                loadParameters (r ^. rattributes) defineParams cp Nothing
                curPos .= cp
                res <- evaluateStatementsFoldable stmts
                out <- finalize (spurious <> res)
                when isImportedDefine popScope
                popScope
                pure out
  
  -- | Given a toplevel (type, name),
  -- return the associated parsed statement together with its evaluated resources
  interpretTopLevel :: TopLevelType -> Text -> InterpreterMonad ([Resource], Statement)
  interpretTopLevel toptype topname =
    -- check if this is a known toplevel
    use (nestedDeclarations . at (toptype, topname)) >>= \case
      Just x -> pure ([], x) -- it is known !
      Nothing -> singleton (GetStatement toptype topname) >>= evalTopLevel
    where
      evalTopLevel :: Statement -> InterpreterMonad ([Resource], Statement)
      evalTopLevel (TopContainer tops s) = do
        pushScope ContRoot
        r <- mapM evaluateStatement tops >>= finalize . concat
        -- popScope
        (nr, ns) <- evalTopLevel s
        popScope
        pure (r <> nr, ns)
      evalTopLevel x = pure ([], x)
  
  -- | Main internal entry point, this function completes the interpretation
  computeCatalog :: NodeName -> InterpreterMonad (FinalCatalog, EdgeMap, FinalCatalog, [Resource])
  computeCatalog nodename = do
    (topres, stmt) <- interpretTopLevel TopNode nodename
    nd <- extractPrism "computeCatalog" _NodeDecl stmt
    let finalStep [] = pure []
        finalStep allres = do
          -- collect stuff and apply thingies
          (realized :!: modified) <- realize allres
          -- we need to run it again against collected stuff, especially
          -- for custom types (defines) that have been realized
          refinalized <- finalize (toList modified) >>= finalStep
          -- replace the modified stuff
          let res = foldl' (\curm e -> curm & at (e ^. rid) ?~ e) realized refinalized
          pure (toList res)
  
        mainstage = Resource (RIdentifier "stage" "main") mempty mempty mempty [ContRoot] Normal mempty (initialPPos mempty) nodename
  
        evaluateNode :: NodeDecl -> InterpreterMonad [Resource]
        evaluateNode (NodeDecl _ sx inheritnode p) = do
          curPos .= p
          pushScope ContRoot
          unless (S.isNothing inheritnode) $ throwPosError "Node inheritance is not handled. It is deprecated since puppet v4"
          mapM evaluateStatement sx >>= finalize . concat
  
    noderes <- evaluateNode nd >>= finalStep . (++ (mainstage : topres))
    let (real :!: exported) = foldl' classify (mempty :!: mempty) noderes
        -- Classify sorts resources between exported and normal ones. It
        -- drops virtual resources, and puts in both categories resources
        -- that are at the same time exported and realized.
        classify ::
          Pair (HashMap RIdentifier Resource) (HashMap RIdentifier Resource) ->
          Resource ->
          Pair (HashMap RIdentifier Resource) (HashMap RIdentifier Resource)
        classify (curr :!: cure) r =
          let i curm = curm & at (r ^. rid) ?~ r
           in case r ^. rvirtuality of
                Normal -> i curr :!: cure
                Exported -> curr :!: i cure
                ExportedRealized -> i curr :!: i cure
                _ -> curr :!: cure
    verified <- Map.fromList . map (\r -> (r ^. rid, r)) <$> mapM validateNativeType (Map.elems real)
    withResourceDependentRelations <- traverse getResourceDependentRelations verified
    edgemap <- makeEdgeMap withResourceDependentRelations
    definedRes <- use definedResources
    pure (withResourceDependentRelations, edgemap, exported, Map.elems definedRes)
  
  -- This extracts additional relationships between resources, that are
  -- dependent on whether some resources are defined. A canonical example is
  -- is the owner field in a File, that can create problems if it's
  -- defined!
  --
  -- For this reason, this function only adds dependencies when the resources
  -- are defined.
  getResourceDependentRelations :: Resource -> InterpreterMonad Resource
  getResourceDependentRelations res =
    extract $
      case res ^. rid . itype of
        "file" -> [depOn "user" "owner", depOn "group" "group"]
        "cron" -> [depOn "user" "user"]
        "exec" -> [depOn "user" "user", depOn "group" "group"]
        _ -> []
    where
      extract actions = do
        newrelations <- fmap (foldl' (Map.unionWith (<>)) (res ^. rrelations)) (sequence actions)
        pure (res & rrelations .~ newrelations)
      depOn :: Text -> Text -> InterpreterMonad (HashMap RIdentifier (HashSet LinkType))
      depOn resType attributeName =
        case res ^? rattributes . ix attributeName of
          Just (PString usr) -> do
            let targetResourceId = RIdentifier resType usr
            existing <- has (ix targetResourceId) <$> use definedResources
            pure $
              if existing
                then Map.singleton targetResourceId (Set.singleton RRequire)
                else Map.empty
          _ -> pure Map.empty
  
  makeEdgeMap :: FinalCatalog -> InterpreterMonad EdgeMap
  makeEdgeMap ct = do
    -- merge the loaded classes and resources
    defs' <- fmap (view rpos) <$> use definedResources
    clss' <- use loadedClasses
    let defs = defs' <> classes' <> aliases' <> names'
        names' = view rpos <$> ct
        -- generate fake resources for all extra aliases
        aliases' = ifromList $ do
          r <- ct ^.. traversed :: [Resource]
          extraAliases <- r ^.. ralias . folded . filtered (/= r ^. rid . iname) :: [Text]
          pure (r ^. rid & iname .~ extraAliases, r ^. rpos)
        classes' = ifromList $ do
          (cn, _ :!: cp) <- itoList clss'
          pure (RIdentifier "class" cn, cp)
    -- Preparation step : all relations to a container become relations to
    -- the stuff that's contained. We build a map of resources, stored by
    -- container.
    -- step 1 - add relations that are stored in resources
    let reorderlink :: (RIdentifier, RIdentifier, LinkType) -> (RIdentifier, RIdentifier, LinkType)
        reorderlink (s, d, RRequire) = (d, s, RBefore)
        reorderlink (s, d, RSubscribe) = (d, s, RNotify)
        reorderlink x = x
        addRR curmap r = iunionWith (<>) curmap newmap
          where
            -- compute the explicit resources, along with the container relationship
            newmap = ifromListWith (<>) resresources
            resid = r ^. rid
            respos = r ^. rpos
            resresources :: [(RIdentifier, [LinkInformation])]
            resresources = do
              (rawdst, lts) <- itoList (r ^. rrelations)
              lt <- toList lts
              let (nsrc, ndst, nlt) = reorderlink (resid, rawdst, lt)
              pure (nsrc, [LinkInformation nsrc ndst nlt respos])
        step1 :: HashMap RIdentifier [LinkInformation]
        step1 = foldl' addRR mempty ct
    -- step 2 - add other relations (mainly stuff made from the "->"
    -- operator)
    let realign (LinkInformation s d t p) =
          let (ns, nd, nt) = reorderlink (s, d, t)
           in (ns, [LinkInformation ns nd nt p])
    rels <- map realign <$> use extraRelations
    let step2 = iunionWith (<>) step1 (ifromList rels)
    -- check that all resources are defined, and build graph
    let checkResDef :: (RIdentifier, [LinkInformation]) -> InterpreterMonad (RIdentifier, RIdentifier, [RIdentifier])
        checkResDef (ri, lifs) = do
          let checkExists r msg = do
                let modulename = getModulename r
                is_ignored <- isIgnoredModule modulename
                unless (has (ix r) defs || is_ignored) (throwPosError msg)
              errmsg = "Unknown resource" <+> pretty ri <+> "used in the following relationships:" <+> vcat (map pretty lifs)
          checkExists ri errmsg
          let genlnk :: LinkInformation -> InterpreterMonad RIdentifier
              genlnk lif = do
                let d = lif ^. linkdst
                checkExists d ("Unknown resource" <+> pretty d <+> "used in a relation at" <+> showPPos (lif ^. linkPos))
                pure d
          ds <- mapM genlnk lifs
          pure (ri, ri, ds)
    edgeList <- mapM checkResDef (itoList step2)
    let (graph, gresolver) = Graph.graphFromEdges' edgeList
    -- now check for scc
    let sccs = filter ((> 1) . length . Tree.flatten) (Graph.scc graph)
    unless (null sccs) $ do
      let trees = vcat (map showtree sccs)
          showtree = indent 2 . vcat . map (mkp . gresolver) . Tree.flatten
          mkp (a, _, links) = resdesc <+> lnks
            where
              resdesc = case ct ^. at a of
                Just r -> pretty r
                _ -> pretty a
              lnks = pretty links
      throwPosError $ "Dependency error, the following resources are strongly connected!" </> trees
    -- let edgePairs = concatMap (\(_,k,ls) -> [(k,l) | l <- ls]) edgeList
    -- throwPosError (vcat (map (\(RIdentifier st sn, RIdentifier dt dn) -> "\"" <> pretty st <> ttext sn <> "\" -> \"" <> ttext dt <> ttext dn <> "\"") edgePairs))
    pure step2
  
  -- This functions performs all the actions triggered by calls to the
  -- realize function or other collectors. It returns a pair of
  -- 'FinalCatalog', where the first part is the new catalog, and the second
  -- part the map of all modified resources. The second part is needed so
  -- that we know for example which resources we should test for expansion
  -- (custom types).
  realize :: [Resource] -> InterpreterMonad (Pair FinalCatalog FinalCatalog)
  realize rs = do
    let -- rma is the initial map of resources, indexed by resource identifier
        rma = ifromList (map (\r -> (r ^. rid, r)) rs)
        -- mutate runs all the resource modifiers (ie. realize, overrides
        -- and other collectors). It stores the modified resources on the
        -- "right" of the resulting pair.
        mutate :: Pair FinalCatalog FinalCatalog -> ResourceModifier -> InterpreterMonad (Pair FinalCatalog FinalCatalog)
        mutate (curmap :!: modified) rmod = do
          let filtrd = curmap ^.. folded . filtered fmod -- all the resources that match the selector/realize criteria
              vcheck f r = f (r ^. rvirtuality)
              (isGoodvirtuality, alterVirtuality) = case rmod ^. rmType of
                RealizeVirtual -> (vcheck (/= Exported), \r -> pure (r & rvirtuality .~ Normal))
                RealizeCollected -> (vcheck (`elem` [Exported, ExportedRealized]), \r -> pure (r & rvirtuality .~ ExportedRealized))
                DontRealize -> (vcheck (`elem` [Normal, ExportedRealized]), pure)
              fmod r = (r ^. rid . itype == rmod ^. rmResType) && checkSearchExpression (rmod ^. rmSearch) r && isGoodvirtuality r
              mutation = alterVirtuality >=> rmod ^. rmMutation
              applyModification :: Pair FinalCatalog FinalCatalog -> Resource -> InterpreterMonad (Pair FinalCatalog FinalCatalog)
              applyModification (cma :!: cmo) r = do
                nr <- mutation r
                let i m = m & at (nr ^. rid) ?~ nr
                pure $
                  if nr /= r
                    then i cma :!: i cmo
                    else cma :!: cmo
          result <- foldM applyModification (curmap :!: modified) filtrd -- apply the modifiation to all the matching resources
          when (rmod ^. rmModifierType == ModifierMustMatch && null filtrd) (throwError (PrettyError ("Could not apply this resource override :" <+> pretty rmod <> ",no matching resource was found.")))
          pure result
        equalModifier (ResourceModifier a1 b1 c1 d1 _ e1) (ResourceModifier a2 b2 c2 d2 _ e2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2
    result <- use resModifiers >>= foldM mutate (rma :!: mempty) . reverse . List.nubBy equalModifier
    resModifiers .= []
    pure result
  
  -- Fold all attribute declarations
  -- checking for duplicates key locally inside a same resource.
  fromAttributeDecls :: Vector AttributeDecl -> InterpreterMonad (Container PValue)
  fromAttributeDecls =
    foldM resolve mempty
    where
      resolve acc adcl =
        case adcl of
          AttributeWildcard v -> do
            pv <- resolveExpression v
            case pv of
              PHash h -> foldM (\curacc (attrname, attrvalue) -> go curacc attrname attrvalue) acc (itoList h)
              _ -> throwPosError ("A hash was expected, not" <+> pretty pv)
          AttributeDecl k _ v -> resolveExpression v >>= go acc k
      go acc k pv =
        case acc ^. at k of
          Just _ -> throwPosError ("Parameter" <+> dullyellow (ppline k) <+> "already defined!")
          Nothing -> pure (acc & at k ?~ pv)
  
  saveCaptureVariables :: InterpreterMonad (HashMap Text (Pair (Pair PValue PPosition) CurContainerDesc))
  saveCaptureVariables = do
    scp <- getScopeName
    vars <- use (scopes . ix scp . scopeVariables)
    pure $ Map.filterWithKey (\k _ -> Text.all Char.isDigit k) vars
  
  restoreCaptureVariables :: HashMap Text (Pair (Pair PValue PPosition) CurContainerDesc) -> InterpreterMonad ()
  restoreCaptureVariables vars = do
    scp <- getScopeName
    scopes . ix scp . scopeVariables %= Map.union vars . Map.filterWithKey (\k _ -> not (Text.all Char.isDigit k))
  
  evaluateStatement :: Statement -> InterpreterMonad [Resource]
  evaluateStatement r@(ClassDeclaration (ClassDecl cname _ _ _ _)) =
    if "::" `Text.isInfixOf` cname
      then nestedDeclarations . at (TopClass, cname) ?= r >> pure []
      else do
        scp <- getScopeName
        let rcname =
              if scp == "::"
                then cname
                else scp <> "::" <> cname
        nestedDeclarations . at (TopClass, rcname) ?= r
        pure []
  evaluateStatement r@(DefineDeclaration (DefineDecl dname _ _ _)) =
    if "::" `Text.isInfixOf` dname
      then nestedDeclarations . at (TopDefine, dname) ?= r >> pure []
      else do
        scp <- getScopeName
        if scp == "::"
          then nestedDeclarations . at (TopDefine, dname) ?= r >> pure []
          else nestedDeclarations . at (TopDefine, scp <> "::" <> dname) ?= r >> pure []
  evaluateStatement r@(ResourceCollectionDeclaration (ResCollDecl ct rtype searchexp mods p)) = do
    curPos .= p
    unless
      (null mods || ct == Collector)
      (throwPosError ("It doesn't seem possible to amend attributes with an exported resource collector:" </> pretty r))
    when (rtype == "class") (throwPosError "Classes cannot be collected")
    rsearch <- resolveSearchExpression searchexp
    let et = case ct of
          Collector -> RealizeVirtual
          ExportedCollector -> RealizeCollected
    resModifiers %= (ResourceModifier rtype ModifierCollector et rsearch (\r' -> foldM modifyCollectedAttribute r' mods) p :)
    -- Now collected from the PuppetDB !
    if et == RealizeCollected
      then do
        let q = searchExpressionToPuppetDB rtype rsearch
        fqdn <- getNodeName
        -- we must filter the resources that originated from this host
        -- here ! They are also turned into "normal" resources
        res <-
          toListOf
            ( folded
                . filtered (hasn't (rnode . only fqdn))
                . to (rvirtuality .~ Normal)
            )
            <$> singleton (PDBGetResources q)
        scpdesc <- ContImported <$> getScope
        void $ enterScope SENormal scpdesc "importing" p
        pushScope scpdesc
        o <- finalize res
        popScope
        pure o
      else pure []
  evaluateStatement (DependencyDeclaration (DepDecl (t1 :!: n1) (t2 :!: n2) lt p)) = do
    curPos .= p
    rn1 <- map (fixResourceName t1) <$> resolveExpressionStrings n1
    rn2 <- map (fixResourceName t2) <$> resolveExpressionStrings n2
    extraRelations <>= [LinkInformation (normalizeRIdentifier t1 an1) (normalizeRIdentifier t2 an2) lt p | an1 <- rn1, an2 <- rn2]
    pure []
  evaluateStatement (ResourceDeclaration (ResDecl t ern eargs virt p)) = do
    curPos .= p
    resnames <- resolveExpressionStrings ern
    args <- fromAttributeDecls eargs
    concat <$> mapM (\n -> registerResource t n args virt p) resnames
  evaluateStatement (MainFunctionDeclaration (MainFuncDecl funcname funcargs p)) = do
    curPos .= p
    mapM resolveExpression (toList funcargs) >>= mainFunctionCall funcname
  evaluateStatement (VarAssignmentDeclaration (VarAssignDecl mt varnames varexpr p)) = do
    curPos .= p
    varval <- resolveExpression varexpr
    mapM_ (resolveDataType >=> (`checkMatch` varval)) mt
    mapM_ (`loadVariable` varval) varnames
    pure []
  evaluateStatement (ConditionalDeclaration (ConditionalDecl conds p)) = do
    curPos .= p
    let checkCond [] = pure []
        checkCond ((e :!: stmts) : xs) = do
          sv <- saveCaptureVariables
          result <- pValue2Bool <$> resolveExpression e
          if result
            then evaluateStatementsFoldable stmts <* restoreCaptureVariables sv
            else restoreCaptureVariables sv *> checkCond xs
    checkCond (toList conds)
  evaluateStatement (ResourceDefaultDeclaration (ResDefaultDecl rtype decls p)) = do
    curPos .= p
    rdecls <- fromAttributeDecls decls
    scp <- getScopeName
    -- invariant that must be respected : the current scope must be created
    -- in "scopes", or nothing gets saved
    preuse (scopes . ix scp) >>= maybe (throwPosError ("INTERNAL ERROR in evaluateStatement ResourceDefaultDeclaration: scope wasn't created - " <> ppline scp)) (const (pure ()))
    let newDefaults = ResDefaults rtype scp rdecls p
        addDefaults x = scopes . ix scp . scopeResDefaults . at rtype ?= x
        -- default merging with parent
        mergedDefaults curdef = newDefaults & resDefValues .~ (rdecls <> (curdef ^. resDefValues))
    preuse (scopes . ix scp . scopeResDefaults . ix rtype) >>= \case
      Nothing -> addDefaults newDefaults
      Just d ->
        if d ^. resDefSrcScope == scp
          then throwPosError ("Defaults for resource" <+> ppline rtype <+> "already declared at" <+> showPPos (d ^. resDefPos))
          else addDefaults (mergedDefaults d)
    pure []
  evaluateStatement (ResourceOverrideDeclaration (ResOverrideDecl t urn eargs p)) = do
    curPos .= p
    raassignements <- fromAttributeDecls eargs
    rn <- resolveExpressionString urn
    scp <- getScopeName
    curoverrides <- use (scopes . ix scp . scopeOverrides)
    let rident = normalizeRIdentifier t rn
    -- check that we didn't already override those values
    withAssignements <- case curoverrides ^. at rident of
      Just (ResRefOverride _ prevass prevpos) -> do
        let cm = prevass `Map.intersection` raassignements
        unless
          (null cm)
          (throwPosError ("The following parameters were already overriden at" <+> showPPos prevpos <+> ":" <+> pretty cm))
        pure (prevass <> raassignements)
      Nothing -> pure raassignements
    scopes . ix scp . scopeOverrides . at rident ?= ResRefOverride rident withAssignements p
    pure []
  evaluateStatement (HigherOrderLambdaDeclaration (HigherOrderLambdaDecl c p)) =
    curPos .= p >> evaluateHFC c
    where
      evaluateHFC :: HOLambdaCall -> InterpreterMonad [Resource]
      evaluateHFC hf =
        let runblock :: [(Text, PValue)] -> InterpreterMonad [Resource]
            runblock assocs = do
              saved <- hfSetvars assocs
              res <- evaluateStatementsFoldable (hf ^. hoLambdaStatements)
              hfRestorevars saved
              pure res
         in case hf ^. hoLambdaFunc of
              LambdaFunc "each" -> do
                varassocs <- hfGenerateAssociations hf
                concat <$> mapM runblock varassocs
              -- we associate each pair of expressions and arguments, and
              -- run the inner code in this scope
              LambdaFunc "assert_type" ->
                case (hf ^.. hoLambdaExpr . folded, hf ^.. hoLambdaParams . folded) of
                  ([utp, uval], [a, b]) -> do
                    let typecheck_lambda (LambdaParam ltype lvar) =
                          case ltype of
                            Nothing -> pure lvar
                            Just udt -> do
                              dt <- resolveDataType udt
                              if dt == DTType
                                then pure lvar
                                else throwPosError ("The lambda value can only be a type in assert_type, not" <+> pretty dt)
                    mtp <- resolveExpression utp
                    val <- resolveExpression uval
                    varexpected <- typecheck_lambda a
                    varactual <- typecheck_lambda b
                    case mtp of
                      PType expectedType ->
                        if datatypeMatch expectedType val
                          then pure []
                          else runblock [(varexpected, PType expectedType), (varactual, PType (typeOf val))]
                      _ -> throwPosError ("The first argument to assert_type should be a data type, not" <+> pretty mtp)
                  _ -> throwPosError "assert_types requires two parameters, and two lambda parameters"
              LambdaFunc "with" -> do
                let expressions = hf ^. hoLambdaExpr
                    parameters = hf ^. hoLambdaParams
                unless
                  (V.length expressions == V.length parameters)
                  (throwPosError ("Mismatched number of arguments and lambda parameters in" <> pretty hf))
                assocs <- forM (V.zip expressions parameters) $ \(uval, LambdaParam mt name) -> do
                  val <- resolveExpression uval
                  -- type checking
                  forM_ mt $ \ut -> do
                    t <- resolveDataType ut
                    checkMatch t val
                  pure (name, val)
                runblock (V.toList assocs)
              fn -> throwPosError ("This lambda function is unknown:" </> pretty fn)
  evaluateStatement r = throwError (PrettyError ("Do not know how to evaluate this statement:" </> pretty r))
  
  -----------------------------------------------------------
  -- Class evaluation
  -----------------------------------------------------------
  
  loadVariable :: Text -> PValue -> InterpreterMonad ()
  loadVariable varname varval = do
    curcont <- getCurContainer
    scp <- getScopeName
    p <- use curPos
    scopeDefined <- has (ix scp) <$> use scopes
    variableDefined <- preuse (scopes . ix scp . scopeVariables . ix varname)
    case (scopeDefined, variableDefined) of
      (False, _) -> throwPosError ("Internal error: trying to save a variable in unknown scope" <+> ppline scp)
      (_, Just ((_ :!: pp) :!: ctx)) ->
        isParent scp (curcont ^. cctype) >>= \case
          True -> do
            debug
              ( "The variable"
                  <+> pretty (UVariableReference varname)
                  <+> "had been overriden because of some arbitrary inheritance rule that was set up to emulate puppet behaviour. It was defined at"
                  <+> showPPos pp
              )
            scopes . ix scp . scopeVariables . at varname ?= ((varval :!: p) :!: curcont ^. cctype)
          False ->
            throwPosError
              ( "Variable"
                  <+> pretty (UVariableReference varname)
                  <+> "already defined at"
                  <+> showPPos pp
                  </> "Context:"
                  <+> pretty ctx
                  </> "Value:"
                  <+> pretty varval
                  </> "Current scope:"
                  <+> ppline scp
              )
      _ -> scopes . ix scp . scopeVariables . at varname ?= ((varval :!: p) :!: curcont ^. cctype)
  
  -- This function loads class and define parameters into scope. It checks
  -- that all mandatory parameters are set, that no extra parameter is declared.
  --
  -- It is able to fill unset parameters with values from Hiera (for classes only) or default values.
  loadParameters ::
    Container PValue -> -- Resource attributes (resolved)
    Parameters -> -- List of parameters as declared (unresolved)
    PPosition -> -- Current position
    Maybe Text -> --  class name
    InterpreterMonad ()
  loadParameters attrs classParams defaultPos classname = do
    p <- use curPos
    curPos .= defaultPos
    let class_params = Set.fromList (classParams ^.. folded . _1 . _1)
        spurious_params = ikeys attrs `Set.difference` class_params
        pp_classdesc = maybe mempty (\x -> " when including class" <+> ppline x) classname
  
        -- the following functions `throwE (Max False)` when there is no value, and `throwE (Max True)` when this value in PUndef.
        check_undef :: S.Maybe UDataType -> Maybe PValue -> ExceptT (Max Bool) InterpreterMonad PValue
        check_undef (S.Just (UDTOptional _)) Nothing = throwE (Max True)
        check_undef _ Nothing = throwE (Max False)
        check_undef _ (Just PUndef) = throwE (Max True)
        check_undef _ (Just v) = pure v
  
        check_hiera :: Text -> S.Maybe UDataType -> ExceptT (Max Bool) InterpreterMonad PValue
        check_hiera k dt = case classname of
          Nothing -> throwE (Max False)
          Just n -> lift (runHiera (n <> "::" <> k) QFirst) >>= check_undef dt
  
        check_def :: Text -> ExceptT (Max Bool) InterpreterMonad PValue
        check_def k = check_undef S.Nothing (attrs ^. at k)
  
        check_default :: S.Maybe Expression -> ExceptT (Max Bool) InterpreterMonad PValue
        check_default S.Nothing = throwE (Max False)
        check_default (S.Just expr) = lift (resolveExpression expr)
  
    unless (null spurious_params) $
      throwPosError ("The following parameters are unknown:" <+> tupled (map (dullyellow . ppline) $ toList spurious_params) <> pp_classdesc)
  
    -- try to set a value to all parameters
    -- The order of evaluation is defined / hiera / default
    unset_params <- fmap concat $ for classParams $ \((varname :!: vartype) :!: valexpr) ->
      runExceptT (check_def varname <|> check_hiera varname vartype <|> check_default valexpr) >>= \case
        Right val -> do
          forM_ vartype $ \utype -> do
            dt <- resolveDataType utype
            unless (datatypeMatch dt val) $
              throwPosError ("Expected type" <+> pretty dt <+> "for parameter" <+> ppline varname <+> "but its value was:" <+> pretty val)
          loadVariable varname val >> pure []
        Left (Max True) -> loadVariable varname PUndef >> pure []
        Left (Max False) -> pure [varname]
    curPos .= p
    unless (null unset_params) $
      throwPosError ("The following mandatory parameters were not set:" <+> tupled (map ppline $ toList unset_params) <> pp_classdesc)
  
  -- Enters a new scope, checks it is not already defined, and inherits the
  -- defaults from the current scope
  --
  -- Inheriting the defaults is necessary for non native types, because they
  -- will be expanded in 'finalize', so if this was not done, we would be
  -- expanding the defines without the defaults applied
  enterScope ::
    ScopeEnteringContext ->
    CurContainerDesc ->
    Text ->
    PPosition ->
    InterpreterMonad Text
  enterScope secontext cont modulename p = do
    let scopename = scopeName cont
    -- This is a special hack for inheritance, because at this time we
    -- have not properly stacked the scopes.
    curcaller <- case secontext of
      SEParent l -> pure (PString $ Text.takeWhile (/= ':') l)
      _ -> resolveVariable "module_name"
    scopeAlreadyDefined <- has (ix scopename) <$> use scopes
    let isImported = case cont of
          ContImported _ -> True
          _ -> False
    -- it is OK to reuse a scope related to imported stuff
    unless (scopeAlreadyDefined && isImported) $ do
      when scopeAlreadyDefined (throwPosError ("Internal error: scope" <+> brackets (ppline scopename) <+> "already defined when loading scope for" <+> pretty cont))
      scp <- getScopeName
      -- TODO fill tags
      basescope <- case secontext of
        SEChild prt -> do
          parentscope <- use (scopes . at prt)
          psc <- case parentscope of
            Just x -> pure x
            Nothing -> throwPosError ("Internal error: could not find parent scope" <+> ppline prt)
          pure (psc & scopeParent .~ S.Just prt)
        _ -> do
          curdefs <- use (scopes . ix scp . scopeResDefaults)
          pure $ ScopeInformation mempty curdefs mempty (CurContainer cont mempty) mempty S.Nothing
      scopes . at scopename ?= basescope
    scopes . ix scopename . scopeVariables . at "caller_module_name" ?= ((curcaller :!: p) :!: cont)
    scopes . ix "::" . scopeVariables . at "calling_module" ?= ((curcaller :!: p) :!: cont)
    scopes . ix scopename . scopeVariables . at "module_name" ?= ((PString modulename :!: p) :!: cont)
    debug ("enterScope, scopename=" <> ppline scopename <+> "caller_module_name=" <> pretty curcaller <+> "module_name=" <> ppline modulename)
    pure scopename
  
  -- Instantiate/declare a class
  loadClass ::
    Text ->
    S.Maybe Text -> -- Set if this is an inheritance load, so that we can set calling module properly
    Container PValue -> -- Resource attributes
    ClassIncludeType ->
    InterpreterMonad [Resource]
  loadClass name loadedfrom attrs incltype = do
    let name' = dropInitialColons name
    nodename <- getNodeName
    singleton (TraceEvent ('[' : toS nodename <> "] loadClass " <> toS name'))
    pos <- use curPos
    -- check if the class has already been loaded
    -- http://docs.puppetlabs.com/puppet/3/reference/lang_classes.html#using-resource-like-declarations
    preuse (loadedClasses . ix name' . _2) >>= \case
      Just pp -> case incltype of
        ClassIncludeLike -> pure []
        _ ->
          throwPosError $
            "Can't include class"
              <+> ppline name'
              <+> "twice when using the resource-like syntax (first occurence at"
              <+> showPPos pp <> ")"
      Nothing -> do
        loadedClasses . at name' ?= (incltype :!: pos) -- set the position of the loaded class
        let modulename = getModulename (RIdentifier "class" name')
        is_ignored <- isIgnoredModule modulename
        if is_ignored
          then pure mempty
          else do
            -- load the actual class, note we are not changing the current position right now
            (spurious, stmt) <- interpretTopLevel TopClass name'
            ClassDecl _ params inh stmts curpos <- extractPrism "loadClass" _ClassDecl stmt
            -- check if we need to define a resource representing the class
            -- This will be the case for the first standard include
            inhstmts <- case inh of
              S.Nothing -> pure []
              S.Just ihname -> loadClass ihname (S.Just name') mempty ClassIncludeLike
            let !scopedesc = ContClass name'
                secontext = case (inh, loadedfrom) of
                  (S.Just x, _) -> SEChild (dropInitialColons x)
                  (_, S.Just x) -> SEParent (dropInitialColons x)
                  _ -> SENormal
            void $ enterScope secontext scopedesc modulename pos
            classresource <-
              if incltype == ClassIncludeLike
                then do
                  scp <- use curScope
                  fqdn <- getNodeName
                  pure [Resource (RIdentifier "class" name') (Set.singleton name') mempty mempty scp Normal mempty pos fqdn]
                else pure []
            pushScope scopedesc
            loadVariable "title" (PString name')
            loadVariable "name" (PString name')
            loadParameters attrs params curpos (Just name')
            curPos .= curpos
            res <- evaluateStatementsFoldable stmts
            out <- finalize (classresource <> spurious <> inhstmts <> res)
            popScope
            pure out
  
  -----------------------------------------------------------
  -- Resource stuff
  -----------------------------------------------------------
  
  addRelationship :: LinkType -> PValue -> Resource -> InterpreterMonad Resource
  addRelationship lt (PResourceReference dt dn) r = pure (r & rrelations %~ insertLt)
    where
      insertLt = iinsertWith (<>) (normalizeRIdentifier dt dn) (Set.singleton lt)
  addRelationship lt (PArray xs) r = foldlM (flip (addRelationship lt)) r xs
  addRelationship _ PUndef r = pure r
  addRelationship _ s _ = throwPosError ("Expected a resource reference, not:" <+> pretty s)
  
  addTagResource :: Resource -> Text -> Resource
  addTagResource r rv = r & rtags . contains rv .~ True
  
  addAttribute :: OverrideType -> Text -> Resource -> PValue -> InterpreterMonad Resource
  addAttribute _ "alias" r v = (\rv -> r & ralias . contains rv .~ True) <$> resolvePValueString v
  addAttribute _ "audit" r _ = use curPos >>= \p -> warn ("Metaparameter audit ignored at" <+> showPPos p) >> pure r
  addAttribute _ "loglevel" r _ = use curPos >>= \p -> warn ("Metaparameter loglevel ignored at" <+> showPPos p) >> pure r
  addAttribute _ "schedule" r _ = use curPos >>= \p -> warn ("Metaparameter schedule ignored at" <+> showPPos p) >> pure r
  addAttribute _ "stage" r _ = use curPos >>= \p -> warn ("Metaparameter stage ignored at" <+> showPPos p) >> pure r
  addAttribute _ "tag" r (PArray v) = foldM (\cr cv -> addTagResource cr <$> resolvePValueString cv) r (toList v)
  addAttribute _ "tag" r v = addTagResource r <$> resolvePValueString v
  addAttribute _ "before" r d = addRelationship RBefore d r
  addAttribute _ "notify" r d = addRelationship RNotify d r
  addAttribute _ "require" r d = addRelationship RRequire d r
  addAttribute _ "subscribe" r d = addRelationship RSubscribe d r
  addAttribute b t r v = go t r v
    where
      go = case b of
        CantOverride -> setAttribute
        Replace -> overrideAttribute
        CantReplace -> defaultAttribute
        AppendAttribute -> appendAttribute
  
  setAttribute :: Text -> Resource -> PValue -> InterpreterMonad Resource
  setAttribute attributename res value =
    case res ^. rattributes . at attributename of
      Nothing -> pure (res & rattributes . at attributename ?~ value)
      Just curval -> do
        -- we must check if the resource scope is a parent of the current scope
        curscope <- getScopeName
        i <- isParent curscope (rcurcontainer res)
        if i -- TODO check why this is set
          then pure (res & rattributes . at attributename ?~ value)
          else do
            -- We will not bark if the same attribute is
            -- defined multiple times with identical values.
            let errmsg = "Attribute" <+> dullmagenta (ppline attributename) <+> "defined multiple times for" <+> pretty res
            if curval == value
              then checkStrict errmsg errmsg
              else throwPosError errmsg
            pure res
  
  overrideAttribute :: Text -> Resource -> PValue -> InterpreterMonad Resource
  overrideAttribute attributename res value = pure (res & rattributes . at attributename ?~ value)
  
  appendAttribute :: Text -> Resource -> PValue -> InterpreterMonad Resource
  appendAttribute attributename res value = do
    nvalue <- case (res ^. rattributes . at attributename, value) of
      (Nothing, _) -> pure value
      (Just (PArray a), PArray b) -> pure (PArray (a <> b))
      (Just (PArray a), b) -> pure (PArray (V.snoc a b))
      (Just a, PArray b) -> pure (PArray (V.cons a b))
      (Just a, b) -> pure (PArray (V.fromList [a, b]))
    pure (res & rattributes . at attributename ?~ nvalue)
  
  defaultAttribute :: Text -> Resource -> PValue -> InterpreterMonad Resource
  defaultAttribute attributename res value =
    pure $ case res ^. rattributes . at attributename of
      Nothing -> res & rattributes . at attributename ?~ value
      Just _ -> res
  
  modifyCollectedAttribute :: Resource -> AttributeDecl -> InterpreterMonad Resource
  modifyCollectedAttribute res attrdecl =
    case attrdecl of
      AttributeDecl attributename arrowop expr -> do
        value <- resolveExpression expr
        let optype = case arrowop of
              AppendArrow -> AppendAttribute
              AssignArrow -> Replace
        addAttribute optype attributename res value
      AttributeWildcard expr -> do
        resolved <- resolveExpression expr
        case resolved of
          PHash hash ->
            foldM (\curres (attrname, attrval) -> addAttribute Replace attrname curres attrval) res (itoList hash)
          _ -> throwPosError ("A hash was expected, not" <+> pretty resolved)
  
  registerResource :: Text -> Text -> Container PValue -> Virtuality -> PPosition -> InterpreterMonad [Resource]
  registerResource "class" _ _ Virtual p = curPos .= p >> throwPosError "Cannot declare a virtual class (or perhaps you can, but I do not know what this means)"
  registerResource "class" _ _ Exported p = curPos .= p >> throwPosError "Cannot declare an exported class (or perhaps you can, but I do not know what this means)"
  registerResource t rn arg vrt p = do
    curPos .= p
    CurContainer cnt tgs <- getCurContainer
    -- default tags
    -- http://docs.puppetlabs.com/puppet/3/reference/lang_tags.html#automatic-tagging
    -- http://docs.puppetlabs.com/puppet/3/reference/lang_tags.html#containment
    let !defaulttags = {-# SCC "rrGetTags" #-} Set.fromList (t : classtags) <> tgs
        allsegs x = x : Text.splitOn "::" x
        (!classtags, !defaultLink) = getClassTags cnt
        getClassTags (ContClass cn) = (allsegs cn, RIdentifier "class" cn)
        getClassTags (ContDefine dt dn _) = (allsegs dt, normalizeRIdentifier dt dn)
        getClassTags ContRoot = ([], RIdentifier "class" "::")
        getClassTags (ContImported _) = ([], RIdentifier "class" "::")
        getClassTags (ContImport _ _) = ([], RIdentifier "class" "::")
        defaultRelation = Map.singleton defaultLink (Set.singleton RRequire)
    allScope <- use curScope
    fqdn <- getNodeName
    let baseresource = Resource (normalizeRIdentifier t rn) (Set.singleton rn) mempty defaultRelation allScope vrt defaulttags p fqdn
    r <- ifoldlM (addAttribute CantOverride) baseresource arg
    let resid = normalizeRIdentifier t rn
    case t of
      "class" ->
        {-# SCC "rrClass" #-}
        do
          definedResources . at resid ?= r
          (r :) <$> loadClass rn S.Nothing (r ^. rattributes) ClassResourceLike
      _ ->
        {-# SCC "rrGeneralCase" #-}
        use (definedResources . at resid) >>= \case
          Just otheres ->
            throwPosError $
              "Resource"
                <+> pretty resid
                <+> "already defined:"
                </> pretty r
                </> pretty otheres
          Nothing -> do
            definedResources . at resid ?= r
            pure [r]
  
  -- functions : this can't really be exported as it uses a lot of stuff from
  -- this module ...
  mainFunctionCall :: Text -> [PValue] -> InterpreterMonad [Resource]
  mainFunctionCall "showscope" _ = use curScope >>= warn . pretty >> pure []
  -- The logging functions
  mainFunctionCall "alert" a = logWithModifier Log.ALERT red a
  mainFunctionCall "crit" a = logWithModifier Log.CRITICAL red a
  mainFunctionCall "debug" a = logWithModifier Log.DEBUG dullwhite a
  mainFunctionCall "emerg" a = logWithModifier Log.EMERGENCY red a
  mainFunctionCall "err" a = logWithModifier Log.ERROR dullred a
  mainFunctionCall "info" a = logWithModifier Log.INFO dullgreen a
  mainFunctionCall "notice" a = logWithModifier Log.NOTICE white a
  mainFunctionCall "warning" a = logWithModifier Log.WARNING dullyellow a
  mainFunctionCall "contain" includes =
    concat <$> mapM doContain includes
    where
      doContain e = do
        classname <- resolvePValueString e
        use (loadedClasses . at classname) >>= \case
          Nothing -> loadClass classname S.Nothing mempty ClassIncludeLike
          Just _ -> pure [] -- TODO check that this happened after class declaration
  mainFunctionCall "include" includes =
    concat <$> mapM doInclude includes
    where
      doInclude e = do
        classname <- resolvePValueString e
        loadClass classname S.Nothing mempty ClassIncludeLike
  mainFunctionCall "require" includes = do
    checkStrict
      "The require function is not supported ! Calling 'include' instead"
      "The 'require' function is not supported in strict mode."
    mainFunctionCall "include" includes
  mainFunctionCall "create_resources" [t, hs] = mainFunctionCall "create_resources" [t, hs, PHash mempty]
  mainFunctionCall "create_resources" [PString t, PHash hs, PHash defparams] = do
    let (ats, t') = Text.span (== '@') t
    virtuality <- case Text.length ats of
      0 -> pure Normal
      1 -> pure Virtual
      2 -> pure Exported
      _ -> throwPosError "Too many @'s"
    p <- use curPos
    let genRes rname (PHash rargs) = registerResource t' rname (rargs <> defparams) virtuality p
        genRes rname x = throwPosError ("create_resource(): the value corresponding to key" <+> ppline rname <+> "should be a hash, not" <+> pretty x)
    concat . Map.elems <$> itraverse genRes hs
  mainFunctionCall "create_resources" args = throwPosError ("create_resource(): expects between two and three arguments, of type [string,hash,hash], and not:" <+> pretty args)
  mainFunctionCall "ensure_packages" args = ensurePackages args
  mainFunctionCall "ensure_resource" args = ensureResource args
  mainFunctionCall "realize" args = do
    pos <- use curPos
    let updateMod (PResourceReference t rn) =
          resModifiers %= (ResourceModifier t ModifierMustMatch RealizeVirtual (REqualitySearch "title" (PString rn)) pure pos :)
        updateMod x = throwPosError ("realize(): all arguments must be resource references, not" <+> pretty x)
    mapM_ updateMod args
    pure []
  mainFunctionCall "tag" args = do
    scp <- getScopeName
    let addTag x = scopes . ix scp . scopeExtraTags . contains x .= True
    mapM_ (resolvePValueString >=> addTag) args
    pure []
  mainFunctionCall "fail" [x] = resolvePValueString x >>= throwPosError . ("fail:" <+>) . dullred . ppline
  mainFunctionCall "fail" _ = throwPosError "fail(): This function takes a single argument"
  -- hiera_include does a unique merge lookup for the requested key, then calls the include function on the resulting array.
  mainFunctionCall "hiera_include" [x] = do
    ndname <- resolvePValueString x
    classes <- toListOf (traverse . _PArray . traverse) <$> runHiera ndname QUnique
    p <- use curPos
    curPos . _1 . _sourceName <>= " [hiera_include call]"
    o <- mainFunctionCall "include" classes
    curPos .= p
    pure o
  mainFunctionCall "hiera_include" _ = throwPosError "hiera_include(): This function takes a single argument"
  -- dumpinfos is a debugging function specific to language-puppet
  mainFunctionCall "dumpinfos" _ = do
    let prntline = logWriter Log.ALERT
        indentln = (<>) "  "
    prntline "Scope stack :"
    scps <- use curScope
    mapM_ (prntline . indentln . pretty) scps
    prntline "Variables in local scope :"
    scp <- getScopeName
    vars <- use (scopes . ix scp . scopeVariables)
    forM_ (sortOn fst (itoList vars)) $ \(idx, (pv :!: _) :!: _) -> prntline $ indentln $ ppline idx <> " -> " <> pretty pv
    pure []
  mainFunctionCall "assert_type" [PType dt, v] =
    if datatypeMatch dt v
      then pure []
      else throwPosError $ "assert_type(): the value " <> pretty v <> " doesn't mach type " <> pretty dt
  mainFunctionCall "assert_type" _ = throwPosError "assert_type(): Expects two arguments"
  mainFunctionCall fname args = do
    p <- use curPos
    let representation = MainFunctionDeclaration (MainFuncDecl fname mempty p)
    rs <- singleton (ExternalFunction fname args)
    unless (rs == PUndef) $ throwPosError ("This function call should pure" <+> pretty PUndef <+> "and not" <+> pretty rs </> pretty representation)
    pure []
  
  ensurePackages :: [PValue] -> InterpreterMonad [Resource]
  ensurePackages [packages] = ensurePackages [packages, PHash mempty]
  ensurePackages [PString p, x] = ensurePackages [PArray (V.singleton (PString p)), x]
  ensurePackages [PArray packages, PHash defparams] = do
    checkStrict
      "The use of the 'ensure_packages' function is a code smell."
      "The 'ensure_packages' function is not allowed in strict mode."
    concat <$> for packages (resolvePValueString >=> ensureResource' "package" (Map.singleton "ensure" "present" <> defparams))
  ensurePackages [PArray _, _] = throwPosError "ensure_packages(): the second argument must be a hash."
  ensurePackages [_, _] = throwPosError "ensure_packages(): the first argument must be a string or an array of strings."
  ensurePackages _ = throwPosError "ensure_packages(): requires one or two arguments."
  
  -- Takes a resource type, title, and a hash of attributes that describe the resource.
  -- Create the resource if it does not exist already.
  -- Takes a resource type, title, and a hash of attributes that describe the resource(s).
  ensureResource :: [PValue] -> InterpreterMonad [Resource]
  ensureResource [PString t, PString title, PHash params] = do
    checkStrict
      "The use of the 'ensure_resource' function is a code smell."
      "The 'ensure_resource' function is not allowed in strict mode."
    ensureResource' t params title
  ensureResource [t, PArray arr, params] = concat <$> mapM (\r -> ensureResource [t, r, params]) (V.toList arr)
  ensureResource [t, title] = ensureResource [t, title, PHash mempty]
  ensureResource [_, PString _, PHash _] = throwPosError "ensureResource(): The first argument must be a string."
  ensureResource [PString _, _, PHash _] = throwPosError "ensureResource(): The second argument must be a string."
  ensureResource [PString _, PString _, _] = throwPosError "ensureResource(): The thrid argument must be a hash."
  ensureResource _ = throwPosError "ensureResource(): expects 2 or 3 arguments."
  
  ensureResource' :: Text -> HashMap Text PValue -> Text -> InterpreterMonad [Resource]
  ensureResource' t params title = do
    isdefined <- has (ix (normalizeRIdentifier t title)) <$> use definedResources
    if isdefined
      then pure []
      else use curPos >>= registerResource t title params Normal
  
  -----------------------------------------------------------
  -- Specific utils functions that depends on this modules
  -----------------------------------------------------------
  
  evaluateStatementsFoldable :: (Foldable f) => f Statement -> InterpreterMonad [Resource]
  evaluateStatementsFoldable = fmap concat . mapM evaluateStatement . toList
  
  -- A helper function for the various loggers
  logWithModifier :: Log.Priority -> (Doc -> Doc) -> [PValue] -> InterpreterMonad [Resource]
  logWithModifier prio m [v] = do
    p <- use curPos
    v' <- resolvePValueString v
    logWriter prio (m (ppline v') <+> showPPos p)
    pure []
  logWithModifier _ _ _ = throwPosError "This function takes a single argument"
  
  -- Contrary to the previous iteration, this will let non native types pass.
  validateNativeType :: Resource -> InterpreterMonad Resource
  validateNativeType r = do
    tps <- singleton GetNativeTypes
    case tps ^. at (r ^. rid . itype) of
      Just x -> case (x ^. puppetValidate) r of
        Right nr -> pure nr
        Left err -> throwPosError ("Invalid resource" <+> pretty r </> getError err)
      Nothing -> pure r
  