{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Test
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the testing command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Test
  ( TestFlags (..)
  , emptyTestFlags
  , defaultTestFlags
  , testCommand
  , TestShowDetails (..)
  , testOptions'
  ) where

import Distribution.Compat.Prelude hiding (get)
import Prelude ()

import qualified Distribution.Compat.CharParsing as P
import Distribution.Parsec
import Distribution.Pretty
import Distribution.ReadE
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Utils
import Distribution.Verbosity
import qualified Text.PrettyPrint as Disp

import Distribution.Simple.Setup.Common

-- ------------------------------------------------------------

-- * Test flags

-- ------------------------------------------------------------

data TestShowDetails = Never | Failures | Always | Streaming | Direct
  deriving (TestShowDetails -> TestShowDetails -> Bool
(TestShowDetails -> TestShowDetails -> Bool)
-> (TestShowDetails -> TestShowDetails -> Bool)
-> Eq TestShowDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestShowDetails -> TestShowDetails -> Bool
== :: TestShowDetails -> TestShowDetails -> Bool
$c/= :: TestShowDetails -> TestShowDetails -> Bool
/= :: TestShowDetails -> TestShowDetails -> Bool
Eq, Eq TestShowDetails
Eq TestShowDetails =>
(TestShowDetails -> TestShowDetails -> Ordering)
-> (TestShowDetails -> TestShowDetails -> Bool)
-> (TestShowDetails -> TestShowDetails -> Bool)
-> (TestShowDetails -> TestShowDetails -> Bool)
-> (TestShowDetails -> TestShowDetails -> Bool)
-> (TestShowDetails -> TestShowDetails -> TestShowDetails)
-> (TestShowDetails -> TestShowDetails -> TestShowDetails)
-> Ord TestShowDetails
TestShowDetails -> TestShowDetails -> Bool
TestShowDetails -> TestShowDetails -> Ordering
TestShowDetails -> TestShowDetails -> TestShowDetails
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TestShowDetails -> TestShowDetails -> Ordering
compare :: TestShowDetails -> TestShowDetails -> Ordering
$c< :: TestShowDetails -> TestShowDetails -> Bool
< :: TestShowDetails -> TestShowDetails -> Bool
$c<= :: TestShowDetails -> TestShowDetails -> Bool
<= :: TestShowDetails -> TestShowDetails -> Bool
$c> :: TestShowDetails -> TestShowDetails -> Bool
> :: TestShowDetails -> TestShowDetails -> Bool
$c>= :: TestShowDetails -> TestShowDetails -> Bool
>= :: TestShowDetails -> TestShowDetails -> Bool
$cmax :: TestShowDetails -> TestShowDetails -> TestShowDetails
max :: TestShowDetails -> TestShowDetails -> TestShowDetails
$cmin :: TestShowDetails -> TestShowDetails -> TestShowDetails
min :: TestShowDetails -> TestShowDetails -> TestShowDetails
Ord, Int -> TestShowDetails
TestShowDetails -> Int
TestShowDetails -> [TestShowDetails]
TestShowDetails -> TestShowDetails
TestShowDetails -> TestShowDetails -> [TestShowDetails]
TestShowDetails
-> TestShowDetails -> TestShowDetails -> [TestShowDetails]
(TestShowDetails -> TestShowDetails)
-> (TestShowDetails -> TestShowDetails)
-> (Int -> TestShowDetails)
-> (TestShowDetails -> Int)
-> (TestShowDetails -> [TestShowDetails])
-> (TestShowDetails -> TestShowDetails -> [TestShowDetails])
-> (TestShowDetails -> TestShowDetails -> [TestShowDetails])
-> (TestShowDetails
    -> TestShowDetails -> TestShowDetails -> [TestShowDetails])
-> Enum TestShowDetails
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TestShowDetails -> TestShowDetails
succ :: TestShowDetails -> TestShowDetails
$cpred :: TestShowDetails -> TestShowDetails
pred :: TestShowDetails -> TestShowDetails
$ctoEnum :: Int -> TestShowDetails
toEnum :: Int -> TestShowDetails
$cfromEnum :: TestShowDetails -> Int
fromEnum :: TestShowDetails -> Int
$cenumFrom :: TestShowDetails -> [TestShowDetails]
enumFrom :: TestShowDetails -> [TestShowDetails]
$cenumFromThen :: TestShowDetails -> TestShowDetails -> [TestShowDetails]
enumFromThen :: TestShowDetails -> TestShowDetails -> [TestShowDetails]
$cenumFromTo :: TestShowDetails -> TestShowDetails -> [TestShowDetails]
enumFromTo :: TestShowDetails -> TestShowDetails -> [TestShowDetails]
$cenumFromThenTo :: TestShowDetails
-> TestShowDetails -> TestShowDetails -> [TestShowDetails]
enumFromThenTo :: TestShowDetails
-> TestShowDetails -> TestShowDetails -> [TestShowDetails]
Enum, TestShowDetails
TestShowDetails -> TestShowDetails -> Bounded TestShowDetails
forall a. a -> a -> Bounded a
$cminBound :: TestShowDetails
minBound :: TestShowDetails
$cmaxBound :: TestShowDetails
maxBound :: TestShowDetails
Bounded, (forall x. TestShowDetails -> Rep TestShowDetails x)
-> (forall x. Rep TestShowDetails x -> TestShowDetails)
-> Generic TestShowDetails
forall x. Rep TestShowDetails x -> TestShowDetails
forall x. TestShowDetails -> Rep TestShowDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestShowDetails -> Rep TestShowDetails x
from :: forall x. TestShowDetails -> Rep TestShowDetails x
$cto :: forall x. Rep TestShowDetails x -> TestShowDetails
to :: forall x. Rep TestShowDetails x -> TestShowDetails
Generic, Int -> TestShowDetails -> ShowS
[TestShowDetails] -> ShowS
TestShowDetails -> FilePath
(Int -> TestShowDetails -> ShowS)
-> (TestShowDetails -> FilePath)
-> ([TestShowDetails] -> ShowS)
-> Show TestShowDetails
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestShowDetails -> ShowS
showsPrec :: Int -> TestShowDetails -> ShowS
$cshow :: TestShowDetails -> FilePath
show :: TestShowDetails -> FilePath
$cshowList :: [TestShowDetails] -> ShowS
showList :: [TestShowDetails] -> ShowS
Show, Typeable)

instance Binary TestShowDetails
instance Structured TestShowDetails

knownTestShowDetails :: [TestShowDetails]
knownTestShowDetails :: [TestShowDetails]
knownTestShowDetails = [TestShowDetails
forall a. Bounded a => a
minBound .. TestShowDetails
forall a. Bounded a => a
maxBound]

instance Pretty TestShowDetails where
  pretty :: TestShowDetails -> Doc
pretty = FilePath -> Doc
Disp.text (FilePath -> Doc)
-> (TestShowDetails -> FilePath) -> TestShowDetails -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
lowercase ShowS
-> (TestShowDetails -> FilePath) -> TestShowDetails -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestShowDetails -> FilePath
forall a. Show a => a -> FilePath
show

instance Parsec TestShowDetails where
  parsec :: forall (m :: * -> *). CabalParsing m => m TestShowDetails
parsec = m TestShowDetails
-> (TestShowDetails -> m TestShowDetails)
-> Maybe TestShowDetails
-> m TestShowDetails
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> m TestShowDetails
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"invalid TestShowDetails") TestShowDetails -> m TestShowDetails
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TestShowDetails -> m TestShowDetails)
-> (FilePath -> Maybe TestShowDetails)
-> FilePath
-> m TestShowDetails
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe TestShowDetails
classify (FilePath -> m TestShowDetails) -> m FilePath -> m TestShowDetails
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FilePath
ident
    where
      ident :: m FilePath
ident = (Char -> Bool) -> m FilePath
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m FilePath
P.munch1 (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
      classify :: FilePath -> Maybe TestShowDetails
classify FilePath
str = FilePath -> [(FilePath, TestShowDetails)] -> Maybe TestShowDetails
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ShowS
lowercase FilePath
str) [(FilePath, TestShowDetails)]
enumMap
      enumMap :: [(String, TestShowDetails)]
      enumMap :: [(FilePath, TestShowDetails)]
enumMap =
        [ (TestShowDetails -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow TestShowDetails
x, TestShowDetails
x)
        | TestShowDetails
x <- [TestShowDetails]
knownTestShowDetails
        ]

-- TODO: do we need this instance?
instance Monoid TestShowDetails where
  mempty :: TestShowDetails
mempty = TestShowDetails
Never
  mappend :: TestShowDetails -> TestShowDetails -> TestShowDetails
mappend = TestShowDetails -> TestShowDetails -> TestShowDetails
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup TestShowDetails where
  TestShowDetails
a <> :: TestShowDetails -> TestShowDetails -> TestShowDetails
<> TestShowDetails
b = if TestShowDetails
a TestShowDetails -> TestShowDetails -> Bool
forall a. Ord a => a -> a -> Bool
< TestShowDetails
b then TestShowDetails
b else TestShowDetails
a

data TestFlags = TestFlags
  { TestFlags -> Flag FilePath
testDistPref :: Flag FilePath
  , TestFlags -> Flag Verbosity
testVerbosity :: Flag Verbosity
  , TestFlags -> Flag PathTemplate
testHumanLog :: Flag PathTemplate
  , TestFlags -> Flag PathTemplate
testMachineLog :: Flag PathTemplate
  , TestFlags -> Flag TestShowDetails
testShowDetails :: Flag TestShowDetails
  , TestFlags -> Flag Bool
testKeepTix :: Flag Bool
  , TestFlags -> Flag FilePath
testWrapper :: Flag FilePath
  , TestFlags -> Flag Bool
testFailWhenNoTestSuites :: Flag Bool
  , -- TODO: think about if/how options are passed to test exes
    TestFlags -> [PathTemplate]
testOptions :: [PathTemplate]
  }
  deriving (Int -> TestFlags -> ShowS
[TestFlags] -> ShowS
TestFlags -> FilePath
(Int -> TestFlags -> ShowS)
-> (TestFlags -> FilePath)
-> ([TestFlags] -> ShowS)
-> Show TestFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestFlags -> ShowS
showsPrec :: Int -> TestFlags -> ShowS
$cshow :: TestFlags -> FilePath
show :: TestFlags -> FilePath
$cshowList :: [TestFlags] -> ShowS
showList :: [TestFlags] -> ShowS
Show, (forall x. TestFlags -> Rep TestFlags x)
-> (forall x. Rep TestFlags x -> TestFlags) -> Generic TestFlags
forall x. Rep TestFlags x -> TestFlags
forall x. TestFlags -> Rep TestFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestFlags -> Rep TestFlags x
from :: forall x. TestFlags -> Rep TestFlags x
$cto :: forall x. Rep TestFlags x -> TestFlags
to :: forall x. Rep TestFlags x -> TestFlags
Generic, Typeable)

instance Binary TestFlags
instance Structured TestFlags

defaultTestFlags :: TestFlags
defaultTestFlags :: TestFlags
defaultTestFlags =
  TestFlags
    { testDistPref :: Flag FilePath
testDistPref = Flag FilePath
forall a. Flag a
NoFlag
    , testVerbosity :: Flag Verbosity
testVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
Flag Verbosity
normal
    , testHumanLog :: Flag PathTemplate
testHumanLog = PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag (PathTemplate -> Flag PathTemplate)
-> PathTemplate -> Flag PathTemplate
forall a b. (a -> b) -> a -> b
$ FilePath -> PathTemplate
toPathTemplate (FilePath -> PathTemplate) -> FilePath -> PathTemplate
forall a b. (a -> b) -> a -> b
$ FilePath
"$pkgid-$test-suite.log"
    , testMachineLog :: Flag PathTemplate
testMachineLog = PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag (PathTemplate -> Flag PathTemplate)
-> PathTemplate -> Flag PathTemplate
forall a b. (a -> b) -> a -> b
$ FilePath -> PathTemplate
toPathTemplate (FilePath -> PathTemplate) -> FilePath -> PathTemplate
forall a b. (a -> b) -> a -> b
$ FilePath
"$pkgid.log"
    , testShowDetails :: Flag TestShowDetails
testShowDetails = TestShowDetails -> Flag TestShowDetails
forall a. a -> Flag a
toFlag TestShowDetails
Direct
    , testKeepTix :: Flag Bool
testKeepTix = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
False
    , testWrapper :: Flag FilePath
testWrapper = Flag FilePath
forall a. Flag a
NoFlag
    , testFailWhenNoTestSuites :: Flag Bool
testFailWhenNoTestSuites = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
False
    , testOptions :: [PathTemplate]
testOptions = []
    }

testCommand :: CommandUI TestFlags
testCommand :: CommandUI TestFlags
testCommand =
  CommandUI
    { commandName :: FilePath
commandName = FilePath
"test"
    , commandSynopsis :: FilePath
commandSynopsis =
        FilePath
"Run all/specific tests in the test suite."
    , commandDescription :: Maybe ShowS
commandDescription = ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$ \FilePath
_pname ->
        ShowS
wrapText ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          ShowS
testOrBenchmarkHelpText FilePath
"test"
    , commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
    , commandUsage :: ShowS
commandUsage =
        FilePath -> [FilePath] -> ShowS
usageAlternatives
          FilePath
"test"
          [ FilePath
"[FLAGS]"
          , FilePath
"TESTCOMPONENTS [FLAGS]"
          ]
    , commandDefaultFlags :: TestFlags
commandDefaultFlags = TestFlags
defaultTestFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField TestFlags]
commandOptions = ShowOrParseArgs -> [OptionField TestFlags]
testOptions'
    }

testOptions' :: ShowOrParseArgs -> [OptionField TestFlags]
testOptions' :: ShowOrParseArgs -> [OptionField TestFlags]
testOptions' ShowOrParseArgs
showOrParseArgs =
  [ (TestFlags -> Flag Verbosity)
-> (Flag Verbosity -> TestFlags -> TestFlags)
-> OptionField TestFlags
forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity TestFlags -> Flag Verbosity
testVerbosity (\Flag Verbosity
v TestFlags
flags -> TestFlags
flags{testVerbosity = v})
  , (TestFlags -> Flag FilePath)
-> (Flag FilePath -> TestFlags -> TestFlags)
-> ShowOrParseArgs
-> OptionField TestFlags
forall flags.
(flags -> Flag FilePath)
-> (Flag FilePath -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref
      TestFlags -> Flag FilePath
testDistPref
      (\Flag FilePath
d TestFlags
flags -> TestFlags
flags{testDistPref = d})
      ShowOrParseArgs
showOrParseArgs
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> Flag PathTemplate)
-> (Flag PathTemplate -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> Flag PathTemplate)
     (Flag PathTemplate -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"log"]
      ( FilePath
"Log all test suite results to file (name template can use "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"$pkgid, $compiler, $os, $arch, $test-suite, $result)"
      )
      TestFlags -> Flag PathTemplate
testHumanLog
      (\Flag PathTemplate
v TestFlags
flags -> TestFlags
flags{testHumanLog = v})
      ( FilePath
-> (FilePath -> Flag PathTemplate)
-> (Flag PathTemplate -> [FilePath])
-> MkOptDescr
     (TestFlags -> Flag PathTemplate)
     (Flag PathTemplate -> TestFlags -> TestFlags)
     TestFlags
forall b a.
Monoid b =>
FilePath
-> (FilePath -> b)
-> (b -> [FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
          FilePath
"TEMPLATE"
          (PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag (PathTemplate -> Flag PathTemplate)
-> (FilePath -> PathTemplate) -> FilePath -> Flag PathTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PathTemplate
toPathTemplate)
          (Flag FilePath -> [FilePath]
forall a. Flag a -> [a]
flagToList (Flag FilePath -> [FilePath])
-> (Flag PathTemplate -> Flag FilePath)
-> Flag PathTemplate
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathTemplate -> FilePath) -> Flag PathTemplate -> Flag FilePath
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> FilePath
fromPathTemplate)
      )
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> Flag PathTemplate)
-> (Flag PathTemplate -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> Flag PathTemplate)
     (Flag PathTemplate -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"machine-log"]
      ( FilePath
"Produce a machine-readable log file (name template can use "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"$pkgid, $compiler, $os, $arch, $result)"
      )
      TestFlags -> Flag PathTemplate
testMachineLog
      (\Flag PathTemplate
v TestFlags
flags -> TestFlags
flags{testMachineLog = v})
      ( FilePath
-> (FilePath -> Flag PathTemplate)
-> (Flag PathTemplate -> [FilePath])
-> MkOptDescr
     (TestFlags -> Flag PathTemplate)
     (Flag PathTemplate -> TestFlags -> TestFlags)
     TestFlags
forall b a.
Monoid b =>
FilePath
-> (FilePath -> b)
-> (b -> [FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
          FilePath
"TEMPLATE"
          (PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag (PathTemplate -> Flag PathTemplate)
-> (FilePath -> PathTemplate) -> FilePath -> Flag PathTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PathTemplate
toPathTemplate)
          (Flag FilePath -> [FilePath]
forall a. Flag a -> [a]
flagToList (Flag FilePath -> [FilePath])
-> (Flag PathTemplate -> Flag FilePath)
-> Flag PathTemplate
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathTemplate -> FilePath) -> Flag PathTemplate -> Flag FilePath
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> FilePath
fromPathTemplate)
      )
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> Flag TestShowDetails)
-> (Flag TestShowDetails -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> Flag TestShowDetails)
     (Flag TestShowDetails -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"show-details"]
      ( FilePath
"'always': always show results of individual test cases. "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'never': never show results of individual test cases. "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'failures': show results of failing test cases. "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'streaming': show results of test cases in real time."
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'direct': send results of test cases in real time; no log file."
      )
      TestFlags -> Flag TestShowDetails
testShowDetails
      (\Flag TestShowDetails
v TestFlags
flags -> TestFlags
flags{testShowDetails = v})
      ( FilePath
-> ReadE (Flag TestShowDetails)
-> (Flag TestShowDetails -> [FilePath])
-> MkOptDescr
     (TestFlags -> Flag TestShowDetails)
     (Flag TestShowDetails -> TestFlags -> TestFlags)
     TestFlags
forall b a.
Monoid b =>
FilePath
-> ReadE b
-> (b -> [FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg
          FilePath
"FILTER"
          ( ShowS
-> ParsecParser (Flag TestShowDetails)
-> ReadE (Flag TestShowDetails)
forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE
              ( \FilePath
_ ->
                  FilePath
"--show-details flag expects one of "
                    FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate
                      FilePath
", "
                      ((TestShowDetails -> FilePath) -> [TestShowDetails] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map TestShowDetails -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow [TestShowDetails]
knownTestShowDetails)
              )
              ((TestShowDetails -> Flag TestShowDetails)
-> ParsecParser TestShowDetails
-> ParsecParser (Flag TestShowDetails)
forall a b. (a -> b) -> ParsecParser a -> ParsecParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestShowDetails -> Flag TestShowDetails
forall a. a -> Flag a
toFlag ParsecParser TestShowDetails
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m TestShowDetails
parsec)
          )
          (Flag FilePath -> [FilePath]
forall a. Flag a -> [a]
flagToList (Flag FilePath -> [FilePath])
-> (Flag TestShowDetails -> Flag FilePath)
-> Flag TestShowDetails
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestShowDetails -> FilePath)
-> Flag TestShowDetails -> Flag FilePath
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestShowDetails -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow)
      )
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> Flag Bool)
-> (Flag Bool -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> Flag Bool)
     (Flag Bool -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"keep-tix-files"]
      FilePath
"keep .tix files for HPC between test runs"
      TestFlags -> Flag Bool
testKeepTix
      (\Flag Bool
v TestFlags
flags -> TestFlags
flags{testKeepTix = v})
      MkOptDescr
  (TestFlags -> Flag Bool)
  (Flag Bool -> TestFlags -> TestFlags)
  TestFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> Flag FilePath)
-> (Flag FilePath -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> Flag FilePath)
     (Flag FilePath -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"test-wrapper"]
      FilePath
"Run test through a wrapper."
      TestFlags -> Flag FilePath
testWrapper
      (\Flag FilePath
v TestFlags
flags -> TestFlags
flags{testWrapper = v})
      ( FilePath
-> (FilePath -> Flag FilePath)
-> (Flag FilePath -> [FilePath])
-> MkOptDescr
     (TestFlags -> Flag FilePath)
     (Flag FilePath -> TestFlags -> TestFlags)
     TestFlags
forall b a.
Monoid b =>
FilePath
-> (FilePath -> b)
-> (b -> [FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
          FilePath
"FILE"
          (FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag :: FilePath -> Flag FilePath)
          (Flag FilePath -> [FilePath]
forall a. Flag a -> [a]
flagToList :: Flag FilePath -> [FilePath])
      )
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> Flag Bool)
-> (Flag Bool -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> Flag Bool)
     (Flag Bool -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"fail-when-no-test-suites"]
      (FilePath
"Exit with failure when no test suites are found.")
      TestFlags -> Flag Bool
testFailWhenNoTestSuites
      (\Flag Bool
v TestFlags
flags -> TestFlags
flags{testFailWhenNoTestSuites = v})
      MkOptDescr
  (TestFlags -> Flag Bool)
  (Flag Bool -> TestFlags -> TestFlags)
  TestFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> [PathTemplate])
-> ([PathTemplate] -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> [PathTemplate])
     ([PathTemplate] -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"test-options"]
      ( FilePath
"give extra options to test executables "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"(name templates can use $pkgid, $compiler, "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"$os, $arch, $test-suite)"
      )
      TestFlags -> [PathTemplate]
testOptions
      (\[PathTemplate]
v TestFlags
flags -> TestFlags
flags{testOptions = v})
      ( FilePath
-> (FilePath -> [PathTemplate])
-> ([PathTemplate] -> [FilePath])
-> MkOptDescr
     (TestFlags -> [PathTemplate])
     ([PathTemplate] -> TestFlags -> TestFlags)
     TestFlags
forall b a.
Monoid b =>
FilePath
-> (FilePath -> b)
-> (b -> [FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
          FilePath
"TEMPLATES"
          ((FilePath -> PathTemplate) -> [FilePath] -> [PathTemplate]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> PathTemplate
toPathTemplate ([FilePath] -> [PathTemplate])
-> (FilePath -> [FilePath]) -> FilePath -> [PathTemplate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitArgs)
          ([FilePath] -> [PathTemplate] -> [FilePath]
forall a b. a -> b -> a
const [])
      )
  , FilePath
-> [FilePath]
-> FilePath
-> (TestFlags -> [PathTemplate])
-> ([PathTemplate] -> TestFlags -> TestFlags)
-> MkOptDescr
     (TestFlags -> [PathTemplate])
     ([PathTemplate] -> TestFlags -> TestFlags)
     TestFlags
-> OptionField TestFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [FilePath
"test-option"]
      ( FilePath
"give extra option to test executables "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"(no need to quote options containing spaces, "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"name template can use $pkgid, $compiler, "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"$os, $arch, $test-suite)"
      )
      TestFlags -> [PathTemplate]
testOptions
      (\[PathTemplate]
v TestFlags
flags -> TestFlags
flags{testOptions = v})
      ( FilePath
-> (FilePath -> [PathTemplate])
-> ([PathTemplate] -> [FilePath])
-> MkOptDescr
     (TestFlags -> [PathTemplate])
     ([PathTemplate] -> TestFlags -> TestFlags)
     TestFlags
forall b a.
Monoid b =>
FilePath
-> (FilePath -> b)
-> (b -> [FilePath])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
          FilePath
"TEMPLATE"
          (\FilePath
x -> [FilePath -> PathTemplate
toPathTemplate FilePath
x])
          ((PathTemplate -> FilePath) -> [PathTemplate] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PathTemplate -> FilePath
fromPathTemplate)
      )
  ]

emptyTestFlags :: TestFlags
emptyTestFlags :: TestFlags
emptyTestFlags = TestFlags
forall a. Monoid a => a
mempty

instance Monoid TestFlags where
  mempty :: TestFlags
mempty = TestFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: TestFlags -> TestFlags -> TestFlags
mappend = TestFlags -> TestFlags -> TestFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup TestFlags where
  <> :: TestFlags -> TestFlags -> TestFlags
(<>) = TestFlags -> TestFlags -> TestFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend