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

  , Seed(..)
  , resolveSeed

  , Verbosity(..)
  , resolveVerbosity

  , WorkerCount(..)
  , resolveWorkers

  , Skip(..)
  , resolveSkip

  , detectMark
  , detectColor
  , detectSeed
  , detectVerbosity
  , detectWorkers
  , detectSkip
  ) where

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

import qualified Data.Text as Text

import qualified GHC.Conc as Conc

import           Hedgehog.Internal.Seed (Seed(..))
import qualified Hedgehog.Internal.Seed as Seed
import           Hedgehog.Internal.Property (Skip(..), skipDecompress)

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

splitOn :: String -> String -> [String]
splitOn :: String -> String -> [String]
splitOn String
needle String
haystack =
  (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
Text.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Text.splitOn (String -> Text
Text.pack String
needle) (String -> Text
Text.pack String
haystack)

parseSeed :: String -> Maybe Seed
parseSeed :: String -> Maybe Seed
parseSeed String
env =
  case String -> String -> [String]
splitOn String
" " String
env of
    [String
value, String
gamma] ->
      Word64 -> Word64 -> Seed
Seed (Word64 -> Word64 -> Seed)
-> Maybe Word64 -> Maybe (Word64 -> Seed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe String
value Maybe (Word64 -> Seed) -> Maybe Word64 -> Maybe Seed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe String
gamma
    [String]
_ ->
      Maybe Seed
forall a. Maybe a
Nothing

detectSeed :: MonadIO m => m Seed
detectSeed :: m Seed
detectSeed =
  IO Seed -> m Seed
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Seed -> m Seed) -> IO Seed -> m Seed
forall a b. (a -> b) -> a -> b
$ do
    Maybe String
menv <- String -> IO (Maybe String)
lookupEnv String
"HEDGEHOG_SEED"
    case String -> Maybe Seed
parseSeed (String -> Maybe Seed) -> Maybe String -> Maybe Seed
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String
menv of
      Maybe Seed
Nothing ->
        IO Seed
forall (m :: * -> *). MonadIO m => m Seed
Seed.random
      Just Seed
seed ->
        Seed -> IO Seed
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seed
seed

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

detectSkip :: MonadIO m => m Skip
detectSkip :: m Skip
detectSkip =
  IO Skip -> m Skip
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Skip -> m Skip) -> IO Skip -> m Skip
forall a b. (a -> b) -> a -> b
$ do
    Maybe String
menv <- String -> IO (Maybe String)
lookupEnv String
"HEDGEHOG_SKIP"
    case Maybe String
menv of
      Maybe String
Nothing ->
        Skip -> IO Skip
forall (f :: * -> *) a. Applicative f => a -> f a
pure Skip
SkipNothing
      Just String
env ->
        case String -> Maybe Skip
skipDecompress String
env of
          Maybe Skip
Nothing ->
            -- It's clearer for the user if we error out here, rather than
            -- silently defaulting to SkipNothing.
            String -> IO Skip
forall a. HasCallStack => String -> a
error String
"HEDGEHOG_SKIP is not a valid Skip."
          Just Skip
skip ->
            Skip -> IO Skip
forall (f :: * -> *) a. Applicative f => a -> f a
pure Skip
skip

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

resolveSeed :: MonadIO m => Maybe Seed -> m Seed
resolveSeed :: Maybe Seed -> m Seed
resolveSeed = \case
  Maybe Seed
Nothing ->
    m Seed
forall (m :: * -> *). MonadIO m => m Seed
detectSeed
  Just Seed
x ->
    Seed -> m Seed
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seed
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

resolveSkip :: MonadIO m => Maybe Skip -> m Skip
resolveSkip :: Maybe Skip -> m Skip
resolveSkip = \case
  Maybe Skip
Nothing ->
    m Skip
forall (m :: * -> *). MonadIO m => m Skip
detectSkip
  Just Skip
x ->
    Skip -> m Skip
forall (f :: * -> *) a. Applicative f => a -> f a
pure Skip
x