TestTarget.hs

module Tricorder.Session.TestTarget
    ( TestTarget (..)
    , render
    , parse
    , resolve
    , project
    )
where

import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey)

import Tricorder.Session.CommandConfig (CommandConfig (..))
import Tricorder.Session.Config (Config (..))
import Tricorder.Session.Stage.Test.Config (TestConfig (..))
import Tricorder.Session.Target (ComponentKind (..), Target (..))

import Tricorder.Session.Target qualified as Target


newtype TestTarget = TestTarget {getTestTarget :: Target}
    deriving stock (Eq, Generic, Ord, Show)
    deriving (FromJSON, ToJSON) via Target
    deriving (FromJSONKey, ToJSONKey) via Target


render :: TestTarget -> Text
render = Target.render . getTestTarget


-- | Parse raw target strings (e.g. the @test_targets@ config) and project them
-- onto their test suites — non-test entries are dropped.
parse :: Text -> Maybe TestTarget
parse = project . Target.parse


-- | [tag:test_targets_invariant] Project a target list onto its test suites —
-- the only way to build a 'TestTargets', so the @test:@-only invariant holds by
-- construction.
project :: Target -> Maybe TestTarget
project = \case
    tgt@(Qualified Test _) -> Just $ TestTarget tgt
    tgt@(PackageQualified _ Test _) -> Just $ TestTarget tgt
    _ -> Nothing


-- | Resolve which test suites to run after a clean build. The explicit
-- source — @test.targets@, falling back to the deprecated top-level
-- @test_targets@ — is projected onto its @test:@ components (see
-- 'projectTestTargets'), so non-test entries are dropped and the result only
-- ever names test suites [ref:test_targets_invariant]. With neither source
-- set, falls back to deriving test targets from the build 'targets'.
resolve :: Config -> [Target] -> [TestTarget]
resolve cfg targets = case cfg.test.commandConfig.targets <|> cfg.testTargets of
    Just explicit -> mapMaybe parse explicit
    Nothing -> mapMaybe project targets