2023-01-30 09:59:04 +03:00
|
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
|
|
|
|
|
|
module Test.AgentTestContext
|
|
|
|
( AgentTestContext (..),
|
|
|
|
introduceAgentTestContext,
|
|
|
|
HasAgentTestContext,
|
|
|
|
getAgentTestContext,
|
|
|
|
)
|
|
|
|
where
|
|
|
|
|
2023-02-02 07:26:29 +03:00
|
|
|
import Command (AgentConfig)
|
2023-01-30 09:59:04 +03:00
|
|
|
import Control.Monad.Reader.Class (MonadReader)
|
|
|
|
import GHC.Stack (HasCallStack)
|
|
|
|
import Hasura.Backends.DataConnector.API qualified as API
|
|
|
|
import Test.Sandwich (HasLabel, Label (..), LabelValue, NodeOptions (..), SpecFree, defaultNodeOptions, getContext, introduce', type (:>))
|
2023-02-02 08:46:56 +03:00
|
|
|
import Prelude
|
2023-01-30 09:59:04 +03:00
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
data AgentTestContext = AgentTestContext
|
|
|
|
{ _atcSourceName :: API.SourceName,
|
|
|
|
_atcCapabilitiesResponse :: API.CapabilitiesResponse,
|
|
|
|
-- | This is the configuration passed by the user on the command line which will
|
|
|
|
-- be used in preference to any dataset clone's config if it is specified
|
2023-02-02 07:26:29 +03:00
|
|
|
_atcAgentConfig :: AgentConfig
|
2023-01-30 09:59:04 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
introduceAgentTestContext :: forall context m. (Monad m) => AgentTestContext -> SpecFree (LabelValue "agent-test-context" AgentTestContext :> context) m () -> SpecFree context m ()
|
|
|
|
introduceAgentTestContext testContext =
|
|
|
|
introduce' nodeOptions "Introduce agent test context" agentTestContextLabel (pure testContext) (const $ pure ())
|
|
|
|
where
|
|
|
|
nodeOptions =
|
|
|
|
defaultNodeOptions
|
|
|
|
{ nodeOptionsVisibilityThreshold = 150,
|
|
|
|
nodeOptionsCreateFolder = False,
|
|
|
|
nodeOptionsRecordTime = False
|
|
|
|
}
|
|
|
|
|
|
|
|
agentTestContextLabel :: Label "agent-test-context" AgentTestContext
|
|
|
|
agentTestContextLabel = Label
|
|
|
|
|
|
|
|
type HasAgentTestContext context = HasLabel context "agent-test-context" AgentTestContext
|
|
|
|
|
|
|
|
getAgentTestContext :: (HasCallStack, HasAgentTestContext context, MonadReader context m) => m AgentTestContext
|
|
|
|
getAgentTestContext = getContext agentTestContextLabel
|