diff --git a/scripts/check-stylish.sh b/scripts/check-stylish.sh index 0eee1fa..61f5d8d 100755 --- a/scripts/check-stylish.sh +++ b/scripts/check-stylish.sh @@ -5,4 +5,4 @@ export LC_ALL=C.UTF-8 [[ -x '/usr/bin/fd' ]] && FD="fd" || FD="fdfind" -$FD . './typed-protocols' -e hs -E Setup.hs -E Core.hs -E Channel.hs -X stylish-haskell -c .stylish-haskell.yaml -i +$FD . './typed-protocols' -e hs -E Setup.hs -E Core.hs -E Channel.hs -E QuickCheck -X stylish-haskell -c .stylish-haskell.yaml -i diff --git a/typed-protocols/CHANGELOG.md b/typed-protocols/CHANGELOG.md index 6442966..b1df317 100644 --- a/typed-protocols/CHANGELOG.md +++ b/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 diff --git a/typed-protocols/properties/Network/TypedProtocol/Codec/Properties.hs b/typed-protocols/properties/Network/TypedProtocol/Codec/Properties.hs index 9686dae..e6190a9 100644 --- a/typed-protocols/properties/Network/TypedProtocol/Codec/Properties.hs +++ b/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 diff --git a/typed-protocols/properties/Network/TypedProtocol/Stateful/Codec/Properties.hs b/typed-protocols/properties/Network/TypedProtocol/Stateful/Codec/Properties.hs index d177304..3d4abb4 100644 --- a/typed-protocols/properties/Network/TypedProtocol/Stateful/Codec/Properties.hs +++ b/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 diff --git a/typed-protocols/properties/Test/QuickCheck/Monoids/Compat.hs b/typed-protocols/properties/Test/QuickCheck/Monoids/Compat.hs new file mode 100644 index 0000000..42e1a05 --- /dev/null +++ b/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 diff --git a/typed-protocols/typed-protocols.cabal b/typed-protocols/typed-protocols.cabal index 7171b53..6a2e3f5 100644 --- a/typed-protocols/typed-protocols.cabal +++ b/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