-- | 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
  , coreOptions
  )
  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
-- 'TestReporter' ingredient by 'ingredientOptions', because the way test
-- reporters are handled already involves parallelism. Other ingredients
-- may also choose to include this option.
newtype NumThreads = NumThreads { NumThreads -> Int
getNumThreads :: Int }
  deriving (NumThreads -> NumThreads -> Bool
(NumThreads -> NumThreads -> Bool)
-> (NumThreads -> NumThreads -> Bool) -> Eq NumThreads
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
Eq NumThreads
-> (NumThreads -> NumThreads -> Ordering)
-> (NumThreads -> NumThreads -> Bool)
-> (NumThreads -> NumThreads -> Bool)
-> (NumThreads -> NumThreads -> Bool)
-> (NumThreads -> NumThreads -> Bool)
-> (NumThreads -> NumThreads -> NumThreads)
-> (NumThreads -> NumThreads -> NumThreads)
-> Ord 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
$cp1Ord :: Eq NumThreads
Ord, Integer -> NumThreads
NumThreads -> NumThreads
NumThreads -> NumThreads -> NumThreads
(NumThreads -> NumThreads -> NumThreads)
-> (NumThreads -> NumThreads -> NumThreads)
-> (NumThreads -> NumThreads -> NumThreads)
-> (NumThreads -> NumThreads)
-> (NumThreads -> NumThreads)
-> (NumThreads -> NumThreads)
-> (Integer -> NumThreads)
-> Num 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 = (NumThreads -> Bool) -> Maybe NumThreads -> Maybe NumThreads
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter NumThreads -> Bool
onlyPositive (Maybe NumThreads -> Maybe NumThreads)
-> (String -> Maybe NumThreads) -> String -> Maybe NumThreads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> NumThreads) -> Maybe Int -> Maybe NumThreads
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> NumThreads
NumThreads (Maybe Int -> Maybe NumThreads)
-> (String -> Maybe Int) -> String -> Maybe NumThreads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged NumThreads String
optionName = String -> Tagged NumThreads String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"num-threads"
  optionHelp :: Tagged NumThreads String
optionHelp = String -> Tagged NumThreads String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Number of threads to use for tests execution"
  optionCLParser :: Parser NumThreads
optionCLParser = Mod OptionFields NumThreads -> Parser NumThreads
forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (Char -> Mod OptionFields NumThreads
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j' Mod OptionFields NumThreads
-> Mod OptionFields NumThreads -> Mod OptionFields NumThreads
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NumThreads
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER")
  showDefaultValue :: NumThreads -> Maybe String
showDefaultValue NumThreads
_ = String -> Maybe String
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

-- | Timeout to be applied to individual tests
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
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
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
      (Integer -> String -> Timeout)
-> Maybe Integer -> Maybe (String -> Timeout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Integer
parseTimeout String
str
      Maybe (String -> Timeout) -> Maybe String -> Maybe Timeout
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
str
  optionName :: Tagged Timeout String
optionName = String -> Tagged Timeout String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"timeout"
  optionHelp :: Tagged Timeout String
optionHelp = String -> Tagged Timeout String
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 = Mod OptionFields Timeout -> Parser Timeout
forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (Char -> Mod OptionFields Timeout
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' Mod OptionFields Timeout
-> Mod OptionFields Timeout -> Mod OptionFields Timeout
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Timeout
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DURATION")

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

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

-- | 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'.
coreOptions :: [OptionDescription]
coreOptions :: [OptionDescription]
coreOptions =
  [ Proxy TestPattern -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy TestPattern
forall k (t :: k). Proxy t
Proxy :: Proxy TestPattern)
  , Proxy Timeout -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy Timeout
forall k (t :: k). Proxy t
Proxy :: Proxy Timeout)
  ]