{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
module Test.DocTest.Internal.Options where
import Prelude ()
import Prelude.Compat
import Control.DeepSeq (NFData)
import Data.List.Compat
import GHC.Generics (Generic)
import qualified Paths_doctest_parallel
import Data.Version (showVersion)
#if __GLASGOW_HASKELL__ < 900
import Config as GHC
#else
import GHC.Settings.Config as GHC
#endif
import Test.DocTest.Internal.Location (Located (Located), Location)
import Test.DocTest.Internal.Interpreter (ghc)
import Text.Read (readMaybe)
usage :: String
usage :: ModuleName
usage = [ModuleName] -> ModuleName
unlines [
ModuleName
"Usage:"
, ModuleName
" doctest [ options ]... [<module>]..."
, ModuleName
" doctest --help"
, ModuleName
" doctest --version"
, ModuleName
" doctest --info"
, ModuleName
""
, ModuleName
"Options:"
, ModuleName
" -jN number of threads to use"
, ModuleName
"† --implicit-module-import import module before testing it (default)"
, ModuleName
"† --randomize-order randomize order in which tests are run"
, ModuleName
"† --seed=N use a specific seed to randomize test order"
, ModuleName
"† --preserve-it preserve the `it` variable between examples"
, ModuleName
" --verbose print each test as it is run"
, ModuleName
" --quiet only print errors"
, ModuleName
" --help display this help and exit"
, ModuleName
" --version output version information and exit"
, ModuleName
" --info output machine-readable version information and exit"
, ModuleName
""
, ModuleName
"Supported inverted options:"
, ModuleName
"† --no-implicit-module-import"
, ModuleName
"† --no-randomize-order (default)"
, ModuleName
"† --no-preserve-it (default)"
, ModuleName
""
, ModuleName
"Options marked with a dagger (†) can also be used to set module level options, using"
, ModuleName
"an ANN pragma like this:"
, ModuleName
""
, ModuleName
" {-# ANN module \"doctest-parallel: --no-randomize-order\" #-} "
, ModuleName
""
]
version :: String
version :: ModuleName
version = Version -> ModuleName
showVersion Version
Paths_doctest_parallel.version
ghcVersion :: String
ghcVersion :: ModuleName
ghcVersion = ModuleName
GHC.cProjectVersion
versionInfo :: String
versionInfo :: ModuleName
versionInfo = [ModuleName] -> ModuleName
unlines [
ModuleName
"doctest version " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
version
, ModuleName
"using version " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
ghcVersion ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
" of the GHC API"
, ModuleName
"using " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
ghc
]
info :: String
info :: ModuleName
info = ModuleName
"[ " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ (ModuleName -> [ModuleName] -> ModuleName
forall a. [a] -> [[a]] -> [a]
intercalate ModuleName
"\n, " ([ModuleName] -> ModuleName)
-> ([(ModuleName, ModuleName)] -> [ModuleName])
-> [(ModuleName, ModuleName)]
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModuleName, ModuleName) -> ModuleName)
-> [(ModuleName, ModuleName)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, ModuleName) -> ModuleName
forall a. Show a => a -> ModuleName
show ([(ModuleName, ModuleName)] -> ModuleName)
-> [(ModuleName, ModuleName)] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [
(ModuleName
"version", ModuleName
version)
, (ModuleName
"ghc_version", ModuleName
ghcVersion)
, (ModuleName
"ghc", ModuleName
ghc)
]) ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
"\n]\n"
data Result a
= ResultStderr String
| ResultStdout String
| Result a
deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq, Int -> Result a -> ModuleName -> ModuleName
[Result a] -> ModuleName -> ModuleName
Result a -> ModuleName
(Int -> Result a -> ModuleName -> ModuleName)
-> (Result a -> ModuleName)
-> ([Result a] -> ModuleName -> ModuleName)
-> Show (Result a)
forall a. Show a => Int -> Result a -> ModuleName -> ModuleName
forall a. Show a => [Result a] -> ModuleName -> ModuleName
forall a. Show a => Result a -> ModuleName
forall a.
(Int -> a -> ModuleName -> ModuleName)
-> (a -> ModuleName) -> ([a] -> ModuleName -> ModuleName) -> Show a
showList :: [Result a] -> ModuleName -> ModuleName
$cshowList :: forall a. Show a => [Result a] -> ModuleName -> ModuleName
show :: Result a -> ModuleName
$cshow :: forall a. Show a => Result a -> ModuleName
showsPrec :: Int -> Result a -> ModuleName -> ModuleName
$cshowsPrec :: forall a. Show a => Int -> Result a -> ModuleName -> ModuleName
Show, (forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: forall a b. (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)
type Warning = String
type ModuleName = String
data Config = Config
{ Config -> Bool
cfgVerbose :: Bool
, Config -> [ModuleName]
cfgModules :: [ModuleName]
, Config -> Maybe Int
cfgThreads :: Maybe Int
, Config -> Bool
cfgQuiet :: Bool
, Config -> ModuleConfig
cfgModuleConfig :: ModuleConfig
} deriving (Int -> Config -> ModuleName -> ModuleName
[Config] -> ModuleName -> ModuleName
Config -> ModuleName
(Int -> Config -> ModuleName -> ModuleName)
-> (Config -> ModuleName)
-> ([Config] -> ModuleName -> ModuleName)
-> Show Config
forall a.
(Int -> a -> ModuleName -> ModuleName)
-> (a -> ModuleName) -> ([a] -> ModuleName -> ModuleName) -> Show a
showList :: [Config] -> ModuleName -> ModuleName
$cshowList :: [Config] -> ModuleName -> ModuleName
show :: Config -> ModuleName
$cshow :: Config -> ModuleName
showsPrec :: Int -> Config -> ModuleName -> ModuleName
$cshowsPrec :: Int -> Config -> ModuleName -> ModuleName
Show, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, (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
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic, Config -> ()
(Config -> ()) -> NFData Config
forall a. (a -> ()) -> NFData a
rnf :: Config -> ()
$crnf :: Config -> ()
NFData)
data ModuleConfig = ModuleConfig
{ ModuleConfig -> Bool
cfgPreserveIt :: Bool
, ModuleConfig -> Bool
cfgRandomizeOrder :: Bool
, ModuleConfig -> Maybe Int
cfgSeed :: Maybe Int
, ModuleConfig -> Bool
cfgImplicitModuleImport :: Bool
} deriving (Int -> ModuleConfig -> ModuleName -> ModuleName
[ModuleConfig] -> ModuleName -> ModuleName
ModuleConfig -> ModuleName
(Int -> ModuleConfig -> ModuleName -> ModuleName)
-> (ModuleConfig -> ModuleName)
-> ([ModuleConfig] -> ModuleName -> ModuleName)
-> Show ModuleConfig
forall a.
(Int -> a -> ModuleName -> ModuleName)
-> (a -> ModuleName) -> ([a] -> ModuleName -> ModuleName) -> Show a
showList :: [ModuleConfig] -> ModuleName -> ModuleName
$cshowList :: [ModuleConfig] -> ModuleName -> ModuleName
show :: ModuleConfig -> ModuleName
$cshow :: ModuleConfig -> ModuleName
showsPrec :: Int -> ModuleConfig -> ModuleName -> ModuleName
$cshowsPrec :: Int -> ModuleConfig -> ModuleName -> ModuleName
Show, ModuleConfig -> ModuleConfig -> Bool
(ModuleConfig -> ModuleConfig -> Bool)
-> (ModuleConfig -> ModuleConfig -> Bool) -> Eq ModuleConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleConfig -> ModuleConfig -> Bool
$c/= :: ModuleConfig -> ModuleConfig -> Bool
== :: ModuleConfig -> ModuleConfig -> Bool
$c== :: ModuleConfig -> ModuleConfig -> Bool
Eq, (forall x. ModuleConfig -> Rep ModuleConfig x)
-> (forall x. Rep ModuleConfig x -> ModuleConfig)
-> Generic ModuleConfig
forall x. Rep ModuleConfig x -> ModuleConfig
forall x. ModuleConfig -> Rep ModuleConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleConfig x -> ModuleConfig
$cfrom :: forall x. ModuleConfig -> Rep ModuleConfig x
Generic, ModuleConfig -> ()
(ModuleConfig -> ()) -> NFData ModuleConfig
forall a. (a -> ()) -> NFData a
rnf :: ModuleConfig -> ()
$crnf :: ModuleConfig -> ()
NFData)
defaultModuleConfig :: ModuleConfig
defaultModuleConfig :: ModuleConfig
defaultModuleConfig = ModuleConfig :: Bool -> Bool -> Maybe Int -> Bool -> ModuleConfig
ModuleConfig
{ cfgPreserveIt :: Bool
cfgPreserveIt = Bool
False
, cfgRandomizeOrder :: Bool
cfgRandomizeOrder = Bool
False
, cfgSeed :: Maybe Int
cfgSeed = Maybe Int
forall a. Maybe a
Nothing
, cfgImplicitModuleImport :: Bool
cfgImplicitModuleImport = Bool
True
}
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool -> [ModuleName] -> Maybe Int -> Bool -> ModuleConfig -> Config
Config
{ cfgVerbose :: Bool
cfgVerbose = Bool
False
, cfgModules :: [ModuleName]
cfgModules = []
, cfgThreads :: Maybe Int
cfgThreads = Maybe Int
forall a. Maybe a
Nothing
, cfgQuiet :: Bool
cfgQuiet = Bool
False
, cfgModuleConfig :: ModuleConfig
cfgModuleConfig = ModuleConfig
defaultModuleConfig
}
parseLocatedModuleOptions ::
ModuleName ->
ModuleConfig ->
[Located String] ->
Either (Location, String) ModuleConfig
parseLocatedModuleOptions :: ModuleName
-> ModuleConfig
-> [Located ModuleName]
-> Either (Location, ModuleName) ModuleConfig
parseLocatedModuleOptions ModuleName
_modName ModuleConfig
modConfig [] = ModuleConfig -> Either (Location, ModuleName) ModuleConfig
forall a b. b -> Either a b
Right ModuleConfig
modConfig
parseLocatedModuleOptions ModuleName
modName ModuleConfig
modConfig0 (Located Location
loc ModuleName
o:[Located ModuleName]
os) =
case ModuleConfig -> ModuleName -> Maybe ModuleConfig
parseModuleOption ModuleConfig
modConfig0 ModuleName
o of
Maybe ModuleConfig
Nothing ->
(Location, ModuleName)
-> Either (Location, ModuleName) ModuleConfig
forall a b. a -> Either a b
Left (Location
loc, ModuleName
o)
Just ModuleConfig
modConfig1 ->
ModuleName
-> ModuleConfig
-> [Located ModuleName]
-> Either (Location, ModuleName) ModuleConfig
parseLocatedModuleOptions ModuleName
modName ModuleConfig
modConfig1 [Located ModuleName]
os
parseModuleOption :: ModuleConfig -> String -> Maybe ModuleConfig
parseModuleOption :: ModuleConfig -> ModuleName -> Maybe ModuleConfig
parseModuleOption ModuleConfig
config ModuleName
arg =
case ModuleName
arg of
ModuleName
"--randomize-order" -> ModuleConfig -> Maybe ModuleConfig
forall a. a -> Maybe a
Just ModuleConfig
config{cfgRandomizeOrder :: Bool
cfgRandomizeOrder=Bool
True}
ModuleName
"--no-randomize-order" -> ModuleConfig -> Maybe ModuleConfig
forall a. a -> Maybe a
Just ModuleConfig
config{cfgRandomizeOrder :: Bool
cfgRandomizeOrder=Bool
False}
ModuleName
"--preserve-it" -> ModuleConfig -> Maybe ModuleConfig
forall a. a -> Maybe a
Just ModuleConfig
config{cfgPreserveIt :: Bool
cfgPreserveIt=Bool
True}
ModuleName
"--no-preserve-it" -> ModuleConfig -> Maybe ModuleConfig
forall a. a -> Maybe a
Just ModuleConfig
config{cfgPreserveIt :: Bool
cfgPreserveIt=Bool
False}
ModuleName
"--implicit-module-import" -> ModuleConfig -> Maybe ModuleConfig
forall a. a -> Maybe a
Just ModuleConfig
config{cfgImplicitModuleImport :: Bool
cfgImplicitModuleImport=Bool
True}
ModuleName
"--no-implicit-module-import" -> ModuleConfig -> Maybe ModuleConfig
forall a. a -> Maybe a
Just ModuleConfig
config{cfgImplicitModuleImport :: Bool
cfgImplicitModuleImport=Bool
False}
(Char
'-':ModuleName
_) | Just Int
n <- ModuleName -> Maybe Int
parseSeed ModuleName
arg -> ModuleConfig -> Maybe ModuleConfig
forall a. a -> Maybe a
Just ModuleConfig
config{cfgSeed :: Maybe Int
cfgSeed=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n}
ModuleName
_ -> Maybe ModuleConfig
forall a. Maybe a
Nothing
parseOptions :: [String] -> Result Config
parseOptions :: [ModuleName] -> Result Config
parseOptions = Config -> [ModuleName] -> Result Config
go Config
defaultConfig
where
go :: Config -> [ModuleName] -> Result Config
go Config
config [] = Config -> Result Config
forall a. a -> Result a
Result Config
config
go Config
config (ModuleName
arg:[ModuleName]
args) =
case ModuleName
arg of
ModuleName
"--help" -> ModuleName -> Result Config
forall a. ModuleName -> Result a
ResultStdout ModuleName
usage
ModuleName
"--info" -> ModuleName -> Result Config
forall a. ModuleName -> Result a
ResultStdout ModuleName
info
ModuleName
"--version" -> ModuleName -> Result Config
forall a. ModuleName -> Result a
ResultStdout ModuleName
versionInfo
ModuleName
"--verbose" -> Config -> [ModuleName] -> Result Config
go Config
config{cfgVerbose :: Bool
cfgVerbose=Bool
True} [ModuleName]
args
ModuleName
"--quiet" -> Config -> [ModuleName] -> Result Config
go Config
config{cfgQuiet :: Bool
cfgQuiet=Bool
True} [ModuleName]
args
(Char
'-':ModuleName
_) | Just Int
n <- ModuleName -> Maybe Int
parseThreads ModuleName
arg -> Config -> [ModuleName] -> Result Config
go Config
config{cfgThreads :: Maybe Int
cfgThreads=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n} [ModuleName]
args
(Char
'-':ModuleName
_)
| Just ModuleConfig
modCfg <- ModuleConfig -> ModuleName -> Maybe ModuleConfig
parseModuleOption (Config -> ModuleConfig
cfgModuleConfig Config
config) ModuleName
arg
-> Config -> [ModuleName] -> Result Config
go Config
config{cfgModuleConfig :: ModuleConfig
cfgModuleConfig=ModuleConfig
modCfg} [ModuleName]
args
(Char
'-':ModuleName
_) -> ModuleName -> Result Config
forall a. ModuleName -> Result a
ResultStderr (ModuleName
"Unknown command line argument: " ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
arg)
ModuleName
mod_ -> Config -> [ModuleName] -> Result Config
go Config
config{cfgModules :: [ModuleName]
cfgModules=ModuleName
mod_ ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: Config -> [ModuleName]
cfgModules Config
config} [ModuleName]
args
parseSeed :: String -> Maybe Int
parseSeed :: ModuleName -> Maybe Int
parseSeed ModuleName
arg = ModuleName -> Maybe Int
forall a. Read a => ModuleName -> Maybe a
readMaybe (ModuleName -> Maybe Int) -> Maybe ModuleName -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ModuleName -> ModuleName -> Maybe ModuleName
parseSpecificFlag ModuleName
arg ModuleName
"seed"
parseThreads :: String -> Maybe Int
parseThreads :: ModuleName -> Maybe Int
parseThreads (Char
'-':Char
'j':ModuleName
n0) = do
Int
n1 <- ModuleName -> Maybe Int
forall a. Read a => ModuleName -> Maybe a
readMaybe ModuleName
n0
if Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n1 else Maybe Int
forall a. Maybe a
Nothing
parseThreads ModuleName
_ = Maybe Int
forall a. Maybe a
Nothing
parseSpecificFlag :: String -> String -> Maybe String
parseSpecificFlag :: ModuleName -> ModuleName -> Maybe ModuleName
parseSpecificFlag ModuleName
arg ModuleName
flag = do
case ModuleName -> (ModuleName, Maybe ModuleName)
parseFlag ModuleName
arg of
(Char
'-':Char
'-':ModuleName
f, Maybe ModuleName
value) | ModuleName
f ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
flag -> Maybe ModuleName
value
(ModuleName, Maybe ModuleName)
_ -> Maybe ModuleName
forall a. Maybe a
Nothing
parseFlag :: String -> (String, Maybe String)
parseFlag :: ModuleName -> (ModuleName, Maybe ModuleName)
parseFlag ModuleName
arg =
case (Char -> Bool) -> ModuleName -> (ModuleName, ModuleName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') ModuleName
arg of
(ModuleName
flag, [Char
'=']) -> (ModuleName
flag, Maybe ModuleName
forall a. Maybe a
Nothing)
(ModuleName
flag, Char
'=':ModuleName
opt) -> (ModuleName
flag, ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
opt)
(ModuleName
flag, ModuleName
_) -> (ModuleName
flag, Maybe ModuleName
forall a. Maybe a
Nothing)