-- | The test driver configuration options module.
--
-- Anything that can be passed as an argument to the test driver
-- definition exists as a field in the 'Config' type.

module Test.Tasty.Discover.Internal.Config
  ( -- * Configuration Options
    Config (..)
  , GlobPattern
  , SkipTest (..)
  , OnPlatform (..)
  , checkPlatform
  , onLinux
  , onDarwin  
  , onWindows
  , onUnix

    -- * Configuration Parser
  , parseConfig

    -- * Configuration Defaults
  , defaultConfig
  ) where

import Data.Maybe            (isJust)
import GHC.Generics          (Generic)
import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), ArgOrder (Permute), OptDescr (Option), getOpt')
import System.FilePath ((</>))
import System.Info (os)
import Test.Tasty.Options (IsOption (..), safeRead)

-- | A tasty ingredient.
type Ingredient = String

-- | A glob pattern.
type GlobPattern = String

-- | Newtype wrapper for skip test option.
--
-- This option type integrates with Tasty's option system to control whether
-- tests should be skipped. When set to @SkipTest True@, tests will show as
-- @[SKIPPED]@ in yellow in the test output and won't actually execute.
--
-- Used internally by the 'skip' function and 'Flavored' type to implement
-- test skipping functionality.
newtype SkipTest = SkipTest Bool
  deriving stock (Int -> SkipTest -> ShowS
[SkipTest] -> ShowS
SkipTest -> String
(Int -> SkipTest -> ShowS)
-> (SkipTest -> String) -> ([SkipTest] -> ShowS) -> Show SkipTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SkipTest -> ShowS
showsPrec :: Int -> SkipTest -> ShowS
$cshow :: SkipTest -> String
show :: SkipTest -> String
$cshowList :: [SkipTest] -> ShowS
showList :: [SkipTest] -> ShowS
Show, SkipTest -> SkipTest -> Bool
(SkipTest -> SkipTest -> Bool)
-> (SkipTest -> SkipTest -> Bool) -> Eq SkipTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SkipTest -> SkipTest -> Bool
== :: SkipTest -> SkipTest -> Bool
$c/= :: SkipTest -> SkipTest -> Bool
/= :: SkipTest -> SkipTest -> Bool
Eq, (forall x. SkipTest -> Rep SkipTest x)
-> (forall x. Rep SkipTest x -> SkipTest) -> Generic SkipTest
forall x. Rep SkipTest x -> SkipTest
forall x. SkipTest -> Rep SkipTest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SkipTest -> Rep SkipTest x
from :: forall x. SkipTest -> Rep SkipTest x
$cto :: forall x. Rep SkipTest x -> SkipTest
to :: forall x. Rep SkipTest x -> SkipTest
Generic)

instance IsOption SkipTest where
  defaultValue :: SkipTest
defaultValue = Bool -> SkipTest
SkipTest Bool
False
  parseValue :: String -> Maybe SkipTest
parseValue = (Bool -> SkipTest) -> Maybe Bool -> Maybe SkipTest
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> SkipTest
SkipTest (Maybe Bool -> Maybe SkipTest)
-> (String -> Maybe Bool) -> String -> Maybe SkipTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged SkipTest String
optionName = String -> Tagged SkipTest String
forall a. a -> Tagged SkipTest a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"skip-test"
  optionHelp :: Tagged SkipTest String
optionHelp = String -> Tagged SkipTest String
forall a. a -> Tagged SkipTest a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Skip test execution (useful for debugging test discovery)"

-- | Newtype wrapper for platform-specific test filtering.
--
-- This option type allows tests to be conditionally executed based on platform
-- criteria. The wrapped function takes a platform string and returns whether
-- the test should run on that platform.
--
-- Platform values correspond to System.Info.os:
-- - "linux" for Linux systems
-- - "darwin" for macOS
-- - "mingw32" for Windows (GHC compiled)
-- - "unix" matches both "linux" and "darwin"
--
-- Example usage:
-- @
-- -- Only run on Linux
-- onLinux :: OnPlatform  
-- onLinux = OnPlatform (== "linux")
--
-- -- Run on Unix-like systems
-- onUnix :: OnPlatform
-- onUnix = OnPlatform (\p -> p `elem` ["linux", "darwin"])
-- @
newtype OnPlatform = OnPlatform (String -> Bool)

instance IsOption OnPlatform where
  defaultValue :: OnPlatform
defaultValue = (String -> Bool) -> OnPlatform
OnPlatform (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True)  -- Run on all platforms by default
  parseValue :: String -> Maybe OnPlatform
parseValue String
s = case String
s of
    String
"linux"   -> OnPlatform -> Maybe OnPlatform
forall a. a -> Maybe a
Just (OnPlatform -> Maybe OnPlatform) -> OnPlatform -> Maybe OnPlatform
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> OnPlatform
OnPlatform (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"linux")
    String
"darwin"  -> OnPlatform -> Maybe OnPlatform
forall a. a -> Maybe a
Just (OnPlatform -> Maybe OnPlatform) -> OnPlatform -> Maybe OnPlatform
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> OnPlatform
OnPlatform (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"darwin") 
    String
"mingw32" -> OnPlatform -> Maybe OnPlatform
forall a. a -> Maybe a
Just (OnPlatform -> Maybe OnPlatform) -> OnPlatform -> Maybe OnPlatform
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> OnPlatform
OnPlatform (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32")  -- Windows with GHC
    String
"windows" -> OnPlatform -> Maybe OnPlatform
forall a. a -> Maybe a
Just (OnPlatform -> Maybe OnPlatform) -> OnPlatform -> Maybe OnPlatform
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> OnPlatform
OnPlatform (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32")  -- Alias for mingw32
    String
"unix"    -> OnPlatform -> Maybe OnPlatform
forall a. a -> Maybe a
Just (OnPlatform -> Maybe OnPlatform) -> OnPlatform -> Maybe OnPlatform
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> OnPlatform
OnPlatform (\String
p -> String
p String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"linux", String
"darwin"])
    String
_         -> Maybe OnPlatform
forall a. Maybe a
Nothing
  optionName :: Tagged OnPlatform String
optionName = String -> Tagged OnPlatform String
forall a. a -> Tagged OnPlatform a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"on-platform"
  optionHelp :: Tagged OnPlatform String
optionHelp = String -> Tagged OnPlatform String
forall a. a -> Tagged OnPlatform a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Run test only on specified platform (linux|darwin|mingw32|windows|unix)"

-- | Check if the current platform matches the OnPlatform criteria
checkPlatform :: OnPlatform -> Bool
checkPlatform :: OnPlatform -> Bool
checkPlatform (OnPlatform String -> Bool
f) = String -> Bool
f String
os

-- | Helper function: only run on Linux
onLinux :: OnPlatform
onLinux :: OnPlatform
onLinux = (String -> Bool) -> OnPlatform
OnPlatform (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"linux")

-- | Helper function: only run on macOS
onDarwin :: OnPlatform
onDarwin :: OnPlatform
onDarwin = (String -> Bool) -> OnPlatform
OnPlatform (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"darwin")

-- | Helper function: only run on Windows (mingw32)
onWindows :: OnPlatform  
onWindows :: OnPlatform
onWindows = (String -> Bool) -> OnPlatform
OnPlatform (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32")

-- | Helper function: only run on Unix-like systems (Linux or macOS)
onUnix :: OnPlatform
onUnix :: OnPlatform
onUnix = (String -> Bool) -> OnPlatform
OnPlatform (\String
p -> String
p String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"linux", String
"darwin"])

-- | The discovery and runner configuration.
data Config = Config
  { Config -> Maybe String
modules             :: Maybe GlobPattern -- ^ Glob pattern for matching modules during test discovery.
  , Config -> Maybe String
moduleSuffix        :: Maybe String      -- ^ <<<DEPRECATED>>>: Module suffix.
  , Config -> String
searchDir           :: FilePath          -- ^ Directory where to look for tests.
  , Config -> Maybe String
generatedModuleName :: Maybe String      -- ^ Name of the generated main module.
  , Config -> Maybe String
ignores             :: Maybe GlobPattern -- ^ Glob pattern for ignoring modules during test discovery.
  , Config -> [String]
ignoredModules      :: [FilePath]        -- ^ <<<DEPRECATED>>>: Ignored modules by full name.
  , Config -> [String]
tastyIngredients    :: [Ingredient]      -- ^ Tasty ingredients to use.
  , Config -> [String]
tastyOptions        :: [String]          -- ^ Options passed to tasty
  , Config -> Bool
inPlace             :: Bool              -- ^ Whether the source file should be modified in-place.
  , Config -> Bool
noModuleSuffix      :: Bool              -- ^ <<<DEPRECATED>>>: suffix and look in all modules.
  , Config -> Bool
debug               :: Bool              -- ^ Debug the generated module.
  , Config -> Bool
treeDisplay         :: Bool              -- ^ Tree display for the test results table.
  , Config -> Bool
noMain              :: Bool              -- ^ Whether to generate main function.
  } deriving stock (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Config -> Rep Config x
from :: forall x. Config -> Rep Config x
$cto :: forall x. Rep Config x -> Config
to :: forall x. Rep Config x -> Config
Generic)

-- | The default configuration
defaultConfig :: FilePath -> Config
defaultConfig :: String -> Config
defaultConfig String
theSearchDir = Maybe String
-> Maybe String
-> String
-> Maybe String
-> Maybe String
-> [String]
-> [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Config
Config Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing String
theSearchDir Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing [] [] [] Bool
False Bool
False Bool
False Bool
False Bool
False

-- | Deprecation message for old `--[no-]module-suffix` option.
moduleSuffixDeprecationMessage :: String
moduleSuffixDeprecationMessage :: String
moduleSuffixDeprecationMessage = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ String
"\n\n"
  , String
"----------------------------------------------------------\n"
  , String
"DEPRECATION NOTICE: `--[no-]module-suffix` is deprecated.\n"
  , String
"The default behaviour now discovers all test module suffixes.\n"
  , String
"Please use the `--modules='<glob-pattern>'` option to specify.\n"
  , String
"----------------------------------------------------------\n"
  ]

-- | Deprecation message for old `--ignore-module` option.
ignoreModuleDeprecationMessage :: String
ignoreModuleDeprecationMessage :: String
ignoreModuleDeprecationMessage = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ String
"\n\n"
  , String
"----------------------------------------------------------\n"
  , String
"DEPRECATION NOTICE: `--ignore-module` is deprecated.\n"
  , String
"Please use the `--ignores='<glob-pattern>'` option instead.\n"
  , String
"----------------------------------------------------------\n"
  ]

-- | Configuration options parser.
parseConfig :: FilePath -> String -> [String] -> Either String Config
parseConfig :: String -> String -> [String] -> Either String Config
parseConfig String
srcDir String
prog [String]
args = case ArgOrder (Config -> Config)
-> [OptDescr (Config -> Config)]
-> [String]
-> ([Config -> Config], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder (Config -> Config)
forall a. ArgOrder a
Permute (String -> [OptDescr (Config -> Config)]
options String
srcDir) [String]
args of
  ([Config -> Config]
opts, [String]
rest, [String]
rest', []) ->
    let config :: Config
config = (Config -> (Config -> Config) -> Config)
-> Config -> [Config -> Config] -> Config
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Config -> Config) -> Config -> Config)
-> Config -> (Config -> Config) -> Config
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Config -> Config) -> Config -> Config
forall a. a -> a
id) (String -> Config
defaultConfig String
srcDir) { tastyOptions = rest ++ rest' } [Config -> Config]
opts in
      if Config -> Bool
noModuleSuffix Config
config Bool -> Bool -> Bool
|| Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Config -> Maybe String
moduleSuffix Config
config)
        then String -> Either String Config
forall a. HasCallStack => String -> a
error String
moduleSuffixDeprecationMessage
        else if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Config -> [String]
ignoredModules Config
config)
          then String -> Either String Config
forall a. HasCallStack => String -> a
error String
ignoreModuleDeprecationMessage
          else Config -> Either String Config
forall a b. b -> Either a b
Right Config
config
  ([Config -> Config]
_, [String]
_, [String]
_, String
err:[String]
_)  -> String -> Either String Config
forall {b}. String -> Either String b
formatError String
err
  where formatError :: String -> Either String b
formatError String
err = String -> Either String b
forall a b. a -> Either a b
Left (String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err)

-- | All configuration options.
options :: FilePath -> [OptDescr (Config -> Config)]
options :: String -> [OptDescr (Config -> Config)]
options String
srcDir =
  [ String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"modules"]
      ((String -> Config -> Config)
-> String -> ArgDescr (Config -> Config)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s Config
c -> Config
c {modules = Just s}) String
"GLOB-PATTERN")
      String
"Specify desired modules with a glob pattern (white-list)"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"module-suffix"]
      ((String -> Config -> Config)
-> String -> ArgDescr (Config -> Config)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s Config
c -> Config
c {moduleSuffix = Just s}) String
"SUFFIX")
      String
"<<<DEPRECATED>>>: Specify desired test module suffix"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"search-dir"]
      ((String -> Config -> Config)
-> String -> ArgDescr (Config -> Config)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s Config
c -> Config
c {searchDir = srcDir </> s}) String
"DIR")
      String
"Directory where to look for tests relative to the directory of src. By default, this is the directory of src."
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"generated-module"]
      ((String -> Config -> Config)
-> String -> ArgDescr (Config -> Config)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s Config
c -> Config
c {generatedModuleName = Just s}) String
"MODULE")
      String
"Qualified generated module name"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ignores"]
      ((String -> Config -> Config)
-> String -> ArgDescr (Config -> Config)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s Config
c -> Config
c {ignores = Just s}) String
"GLOB-PATTERN")
      String
"Specify desired modules to ignore with a glob pattern (black-list)"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ignore-module"]
      ((String -> Config -> Config)
-> String -> ArgDescr (Config -> Config)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s Config
c -> Config
c {ignoredModules = s : ignoredModules c}) String
"FILE")
      String
"<<<DEPRECATED>>>: Ignore a test module"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ingredient"]
      ((String -> Config -> Config)
-> String -> ArgDescr (Config -> Config)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s Config
c -> Config
c {tastyIngredients = s : tastyIngredients c}) String
"INGREDIENT")
      String
"Qualified tasty ingredient name"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"in-place"]
      ((Config -> Config) -> ArgDescr (Config -> Config)
forall a. a -> ArgDescr a
NoArg ((Config -> Config) -> ArgDescr (Config -> Config))
-> (Config -> Config) -> ArgDescr (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
c -> Config
c {inPlace = True})
      String
"Whether the source file should be modified in-place"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"no-module-suffix"]
      ((Config -> Config) -> ArgDescr (Config -> Config)
forall a. a -> ArgDescr a
NoArg ((Config -> Config) -> ArgDescr (Config -> Config))
-> (Config -> Config) -> ArgDescr (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
c -> Config
c {noModuleSuffix = True})
      String
"<<<DEPRECATED>>>: Ignore test module suffix and import them all"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"debug"]
      ((Config -> Config) -> ArgDescr (Config -> Config)
forall a. a -> ArgDescr a
NoArg ((Config -> Config) -> ArgDescr (Config -> Config))
-> (Config -> Config) -> ArgDescr (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
c -> Config
c {debug = True})
      String
"Debug output of generated test module"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"tree-display"]
      ((Config -> Config) -> ArgDescr (Config -> Config)
forall a. a -> ArgDescr a
NoArg ((Config -> Config) -> ArgDescr (Config -> Config))
-> (Config -> Config) -> ArgDescr (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
c -> Config
c {treeDisplay = True})
      String
"Display test output hierarchically"
  , String
-> [String]
-> ArgDescr (Config -> Config)
-> String
-> OptDescr (Config -> Config)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"no-main"]
      ((Config -> Config) -> ArgDescr (Config -> Config)
forall a. a -> ArgDescr a
NoArg ((Config -> Config) -> ArgDescr (Config -> Config))
-> (Config -> Config) -> ArgDescr (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
c -> Config
c {noMain = True})
      String
"Do not generate a main function"
  ]