{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
module Test.DocTest.Internal.Options where
import Prelude ()
import Prelude.Compat
import Data.List.Compat
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.Interpreter (ghc)
import Text.Read (readMaybe)
usage :: String
usage :: String
usage = [String] -> String
unlines [
"Usage:"
, " doctest [ --fast | --preserve-it | --verbose | -jN ]..."
, " doctest --help"
, " doctest --version"
, " doctest --info"
, ""
, "Options:"
, " -jN number of threads to use"
, " --preserve-it preserve the `it` variable between examples"
, " --verbose print each test as it is run"
, " --help display this help and exit"
, " --version output version information and exit"
, " --info output machine-readable version information and exit"
]
version :: String
version :: String
version = Version -> String
showVersion Version
Paths_doctest_parallel.version
ghcVersion :: String
ghcVersion :: String
ghcVersion = String
GHC.cProjectVersion
versionInfo :: String
versionInfo :: String
versionInfo = [String] -> String
unlines [
"doctest version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version
, "using version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghcVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ " of the GHC API"
, "using " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghc
]
info :: String
info :: String
info = "[ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n, " ([String] -> String)
-> ([(String, String)] -> [String]) -> [(String, String)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a. Show a => a -> String
show ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$ [
("version", String
version)
, ("ghc_version", String
ghcVersion)
, ("ghc", String
ghc)
]) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\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 -> String -> String
[Result a] -> String -> String
Result a -> String
(Int -> Result a -> String -> String)
-> (Result a -> String)
-> ([Result a] -> String -> String)
-> Show (Result a)
forall a. Show a => Int -> Result a -> String -> String
forall a. Show a => [Result a] -> String -> String
forall a. Show a => Result a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Result a] -> String -> String
$cshowList :: forall a. Show a => [Result a] -> String -> String
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Result a -> String -> String
Show, a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(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
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (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
cfgPreserveIt :: Bool
, Config -> Bool
cfgVerbose :: Bool
, Config -> [String]
cfgModules :: [ModuleName]
, Config -> Maybe Int
cfgThreads :: Maybe Int
} deriving (Int -> Config -> String -> String
[Config] -> String -> String
Config -> String
(Int -> Config -> String -> String)
-> (Config -> String)
-> ([Config] -> String -> String)
-> Show Config
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Config] -> String -> String
$cshowList :: [Config] -> String -> String
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> String -> String
$cshowsPrec :: Int -> Config -> String -> String
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)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool -> Bool -> [String] -> Maybe Int -> Config
Config
{ cfgPreserveIt :: Bool
cfgPreserveIt = Bool
False
, cfgVerbose :: Bool
cfgVerbose = Bool
False
, cfgModules :: [String]
cfgModules = []
, cfgThreads :: Maybe Int
cfgThreads = Maybe Int
forall a. Maybe a
Nothing
}
parseOptions :: [String] -> Result Config
parseOptions :: [String] -> Result Config
parseOptions = Config -> [String] -> Result Config
go Config
defaultConfig
where
go :: Config -> [String] -> Result Config
go config :: Config
config [] = Config -> Result Config
forall a. a -> Result a
Result Config
config
go config :: Config
config (arg :: String
arg:args :: [String]
args) =
case String
arg of
"--help" -> String -> Result Config
forall a. String -> Result a
ResultStdout String
usage
"--info" -> String -> Result Config
forall a. String -> Result a
ResultStdout String
info
"--version" -> String -> Result Config
forall a. String -> Result a
ResultStdout String
versionInfo
"--preserve-it" -> Config -> [String] -> Result Config
go Config
config{cfgPreserveIt :: Bool
cfgPreserveIt=Bool
True} [String]
args
"--verbose" -> Config -> [String] -> Result Config
go Config
config{cfgVerbose :: Bool
cfgVerbose=Bool
True} [String]
args
('-':'j':n0 :: String
n0) | Just n1 :: Int
n1 <- String -> Maybe Int
parseThreads String
n0 -> Config -> [String] -> Result Config
go Config
config{cfgThreads :: Maybe Int
cfgThreads=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n1} [String]
args
('-':_) -> String -> Result Config
forall a. String -> Result a
ResultStderr ("Unknown command line argument: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
arg)
mod_ :: String
mod_ -> Config -> [String] -> Result Config
go Config
config{cfgModules :: [String]
cfgModules=String
mod_ String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Config -> [String]
cfgModules Config
config} [String]
args
parseThreads :: String -> Maybe Int
parseThreads :: String -> Maybe Int
parseThreads n0 :: String
n0 = do
Int
n1 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
n0
if Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n1 else Maybe Int
forall a. Maybe a
Nothing
parseFlag :: String -> (String, Maybe String)
parseFlag :: String -> (String, Maybe String)
parseFlag arg :: String
arg =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=') String
arg of
(flag :: String
flag, ['=']) -> (String
flag, Maybe String
forall a. Maybe a
Nothing)
(flag :: String
flag, ('=':opt :: String
opt)) -> (String
flag, String -> Maybe String
forall a. a -> Maybe a
Just String
opt)
(flag :: String
flag, _) -> (String
flag, Maybe String
forall a. Maybe a
Nothing)