Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion scripts/check-stylish.sh
Original file line number Diff line number Diff line change
Expand Up @@ -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
6 changes: 5 additions & 1 deletion typed-protocols/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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

Expand Down
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuantifiedConstraints #-}

module Network.TypedProtocol.Codec.Properties
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuantifiedConstraints #-}

module Network.TypedProtocol.Stateful.Codec.Properties
Expand All @@ -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
Expand Down
85 changes: 85 additions & 0 deletions typed-protocols/properties/Test/QuickCheck/Monoids/Compat.hs
Original file line number Diff line number Diff line change
@@ -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
5 changes: 3 additions & 2 deletions typed-protocols/typed-protocols.cabal
Original file line number Diff line number Diff line change
@@ -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/)
Expand Down Expand Up @@ -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
Expand Down