-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- FromConfig instance for hspec
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
module Conferer.FromConfig.Hspec where

import Conferer.FromConfig

import Data.Text (toLower)
import Data.Dynamic (toDyn, Dynamic)

import qualified Test.Hspec.Core.Runner as Hspec
import qualified Test.Hspec.Core.Formatters as Hspec

instance FromConfig Hspec.ColorMode where
  fromConfig :: Key -> Config -> IO ColorMode
fromConfig =
    (Text -> Maybe ColorMode) -> Key -> Config -> IO ColorMode
forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO a
fetchFromConfigWith ((Text -> Maybe ColorMode) -> Key -> Config -> IO ColorMode)
-> (Text -> Maybe ColorMode) -> Key -> Config -> IO ColorMode
forall a b. (a -> b) -> a -> b
$
    (\case
      Text
"auto" -> ColorMode -> Maybe ColorMode
forall a. a -> Maybe a
Just ColorMode
Hspec.ColorAuto
      Text
"never" -> ColorMode -> Maybe ColorMode
forall a. a -> Maybe a
Just ColorMode
Hspec.ColorNever
      Text
"always" -> ColorMode -> Maybe ColorMode
forall a. a -> Maybe a
Just ColorMode
Hspec.ColorAlways
      Text
_ -> Maybe ColorMode
forall a. Maybe a
Nothing
    ) (Text -> Maybe ColorMode)
-> (Text -> Text) -> Text -> Maybe ColorMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toLower

instance FromConfig Hspec.Formatter where
  fromConfig :: Key -> Config -> IO Formatter
fromConfig =
    (Text -> Maybe Formatter) -> Key -> Config -> IO Formatter
forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO a
fetchFromConfigWith ((Text -> Maybe Formatter) -> Key -> Config -> IO Formatter)
-> (Text -> Maybe Formatter) -> Key -> Config -> IO Formatter
forall a b. (a -> b) -> a -> b
$
    (\case
      Text
"silent" -> Formatter -> Maybe Formatter
forall a. a -> Maybe a
Just Formatter
Hspec.silent
      Text
"specdoc" -> Formatter -> Maybe Formatter
forall a. a -> Maybe a
Just Formatter
Hspec.specdoc
      Text
"progress" -> Formatter -> Maybe Formatter
forall a. a -> Maybe a
Just Formatter
Hspec.progress
      Text
"failed_examples" -> Formatter -> Maybe Formatter
forall a. a -> Maybe a
Just Formatter
Hspec.failed_examples
      Text
_ -> Maybe Formatter
forall a. Maybe a
Nothing
    ) (Text -> Maybe Formatter)
-> (Text -> Text) -> Text -> Maybe Formatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toLower

instance DefaultConfig Hspec.Config where
  configDef :: Config
configDef = Config
Hspec.defaultConfig

-- | Deconstruct a 'Hspec.Config' into a many key/dynamic pairs to
-- provide valid defaults for downstream 'fetchFromConfig'
desconstructHspecConfigToDefaults :: Hspec.Config -> [(Key, Dynamic)]
desconstructHspecConfigToDefaults :: Config -> [(Key, Dynamic)]
desconstructHspecConfigToDefaults Hspec.Config{Bool
Int
Maybe Int
Maybe Integer
Maybe FilePath
Maybe Formatter
Maybe (Path -> Bool)
Either Handle FilePath
ColorMode
configIgnoreConfigFile :: Config -> Bool
configDryRun :: Config -> Bool
configFocusedOnly :: Config -> Bool
configFailOnFocused :: Config -> Bool
configPrintCpuTime :: Config -> Bool
configFastFail :: Config -> Bool
configRandomize :: Config -> Bool
configFailureReport :: Config -> Maybe FilePath
configRerun :: Config -> Bool
configRerunAllOnSuccess :: Config -> Bool
configFilterPredicate :: Config -> Maybe (Path -> Bool)
configSkipPredicate :: Config -> Maybe (Path -> Bool)
configQuickCheckSeed :: Config -> Maybe Integer
configQuickCheckMaxSuccess :: Config -> Maybe Int
configQuickCheckMaxDiscardRatio :: Config -> Maybe Int
configQuickCheckMaxSize :: Config -> Maybe Int
configSmallCheckDepth :: Config -> Int
configColorMode :: Config -> ColorMode
configDiff :: Config -> Bool
configFormatter :: Config -> Maybe Formatter
configHtmlOutput :: Config -> Bool
configOutputFile :: Config -> Either Handle FilePath
configConcurrentJobs :: Config -> Maybe Int
configConcurrentJobs :: Maybe Int
configOutputFile :: Either Handle FilePath
configHtmlOutput :: Bool
configFormatter :: Maybe Formatter
configDiff :: Bool
configColorMode :: ColorMode
configSmallCheckDepth :: Int
configQuickCheckMaxSize :: Maybe Int
configQuickCheckMaxDiscardRatio :: Maybe Int
configQuickCheckMaxSuccess :: Maybe Int
configQuickCheckSeed :: Maybe Integer
configSkipPredicate :: Maybe (Path -> Bool)
configFilterPredicate :: Maybe (Path -> Bool)
configRerunAllOnSuccess :: Bool
configRerun :: Bool
configFailureReport :: Maybe FilePath
configRandomize :: Bool
configFastFail :: Bool
configPrintCpuTime :: Bool
configFailOnFocused :: Bool
configFocusedOnly :: Bool
configDryRun :: Bool
configIgnoreConfigFile :: Bool
..} =
  [ (Key
"dryRun", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configDryRun)
  , (Key
"fastFail", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configFastFail)
  , (Key
"rerun", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configRerun)
  , (Key
"quickCheckMaxSuccess", Maybe Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe Int
configQuickCheckMaxSuccess)
  , (Key
"quickCheckMaxDiscardRatio", Maybe Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe Int
configQuickCheckMaxDiscardRatio)
  , (Key
"quickCheckMaxSize", Maybe Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe Int
configQuickCheckMaxSize)
  , (Key
"quickCheckSeed", Maybe Integer -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe Integer
configQuickCheckSeed)
  , (Key
"smallCheckDepth", Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Int
configSmallCheckDepth)
  , (Key
"colorMode", ColorMode -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn ColorMode
configColorMode)
  , (Key
"htmlOutput", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configHtmlOutput)
  , (Key
"formatter", Maybe Formatter -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe Formatter
configFormatter)
#if MIN_VERSION_hspec_core(2,1,1)
  , (Key
"skipPredicate", Maybe (Path -> Bool) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe (Path -> Bool)
configSkipPredicate)
#endif
#if MIN_VERSION_hspec_core(2,1,9)
  , (Key
"concurrentJobs", Maybe Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe Int
configConcurrentJobs)
#endif
#if MIN_VERSION_hspec_core(2,4,0)
  , (Key
"ignoreConfigFile", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configIgnoreConfigFile)
  , (Key
"printCpuTime", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configPrintCpuTime)
  , (Key
"diff", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configDiff)
#endif
#if MIN_VERSION_hspec_core(2,4,2)
  , (Key
"failureReport", Maybe FilePath -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe FilePath
configFailureReport)
#endif
#if MIN_VERSION_hspec_core(2,7,0)
  , (Key
"focusedOnly", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configFocusedOnly)
  , (Key
"failOnFocused", Bool -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Bool
configFailOnFocused)
#endif
  ]

instance FromConfig Hspec.Config where
  fromConfig :: Key -> Config -> IO Config
fromConfig Key
key Config
originalConfig = do
    Config
config <- (Config -> [(Key, Dynamic)]) -> Key -> Config -> IO Config
forall a.
Typeable a =>
(a -> [(Key, Dynamic)]) -> Key -> Config -> IO Config
addDefaultsAfterDeconstructingToDefaults
      Config -> [(Key, Dynamic)]
desconstructHspecConfigToDefaults
      Key
key Config
originalConfig

    Bool
configDryRun <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"dryRun") Config
config
    Bool
configFastFail <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"fastFail") Config
config
    Bool
configRerun <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"rerun") Config
config
    Maybe Int
configQuickCheckMaxSuccess <- Key -> Config -> IO (Maybe Int)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"quickCheckMaxSuccess") Config
config
    Maybe Int
configQuickCheckMaxDiscardRatio <- Key -> Config -> IO (Maybe Int)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"quickCheckMaxDiscardRatio") Config
config
    Maybe Int
configQuickCheckMaxSize <- Key -> Config -> IO (Maybe Int)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"quickCheckMaxSize") Config
config
    Maybe Integer
configQuickCheckSeed <- Key -> Config -> IO (Maybe Integer)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"quickCheckSeed") Config
config
    Int
configSmallCheckDepth <- Key -> Config -> IO Int
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"smallCheckDepth") Config
config
    ColorMode
configColorMode <- Key -> Config -> IO ColorMode
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"colorMode") Config
config
    Bool
configHtmlOutput <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"htmlOutput") Config
config
    Maybe Formatter
configFormatter <- Key -> Config -> IO (Maybe Formatter)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"formatter") Config
config
    Bool
configRerunAllOnSuccess <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"rerunAllOnSuccess") Config
config
    Maybe (Path -> Bool)
configFilterPredicate <- Key -> Config -> IO (Maybe (Path -> Bool))
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"filterPredicate") Config
config
    Either Handle FilePath
configOutputFile <- Key -> Config -> IO (Either Handle FilePath)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"outputFile") Config
config
#if MIN_VERSION_hspec_core(2,1,1)
    Maybe (Path -> Bool)
configSkipPredicate <- Key -> Config -> IO (Maybe (Path -> Bool))
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"skipPredicate") Config
config
#endif
#if MIN_VERSION_hspec_core(2,1,9)
    Maybe Int
configConcurrentJobs <- Key -> Config -> IO (Maybe Int)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"concurrentJobs") Config
config
#endif
#if MIN_VERSION_hspec_core(2,4,0)
    Bool
configIgnoreConfigFile <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"ignoreConfigFile") Config
config
    Bool
configPrintCpuTime <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"printCpuTime") Config
config
    Bool
configDiff <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"diff") Config
config
#endif
#if MIN_VERSION_hspec_core(2,4,2)
    Maybe FilePath
configFailureReport <- Key -> Config -> IO (Maybe FilePath)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"failureReport") Config
config
#endif
#if MIN_VERSION_hspec_core(2,7,0)
    Bool
configFocusedOnly <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"focusedOnly") Config
config
    Bool
configFailOnFocused <- Key -> Config -> IO Bool
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"failOnFocused") Config
config
#endif
    Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> Bool
-> Bool
-> Maybe (Path -> Bool)
-> Maybe (Path -> Bool)
-> Maybe Integer
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Int
-> ColorMode
-> Bool
-> Maybe Formatter
-> Bool
-> Either Handle FilePath
-> Maybe Int
-> Config
Hspec.Config{Bool
Int
Maybe Int
Maybe Integer
Maybe FilePath
Maybe Formatter
Maybe (Path -> Bool)
Either Handle FilePath
ColorMode
configFailOnFocused :: Bool
configFocusedOnly :: Bool
configFailureReport :: Maybe FilePath
configDiff :: Bool
configPrintCpuTime :: Bool
configIgnoreConfigFile :: Bool
configConcurrentJobs :: Maybe Int
configSkipPredicate :: Maybe (Path -> Bool)
configOutputFile :: Either Handle FilePath
configFilterPredicate :: Maybe (Path -> Bool)
configRerunAllOnSuccess :: Bool
configFormatter :: Maybe Formatter
configHtmlOutput :: Bool
configColorMode :: ColorMode
configSmallCheckDepth :: Int
configQuickCheckSeed :: Maybe Integer
configQuickCheckMaxSize :: Maybe Int
configQuickCheckMaxDiscardRatio :: Maybe Int
configQuickCheckMaxSuccess :: Maybe Int
configRerun :: Bool
configFastFail :: Bool
configDryRun :: Bool
configIgnoreConfigFile :: Bool
configDryRun :: Bool
configFocusedOnly :: Bool
configFailOnFocused :: Bool
configPrintCpuTime :: Bool
configFastFail :: Bool
configFailureReport :: Maybe FilePath
configRerun :: Bool
configRerunAllOnSuccess :: Bool
configFilterPredicate :: Maybe (Path -> Bool)
configSkipPredicate :: Maybe (Path -> Bool)
configQuickCheckSeed :: Maybe Integer
configQuickCheckMaxSuccess :: Maybe Int
configQuickCheckMaxDiscardRatio :: Maybe Int
configQuickCheckMaxSize :: Maybe Int
configSmallCheckDepth :: Int
configColorMode :: ColorMode
configDiff :: Bool
configFormatter :: Maybe Formatter
configHtmlOutput :: Bool
configOutputFile :: Either Handle FilePath
configConcurrentJobs :: Maybe Int
..}