{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Hedgehog.Internal.Config (
    UseColor(..)
  , resolveColor

  , Verbosity(..)
  , resolveVerbosity

  , WorkerCount(..)
  , resolveWorkers

  , detectMark
  , detectColor
  , detectVerbosity
  , detectWorkers
  ) where

import           Control.Monad.IO.Class (MonadIO(..))

import qualified GHC.Conc as Conc

import           Language.Haskell.TH.Syntax (Lift)

import           System.Console.ANSI (hSupportsANSI)
import           System.Environment (lookupEnv)
import           System.IO (stdout)

import           Text.Read (readMaybe)


-- | Whether to render output using ANSI colors or not.
--
data UseColor =
    DisableColor
    -- ^ Disable ANSI colors in report output.
  | EnableColor
    -- ^ Enable ANSI colors in report output.
    deriving (UseColor -> UseColor -> Bool
(UseColor -> UseColor -> Bool)
-> (UseColor -> UseColor -> Bool) -> Eq UseColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UseColor -> UseColor -> Bool
$c/= :: UseColor -> UseColor -> Bool
== :: UseColor -> UseColor -> Bool
$c== :: UseColor -> UseColor -> Bool
Eq, Eq UseColor
Eq UseColor
-> (UseColor -> UseColor -> Ordering)
-> (UseColor -> UseColor -> Bool)
-> (UseColor -> UseColor -> Bool)
-> (UseColor -> UseColor -> Bool)
-> (UseColor -> UseColor -> Bool)
-> (UseColor -> UseColor -> UseColor)
-> (UseColor -> UseColor -> UseColor)
-> Ord UseColor
UseColor -> UseColor -> Bool
UseColor -> UseColor -> Ordering
UseColor -> UseColor -> UseColor
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 :: UseColor -> UseColor -> UseColor
$cmin :: UseColor -> UseColor -> UseColor
max :: UseColor -> UseColor -> UseColor
$cmax :: UseColor -> UseColor -> UseColor
>= :: UseColor -> UseColor -> Bool
$c>= :: UseColor -> UseColor -> Bool
> :: UseColor -> UseColor -> Bool
$c> :: UseColor -> UseColor -> Bool
<= :: UseColor -> UseColor -> Bool
$c<= :: UseColor -> UseColor -> Bool
< :: UseColor -> UseColor -> Bool
$c< :: UseColor -> UseColor -> Bool
compare :: UseColor -> UseColor -> Ordering
$ccompare :: UseColor -> UseColor -> Ordering
$cp1Ord :: Eq UseColor
Ord, Int -> UseColor -> ShowS
[UseColor] -> ShowS
UseColor -> String
(Int -> UseColor -> ShowS)
-> (UseColor -> String) -> ([UseColor] -> ShowS) -> Show UseColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UseColor] -> ShowS
$cshowList :: [UseColor] -> ShowS
show :: UseColor -> String
$cshow :: UseColor -> String
showsPrec :: Int -> UseColor -> ShowS
$cshowsPrec :: Int -> UseColor -> ShowS
Show, UseColor -> Q Exp
UseColor -> Q (TExp UseColor)
(UseColor -> Q Exp)
-> (UseColor -> Q (TExp UseColor)) -> Lift UseColor
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: UseColor -> Q (TExp UseColor)
$cliftTyped :: UseColor -> Q (TExp UseColor)
lift :: UseColor -> Q Exp
$clift :: UseColor -> Q Exp
Lift)

-- | How verbose should the report output be.
--
data Verbosity =
    Quiet
    -- ^ Only display the summary of the test run.
  | Normal
    -- ^ Display each property as it is running, as well as the summary.
    deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
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 :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show, Verbosity -> Q Exp
Verbosity -> Q (TExp Verbosity)
(Verbosity -> Q Exp)
-> (Verbosity -> Q (TExp Verbosity)) -> Lift Verbosity
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Verbosity -> Q (TExp Verbosity)
$cliftTyped :: Verbosity -> Q (TExp Verbosity)
lift :: Verbosity -> Q Exp
$clift :: Verbosity -> Q Exp
Lift)

-- | The number of workers to use when running properties in parallel.
--
newtype WorkerCount =
  WorkerCount Int
  deriving (WorkerCount -> WorkerCount -> Bool
(WorkerCount -> WorkerCount -> Bool)
-> (WorkerCount -> WorkerCount -> Bool) -> Eq WorkerCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkerCount -> WorkerCount -> Bool
$c/= :: WorkerCount -> WorkerCount -> Bool
== :: WorkerCount -> WorkerCount -> Bool
$c== :: WorkerCount -> WorkerCount -> Bool
Eq, Eq WorkerCount
Eq WorkerCount
-> (WorkerCount -> WorkerCount -> Ordering)
-> (WorkerCount -> WorkerCount -> Bool)
-> (WorkerCount -> WorkerCount -> Bool)
-> (WorkerCount -> WorkerCount -> Bool)
-> (WorkerCount -> WorkerCount -> Bool)
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> Ord WorkerCount
WorkerCount -> WorkerCount -> Bool
WorkerCount -> WorkerCount -> Ordering
WorkerCount -> WorkerCount -> WorkerCount
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 :: WorkerCount -> WorkerCount -> WorkerCount
$cmin :: WorkerCount -> WorkerCount -> WorkerCount
max :: WorkerCount -> WorkerCount -> WorkerCount
$cmax :: WorkerCount -> WorkerCount -> WorkerCount
>= :: WorkerCount -> WorkerCount -> Bool
$c>= :: WorkerCount -> WorkerCount -> Bool
> :: WorkerCount -> WorkerCount -> Bool
$c> :: WorkerCount -> WorkerCount -> Bool
<= :: WorkerCount -> WorkerCount -> Bool
$c<= :: WorkerCount -> WorkerCount -> Bool
< :: WorkerCount -> WorkerCount -> Bool
$c< :: WorkerCount -> WorkerCount -> Bool
compare :: WorkerCount -> WorkerCount -> Ordering
$ccompare :: WorkerCount -> WorkerCount -> Ordering
$cp1Ord :: Eq WorkerCount
Ord, Int -> WorkerCount -> ShowS
[WorkerCount] -> ShowS
WorkerCount -> String
(Int -> WorkerCount -> ShowS)
-> (WorkerCount -> String)
-> ([WorkerCount] -> ShowS)
-> Show WorkerCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkerCount] -> ShowS
$cshowList :: [WorkerCount] -> ShowS
show :: WorkerCount -> String
$cshow :: WorkerCount -> String
showsPrec :: Int -> WorkerCount -> ShowS
$cshowsPrec :: Int -> WorkerCount -> ShowS
Show, Integer -> WorkerCount
WorkerCount -> WorkerCount
WorkerCount -> WorkerCount -> WorkerCount
(WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount)
-> (Integer -> WorkerCount)
-> Num WorkerCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> WorkerCount
$cfromInteger :: Integer -> WorkerCount
signum :: WorkerCount -> WorkerCount
$csignum :: WorkerCount -> WorkerCount
abs :: WorkerCount -> WorkerCount
$cabs :: WorkerCount -> WorkerCount
negate :: WorkerCount -> WorkerCount
$cnegate :: WorkerCount -> WorkerCount
* :: WorkerCount -> WorkerCount -> WorkerCount
$c* :: WorkerCount -> WorkerCount -> WorkerCount
- :: WorkerCount -> WorkerCount -> WorkerCount
$c- :: WorkerCount -> WorkerCount -> WorkerCount
+ :: WorkerCount -> WorkerCount -> WorkerCount
$c+ :: WorkerCount -> WorkerCount -> WorkerCount
Num, Int -> WorkerCount
WorkerCount -> Int
WorkerCount -> [WorkerCount]
WorkerCount -> WorkerCount
WorkerCount -> WorkerCount -> [WorkerCount]
WorkerCount -> WorkerCount -> WorkerCount -> [WorkerCount]
(WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount)
-> (Int -> WorkerCount)
-> (WorkerCount -> Int)
-> (WorkerCount -> [WorkerCount])
-> (WorkerCount -> WorkerCount -> [WorkerCount])
-> (WorkerCount -> WorkerCount -> [WorkerCount])
-> (WorkerCount -> WorkerCount -> WorkerCount -> [WorkerCount])
-> Enum WorkerCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WorkerCount -> WorkerCount -> WorkerCount -> [WorkerCount]
$cenumFromThenTo :: WorkerCount -> WorkerCount -> WorkerCount -> [WorkerCount]
enumFromTo :: WorkerCount -> WorkerCount -> [WorkerCount]
$cenumFromTo :: WorkerCount -> WorkerCount -> [WorkerCount]
enumFromThen :: WorkerCount -> WorkerCount -> [WorkerCount]
$cenumFromThen :: WorkerCount -> WorkerCount -> [WorkerCount]
enumFrom :: WorkerCount -> [WorkerCount]
$cenumFrom :: WorkerCount -> [WorkerCount]
fromEnum :: WorkerCount -> Int
$cfromEnum :: WorkerCount -> Int
toEnum :: Int -> WorkerCount
$ctoEnum :: Int -> WorkerCount
pred :: WorkerCount -> WorkerCount
$cpred :: WorkerCount -> WorkerCount
succ :: WorkerCount -> WorkerCount
$csucc :: WorkerCount -> WorkerCount
Enum, Num WorkerCount
Ord WorkerCount
Num WorkerCount
-> Ord WorkerCount -> (WorkerCount -> Rational) -> Real WorkerCount
WorkerCount -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: WorkerCount -> Rational
$ctoRational :: WorkerCount -> Rational
$cp2Real :: Ord WorkerCount
$cp1Real :: Num WorkerCount
Real, Enum WorkerCount
Real WorkerCount
Real WorkerCount
-> Enum WorkerCount
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount -> WorkerCount)
-> (WorkerCount -> WorkerCount -> (WorkerCount, WorkerCount))
-> (WorkerCount -> WorkerCount -> (WorkerCount, WorkerCount))
-> (WorkerCount -> Integer)
-> Integral WorkerCount
WorkerCount -> Integer
WorkerCount -> WorkerCount -> (WorkerCount, WorkerCount)
WorkerCount -> WorkerCount -> WorkerCount
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: WorkerCount -> Integer
$ctoInteger :: WorkerCount -> Integer
divMod :: WorkerCount -> WorkerCount -> (WorkerCount, WorkerCount)
$cdivMod :: WorkerCount -> WorkerCount -> (WorkerCount, WorkerCount)
quotRem :: WorkerCount -> WorkerCount -> (WorkerCount, WorkerCount)
$cquotRem :: WorkerCount -> WorkerCount -> (WorkerCount, WorkerCount)
mod :: WorkerCount -> WorkerCount -> WorkerCount
$cmod :: WorkerCount -> WorkerCount -> WorkerCount
div :: WorkerCount -> WorkerCount -> WorkerCount
$cdiv :: WorkerCount -> WorkerCount -> WorkerCount
rem :: WorkerCount -> WorkerCount -> WorkerCount
$crem :: WorkerCount -> WorkerCount -> WorkerCount
quot :: WorkerCount -> WorkerCount -> WorkerCount
$cquot :: WorkerCount -> WorkerCount -> WorkerCount
$cp2Integral :: Enum WorkerCount
$cp1Integral :: Real WorkerCount
Integral, WorkerCount -> Q Exp
WorkerCount -> Q (TExp WorkerCount)
(WorkerCount -> Q Exp)
-> (WorkerCount -> Q (TExp WorkerCount)) -> Lift WorkerCount
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: WorkerCount -> Q (TExp WorkerCount)
$cliftTyped :: WorkerCount -> Q (TExp WorkerCount)
lift :: WorkerCount -> Q Exp
$clift :: WorkerCount -> Q Exp
Lift)

detectMark :: MonadIO m => m Bool
detectMark :: m Bool
detectMark = do
  Maybe String
user <- IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
"USER"
  Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe String
user Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"mth"

lookupBool :: MonadIO m => String -> m (Maybe Bool)
lookupBool :: String -> m (Maybe Bool)
lookupBool String
key =
  IO (Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ do
    Maybe String
menv <- String -> IO (Maybe String)
lookupEnv String
key
    case Maybe String
menv of
      Just String
"0" ->
        Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
      Just String
"no" ->
        Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
      Just String
"false" ->
        Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False

      Just String
"1" ->
        Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      Just String
"yes" ->
        Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      Just String
"true" ->
        Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True

      Maybe String
_ ->
        Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing

detectColor :: MonadIO m => m UseColor
detectColor :: m UseColor
detectColor =
  IO UseColor -> m UseColor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UseColor -> m UseColor) -> IO UseColor -> m UseColor
forall a b. (a -> b) -> a -> b
$ do
    Maybe Bool
ok <- String -> IO (Maybe Bool)
forall (m :: * -> *). MonadIO m => String -> m (Maybe Bool)
lookupBool String
"HEDGEHOG_COLOR"
    case Maybe Bool
ok of
      Just Bool
False ->
        UseColor -> IO UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
DisableColor

      Just Bool
True ->
        UseColor -> IO UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
EnableColor

      Maybe Bool
Nothing -> do
        Bool
mth <- IO Bool
forall (m :: * -> *). MonadIO m => m Bool
detectMark
        if Bool
mth then
          UseColor -> IO UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
DisableColor -- avoid getting fired :)
        else do
          Bool
enable <- Handle -> IO Bool
hSupportsANSI Handle
stdout
          if Bool
enable then
            UseColor -> IO UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
EnableColor
          else
            UseColor -> IO UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
DisableColor

detectVerbosity :: MonadIO m => m Verbosity
detectVerbosity :: m Verbosity
detectVerbosity =
  IO Verbosity -> m Verbosity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Verbosity -> m Verbosity) -> IO Verbosity -> m Verbosity
forall a b. (a -> b) -> a -> b
$ do
    Maybe Int
menv <- (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> Maybe String -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe String -> Maybe Int) -> IO (Maybe String) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"HEDGEHOG_VERBOSITY"
    case Maybe Int
menv of
      Just (Int
0 :: Int) ->
        Verbosity -> IO Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Quiet

      Just (Int
1 :: Int) ->
        Verbosity -> IO Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Normal

      Maybe Int
_ -> do
        Bool
mth <- IO Bool
forall (m :: * -> *). MonadIO m => m Bool
detectMark
        if Bool
mth then
          Verbosity -> IO Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Quiet
        else
          Verbosity -> IO Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Normal

detectWorkers :: MonadIO m => m WorkerCount
detectWorkers :: m WorkerCount
detectWorkers = do
  IO WorkerCount -> m WorkerCount
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WorkerCount -> m WorkerCount)
-> IO WorkerCount -> m WorkerCount
forall a b. (a -> b) -> a -> b
$ do
    Maybe Int
menv <- (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> Maybe String -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe String -> Maybe Int) -> IO (Maybe String) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"HEDGEHOG_WORKERS"
    case Maybe Int
menv of
      Maybe Int
Nothing ->
        Int -> WorkerCount
WorkerCount (Int -> WorkerCount) -> IO Int -> IO WorkerCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
Conc.getNumProcessors
      Just Int
env ->
        WorkerCount -> IO WorkerCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkerCount -> IO WorkerCount) -> WorkerCount -> IO WorkerCount
forall a b. (a -> b) -> a -> b
$ Int -> WorkerCount
WorkerCount Int
env

resolveColor :: MonadIO m => Maybe UseColor -> m UseColor
resolveColor :: Maybe UseColor -> m UseColor
resolveColor = \case
  Maybe UseColor
Nothing ->
    m UseColor
forall (m :: * -> *). MonadIO m => m UseColor
detectColor
  Just UseColor
x ->
    UseColor -> m UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
x

resolveVerbosity :: MonadIO m => Maybe Verbosity -> m Verbosity
resolveVerbosity :: Maybe Verbosity -> m Verbosity
resolveVerbosity = \case
  Maybe Verbosity
Nothing ->
    m Verbosity
forall (m :: * -> *). MonadIO m => m Verbosity
detectVerbosity
  Just Verbosity
x ->
    Verbosity -> m Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
x

resolveWorkers :: MonadIO m => Maybe WorkerCount -> m WorkerCount
resolveWorkers :: Maybe WorkerCount -> m WorkerCount
resolveWorkers = \case
  Maybe WorkerCount
Nothing ->
    m WorkerCount
forall (m :: * -> *). MonadIO m => m WorkerCount
detectWorkers
  Just WorkerCount
x ->
    WorkerCount -> m WorkerCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkerCount
x