-- | 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

    -- * 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 ((</>))

-- | A tasty ingredient.
type Ingredient = String

-- | A glob pattern.
type GlobPattern = String

-- | The discovery and runner configuration.
data Config = Config
  { Config -> Maybe GlobPattern
modules             :: Maybe GlobPattern -- ^ Glob pattern for matching modules during test discovery.
  , Config -> Maybe GlobPattern
moduleSuffix        :: Maybe String      -- ^ <<<DEPRECATED>>>: Module suffix.
  , Config -> GlobPattern
searchDir           :: FilePath          -- ^ Directory where to look for tests.
  , Config -> Maybe GlobPattern
generatedModuleName :: Maybe String      -- ^ Name of the generated main module.
  , Config -> Maybe GlobPattern
ignores             :: Maybe GlobPattern -- ^ Glob pattern for ignoring modules during test discovery.
  , Config -> [GlobPattern]
ignoredModules      :: [FilePath]        -- ^ <<<DEPRECATED>>>: Ignored modules by full name.
  , Config -> [GlobPattern]
tastyIngredients    :: [Ingredient]      -- ^ Tasty ingredients to use.
  , Config -> [GlobPattern]
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.
  } deriving stock (Int -> Config -> ShowS
[Config] -> ShowS
Config -> GlobPattern
(Int -> Config -> ShowS)
-> (Config -> GlobPattern) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS)
-> (a -> GlobPattern) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> GlobPattern
show :: Config -> GlobPattern
$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 :: GlobPattern -> Config
defaultConfig GlobPattern
theSearchDir = Maybe GlobPattern
-> Maybe GlobPattern
-> GlobPattern
-> Maybe GlobPattern
-> Maybe GlobPattern
-> [GlobPattern]
-> [GlobPattern]
-> [GlobPattern]
-> Bool
-> Bool
-> Bool
-> Bool
-> Config
Config Maybe GlobPattern
forall a. Maybe a
Nothing Maybe GlobPattern
forall a. Maybe a
Nothing GlobPattern
theSearchDir Maybe GlobPattern
forall a. Maybe a
Nothing Maybe GlobPattern
forall a. Maybe a
Nothing [] [] [] Bool
False Bool
False Bool
False Bool
False

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

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

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

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