sandwich-quickcheck (empty) → 0.1.0.3

raw patch · 7 files changed

+258/−0 lines, 7 filesdep +QuickCheckdep +basedep +freesetup-changed

Dependencies added: QuickCheck, base, free, monad-control, safe-exceptions, sandwich, sandwich-quickcheck, string-interpolate, time

Files

ChangeLog.md +3/−0
LICENSE +30/−0
Setup.hs +2/−0
app/Main.hs +22/−0
sandwich-quickcheck.cabal +87/−0
src/Test/Sandwich/QuickCheck.hs +93/−0
test/Spec.hs +21/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for sandwich-webdriver++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Tom McLaughlin (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tom McLaughlin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Data.Time.Clock+import Test.Sandwich+import Test.Sandwich.QuickCheck++quickcheckDemo :: TopSpec+quickcheckDemo = introduceQuickCheck $ do+  prop "List reversal" $ \(xs :: [Int]) -> reverse (reverse xs) == xs++  prop "Failing list reversal" $ \(xs :: [Int]) -> (reverse xs) == xs+++testOptions = defaultOptions {+  optionsTestArtifactsDirectory = TestArtifactsGeneratedDirectory "test_runs" (show <$> getCurrentTime)+  }++main :: IO ()+main = runSandwichWithCommandLineArgs testOptions quickcheckDemo

+ sandwich-quickcheck.cabal view

@@ -0,0 +1,87 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 550a21dbc3c29a2558180bd59d81d07e61dba1483adee2d466cb5d1d5a1e2adf++name:           sandwich-quickcheck+version:        0.1.0.3+synopsis:       Sandwich integration with QuickCheck+description:    Please see the <https://codedownio.github.io/sandwich/docs/extensions/sandwich-quickcheck documentation>.+category:       Testing+homepage:       https://codedownio.github.io/sandwich+bug-reports:    https://github.com/codedownio/sandwich-quickcheck/issues+author:         Tom McLaughlin+maintainer:     tom@codedown.io+copyright:      2021 Tom McLaughlin+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/codedownio/sandwich-quickcheck++library+  exposed-modules:+      Test.Sandwich.QuickCheck+  other-modules:+      Paths_sandwich_quickcheck+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase+  build-depends:+      QuickCheck+    , base <4.15+    , free+    , monad-control+    , safe-exceptions+    , sandwich+    , string-interpolate+    , time+  default-language: Haskell2010++executable sandwich-quickcheck-exe+  main-is: Main.hs+  other-modules:+      Paths_sandwich_quickcheck+  hs-source-dirs:+      app+  default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , base <4.15+    , free+    , monad-control+    , safe-exceptions+    , sandwich+    , sandwich-quickcheck+    , string-interpolate+    , time+  default-language: Haskell2010++test-suite sandwich-quickcheck-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_sandwich_quickcheck+  hs-source-dirs:+      test+  default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , base <4.15+    , free+    , monad-control+    , safe-exceptions+    , sandwich+    , sandwich-quickcheck+    , string-interpolate+    , time+  default-language: Haskell2010

+ src/Test/Sandwich/QuickCheck.hs view

@@ -0,0 +1,93 @@++-- | Functions for introducing QuickCheck tests into a Sandwich test tree. Modelled after Hspec's version.++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-}++module Test.Sandwich.QuickCheck (+  -- * Introducing QuickCheck args+  -- Any tests that use QuickCheck should be wrapped in one of these.+  introduceQuickCheck+  , introduceQuickCheck'+  , introduceQuickCheck''++  -- * Prop+  , prop++  -- * Modifying QuickCheck args+  , modifyArgs+  , modifyMaxSuccess+  , modifyMaxDiscardRatio+  , modifyMaxSize+  , modifyMaxShrinks+  ) where++import Control.Exception.Safe+import Control.Monad.Free+import Control.Monad.IO.Class+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.String.Interpolate+import GHC.Stack+import Test.QuickCheck as QC+import Test.Sandwich+import Test.Sandwich.Internal+++data QuickCheckContext = QuickCheckContext Args+  deriving Show+quickCheckContext = Label :: Label "quickCheckContext" QuickCheckContext+type HasQuickCheckContext context = HasLabel context "quickCheckContext" QuickCheckContext++data QuickCheckException = QuickCheckException QC.Result+  deriving (Show)+instance Exception QuickCheckException++-- | Same as 'introduceQuickCheck'' but with default args.+introduceQuickCheck :: (MonadIO m, MonadBaseControl IO m)+  => SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()+introduceQuickCheck = introduceQuickCheck'' "Introduce QuickCheck context" stdArgs++-- | Same as 'introduceQuickCheck''' but with a default message.+introduceQuickCheck' :: (MonadIO m, MonadBaseControl IO m)+  => Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()+introduceQuickCheck' = introduceQuickCheck'' "Introduce QuickCheck context"++-- | Introduce QuickCheck args with configurable message.+introduceQuickCheck'' :: (MonadIO m, MonadBaseControl IO m)+  => String -> Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()+introduceQuickCheck'' msg args = introduce msg quickCheckContext (return $ QuickCheckContext args) (const $ return ())++-- | 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+  QuickCheckContext args <- getContext quickCheckContext+  liftIO (quickCheckWithResult args p) >>= \case+    QC.Success {..} -> do+      info [i|Success (#{numTests} tests, #{numDiscarded} skipped)|]+      return ()+    x -> throwIO (QuickCheckException x)++-- | Modify the 'Args' for the given spec.+modifyArgs :: (HasQuickCheckContext context, Monad m) => (Args -> Args) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()+modifyArgs f = introduce "Modified QuickCheck context" quickCheckContext acquire (const $ return ())+  where+    acquire = do+       QuickCheckContext args <- getContext quickCheckContext+       return $ QuickCheckContext (f args)++-- | Modify the 'maxSuccess' for given spec.+modifyMaxSuccess :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()+modifyMaxSuccess f = modifyArgs $ \args -> args { maxSuccess = f (maxSuccess args) }++-- | Modify the 'maxDiscardRatio' for given spec.+modifyMaxDiscardRatio :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()+modifyMaxDiscardRatio f = modifyArgs $ \args -> args { maxDiscardRatio = f (maxDiscardRatio args) }++-- | Modify the 'maxSize' for given spec.+modifyMaxSize :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()+modifyMaxSize f = modifyArgs $ \args -> args { maxSize = f (maxSize args) }++-- | Modify the 'maxShrinks' for 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) }

+ test/Spec.hs view

@@ -0,0 +1,21 @@++import Test.Sandwich+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+  it "succeeds" (return ())++main :: IO ()+main = runSandwich options verySimple+  where+    options = defaultOptions {+      optionsTestArtifactsDirectory = TestArtifactsGeneratedDirectory "test_runs" (show <$> getCurrentTime)+      }