{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Skeletest.Main (
runSkeletest,
Flag,
flag,
SnapshotRenderer (..),
renderWithShow,
Plugin,
Spec,
) where
import Control.Monad (unless)
import Data.Maybe (fromMaybe)
import Data.Text qualified as Text
import System.Exit (exitFailure)
import Skeletest.Internal.CLI (Flag, flag, loadCliArgs)
import Skeletest.Internal.Snapshot (
SnapshotRenderer (..),
SnapshotUpdateFlag,
defaultSnapshotRenderers,
renderWithShow,
setSnapshotRenderers,
)
import Skeletest.Internal.Spec (
Spec,
SpecInfo (..),
applyTestSelections,
pruneSpec,
runSpecs,
)
import Skeletest.Plugin (Plugin (..))
import Skeletest.Prop.Internal (PropLimitFlag, PropSeedFlag)
runSkeletest :: [Plugin] -> [(FilePath, String, Spec)] -> IO ()
runSkeletest :: [Plugin] -> [(FilePath, FilePath, Spec)] -> IO ()
runSkeletest = Plugin -> [(FilePath, FilePath, Spec)] -> IO ()
runSkeletest' (Plugin -> [(FilePath, FilePath, Spec)] -> IO ())
-> ([Plugin] -> Plugin)
-> [Plugin]
-> [(FilePath, FilePath, Spec)]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Plugin] -> Plugin
forall a. Monoid a => [a] -> a
mconcat
runSkeletest' :: Plugin -> [(FilePath, String, Spec)] -> IO ()
runSkeletest' :: Plugin -> [(FilePath, FilePath, Spec)] -> IO ()
runSkeletest' Plugin{[Flag]
[SnapshotRenderer]
Hooks
cliFlags :: [Flag]
snapshotRenderers :: [SnapshotRenderer]
hooks :: Hooks
hooks :: Plugin -> Hooks
snapshotRenderers :: Plugin -> [SnapshotRenderer]
cliFlags :: Plugin -> [Flag]
..} [(FilePath, FilePath, Spec)]
testModules = do
selections <- [Flag] -> [Flag] -> IO TestTargets
loadCliArgs [Flag]
builtinFlags [Flag]
cliFlags
setSnapshotRenderers (snapshotRenderers <> defaultSnapshotRenderers)
let initialSpecs = ((FilePath, FilePath, Spec) -> SpecInfo)
-> [(FilePath, FilePath, Spec)] -> [SpecInfo]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath, Spec) -> SpecInfo
mkSpec [(FilePath, FilePath, Spec)]
testModules
success <- runSpecs hooks . pruneSpec . applyTestSelections selections $ initialSpecs
unless success exitFailure
where
builtinFlags :: [Flag]
builtinFlags =
[ forall a. IsFlag a => Flag
flag @SnapshotUpdateFlag
, forall a. IsFlag a => Flag
flag @PropSeedFlag
, forall a. IsFlag a => Flag
flag @PropLimitFlag
]
mkSpec :: (FilePath, FilePath, Spec) -> SpecInfo
mkSpec (FilePath
specPath, FilePath
name, Spec
specSpec) =
SpecInfo
{ FilePath
specPath :: FilePath
specPath :: FilePath
specPath
, specName :: Text
specName = Text -> Text -> Text
stripSuffix Text
"Spec" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
name
, Spec
specSpec :: Spec
specSpec :: Spec
specSpec
}
stripSuffix :: Text -> Text -> Text
stripSuffix Text
suf Text
s = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
s (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
Text.stripSuffix Text
suf Text
s