{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
--
-- Copyright (c) 2009-2022   Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--

{- |

This module defines the commandline options of the test driver provided by HTF.

-}
module Test.Framework.CmdlineOptions (

    CmdlineOptions(..), defaultCmdlineOptions, parseTestArgs, helpString,
    testConfigFromCmdlineOptions

) where

import Test.Framework.TestReporter
import Test.Framework.TestTypes
import Test.Framework.History
import Test.Framework.Utils

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(a,b,c) 1
#endif
#if !MIN_VERSION_base(4,6,0)
import Prelude hiding ( catch )
#endif
import Control.Exception

import Data.Char (toLower)
import Data.Maybe

import System.IO
import System.Environment hiding (getEnv)
import System.Directory
import System.Console.GetOpt
import qualified Text.Regex as R

#ifndef mingw32_HOST_OS
import System.Posix.Terminal
import System.Posix.IO (stdOutput)
import System.Posix.Env
#endif

#ifdef __GLASGOW_HASKELL__
import GHC.Conc ( numCapabilities )
#endif

import qualified Data.ByteString as BS
import Control.Monad

--
-- CmdlineOptions
--

-- | Commandline options for running tests.
data CmdlineOptions = CmdlineOptions {
      CmdlineOptions -> Bool
opts_quiet :: Bool                -- ^ Be quiet or not.
    , CmdlineOptions -> TestFilter
opts_filter :: TestFilter         -- ^ Run only tests matching this filter.
    , CmdlineOptions -> Bool
opts_help :: Bool                 -- ^ If 'True', display a help message and exit.
    , CmdlineOptions -> [String]
opts_negated :: [String]          -- ^ Regular expressions matching test names which should /not/ run.
    , CmdlineOptions -> Maybe Int
opts_threads :: Maybe Int         -- ^ Use @Just i@ for parallel execution with @i@ threads, @Nothing@ for sequential execution.
    , CmdlineOptions -> Bool
opts_shuffle :: Bool              -- ^ If 'True', shuffle tests when running them in parallel. Default: 'False'
    , CmdlineOptions -> Bool
opts_machineOutput :: Bool        -- ^ Format output for machines (JSON format) or humans. See 'Test.Framework.JsonOutput' for a definition of the JSON format.
    , CmdlineOptions -> Maybe String
opts_machineOutputXml :: Maybe FilePath -- ^ Output file for junit-style XML output. See 'Test.Framework.XmlOutput' for a definition of the XML format.
    , CmdlineOptions -> Maybe Bool
opts_useColors :: Maybe Bool      -- ^ Use @Just b@ to enable/disable use of colors, @Nothing@ infers the use of colors.
    , CmdlineOptions -> Maybe String
opts_outputFile :: Maybe FilePath -- ^ The output file, defaults to stdout
    , CmdlineOptions -> Bool
opts_listTests :: Bool            -- ^ If 'True', lists all tests available and exits.
    , CmdlineOptions -> Bool
opts_split :: Bool                -- ^ If 'True', each message is sent to a new ouput file (derived by appending an index to 'opts_outputFile').
    , CmdlineOptions -> Maybe String
opts_historyFile :: Maybe FilePath -- ^ History file, default: @./.HTF/<ProgramName>.history@
    , CmdlineOptions -> Bool
opts_failFast :: Bool             -- ^ Fail and terminate test run as soon as the first test fails. Default: 'False'
    , CmdlineOptions -> Bool
opts_sortByPrevTime :: Bool       -- ^ Sort tests by their previous run times (ascending). Default: 'False'
    , CmdlineOptions -> Maybe Int
opts_maxPrevTimeMs :: Maybe Milliseconds -- ^ Ignore tests with a runtime greater than given in a previous test run.
    , CmdlineOptions -> Maybe Int
opts_maxCurTimeMs :: Maybe Milliseconds  -- ^ Abort tests that run more than the given milliseconds.
    , CmdlineOptions -> Maybe Double
opts_prevFactor :: Maybe Double -- ^ Warn if a test runs more than N times slower than in a previous run.
    , CmdlineOptions -> Bool
opts_timeoutIsSuccess :: Bool -- ^ Do not regard test timeout as an error.
    , CmdlineOptions -> Int
opts_repeat :: Int                 -- ^ Number of times to repeat tests selected on the command line before reporting them as a success.
    }

{- |
The default 'CmdlineOptions'.
-}
defaultCmdlineOptions :: CmdlineOptions
defaultCmdlineOptions :: CmdlineOptions
defaultCmdlineOptions = CmdlineOptions :: Bool
-> TestFilter
-> Bool
-> [String]
-> Maybe Int
-> Bool
-> Bool
-> Maybe String
-> Maybe Bool
-> Maybe String
-> Bool
-> Bool
-> Maybe String
-> Bool
-> Bool
-> Maybe Int
-> Maybe Int
-> Maybe Double
-> Bool
-> Int
-> CmdlineOptions
CmdlineOptions {
      opts_quiet :: Bool
opts_quiet = Bool
False
    , opts_filter :: TestFilter
opts_filter = Bool -> TestFilter
forall a b. a -> b -> a
const Bool
True
    , opts_help :: Bool
opts_help = Bool
False
    , opts_negated :: [String]
opts_negated = []
    , opts_threads :: Maybe Int
opts_threads = Maybe Int
forall a. Maybe a
Nothing
    , opts_shuffle :: Bool
opts_shuffle = Bool
False
    , opts_machineOutput :: Bool
opts_machineOutput = Bool
False
    , opts_machineOutputXml :: Maybe String
opts_machineOutputXml = Maybe String
forall a. Maybe a
Nothing
    , opts_useColors :: Maybe Bool
opts_useColors = Maybe Bool
forall a. Maybe a
Nothing
    , opts_outputFile :: Maybe String
opts_outputFile = Maybe String
forall a. Maybe a
Nothing
    , opts_listTests :: Bool
opts_listTests = Bool
False
    , opts_split :: Bool
opts_split = Bool
False
    , opts_historyFile :: Maybe String
opts_historyFile = Maybe String
forall a. Maybe a
Nothing
    , opts_failFast :: Bool
opts_failFast = Bool
False
    , opts_sortByPrevTime :: Bool
opts_sortByPrevTime = Bool
False
    , opts_maxPrevTimeMs :: Maybe Int
opts_maxPrevTimeMs = Maybe Int
forall a. Maybe a
Nothing
    , opts_maxCurTimeMs :: Maybe Int
opts_maxCurTimeMs = Maybe Int
forall a. Maybe a
Nothing
    , opts_prevFactor :: Maybe Double
opts_prevFactor = Maybe Double
forall a. Maybe a
Nothing
    , opts_timeoutIsSuccess :: Bool
opts_timeoutIsSuccess = Bool
False
    , opts_repeat :: Int
opts_repeat = Int
1
    }

processorCount :: Int
#ifdef __GLASGOW_HASKELL__
processorCount :: Int
processorCount = Int
numCapabilities
#else
processorCount = 1
#endif

optionDescriptions :: [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
optionDescriptions :: [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
optionDescriptions =
    [ String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'q']     [String
"quiet"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_quiet :: Bool
opts_quiet = Bool
True }))
             String
"Only display errors."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'n']     [String
"not"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_negated :: [String]
opts_negated = String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (CmdlineOptions -> [String]
opts_negated CmdlineOptions
o) }) String
"PATTERN")
             String
"Tests to exclude."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'l']     [String
"list"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_listTests :: Bool
opts_listTests = Bool
True }))
             String
"List all matching tests."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'j']     [String
"threads"]
             ((Maybe String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (\Maybe String
ms CmdlineOptions
o -> Maybe String -> Either String Int
parseThreads Maybe String
ms Either String Int
-> (Int -> Either String CmdlineOptions)
-> Either String CmdlineOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_threads :: Maybe Int
opts_threads = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i }) String
"N")
             (String
"Run N tests in parallel, default N=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
processorCount String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".")
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"shuffle"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> String -> Either String Bool
forall a. String -> Either a Bool
parseBool String
s Either String Bool
-> (Bool -> Either String CmdlineOptions)
-> Either String CmdlineOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_shuffle :: Bool
opts_shuffle = Bool
b }) String
"BOOL")
             String
"Shuffle test order. Default: false"
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'o']     [String
"output-file"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_outputFile :: Maybe String
opts_outputFile = String -> Maybe String
forall a. a -> Maybe a
Just String
s }) String
"FILE")
             String
"Name of output file."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"json"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_machineOutput :: Bool
opts_machineOutput = Bool
True }))
             String
"Output results in machine-readable JSON format (incremental)."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"xml"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_machineOutputXml :: Maybe String
opts_machineOutputXml = String -> Maybe String
forall a. a -> Maybe a
Just String
s }) String
"FILE")
             String
"Output results in junit-style XML format."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"split"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_split :: Bool
opts_split = Bool
True }))
             String
"Splits results in separate files to avoid file locking (requires -o/--output-file)."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"colors"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> String -> Either String Bool
forall a. String -> Either a Bool
parseBool String
s Either String Bool
-> (Bool -> Either String CmdlineOptions)
-> Either String CmdlineOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_useColors :: Maybe Bool
opts_useColors = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b }) String
"BOOL")
             String
"Use colors or not."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"history"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_historyFile :: Maybe String
opts_historyFile = String -> Maybe String
forall a. a -> Maybe a
Just String
s }) String
"FILE")
             String
"Path to the history file. Default: ./.HTF/<ProgramName>.history"
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"fail-fast"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_failFast :: Bool
opts_failFast = Bool
True }))
             String
"Fail and abort test run as soon as the first test fails."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"sort-by-prev-time"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_sortByPrevTime :: Bool
opts_sortByPrevTime = Bool
True }))
             String
"Sort tests ascending by their execution of the previous test run (if available). Default: false"
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"max-prev-ms"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> String -> String -> Either String Int
forall b. Read b => String -> String -> Either String b
parseRead String
"--max-prev-ms" String
s Either String Int
-> (Int -> Either String CmdlineOptions)
-> Either String CmdlineOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
ms::Int) -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_maxPrevTimeMs :: Maybe Int
opts_maxPrevTimeMs = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ms }) String
"MILLISECONDS")
             String
"Do not try to execute tests that had a execution time greater than MILLISECONDS in a previous test run."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"max-cur-ms"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> String -> String -> Either String Int
forall b. Read b => String -> String -> Either String b
parseRead String
"--max-cur-ms" String
s Either String Int
-> (Int -> Either String CmdlineOptions)
-> Either String CmdlineOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
ms::Int) ->
                              CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_maxCurTimeMs :: Maybe Int
opts_maxCurTimeMs = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ms }) String
"MILLISECONDS")
             String
"Abort a test that runs more than MILLISECONDS."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"prev-factor"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> String -> String -> Either String Double
forall b. Read b => String -> String -> Either String b
parseRead String
"--prev-factor" String
s Either String Double
-> (Double -> Either String CmdlineOptions)
-> Either String CmdlineOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Double
ms::Double) ->
                              CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_prevFactor :: Maybe Double
opts_prevFactor = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
ms }) String
"DOUBLE")
             String
"Abort a test that runs more than DOUBLE times slower than in a previous run."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"timeout-is-success"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_timeoutIsSuccess :: Bool
opts_timeoutIsSuccess = Bool
True }))
             String
"Do not regard a test timeout as an error."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []        [String
"repeat"]
             ((String -> CmdlineOptions -> Either String CmdlineOptions)
-> String
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s CmdlineOptions
o -> String -> String -> Either String Int
forall b. Read b => String -> String -> Either String b
parseRead String
"--repeat" String
s Either String Int
-> (Int -> Either String CmdlineOptions)
-> Either String CmdlineOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
i::Int) ->
                              CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_repeat :: Int
opts_repeat = Int
i}) String
"NUMBER")
             String
"Execute the tests selected on the command line NUMBER times."
    , String
-> [String]
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
-> String
-> OptDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'h']     [String
"help"]
             ((CmdlineOptions -> Either String CmdlineOptions)
-> ArgDescr (CmdlineOptions -> Either String CmdlineOptions)
forall a. a -> ArgDescr a
NoArg (\CmdlineOptions
o -> CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions -> Either String CmdlineOptions)
-> CmdlineOptions -> Either String CmdlineOptions
forall a b. (a -> b) -> a -> b
$ CmdlineOptions
o { opts_help :: Bool
opts_help = Bool
True }))
             String
"Display this message."
    ]
    where
      parseThreads :: Maybe String -> Either String Int
parseThreads Maybe String
Nothing = Int -> Either String Int
forall a b. b -> Either a b
Right Int
processorCount
      parseThreads (Just String
s) =
          case String -> Maybe Int
forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
s of
            Just Int
i -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
i
            Maybe Int
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left (String
"invalid number of threads: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
      parseBool :: String -> Either a Bool
parseBool String
s =
          Bool -> Either a Bool
forall a b. b -> Either a b
Right (Bool -> Either a Bool) -> Bool -> Either a Bool
forall a b. (a -> b) -> a -> b
$
          if (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"1", String
"true", String
"yes", String
"on"] then Bool
True else Bool
False
      parseRead :: String -> String -> Either String b
parseRead String
opt String
s =
          case String -> Maybe b
forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
s of
            Just b
i -> b -> Either String b
forall a b. b -> Either a b
Right b
i
            Maybe b
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left (String
"invalid value for option " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)

{- |

Parse commandline arguments into 'CmdlineOptions'. Here is a synopsis
of the format of the commandline arguments:

> USAGE: COMMAND [OPTION ...] PATTERN ...
>
>   where PATTERN is a posix regular expression matching
>   the names of the tests to run.
>
>   -q          --quiet                     Only display errors.
>   -n PATTERN  --not=PATTERN               Tests to exclude.
>   -l          --list                      List all matching tests.
>   -j[N]       --threads[=N]               Run N tests in parallel, default N=1.
>               --shuffle=BOOL              Shuffle test order. Default: false
>   -o FILE     --output-file=FILE          Name of output file.
>               --json                      Output results in machine-readable JSON format (incremental).
>               --xml=FILE                  Output results in junit-style XML format.
>               --split                     Splits results in separate files to avoid file locking (requires -o/--output-file).
>               --colors=BOOL               Use colors or not.
>               --history=FILE              Path to the history file. Default: ./.HTF/<ProgramName>.history
>               --fail-fast                 Fail and abort test run as soon as the first test fails.
>               --sort-by-prev-time         Sort tests ascending by their execution of the previous test run (if available). Default: false
>               --max-prev-ms=MILLISECONDS  Do not try to execute tests that had a execution time greater than MILLISECONDS in a previous test run.
>               --max-cur-ms=MILLISECONDS   Abort a test that runs more than MILLISECONDS.
>               --prev-factor=DOUBLE        Abort a test that runs more than DOUBLE times slower than in a previous run.
>               --timeout-is-success        Do not regard a test timeout as an error.
>   -h          --help                      Display this message.

-}

parseTestArgs :: [String] -> Either String CmdlineOptions
parseTestArgs :: [String] -> Either String CmdlineOptions
parseTestArgs [String]
args =
    case ArgOrder (CmdlineOptions -> Either String CmdlineOptions)
-> [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
-> [String]
-> ([CmdlineOptions -> Either String CmdlineOptions], [String],
    [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (CmdlineOptions -> Either String CmdlineOptions)
forall a. ArgOrder a
Permute [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
optionDescriptions [String]
args of
      ([CmdlineOptions -> Either String CmdlineOptions]
optTrans, [String]
tests, []) ->
          do CmdlineOptions
opts <- (CmdlineOptions
 -> (CmdlineOptions -> Either String CmdlineOptions)
 -> Either String CmdlineOptions)
-> CmdlineOptions
-> [CmdlineOptions -> Either String CmdlineOptions]
-> Either String CmdlineOptions
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\CmdlineOptions
o CmdlineOptions -> Either String CmdlineOptions
f -> CmdlineOptions -> Either String CmdlineOptions
f CmdlineOptions
o) CmdlineOptions
defaultCmdlineOptions [CmdlineOptions -> Either String CmdlineOptions]
optTrans
             Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CmdlineOptions -> Bool
opts_shuffle CmdlineOptions
opts Bool -> Bool -> Bool
&& CmdlineOptions -> Bool
opts_sortByPrevTime CmdlineOptions
opts) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
                 String -> Either String ()
forall a b. a -> Either a b
Left (String
"Options --shuffle=true and --sort-by-prev-time are in conflict. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
"Can only use one of both.\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
-> [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
-> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageHeader [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
optionDescriptions)
             case (CmdlineOptions -> Maybe String
opts_outputFile CmdlineOptions
opts, CmdlineOptions -> Bool
opts_split CmdlineOptions
opts) of
               (Maybe String
Nothing, Bool
True) -> String -> Either String CmdlineOptions
forall a b. a -> Either a b
Left (String
"Option --split requires -o or --output-file\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                        String
-> [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
-> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageHeader [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
optionDescriptions)
               (Maybe String, Bool)
_ -> let posStrs :: [String]
posStrs = [String]
tests
                        negStrs :: [String]
negStrs = CmdlineOptions -> [String]
opts_negated CmdlineOptions
opts
                        pos :: [Regex]
pos = (String -> Regex) -> [String] -> [Regex]
forall a b. (a -> b) -> [a] -> [b]
map String -> Regex
mkRegex [String]
posStrs
                        neg :: [Regex]
neg = (String -> Regex) -> [String] -> [Regex]
forall a b. (a -> b) -> [a] -> [b]
map String -> Regex
mkRegex [String]
negStrs
                        pred :: GenFlatTest a -> Bool
pred (FlatTest TestSort
_ TestPath
path Maybe Location
_ a
_) =
                            let flat :: String
flat = TestPath -> String
flatName TestPath
path
                            in if ((Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Regex
s -> Regex
s Regex -> String -> Bool
`matches` String
flat) [Regex]
neg)
                                  then Bool
False
                                  else [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Regex]
pos Bool -> Bool -> Bool
|| (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Regex
s -> Regex
s Regex -> String -> Bool
`matches` String
flat) [Regex]
pos
                    in CmdlineOptions -> Either String CmdlineOptions
forall a b. b -> Either a b
Right (CmdlineOptions
opts { opts_filter :: TestFilter
opts_filter = TestFilter
forall a. GenFlatTest a -> Bool
pred })
      ([CmdlineOptions -> Either String CmdlineOptions]
_,[String]
_,[String]
errs) ->
          String -> Either String CmdlineOptions
forall a b. a -> Either a b
Left ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
errs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
-> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageHeader [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
optionDescriptions)
    where
      matches :: Regex -> String -> Bool
matches Regex
r String
s = Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
R.matchRegex Regex
r String
s
      mkRegex :: String -> Regex
mkRegex String
s = String -> Bool -> Bool -> Regex
R.mkRegexWithOpts String
s Bool
True Bool
False

usageHeader :: String
usageHeader :: String
usageHeader = (String
"USAGE: COMMAND [OPTION ...] PATTERN ...\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
               String
"  where PATTERN is a posix regular expression matching\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
               String
"  the names of the tests to run.\n")

-- | The string displayed for the @--help@ option.
helpString :: String
helpString :: String
helpString = String
-> [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
-> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageHeader [OptDescr (CmdlineOptions -> Either String CmdlineOptions)]
optionDescriptions

--
-- TestConfig
--

-- | Turn the 'CmdlineOptions' into a 'TestConfig'.
testConfigFromCmdlineOptions :: CmdlineOptions -> IO TestConfig
testConfigFromCmdlineOptions :: CmdlineOptions -> IO TestConfig
testConfigFromCmdlineOptions CmdlineOptions
opts =
    do (TestOutput
output, Bool
colors) <-
           case (CmdlineOptions -> Maybe String
opts_outputFile CmdlineOptions
opts, CmdlineOptions -> Bool
opts_split CmdlineOptions
opts) of
             (Just String
fname, Bool
True) -> (TestOutput, Bool) -> IO (TestOutput, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> TestOutput
TestOutputSplitted String
fname, Bool
False)
             (Maybe String, Bool)
_ -> do (Handle
outputHandle, Bool
closeOutput, Maybe Fd
mOutputFd) <- IO (Handle, Bool, Maybe Fd)
openOutputFile
                     Bool
colors <- Maybe Fd -> IO Bool
checkColors Maybe Fd
mOutputFd
                     (TestOutput, Bool) -> IO (TestOutput, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Bool -> TestOutput
TestOutputHandle Handle
outputHandle Bool
closeOutput, Bool
colors)
       let threads :: Maybe Int
threads = CmdlineOptions -> Maybe Int
opts_threads CmdlineOptions
opts
           reporters :: [TestReporter]
reporters = IsParallel -> IsJsonOutput -> IsXmlOutput -> [TestReporter]
defaultTestReporters (Bool -> IsParallel
isParallelFromBool (Bool -> IsParallel) -> Bool -> IsParallel
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
threads)
                                            (if CmdlineOptions -> Bool
opts_machineOutput CmdlineOptions
opts then IsJsonOutput
JsonOutput else IsJsonOutput
NoJsonOutput)
                                            (if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (CmdlineOptions -> Maybe String
opts_machineOutputXml CmdlineOptions
opts) then IsXmlOutput
XmlOutput else IsXmlOutput
NoXmlOutput)
       String
historyFile <- IO String
getHistoryFile
       TestHistory
history <- String -> IO TestHistory
getHistory String
historyFile
       TestConfig -> IO TestConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (TestConfig -> IO TestConfig) -> TestConfig -> IO TestConfig
forall a b. (a -> b) -> a -> b
$ TestConfig :: Bool
-> Maybe Int
-> Bool
-> TestOutput
-> Maybe String
-> TestFilter
-> [TestReporter]
-> Bool
-> String
-> TestHistory
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> Maybe Double
-> Int
-> TestConfig
TestConfig { tc_quiet :: Bool
tc_quiet = CmdlineOptions -> Bool
opts_quiet CmdlineOptions
opts
                           , tc_threads :: Maybe Int
tc_threads = Maybe Int
threads
                           , tc_shuffle :: Bool
tc_shuffle = CmdlineOptions -> Bool
opts_shuffle CmdlineOptions
opts
                           , tc_output :: TestOutput
tc_output = TestOutput
output
                           , tc_outputXml :: Maybe String
tc_outputXml = CmdlineOptions -> Maybe String
opts_machineOutputXml CmdlineOptions
opts
                           , tc_reporters :: [TestReporter]
tc_reporters = [TestReporter]
reporters
                           , tc_filter :: TestFilter
tc_filter = CmdlineOptions -> TestFilter
opts_filter CmdlineOptions
opts TestFilter -> TestFilter -> TestFilter
forall t. (t -> Bool) -> (t -> Bool) -> t -> Bool
`mergeFilters` (TestHistory -> TestFilter
forall a. TestHistory -> GenFlatTest a -> Bool
historicFilter TestHistory
history)
                           , tc_useColors :: Bool
tc_useColors = Bool
colors
                           , tc_historyFile :: String
tc_historyFile = String
historyFile
                           , tc_history :: TestHistory
tc_history = TestHistory
history
                           , tc_sortByPrevTime :: Bool
tc_sortByPrevTime = CmdlineOptions -> Bool
opts_sortByPrevTime CmdlineOptions
opts
                           , tc_failFast :: Bool
tc_failFast = CmdlineOptions -> Bool
opts_failFast CmdlineOptions
opts
                           , tc_maxSingleTestTime :: Maybe Int
tc_maxSingleTestTime = CmdlineOptions -> Maybe Int
opts_maxCurTimeMs CmdlineOptions
opts
                           , tc_prevFactor :: Maybe Double
tc_prevFactor = CmdlineOptions -> Maybe Double
opts_prevFactor CmdlineOptions
opts
                           , tc_timeoutIsSuccess :: Bool
tc_timeoutIsSuccess = CmdlineOptions -> Bool
opts_timeoutIsSuccess CmdlineOptions
opts
                           , tc_repeat :: Int
tc_repeat = CmdlineOptions -> Int
opts_repeat CmdlineOptions
opts
                           }
    where
#ifdef mingw32_HOST_OS
      openOutputFile =
          case opts_outputFile opts of
            Nothing -> return (stdout, False, Nothing)
            Just fname ->
                do f <- openFile fname WriteMode
                   return (f, True, Nothing)
      checkColors mOutputFd =
          case opts_useColors opts of
            Just b -> return b
            Nothing -> return False
#else
      openOutputFile :: IO (Handle, Bool, Maybe Fd)
openOutputFile =
          case CmdlineOptions -> Maybe String
opts_outputFile CmdlineOptions
opts of
            Maybe String
Nothing -> (Handle, Bool, Maybe Fd) -> IO (Handle, Bool, Maybe Fd)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
stdout, Bool
False, Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdOutput)
            Just String
fname ->
                do Handle
f <- String -> IOMode -> IO Handle
openFile String
fname IOMode
WriteMode
                   (Handle, Bool, Maybe Fd) -> IO (Handle, Bool, Maybe Fd)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
f, Bool
True, Maybe Fd
forall a. Maybe a
Nothing)
      checkColors :: Maybe Fd -> IO Bool
checkColors Maybe Fd
mOutputFd =
          case CmdlineOptions -> Maybe Bool
opts_useColors CmdlineOptions
opts of
            Just Bool
b -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
            Maybe Bool
Nothing ->
                do Maybe String
mterm <- String -> IO (Maybe String)
getEnv String
"TERM"
                   case Maybe String
mterm of
                     Maybe String
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                     Just String
s | (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dumb" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                     Maybe String
_ -> do Maybe String
mx <- String -> IO (Maybe String)
getEnv String
"HTF_NO_COLORS"
                             case Maybe String
mx of
                               Just String
s | (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"", String
"1", String
"y", String
"yes", String
"true"] -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                               Maybe String
_ -> case Maybe Fd
mOutputFd of
                                      Just Fd
fd -> Fd -> IO Bool
queryTerminal Fd
fd
                                      Maybe Fd
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
#endif
      getHistoryFile :: IO String
getHistoryFile =
          case CmdlineOptions -> Maybe String
opts_historyFile CmdlineOptions
opts of
            Just String
fp -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fp
            Maybe String
Nothing ->
                do String
progName <- IO String
getProgName
                   let x :: String
x = if String
progName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"<interactive>" then String
"interactive" else String
progName
                   String
curDir <- IO String
getCurrentDirectory
                   let dir :: String
dir = String
curDir String -> String -> String
</> String
".HTF"
                   Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
                   String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".history")
      getHistory :: String -> IO TestHistory
getHistory String
fp =
          do Bool
b <- String -> IO Bool
doesFileExist String
fp
             if Bool -> Bool
not Bool
b
             then TestHistory -> IO TestHistory
forall (m :: * -> *) a. Monad m => a -> m a
return TestHistory
emptyTestHistory
             else do ByteString
bs <- String -> IO ByteString
BS.readFile String
fp
                     case ByteString -> Either String TestHistory
deserializeTestHistory ByteString
bs of
                       Right TestHistory
history -> TestHistory -> IO TestHistory
forall (m :: * -> *) a. Monad m => a -> m a
return TestHistory
history
                       Left String
err ->
                           do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Error deserializing content of HTF history file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
                              TestHistory -> IO TestHistory
forall (m :: * -> *) a. Monad m => a -> m a
return TestHistory
emptyTestHistory
                  IO TestHistory -> (IOException -> IO TestHistory) -> IO TestHistory
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
e::IOException) ->
                               do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Error reading HTF history file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e)
                                  TestHistory -> IO TestHistory
forall (m :: * -> *) a. Monad m => a -> m a
return TestHistory
emptyTestHistory)
      mergeFilters :: (t -> Bool) -> (t -> Bool) -> t -> Bool
mergeFilters t -> Bool
f1 t -> Bool
f2 t
t =
          t -> Bool
f1 t
t Bool -> Bool -> Bool
&& t -> Bool
f2 t
t
      historicFilter :: TestHistory -> GenFlatTest a -> Bool
historicFilter TestHistory
history GenFlatTest a
t =
          case CmdlineOptions -> Maybe Int
opts_maxPrevTimeMs CmdlineOptions
opts of
            Maybe Int
Nothing -> Bool
True
            Just Int
ms ->
                case Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max ((HistoricTestResult -> Int)
-> Maybe HistoricTestResult -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HistoricTestResult -> Int
htr_timeMs (Text -> TestHistory -> Maybe HistoricTestResult
findHistoricTestResult (GenFlatTest a -> Text
forall a. GenFlatTest a -> Text
historyKey GenFlatTest a
t) TestHistory
history))
                         ((HistoricTestResult -> Int)
-> Maybe HistoricTestResult -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HistoricTestResult -> Int
htr_timeMs (Text -> TestHistory -> Maybe HistoricTestResult
findHistoricSuccessfulTestResult (GenFlatTest a -> Text
forall a. GenFlatTest a -> Text
historyKey GenFlatTest a
t) TestHistory
history))
                of
                  Maybe Int
Nothing -> Bool
True
                  Just Int
t -> Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ms