diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ -# Changelog for sandwich-webdriver +# Changelog for sandwich-quickcheck ## Unreleased changes + +## 0.1.0.6 + +* Relax base bound so we can build on GHC 9 diff --git a/sandwich-quickcheck.cabal b/sandwich-quickcheck.cabal --- a/sandwich-quickcheck.cabal +++ b/sandwich-quickcheck.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack -- --- hash: 67356bf7a3c5379b23a3aa5424a5642190d8cb9ea816333b653d3e43f689a83f +-- hash: 0ea5e32d58d7b525d0efda5e1eb784b3fd8b9b8a7502b90d9a729fff9cb62991 name: sandwich-quickcheck -version: 0.1.0.5 +version: 0.1.0.6 synopsis: Sandwich integration with QuickCheck description: Please see the . category: Testing @@ -33,16 +33,23 @@ Paths_sandwich_quickcheck hs-source-dirs: src - default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase + default-extensions: + OverloadedStrings + QuasiQuotes + NamedFieldPuns + RecordWildCards + ScopedTypeVariables + FlexibleContexts + FlexibleInstances + LambdaCase build-depends: QuickCheck - , base <4.15 - , brick + , base <5 , free , monad-control + , mtl , safe-exceptions , sandwich >=0.1.0.4 - , string-interpolate , text , time default-language: Haskell2010 @@ -54,18 +61,24 @@ Paths_sandwich_quickcheck hs-source-dirs: test - default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase + default-extensions: + OverloadedStrings + QuasiQuotes + NamedFieldPuns + RecordWildCards + ScopedTypeVariables + FlexibleContexts + FlexibleInstances + LambdaCase ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: QuickCheck - , base <4.15 - , brick + , base <5 , free , monad-control + , mtl , safe-exceptions , sandwich >=0.1.0.4 - , sandwich-quickcheck - , string-interpolate , text , time default-language: Haskell2010 diff --git a/src/Test/Sandwich/QuickCheck.hs b/src/Test/Sandwich/QuickCheck.hs --- a/src/Test/Sandwich/QuickCheck.hs +++ b/src/Test/Sandwich/QuickCheck.hs @@ -1,4 +1,3 @@ - -- | Functions for introducing QuickCheck tests into a Sandwich test tree. Modelled after Hspec's version. -- -- Documentation can be found . @@ -6,6 +5,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeApplications #-} module Test.Sandwich.QuickCheck ( -- * Introducing QuickCheck args @@ -14,6 +15,12 @@ , introduceQuickCheck' , introduceQuickCheck'' + -- * Versions that can be configured with built-in command line arguments. + -- Pass --print-quickcheck-flags to list them. + , introduceQuickCheckCommandLineOptions + , introduceQuickCheckCommandLineOptions' + , introduceQuickCheckCommandLineOptions'' + -- * Prop , prop @@ -28,10 +35,13 @@ import Control.Exception.Safe import Control.Monad.Free import Control.Monad.IO.Class +import Control.Monad.Reader import Control.Monad.Trans.Control (MonadBaseControl) +import Data.Maybe import qualified Data.Text as T import GHC.Stack import Test.QuickCheck as QC +import Test.QuickCheck.Random as QC import Test.Sandwich import Test.Sandwich.Internal @@ -60,6 +70,27 @@ => String -> Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m () introduceQuickCheck'' msg args = introduce msg quickCheckContext (return $ QuickCheckContext args) (const $ return ()) + +-- | Same as 'introduceQuickCheckCommandLineOptions'' but with default args. +introduceQuickCheckCommandLineOptions :: forall a m context. (MonadIO m, MonadBaseControl IO m, HasLabel context "commandLineOptions" (CommandLineOptions a), MonadReader context m) + => SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m () +introduceQuickCheckCommandLineOptions = introduceQuickCheckCommandLineOptions'' @a "Introduce QuickCheck context with command line options" stdArgs + +-- | Same as 'introduceQuickCheckCommandLineOptions''' but with a default message. +introduceQuickCheckCommandLineOptions' :: forall a m context. (MonadIO m, MonadBaseControl IO m, HasLabel context "commandLineOptions" (CommandLineOptions a), MonadReader context m) + => Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m () +introduceQuickCheckCommandLineOptions' = introduceQuickCheckCommandLineOptions'' @a "Introduce QuickCheck context with command line options" + +-- | Introduce QuickCheck args with configurable message, overriding those args with any command line options passed. +introduceQuickCheckCommandLineOptions'' :: forall a m context. (MonadIO m, MonadBaseControl IO m, HasLabel context "commandLineOptions" (CommandLineOptions a), MonadReader context m) + => String -> Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m () +introduceQuickCheckCommandLineOptions'' msg args = introduce msg quickCheckContext getContext (const $ return ()) + where + getContext = do + clo <- getCommandLineOptions @a + return $ QuickCheckContext $ addCommandLineOptions clo args + + -- | Similar to 'it'. Runs the given prop with QuickCheck using the currently introduced 'Args'. Throws an appropriate exception on failure. prop :: (HasCallStack, HasQuickCheckContext context, MonadIO m, MonadThrow m, Testable prop) => String -> prop -> Free (SpecCommand context m) () prop msg p = it msg $ do @@ -91,3 +122,12 @@ -- | Modify the 'maxShrinks' for the given spec. modifyMaxShrinks :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m () modifyMaxShrinks f = modifyArgs $ \args -> args { maxShrinks = f (maxShrinks args) } + +addCommandLineOptions :: CommandLineOptions a -> Args -> Args +addCommandLineOptions (CommandLineOptions {optQuickCheckOptions=(CommandLineQuickCheckOptions {..})}) baseArgs@(Args {..}) = baseArgs { + replay = maybe replay (\n -> Just (mkQCGen (fromIntegral n), 0)) optQuickCheckSeed + , maxDiscardRatio = fromMaybe maxSuccess optQuickCheckMaxDiscardRatio + , maxSize = fromMaybe maxSuccess optQuickCheckMaxSize + , maxSuccess = fromMaybe maxSuccess optQuickCheckMaxSuccess + , maxShrinks = fromMaybe maxSuccess optQuickCheckMaxShrinks + } diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,11 +3,6 @@ import Data.Time.Clock import Test.Sandwich.Formatters.Print -data Foo = Foo { fooInt :: Int, fooString :: String, fooBar :: Bar } deriving (Show, Eq) -data Bar = Bar { barInt :: Int, barString :: String } deriving (Show, Eq) -data Baz = Baz Int String Bar deriving (Show, Eq) -data Simple = Simple { simpleInt :: Int } deriving (Show, Eq) - verySimple :: TopSpec verySimple = do