module Test.Tasty.Config (
Config (..)
, GlobPattern
, parseConfig
, defaultConfig
) where
import Data.Maybe (isJust)
import System.Console.GetOpt (ArgDescr (NoArg, ReqArg),
ArgOrder (Permute), OptDescr (Option),
getOpt')
type Ingredient = String
type GlobPattern = String
data Config = Config
{ Config -> Maybe GlobPattern
modules :: Maybe GlobPattern
, Config -> Maybe GlobPattern
moduleSuffix :: Maybe String
, Config -> Maybe GlobPattern
generatedModuleName :: Maybe String
, Config -> Maybe GlobPattern
ignores :: Maybe GlobPattern
, Config -> [GlobPattern]
ignoredModules :: [FilePath]
, Config -> [GlobPattern]
tastyIngredients :: [Ingredient]
, Config -> [GlobPattern]
tastyOptions :: [String]
, Config -> Bool
noModuleSuffix :: Bool
, Config -> Bool
debug :: Bool
, Config -> Bool
treeDisplay :: Bool
} deriving (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
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> GlobPattern
$cshow :: Config -> GlobPattern
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Maybe GlobPattern
-> Maybe GlobPattern
-> Maybe GlobPattern
-> Maybe GlobPattern
-> [GlobPattern]
-> [GlobPattern]
-> [GlobPattern]
-> Bool
-> Bool
-> Bool
-> Config
Config Maybe GlobPattern
forall a. Maybe a
Nothing Maybe GlobPattern
forall a. Maybe a
Nothing Maybe GlobPattern
forall a. Maybe a
Nothing Maybe GlobPattern
forall a. Maybe a
Nothing [] [] [] Bool
False Bool
False Bool
False
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
[ "\n\n"
, "----------------------------------------------------------\n"
, "DEPRECATION NOTICE: `--[no-]module-suffix` is deprecated.\n"
, "The default behaviour now discovers all test module suffixes.\n"
, "Please use the `--modules='<glob-pattern>'` option to specify.\n"
, "----------------------------------------------------------\n"
]
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
[ "\n\n"
, "----------------------------------------------------------\n"
, "DEPRECATION NOTICE: `--ignore-module` is deprecated.\n"
, "Please use the `--ignores='<glob-pattern>'` option instead.\n"
, "----------------------------------------------------------\n"
]
parseConfig :: String -> [String] -> Either String Config
parseConfig :: GlobPattern -> [GlobPattern] -> Either GlobPattern Config
parseConfig prog :: GlobPattern
prog args :: [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 [OptDescr (Config -> Config)]
options [GlobPattern]
args of
(opts :: [Config -> Config]
opts, rest :: [GlobPattern]
rest, rest' :: [GlobPattern]
rest', []) ->
let config :: Config
config = (Config -> (Config -> Config) -> Config)
-> Config -> [Config -> Config] -> Config
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) Config
defaultConfig { tastyOptions :: [GlobPattern]
tastyOptions = [GlobPattern]
rest [GlobPattern] -> [GlobPattern] -> [GlobPattern]
forall a. [a] -> [a] -> [a]
++ [GlobPattern]
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 (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
(_, _, _, err :: GlobPattern
err:_) -> GlobPattern -> Either GlobPattern Config
forall b. GlobPattern -> Either GlobPattern b
formatError GlobPattern
err
where
formatError :: GlobPattern -> Either GlobPattern b
formatError err :: GlobPattern
err = GlobPattern -> Either GlobPattern b
forall a b. a -> Either a b
Left (GlobPattern
prog GlobPattern -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " GlobPattern -> ShowS
forall a. [a] -> [a] -> [a]
++ GlobPattern
err)
options :: [OptDescr (Config -> Config)]
options :: [OptDescr (Config -> Config)]
options = [
GlobPattern
-> [GlobPattern]
-> ArgDescr (Config -> Config)
-> GlobPattern
-> OptDescr (Config -> Config)
forall a.
GlobPattern
-> [GlobPattern] -> ArgDescr a -> GlobPattern -> OptDescr a
Option [] ["modules"]
((GlobPattern -> Config -> Config)
-> GlobPattern -> ArgDescr (Config -> Config)
forall a. (GlobPattern -> a) -> GlobPattern -> ArgDescr a
ReqArg (\s :: GlobPattern
s c :: Config
c -> Config
c {modules :: Maybe GlobPattern
modules = GlobPattern -> Maybe GlobPattern
forall a. a -> Maybe a
Just GlobPattern
s}) "GLOB-PATTERN")
"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 [] ["module-suffix"]
((GlobPattern -> Config -> Config)
-> GlobPattern -> ArgDescr (Config -> Config)
forall a. (GlobPattern -> a) -> GlobPattern -> ArgDescr a
ReqArg (\s :: GlobPattern
s c :: Config
c -> Config
c {moduleSuffix :: Maybe GlobPattern
moduleSuffix = GlobPattern -> Maybe GlobPattern
forall a. a -> Maybe a
Just GlobPattern
s}) "SUFFIX")
"<<<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 [] ["generated-module"]
((GlobPattern -> Config -> Config)
-> GlobPattern -> ArgDescr (Config -> Config)
forall a. (GlobPattern -> a) -> GlobPattern -> ArgDescr a
ReqArg (\s :: GlobPattern
s c :: Config
c -> Config
c {generatedModuleName :: Maybe GlobPattern
generatedModuleName = GlobPattern -> Maybe GlobPattern
forall a. a -> Maybe a
Just GlobPattern
s}) "MODULE")
"Qualified generated module name"
, GlobPattern
-> [GlobPattern]
-> ArgDescr (Config -> Config)
-> GlobPattern
-> OptDescr (Config -> Config)
forall a.
GlobPattern
-> [GlobPattern] -> ArgDescr a -> GlobPattern -> OptDescr a
Option [] ["ignores"]
((GlobPattern -> Config -> Config)
-> GlobPattern -> ArgDescr (Config -> Config)
forall a. (GlobPattern -> a) -> GlobPattern -> ArgDescr a
ReqArg (\s :: GlobPattern
s c :: Config
c -> Config
c {ignores :: Maybe GlobPattern
ignores = GlobPattern -> Maybe GlobPattern
forall a. a -> Maybe a
Just GlobPattern
s}) "GLOB-PATTERN")
"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 [] ["ignore-module"]
((GlobPattern -> Config -> Config)
-> GlobPattern -> ArgDescr (Config -> Config)
forall a. (GlobPattern -> a) -> GlobPattern -> ArgDescr a
ReqArg (\s :: GlobPattern
s c :: Config
c -> Config
c {ignoredModules :: [GlobPattern]
ignoredModules = GlobPattern
s GlobPattern -> [GlobPattern] -> [GlobPattern]
forall a. a -> [a] -> [a]
: Config -> [GlobPattern]
ignoredModules Config
c}) "FILE")
"<<<DEPRECATED>>>: Ignore a test module"
, GlobPattern
-> [GlobPattern]
-> ArgDescr (Config -> Config)
-> GlobPattern
-> OptDescr (Config -> Config)
forall a.
GlobPattern
-> [GlobPattern] -> ArgDescr a -> GlobPattern -> OptDescr a
Option [] ["ingredient"]
((GlobPattern -> Config -> Config)
-> GlobPattern -> ArgDescr (Config -> Config)
forall a. (GlobPattern -> a) -> GlobPattern -> ArgDescr a
ReqArg (\s :: GlobPattern
s c :: Config
c -> Config
c {tastyIngredients :: [GlobPattern]
tastyIngredients = GlobPattern
s GlobPattern -> [GlobPattern] -> [GlobPattern]
forall a. a -> [a] -> [a]
: Config -> [GlobPattern]
tastyIngredients Config
c}) "INGREDIENT")
"Qualified tasty ingredient name"
, GlobPattern
-> [GlobPattern]
-> ArgDescr (Config -> Config)
-> GlobPattern
-> OptDescr (Config -> Config)
forall a.
GlobPattern
-> [GlobPattern] -> ArgDescr a -> GlobPattern -> OptDescr a
Option [] ["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
$ \c :: Config
c -> Config
c {noModuleSuffix :: Bool
noModuleSuffix = Bool
True})
"<<<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 [] ["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
$ \c :: Config
c -> Config
c {debug :: Bool
debug = Bool
True})
"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 [] ["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
$ \c :: Config
c -> Config
c {treeDisplay :: Bool
treeDisplay = Bool
True})
"Display test output hierarchically"
]