mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-25 00:13:11 +03:00
67bc017cf3
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7765 GitOrigin-RevId: 7dd6b1c065cc68ab413736ca49e5957a7697566b
46 lines
1.8 KiB
Haskell
46 lines
1.8 KiB
Haskell
{-# LANGUAGE ConstraintKinds #-}
|
|
|
|
module Test.AgentTestContext
|
|
( AgentTestContext (..),
|
|
introduceAgentTestContext,
|
|
HasAgentTestContext,
|
|
getAgentTestContext,
|
|
)
|
|
where
|
|
|
|
import Command (AgentConfig)
|
|
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 (:>))
|
|
import Prelude
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
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
|
|
_atcAgentConfig :: AgentConfig
|
|
}
|
|
|
|
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
|