skeletest-0.3.4: src/Skeletest/Main.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Skeletest.Main (
  runSkeletest,

  -- * CLI flags
  Flag,
  flag,

  -- * Snapshots
  SnapshotRenderer (..),
  renderWithShow,

  -- * Plugins
  Plugin,

  -- * Re-exports
  Spec,
) where

import Control.Monad (unless, (<=<))
import Skeletest.Internal.CLI (Flag, flag, loadCliArgs)
import Skeletest.Internal.Capture (CaptureOutputFlag)
import Skeletest.Internal.Snapshot (
  SnapshotRenderer (..),
  SnapshotUpdateFlag,
  defaultSnapshotRenderers,
  renderWithShow,
  setSnapshotRenderers,
 )
import Skeletest.Internal.Spec (
  Spec,
  SpecInfo (..),
  applyTestSelectionsHook,
  focusHook,
  manualTestsHook,
  runSpecs,
  skipHook,
  xfailHook,
 )
import Skeletest.Plugin (Hooks (..), Plugin (..))
import Skeletest.Prop.Internal (PropLimitFlag, PropSeedFlag)
import System.Exit (exitFailure)

runSkeletest :: [Plugin] -> [(FilePath, Spec)] -> IO ()
runSkeletest = runSkeletest' . mconcat

runSkeletest' :: Plugin -> [(FilePath, Spec)] -> IO ()
runSkeletest' Plugin{hooks = hooks0, ..} testModules = do
  selections <- loadCliArgs builtinFlags cliFlags
  setSnapshotRenderers (snapshotRenderers <> defaultSnapshotRenderers)

  let initialSpecs = map mkSpec testModules
  success <- runSpecs hooks <=< hooks.modifySpecRegistry selections pure $ initialSpecs
  unless success exitFailure
 where
  hooks = mconcat builtinHooks <> hooks0

  builtinHooks =
    [ xfailHook
    , skipHook
    , focusHook
    , applyTestSelectionsHook
    , manualTestsHook
    ]

  builtinFlags =
    [ flag @SnapshotUpdateFlag
    , flag @PropSeedFlag
    , flag @PropLimitFlag
    , flag @CaptureOutputFlag
    ]

  mkSpec (specPath, specSpec) =
    SpecInfo
      { specPath
      , specSpec
      }