typed-protocols: support QuickCheck 2.15

Author: coot

typed-protocols/CHANGELOG.md

@@ -1,6 +1,10 @@
 # Revision history for typed-protocols
 
-## 1.1.0.0 -- 05.08.2025
+## 1.1.0.1 -- 2025-10-14
+
+* Support QuickCheck <= 2.15
+
+## 1.1.0.0 -- 2025-08-03
 
 ### Breaking changes
 

typed-protocols/properties/Network/TypedProtocol/Codec/Properties.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 
 module Network.TypedProtocol.Codec.Properties
@@ -37,6 +38,9 @@ import Network.TypedProtocol.Codec
 import Network.TypedProtocol.Core
 
 import Test.QuickCheck
+#if !MIN_VERSION_QuickCheck(2,16,0)
+import Test.QuickCheck.Monoids.Compat
+#endif
 
 
 -- | The 'CodecF' round-trip property: decode after encode gives the same

typed-protocols/properties/Network/TypedProtocol/Stateful/Codec/Properties.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 
 module Network.TypedProtocol.Stateful.Codec.Properties
@@ -13,6 +14,9 @@ import Network.TypedProtocol.Core
 import Network.TypedProtocol.Stateful.Codec
 
 import Test.QuickCheck
+#if !MIN_VERSION_QuickCheck(2,16,0)
+import Test.QuickCheck.Monoids.Compat
+#endif
 
 
 -- | The 'Codec' round-trip property: decode after encode gives the same

typed-protocols/properties/Test/QuickCheck/Monoids/Compat.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-- | Monoids using `.&&.` and `.||.`.
+--
+-- They satisfy monoid laws with respect to the `isSuccess` unless one is using
+-- `checkCoverage` (see test for a counterexample).
+--
+module Test.QuickCheck.Monoids.Compat
+#if !MIN_VERSION_QuickCheck(2,16,0)
+  ( type Every
+  , All(Every, getEvery, ..)
+  , type Some
+  , Any(Some, getSome, ..)
+#else
+  ( All (..)
+  , Any (..)
+  , Every (..)
+  , Some (..)
+#endif
+  ) where
+
+import Data.List.NonEmpty as NonEmpty
+import Data.Semigroup (Semigroup (..))
+import Test.QuickCheck
+
+-- | Conjunction monoid build with `.&&.`.
+--
+-- Use `property @All` as an accessor which doesn't leak
+-- existential variables.
+--
+data All = forall p. Testable p => All { getAll :: p }
+
+#if !MIN_VERSION_QuickCheck(2,16,0)
+type Every = All
+
+pattern Every :: ()
+              => Testable p
+              => p
+              -> All
+pattern Every { getEvery } = All getEvery
+#endif
+
+instance Testable All where
+    property (All p) = property p
+
+instance Semigroup All where
+    All p <> All p' = All (p .&&. p')
+    sconcat = All . conjoin . NonEmpty.toList
+
+instance Monoid All where
+    mempty = All True
+    mconcat = All . conjoin
+
+
+-- | Disjunction monoid build with `.||.`.
+--
+-- Use `property @Any` as an accessor which doesn't leak
+-- existential variables.
+--
+data Any = forall p. Testable p => Any { getAny :: p }
+
+#if !MIN_VERSION_QuickCheck(2,16,0)
+type Some = Any
+
+pattern Some :: ()
+              => Testable p
+              => p
+              -> Any
+pattern Some { getSome } = Any getSome
+#endif
+
+instance Testable Any where
+    property (Any p) = property p
+
+instance Semigroup Any where
+    Any p <> Any p' = Any (p .||. p')
+    sconcat = Any . disjoin . NonEmpty.toList
+
+instance Monoid Any where
+    mempty = Any False
+    mconcat = Any . disjoin

typed-protocols/typed-protocols.cabal

@@ -1,6 +1,6 @@
 cabal-version:       3.4
 name:                typed-protocols
-version:             1.1.0.0
+version:             1.1.0.1
 synopsis:            A framework for strongly typed protocols
 description:         A robust session type framework which supports protocol pipelining.
                      Haddocks are published [here](https://input-output-hk.github.io/typed-protocols/)
@@ -54,9 +54,10 @@ library codec-properties
   visibility:         public
   exposed-modules:    Network.TypedProtocol.Codec.Properties
                       Network.TypedProtocol.Stateful.Codec.Properties
+  other-modules:      Test.QuickCheck.Monoids.Compat
   build-depends:      base >=4.12 && <4.22,
                       typed-protocols:{stateful, typed-protocols},
-                      QuickCheck >= 2.16
+                      QuickCheck
   hs-source-dirs:     properties
   default-extensions: GADTs
                       ImportQualifiedPost