Add extensions API

hspec-core/package.yaml

@@ -54,6 +54,7 @@ library:
     - Test.Hspec.Core.Extension.Item
     - Test.Hspec.Core.Extension.Spec
     - Test.Hspec.Core.Extension.Tree
+    - Test.Hspec.Core.Extension.Option
     - Test.Hspec.Core.Extension.Config
     - Test.Hspec.Core.Spec
     - Test.Hspec.Core.Hooks

hspec-core/src/GetOpt/Declarative/Types.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 module GetOpt.Declarative.Types where
 
 import           Prelude ()
@@ -17,18 +16,3 @@ data OptionSetter config =
   | Flag (Bool -> config -> config)
   | OptArg String (Maybe String -> config -> Maybe config)
   | Arg String (String -> config -> Maybe config)
-
-mapOption :: (b -> a) -> (a -> b) -> Option a -> Option b
-mapOption from to option = option {
-  optionSetter = mapOptionSetter from to $ optionSetter option
-}
-
-mapOptionSetter :: (b -> a) -> (a -> b) -> OptionSetter a -> OptionSetter b
-mapOptionSetter from to = \ case
-  NoArg f -> NoArg $ lift f
-  Flag f -> Flag $ lift . f
-  OptArg name f -> OptArg name $ liftF . f
-  Arg name f -> Arg name $ liftF . f
-  where
-    lift f = to . f . from
-    liftF f = fmap to . f . from

hspec-core/src/Test/Hspec/Core/Extension.hs

@@ -1,5 +1,6 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
 -- | Stability: unstable
-module Test.Hspec.Core.Extension (
+module Test.Hspec.Core.Extension {-# WARNING "This API is experimental." #-} (
 -- * Lifecycle of a test run
 {- |
 A test run goes through four distinct phases:
@@ -16,6 +17,7 @@ When writing extensions the following imports are recommended:
 @
 import "Test.Hspec.Core.Extension"
 import "Test.Hspec.Core.Extension.Config" qualified as Config
+import "Test.Hspec.Core.Extension.Option" qualified as Option
 import "Test.Hspec.Core.Extension.Item" qualified as Item
 import "Test.Hspec.Core.Extension.Spec" qualified as Spec
 import "Test.Hspec.Core.Extension.Tree" qualified as Tree
@@ -37,16 +39,12 @@ import "Test.Hspec.Core.Extension.Tree" qualified as Tree
 
 -- ** Phase 2: Parsing command-line options
 {- |
-An extension can use `registerOption` during phase 1 to register custom command-line options, and as a consequence indirectly influence this phase.
+An extension can use `registerOptions` during phase 1 to register custom command-line options, and as a consequence indirectly influence this phase.
 
 * Options can use @Config.`Test.Hspec.Core.Extension.Config.setAnnotation`@ to add custom metadata to the `Config`.
 -}
 , Option
-, OptionSetter
-, registerOption
-, flag
-, option
-, argument
+, registerOptions
 
 -- ** Phase 3: Transforming the spec tree
 {- |
@@ -81,39 +79,25 @@ import           Test.Hspec.Core.Compat
 import qualified Data.CallStack as CallStack
 
 import qualified GetOpt.Declarative as Declarative
-import           Test.Hspec.Core.Spec (SpecM, SpecWith, runIO)
+import           Test.Hspec.Core.Spec (SpecM, SpecWith, runIO, modifyConfig)
 import qualified Test.Hspec.Core.Spec as Core
 import qualified Test.Hspec.Core.Config.Definition as Core
 
 import           Test.Hspec.Core.Extension.Config (Config)
 import qualified Test.Hspec.Core.Extension.Config as Config
 import qualified Test.Hspec.Core.Extension.Config.Type as Config
+import           Test.Hspec.Core.Extension.Option
 import           Test.Hspec.Core.Extension.Item
 import           Test.Hspec.Core.Extension.Tree
 
-newtype Option = Option { unOption :: Declarative.Option Config }
-newtype OptionSetter = OptionSetter { unOptionSetter :: Declarative.OptionSetter Config }
-
-flag :: String -> (Bool -> Config -> Config) -> String -> Option
-flag name setter = Option . Core.flag name setter
-
-option :: String -> OptionSetter -> String -> Option
-option name setter = Option . Core.option name (unOptionSetter setter)
-
-argument :: String -> (String -> Maybe a) -> (a -> Config -> Config) -> OptionSetter
-argument name parser setter = OptionSetter (Core.argument name parser setter)
-
-registerOption :: HasCallStack => Option -> SpecWith a
-registerOption = Core.modifyConfig . Core.addExtensionOptions section . return . liftOption
+registerOptions :: HasCallStack => [Option] -> SpecWith a
+registerOptions = Core.modifyConfig . Core.addExtensionOptions section . map liftOption
   where
     section = "OPTIONS FOR " <> package
     package = maybe "main" (CallStack.srcLocPackage . snd) CallStack.callSite
 
     liftOption :: Option -> Declarative.Option Core.Config
-    liftOption = Declarative.mapOption Config.from Config.to . unOption
-
-modifyConfig :: (Config -> Config) -> SpecWith a
-modifyConfig f = Core.modifyConfig (Config.to . f . Config.from)
+    liftOption = Config.unOption
 
 {- |
 Register a transformation that transforms the spec tree in phase 3.

hspec-core/src/Test/Hspec/Core/Extension/Config.hs

@@ -1,4 +1,5 @@
-module Test.Hspec.Core.Extension.Config (
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+module Test.Hspec.Core.Extension.Config {-# WARNING "This API is experimental." #-} (
 -- * Types
   Config(..)
 , Path

hspec-core/src/Test/Hspec/Core/Extension/Config/Type.hs

@@ -1,10 +1,7 @@
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 module Test.Hspec.Core.Extension.Config.Type (
-  Config(..)
-, to
-, from
+  Option(..)
+, Config(..)
 
 , setAnnotation
 , getAnnotation
@@ -18,159 +15,21 @@ module Test.Hspec.Core.Extension.Config.Type (
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Test.Hspec.Core.Format
-import           Test.Hspec.Core.Config.Definition (ColorMode(..), UnicodeMode(..))
+import qualified GetOpt.Declarative as Declarative
+
+import           Test.Hspec.Core.Config.Definition (Config(..))
 import qualified Test.Hspec.Core.Config.Definition as Core
-import           Test.Hspec.Core.Annotations (Annotations)
 import qualified Test.Hspec.Core.Annotations as Annotations
 
 import           Test.Hspec.Core.Extension.Tree (SpecTree)
 
-data Config = Config {
-  ignoreConfigFile :: Bool
-, dryRun :: Bool
-, focusedOnly :: Bool
-, failOnEmpty :: Bool
-, failOnFocused :: Bool
-, failOnPending :: Bool
-, failOnEmptyDescription :: Bool
-, printSlowItems :: Maybe Int
-, printCpuTime :: Bool
-, failFast :: Bool
-, randomize :: Bool
-, seed :: Maybe Integer
-, failureReport :: Maybe FilePath
-, rerun :: Bool
-, rerunAllOnSuccess :: Bool
-
--- |
--- A predicate that is used to filter the spec before it is run.  Only examples
--- that satisfy the predicate are run.
-, filterPredicate :: Maybe (Path -> Bool)
-, skipPredicate :: Maybe (Path -> Bool)
-, quickCheckMaxSuccess :: Maybe Int
-, quickCheckMaxDiscardRatio :: Maybe Int
-, quickCheckMaxSize :: Maybe Int
-, quickCheckMaxShrinks :: Maybe Int
-, smallCheckDepth :: Maybe Int
-, colorMode :: ColorMode
-, unicodeMode :: UnicodeMode
-, diff :: Bool
-, diffContext :: Maybe Int
-
--- |
--- An action that is used to print diffs.  The first argument is the value of
--- `configDiffContext`.  The remaining two arguments are the @expected@ and
--- @actual@ value.
-, externalDiff :: Maybe (Maybe Int -> String -> String -> IO ())
-
-, prettyPrint :: Bool
-, prettyPrintFunction :: Bool -> String -> String -> (String, String)
-, formatException :: SomeException -> String
-, times :: Bool
-, expertMode :: Bool
-, htmlOutput :: Bool
-, concurrentJobs :: Maybe Int
-, annotations :: Annotations
-}
-
-to :: Config -> Core.Config
-to Config{..} = Core.Config {
-  configIgnoreConfigFile = ignoreConfigFile
-, configDryRun = dryRun
-, configFocusedOnly = focusedOnly
-, configFailOnEmpty = failOnEmpty
-, configFailOnFocused = failOnFocused
-, configFailOnPending = failOnPending
-, configFailOnEmptyDescription = failOnEmptyDescription
-, configPrintSlowItems = printSlowItems
-, configPrintCpuTime = printCpuTime
-, configFailFast = failFast
-, configRandomize = randomize
-, configSeed = seed
-, configFailureReport = failureReport
-, configRerun = rerun
-, configRerunAllOnSuccess = rerunAllOnSuccess
-, configFilterPredicate = filterPredicate
-, configSkipPredicate = skipPredicate
-, configQuickCheckMaxSuccess = quickCheckMaxSuccess
-, configQuickCheckMaxDiscardRatio = quickCheckMaxDiscardRatio
-, configQuickCheckMaxSize = quickCheckMaxSize
-, configQuickCheckMaxShrinks = quickCheckMaxShrinks
-, configSmallCheckDepth = smallCheckDepth
-, configColorMode = colorMode
-, configUnicodeMode = unicodeMode
-, configDiff = diff
-, configDiffContext = diffContext
-, configExternalDiff = externalDiff
-, configPrettyPrint = prettyPrint
-, configPrettyPrintFunction = prettyPrintFunction
-, configFormatException = formatException
-, configTimes = times
-, configExpertMode = expertMode
-, configAvailableFormatters = availableFormatters
-, configFormat = format
-, configHtmlOutput = htmlOutput
-, configConcurrentJobs = concurrentJobs
-, configAnnotations = annotations
-
-, configQuickCheckSeed = Nothing
-, configFormatter = Nothing
-} where
-    Formatters availableFormatters format = getFormatters annotations
-
-from :: Core.Config -> Config
-from config@Core.Config{..} = Config{
-  ignoreConfigFile = configIgnoreConfigFile
-, dryRun = configDryRun
-, focusedOnly = configFocusedOnly
-, failOnEmpty = configFailOnEmpty
-, failOnFocused = configFailOnFocused
-, failOnPending = configFailOnPending
-, failOnEmptyDescription = configFailOnEmptyDescription
-, printSlowItems = configPrintSlowItems
-, printCpuTime = configPrintCpuTime
-, failFast = configFailFast
-, randomize = configRandomize
-, seed = Core.getSeed config
-, failureReport = configFailureReport
-, rerun = configRerun
-, rerunAllOnSuccess = configRerunAllOnSuccess
-, filterPredicate = configFilterPredicate
-, skipPredicate = configSkipPredicate
-, quickCheckMaxSuccess = configQuickCheckMaxSuccess
-, quickCheckMaxDiscardRatio = configQuickCheckMaxDiscardRatio
-, quickCheckMaxSize = configQuickCheckMaxSize
-, quickCheckMaxShrinks = configQuickCheckMaxShrinks
-, smallCheckDepth = configSmallCheckDepth
-, colorMode = configColorMode
-, unicodeMode = configUnicodeMode
-, diff = configDiff
-, diffContext = configDiffContext
-, externalDiff = configExternalDiff
-, prettyPrint = configPrettyPrint
-, prettyPrintFunction = configPrettyPrintFunction
-, formatException = configFormatException
-, times = configTimes
-, expertMode = configExpertMode
-, htmlOutput = configHtmlOutput
-, concurrentJobs = configConcurrentJobs
-, annotations = setFormatters (Formatters configAvailableFormatters (Core.getFormatter config)) configAnnotations
-}
-
-data Formatters = Formatters [(String, FormatConfig -> IO Format)] (Maybe (FormatConfig -> IO Format))
-
-getFormatters :: Annotations -> Formatters
-getFormatters = fromMaybe (Formatters [] Nothing) . Annotations.getValue
-
-setFormatters :: Formatters -> Annotations -> Annotations
-setFormatters = Annotations.setValue
+newtype Option = Option { unOption :: Declarative.Option Config }
 
 setAnnotation :: Typeable value => value -> Config -> Config
-setAnnotation value config = config { annotations = Annotations.setValue value $ annotations config }
+setAnnotation value config = config { configAnnotations = Annotations.setValue value $ configAnnotations config }
 
 getAnnotation :: Typeable value => Config -> Maybe value
-getAnnotation = Annotations.getValue . annotations
+getAnnotation = Annotations.getValue . configAnnotations
 
 newtype SpecTransformation = SpecTransformation { unSpecTransformation :: Config -> [SpecTree] -> [SpecTree] }
 
@@ -181,4 +40,4 @@ getSpecTransformation :: Config -> Config -> [SpecTree] -> [SpecTree]
 getSpecTransformation = maybe (\ _ -> id) unSpecTransformation . getAnnotation
 
 applySpecTransformation :: Core.Config -> [SpecTree] -> [SpecTree]
-applySpecTransformation (from -> config) = getSpecTransformation config config
+applySpecTransformation config = getSpecTransformation config config

hspec-core/src/Test/Hspec/Core/Extension/Item.hs

@@ -1,4 +1,4 @@
-module Test.Hspec.Core.Extension.Item (
+module Test.Hspec.Core.Extension.Item {-# WARNING "This API is experimental." #-} (
 -- * Types
   Item(..)
 , Location(..)

hspec-core/src/Test/Hspec/Core/Extension/Option.hs

@@ -0,0 +1,27 @@
+module Test.Hspec.Core.Extension.Option {-# WARNING "This API is experimental." #-} (
+  Option
+, flag
+, argument
+, noArgument
+, optionalArgument
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
+import qualified GetOpt.Declarative as Declarative
+import qualified Test.Hspec.Core.Config.Definition as Core
+
+import           Test.Hspec.Core.Extension.Config.Type (Option(..), Config)
+
+flag :: String -> (Bool -> Config -> Config) -> String -> Option
+flag name setter = Option . Core.flag name setter
+
+argument :: String -> String -> (String -> Config -> Maybe Config) -> String -> Option
+argument name argumentName setter = Option . Core.option name (Declarative.Arg argumentName setter)
+
+optionalArgument :: String -> String -> (Maybe String -> Config -> Maybe Config) -> String -> Option
+optionalArgument name argumentName setter = Option . Core.option name (Declarative.OptArg argumentName setter)
+
+noArgument :: String -> (Config -> Config) -> String -> Option
+noArgument name setter help = Option $ Declarative.Option name Nothing (Declarative.NoArg setter) help False

hspec-core/src/Test/Hspec/Core/Extension/Spec.hs

@@ -1,4 +1,4 @@
-module Test.Hspec.Core.Extension.Spec (
+module Test.Hspec.Core.Extension.Spec {-# WARNING "This API is experimental." #-} (
   mapItems
 ) where
 

hspec-core/src/Test/Hspec/Core/Extension/Tree.hs

@@ -1,4 +1,4 @@
-module Test.Hspec.Core.Extension.Tree (
+module Test.Hspec.Core.Extension.Tree {-# WARNING "This API is experimental." #-} (
   SpecTree
 , mapItems
 , filterItems
@@ -13,7 +13,7 @@ import qualified Test.Hspec.Core.Spec as Core
 type SpecTree = Core.SpecTree ()
 
 mapItems :: (Item () -> Item ()) -> [SpecTree] -> [SpecTree]
-mapItems = bimapForest id
+mapItems = map . fmap
 
 filterItems :: (Item () -> Bool) -> [SpecTree] -> [SpecTree]
 filterItems = filterForest

hspec-core/test/Test/Hspec/Core/RunnerSpec.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -27,6 +28,7 @@ import qualified Test.QuickCheck as QC
 import qualified Test.Hspec.Core.Hooks as H
 
 import           Test.Hspec.Core.Formatters.Pretty.ParserSpec (Person(..))
+import           Test.Hspec.Core.Extension ()
 
 runPropFoo :: [String] -> IO String
 runPropFoo args = unlines . normalizeSummary . lines <$> do