content: {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedLists #-}
  
  module Helpers
    ( module Exports,
      checkExprsSuccess,
      checkExprsError,
      pureCatalog,
      getResource,
      getAttribute,
      renderToString,
      withStdlibFunction,
    )
  where
  
  import qualified Data.HashMap.Strict as HM
  import qualified Data.Maybe.Strict as S
  import qualified Data.Vector as Vector
  import Puppet.Interpreter as Exports
  import Puppet.Parser as Exports
  import Puppet.Runner as Exports hiding (getCatalog)
  import Test.Hspec as Exports
  import XPrelude as Exports
  
  -- | Given a raw text input to be parsed, compute the manifest in a pure setting.
  -- The 'InterpreterWriter' might be useful for debugging purpose.
  pureCatalog :: Text -> Either String (FinalCatalog, InterpreterWriter)
  pureCatalog = runExcept . fmap (\s -> (s ^. _1, s ^. _6)) . compileCatalog
    where
      compileCatalog :: Text -> Except String (FinalCatalog, EdgeMap, FinalCatalog, [Resource], InterpreterState, InterpreterWriter)
      compileCatalog input = do
        statements <- either (throwError . show) pure (runPuppetParser mempty input)
        let nodename = "pure"
            top_node = [((TopNode, nodename), NodeDeclaration (NodeDecl (NodeName nodename) statements S.Nothing (initialPPos mempty)))]
            (res, finalState, logs) = pureEval top_node (computeCatalog nodename)
        (catalog, em, exported, defResources) <- either (throwError . show) pure res
        pure (catalog, em, exported, defResources, finalState, logs)
  
  getResource :: (MonadFail m) => RIdentifier -> FinalCatalog -> m Resource
  getResource resid catalog = maybe (fail ("Unknown resource " <> renderToString resid)) pure (HM.lookup resid catalog)
  
  getAttribute :: (MonadFail m) => Text -> Resource -> m PValue
  getAttribute att res =
    case res ^? rattributes . ix att of
      Nothing -> fail ("Unknown attribute: " <> toS att)
      Just x -> return x
  
  withStdlibFunction :: Text -> (([PValue] -> InterpreterMonad PValue) -> Spec) -> Spec
  withStdlibFunction fname testsuite =
    case stdlibFunctions ^? ix fname of
      Just f -> testsuite f
      Nothing -> panic ("Don't know this function: " <> fname)
  
  checkExprsSuccess :: Text -> [Expression] -> Text -> Expectation
  checkExprsSuccess fname args res =
    case evalExprs fname args of
      Left rr -> expectationFailure (show rr)
      Right res' -> res' `shouldBe` res
  
  checkExprsError :: Text -> [Expression] -> String -> Expectation
  checkExprsError fname args msg =
    case evalExprs fname args of
      Left rr -> show rr `shouldContain` msg
      Right r -> expectationFailure ("Should have errored, received this instead: " <> show r)
  
  evalExprs :: Text -> [Expression] -> Either PrettyError Text
  evalExprs fname =
    dummyEval . resolveValue . UFunctionCall fname . Vector.fromList >=> \case
      PString s -> return s
      v -> Left ("Expected a string, not " <> PrettyError (pretty v))
  
  renderToString :: (Pretty a) => a -> String
  renderToString d = displayS (renderCompact (pretty d)) ""
  