{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# 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 (when)
import Data.Foldable (traverse_)
import Skeletest.Internal.CLI (
  ANSIFlag (..),
  Flag,
  FormatFlag,
  flag,
  getFlag,
  loadCliArgs,
 )
import Skeletest.Internal.Capture (CaptureOutputFlag (..), captureOutputPlugin)
import Skeletest.Internal.Exit (TestExitCode (..), exitWith, handleUnknownErrors)
import Skeletest.Internal.Hooks (
  ModifySpecRegistryHookContext (..),
  RunSpecsHookContext (..),
  setUserHooks,
  userHooks,
 )
import Skeletest.Internal.Snapshot (
  SnapshotRenderer (..),
  renderWithShow,
  setSnapshotRenderers,
  snapshotPlugin,
 )
import Skeletest.Internal.Spec (
  Spec,
  SpecInfo (..),
  newSpecRunner,
  specTreePlugin,
 )
import Skeletest.Internal.Spec.Tree (getSpecTests)
import Skeletest.Internal.Utils.Color qualified as Color
import Skeletest.Internal.Utils.Term qualified as Term
import Skeletest.Plugin (Hooks (..), Plugin (..))
import Skeletest.Prop.Internal (propPlugin)

runSkeletest :: [Plugin] -> [(FilePath, Spec)] -> IO ()
runSkeletest :: [Plugin] -> [(FilePath, Spec)] -> IO ()
runSkeletest [Plugin]
userPlugins [(FilePath, Spec)]
testModules = IO () -> IO ()
forall a. IO a -> IO a
handleUnknownErrors (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  IO ()
Term.init
  TestTargets
selections <- [Flag] -> [Flag] -> IO TestTargets
loadCliArgs [Flag]
builtinFlags [Flag]
cliFlags
  IO ()
resolveANSISupport

  [SnapshotRenderer] -> IO ()
setSnapshotRenderers [SnapshotRenderer]
snapshotRenderers
  Hooks -> IO ()
setUserHooks Hooks
hooks

  let initialSpecs :: [SpecInfo]
initialSpecs = ((FilePath, Spec) -> SpecInfo) -> [(FilePath, Spec)] -> [SpecInfo]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Spec) -> SpecInfo
mkSpec [(FilePath, Spec)]
testModules
  [SpecInfo]
specs <-
    UserHooks
userHooks.modifySpecRegistry
      ModifySpecRegistryHookContext
        { testTargets :: TestTargets
testTargets = TestTargets
selections
        }
      [SpecInfo]
initialSpecs
      [SpecInfo] -> IO [SpecInfo]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([SpecTest] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SpecTest] -> Bool) -> [SpecTest] -> Bool
forall a b. (a -> b) -> a -> b
$ (SpecInfo -> [SpecTest]) -> [SpecInfo] -> [SpecTest]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Spec -> [SpecTest]
getSpecTests (Spec -> [SpecTest])
-> (SpecInfo -> Spec) -> SpecInfo -> [SpecTest]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.spec)) [SpecInfo]
specs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
Term.outputErr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
Color.red Text
"ERROR: No tests selected!"
    TestExitCode -> IO ()
forall a. TestExitCode -> IO a
exitWith TestExitCode
ExitNoTests

  SpecRunner
runner <- [SpecInfo] -> IO SpecRunner
newSpecRunner [SpecInfo]
initialSpecs
  TestExitCode
exitCode <-
    UserHooks
userHooks.runSpecs
      RunSpecsHookContext
RunSpecsHookContext
      [SpecInfo]
specs
      SpecRunner
runner.run
  SpecRunner
runner.printSummary
  TestExitCode -> IO ()
forall a. TestExitCode -> IO a
exitWith TestExitCode
exitCode
 where
  builtinPlugins :: [Plugin]
builtinPlugins =
    [ Plugin
specTreePlugin
    , Plugin
snapshotPlugin
    , Plugin
captureOutputPlugin
    , Plugin
propPlugin
    ]

  hooks :: Hooks
hooks = (Plugin -> Hooks) -> [Plugin] -> Hooks
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (.hooks) ([Plugin] -> Hooks) -> [Plugin] -> Hooks
forall a b. (a -> b) -> a -> b
$ [Plugin]
builtinPlugins [Plugin] -> [Plugin] -> [Plugin]
forall a. Semigroup a => a -> a -> a
<> [Plugin]
userPlugins
  snapshotRenderers :: [SnapshotRenderer]
snapshotRenderers = (Plugin -> [SnapshotRenderer]) -> [Plugin] -> [SnapshotRenderer]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (.snapshotRenderers) ([Plugin] -> [SnapshotRenderer]) -> [Plugin] -> [SnapshotRenderer]
forall a b. (a -> b) -> a -> b
$ [Plugin]
builtinPlugins [Plugin] -> [Plugin] -> [Plugin]
forall a. Semigroup a => a -> a -> a
<> [Plugin]
userPlugins

  cliFlags :: [Flag]
cliFlags = (Plugin -> [Flag]) -> [Plugin] -> [Flag]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (.cliFlags) [Plugin]
userPlugins
  builtinFlags :: [Flag]
builtinFlags = (Plugin -> [Flag]) -> [Plugin] -> [Flag]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (.cliFlags) [Plugin]
builtinPlugins [Flag] -> [Flag] -> [Flag]
forall a. Semigroup a => a -> a -> a
<> [Flag]
generalFlags
  generalFlags :: [Flag]
generalFlags =
    [ forall a. IsFlag a => Flag
flag @ANSIFlag
    , forall a. IsFlag a => Flag
flag @(Maybe FormatFlag)
    ]

  mkSpec :: (FilePath, Spec) -> SpecInfo
mkSpec (FilePath
specPath, Spec
spec) =
    SpecInfo
      { FilePath
specPath :: FilePath
specPath :: FilePath
specPath
      , Spec
spec :: Spec
spec :: Spec
spec
      }

resolveANSISupport :: IO ()
resolveANSISupport :: IO ()
resolveANSISupport = do
  CaptureOutputFlag Bool
captureOutput <- IO CaptureOutputFlag
forall a (m :: * -> *). (MonadIO m, IsFlag a) => m a
getFlag
  ANSIFlag Maybe Bool
mUseANSI <- IO ANSIFlag
forall a (m :: * -> *). (MonadIO m, IsFlag a) => m a
getFlag
  (Bool -> IO ()) -> Maybe Bool -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Bool -> IO ()
Term.setANSISupport (Maybe Bool -> IO ()) -> Maybe Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
    if
      | Just Bool
userANSI <- Maybe Bool
mUseANSI -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
userANSI
      | Bool -> Bool
not Bool
captureOutput -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False -- if --capture-output=off, ANSI could mess up output
      | Bool
otherwise -> Maybe Bool
forall a. Maybe a
Nothing