-- | Core options, i.e. the options used by tasty itself
{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-} -- for (^)
module Test.Tasty.Options.Core
  ( NumThreads(..)
  , Timeout(..)
  , mkTimeout
  , HideProgress(..)
  , coreOptions
  -- * Helpers
  , parseDuration
  )
  where

import Control.Monad (mfilter)
import Data.Proxy
import Data.Typeable
import Data.Fixed
import Options.Applicative hiding (str)
import GHC.Conc
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif

import Test.Tasty.Options
import Test.Tasty.Patterns

-- | Number of parallel threads to use for running tests.
--
-- Note that this is /not/ included in 'coreOptions'.
-- Instead, it's automatically included in the options for any
-- 'Test.Tasty.Ingredients.TestReporter' ingredient by
-- 'Test.Tasty.Ingredients.ingredientOptions', because the way test
-- reporters are handled already involves parallelism. Other ingredients
-- may also choose to include this option.
--
-- @since 0.1
newtype NumThreads = NumThreads { NumThreads -> Int
getNumThreads :: Int }
  deriving (NumThreads -> NumThreads -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumThreads -> NumThreads -> Bool
$c/= :: NumThreads -> NumThreads -> Bool
== :: NumThreads -> NumThreads -> Bool
$c== :: NumThreads -> NumThreads -> Bool
Eq, Eq NumThreads
NumThreads -> NumThreads -> Bool
NumThreads -> NumThreads -> Ordering
NumThreads -> NumThreads -> NumThreads
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
min :: NumThreads -> NumThreads -> NumThreads
$cmin :: NumThreads -> NumThreads -> NumThreads
max :: NumThreads -> NumThreads -> NumThreads
$cmax :: NumThreads -> NumThreads -> NumThreads
>= :: NumThreads -> NumThreads -> Bool
$c>= :: NumThreads -> NumThreads -> Bool
> :: NumThreads -> NumThreads -> Bool
$c> :: NumThreads -> NumThreads -> Bool
<= :: NumThreads -> NumThreads -> Bool
$c<= :: NumThreads -> NumThreads -> Bool
< :: NumThreads -> NumThreads -> Bool
$c< :: NumThreads -> NumThreads -> Bool
compare :: NumThreads -> NumThreads -> Ordering
$ccompare :: NumThreads -> NumThreads -> Ordering
Ord, Integer -> NumThreads
NumThreads -> NumThreads
NumThreads -> NumThreads -> NumThreads
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NumThreads
$cfromInteger :: Integer -> NumThreads
signum :: NumThreads -> NumThreads
$csignum :: NumThreads -> NumThreads
abs :: NumThreads -> NumThreads
$cabs :: NumThreads -> NumThreads
negate :: NumThreads -> NumThreads
$cnegate :: NumThreads -> NumThreads
* :: NumThreads -> NumThreads -> NumThreads
$c* :: NumThreads -> NumThreads -> NumThreads
- :: NumThreads -> NumThreads -> NumThreads
$c- :: NumThreads -> NumThreads -> NumThreads
+ :: NumThreads -> NumThreads -> NumThreads
$c+ :: NumThreads -> NumThreads -> NumThreads
Num, Typeable)
instance IsOption NumThreads where
  defaultValue :: NumThreads
defaultValue = Int -> NumThreads
NumThreads Int
numCapabilities
  parseValue :: String -> Maybe NumThreads
parseValue = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter NumThreads -> Bool
onlyPositive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> NumThreads
NumThreads forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged NumThreads String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"num-threads"
  optionHelp :: Tagged NumThreads String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Number of threads to use for tests execution"
  optionCLParser :: Parser NumThreads
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER")
  showDefaultValue :: NumThreads -> Maybe String
showDefaultValue NumThreads
_ = forall a. a -> Maybe a
Just String
"# of cores/capabilities"

-- | Filtering function to prevent non-positive number of threads
onlyPositive :: NumThreads -> Bool
onlyPositive :: NumThreads -> Bool
onlyPositive (NumThreads Int
x) = Int
x forall a. Ord a => a -> a -> Bool
> Int
0

-- | Timeout to be applied to individual tests.
--
-- @since 0.8
data Timeout
  = Timeout Integer String
    -- ^ 'String' is the original representation of the timeout (such as
    -- @\"0.5m\"@), so that we can print it back. 'Integer' is the number of
    -- microseconds.
  | NoTimeout
  deriving (Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show, Typeable)

instance IsOption Timeout where
  defaultValue :: Timeout
defaultValue = Timeout
NoTimeout
  parseValue :: String -> Maybe Timeout
parseValue String
str =
    Integer -> String -> Timeout
Timeout
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Integer
parseDuration String
str
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
str
  optionName :: Tagged Timeout String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"timeout"
  optionHelp :: Tagged Timeout String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Timeout for individual tests (suffixes: ms,s,m,h; default: s)"
  optionCLParser :: Parser Timeout
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DURATION")

-- | Parses a suffixed duration (e.g. "10s") to an Integer representing
-- number of microseconds.
parseDuration :: String -> Maybe Integer
parseDuration :: String -> Maybe Integer
parseDuration String
str =
  -- it sucks that there's no more direct way to convert to a number of
  -- microseconds
  (forall a b. (RealFrac a, Integral b) => a -> b
round :: Micro -> Integer) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Micro
10forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  case forall a. Read a => ReadS a
reads String
str of
    [(Micro
n, String
suffix)] ->
      case String
suffix of
        String
"ms" -> forall a. a -> Maybe a
Just (Micro
n forall a. Fractional a => a -> a -> a
/ Micro
10forall a b. (Num a, Integral b) => a -> b -> a
^Integer
3)
        String
"" -> forall a. a -> Maybe a
Just Micro
n
        String
"s" -> forall a. a -> Maybe a
Just Micro
n
        String
"m" -> forall a. a -> Maybe a
Just (Micro
n forall a. Num a => a -> a -> a
* Micro
60)
        String
"h" -> forall a. a -> Maybe a
Just (Micro
n forall a. Num a => a -> a -> a
* Micro
60forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2)
        String
_ -> forall a. Maybe a
Nothing
    [(Micro, String)]
_ -> forall a. Maybe a
Nothing

-- | A shortcut for creating 'Timeout' values.
--
-- @since 0.8
mkTimeout
  :: Integer -- ^ microseconds
  -> Timeout
mkTimeout :: Integer -> Timeout
mkTimeout Integer
n =
  Integer -> String -> Timeout
Timeout Integer
n forall a b. (a -> b) -> a -> b
$
    forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True (forall a. Num a => Integer -> a
fromInteger Integer
n forall a. Fractional a => a -> a -> a
/ (Micro
10forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6) :: Micro) forall a. [a] -> [a] -> [a]
++ String
"s"

-- | Hide progress information. If progress disabled, the test launcher
-- 'Test.Tasty.Runners.launchTestTree' completely ignores callbacks to update progress.
-- If enabled, it's up to individual 'Test.Tasty.Ingredients.TestReporter's
-- how to execute, some might not be able to render progress anyways.
--
-- @since 1.5
newtype HideProgress = HideProgress { HideProgress -> Bool
getHideProgress :: Bool }
  deriving (HideProgress -> HideProgress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HideProgress -> HideProgress -> Bool
$c/= :: HideProgress -> HideProgress -> Bool
== :: HideProgress -> HideProgress -> Bool
$c== :: HideProgress -> HideProgress -> Bool
Eq, Eq HideProgress
HideProgress -> HideProgress -> Bool
HideProgress -> HideProgress -> Ordering
HideProgress -> HideProgress -> HideProgress
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
min :: HideProgress -> HideProgress -> HideProgress
$cmin :: HideProgress -> HideProgress -> HideProgress
max :: HideProgress -> HideProgress -> HideProgress
$cmax :: HideProgress -> HideProgress -> HideProgress
>= :: HideProgress -> HideProgress -> Bool
$c>= :: HideProgress -> HideProgress -> Bool
> :: HideProgress -> HideProgress -> Bool
$c> :: HideProgress -> HideProgress -> Bool
<= :: HideProgress -> HideProgress -> Bool
$c<= :: HideProgress -> HideProgress -> Bool
< :: HideProgress -> HideProgress -> Bool
$c< :: HideProgress -> HideProgress -> Bool
compare :: HideProgress -> HideProgress -> Ordering
$ccompare :: HideProgress -> HideProgress -> Ordering
Ord, Typeable)
instance IsOption HideProgress where
    defaultValue :: HideProgress
defaultValue = Bool -> HideProgress
HideProgress Bool
False
    parseValue :: String -> Maybe HideProgress
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> HideProgress
HideProgress forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
safeReadBool
    optionName :: Tagged HideProgress String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"hide-progress"
    optionHelp :: Tagged HideProgress String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Do not show progress"
    optionCLParser :: Parser HideProgress
optionCLParser = forall v. IsOption v => Mod FlagFields v -> v -> Parser v
mkFlagCLParser forall a. Monoid a => a
mempty (Bool -> HideProgress
HideProgress Bool
True)

-- | The list of all core options, i.e. the options not specific to any
-- provider or ingredient, but to tasty itself. Currently contains
-- 'TestPattern' and 'Timeout'.
--
-- @since 0.1
coreOptions :: [OptionDescription]
coreOptions :: [OptionDescription]
coreOptions =
  [ forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TestPattern)
  , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy Timeout)
  , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy HideProgress)
  ]