diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,58 @@ # Revision history for quickcheck-lockstep +## 0.8.0 -- 2025-07-03 + +* BREAKING: Support `quickcheck-dynamic-4`. Going from version 3 to 4, some + breaking changes were introduced in `quickcheck-dynamic`, which cascades into + changes for `quickcheck-lockstep`. The changes to the latter are listed below + together with hints as to how to migrate from `quickcheck-lockstep-0.7` to + `quickcheck-lockstep-0.8`. For migrating from `quickcheck-dynamic-3` to + `quickcheck-dynamic-4`, see [the `quickcheck-dynamic-4` + changelog](https://hackage.haskell.org/package/quickcheck-dynamic-4.0.0/changelog). + + - The `Realized` type family is removed. + + + Types of the form `Realized m a` are replaced by `a` everywhere. + + Users should make this change in their own code as well. + + + Types of the form `LookUp m` are replaced by `LookUp` everywhere. + + Users should make this change in their own code as well. + + + The `RealLookUp` type synonym no longer has an `m` type argument, and the + `Proxy m` type is removed from the right-hand side of the definition. + Types of the form `RealLookup m op` are replaced by `RealLookup op` + everywhere. + + Users should make this change in their own code as well. (Any values of) + the type `Proxy m` that were previously passed to functions of the + `RealLookup` type can be removed. + + + `WrapRealized m` is replaced by `Identity`. The `WrapRealized m` type and + its helper functions (`intOpRealizedId`, `intOpTransformer`) are removed + completely. A new helper function called `intOpIdentity` is added. For the + `Op` from the `SumProd` module, the instances `InterpretOp Op + (WrapRealized IO)`, `InterpretOp Op (WrapRealized (StateT s m))`, and + `InterpretOp Op (WrapRealized (ReaderT r m))` are removed and replaced by + an `InterpretOp Op Identity` instance. + + Instead of providing an `InterpretOp op (WrapRealized m)` instance, users + should now provide an `InterpretOp op Identity` instance if `op` is a + custom type that is not included in `quickcheck-lockstep` (like + `SumProd.Op`, which comes an instance already defined). Use + `intOpIdentity` to help define this instance for custom `op` types. + + - The `Error` type family is moved from `StateModel` to `RunModel`, and now + requires an additional `m` type paramer. For `quickcheck-lockstep`, types of + the form `Error st` are replaced by `Error st m` everywhere. + + The user should make this change in their own code as well. + +* PATCH: enable a bunch of GHC warnings +* PATCH: use GHC2021, and if not available, enable all GHC2021 language + extensions explicitly. + ## 0.7.0 -- 2025-05-09 * BREAKING: Rename `lookupGVar` to `realLookupVar`, and add a `RealLookup` diff --git a/quickcheck-lockstep.cabal b/quickcheck-lockstep.cabal --- a/quickcheck-lockstep.cabal +++ b/quickcheck-lockstep.cabal @@ -1,6 +1,6 @@ -cabal-version: 2.4 +cabal-version: 3.4 name: quickcheck-lockstep -version: 0.7.0 +version: 0.8.0 license: BSD-3-Clause license-file: LICENSE author: Edsko de Vries @@ -34,29 +34,96 @@ type: git location: https://github.com/well-typed/quickcheck-lockstep -common lang +source-repository head + type: git + location: https://github.com/well-typed/quickcheck-lockstep + tag: quickcheck-lockstep-0.8.0 + +common language + -- This is at the top-level so that `cabal check` does not complain. default-language: Haskell2010 + + -- For newer GHC's, override Haskell2010 with GHC2021 + if impl(ghc >=9.2.1) + default-language: GHC2021 + + -- For older GHC's, manually enable all language extensions that are in + -- GHC2021 + -- + -- NOTE: FieldSelectors is not supported on ghc-8.10.7, so it is the only + -- language extension that is missing compared to GHC2021 + else + default-extensions: + BangPatterns + BinaryLiterals + ConstrainedClassMethods + ConstraintKinds + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DoAndIfThenElse + EmptyCase + EmptyDataDecls + EmptyDataDeriving + ExistentialQuantification + ExplicitForAll + FlexibleContexts + FlexibleInstances + ForeignFunctionInterface + GADTSyntax + GeneralisedNewtypeDeriving + HexFloatLiterals + ImplicitPrelude + ImportQualifiedPost + InstanceSigs + KindSignatures + MonomorphismRestriction + MultiParamTypeClasses + NamedFieldPuns + NamedWildCards + NoExplicitNamespaces + NumericUnderscores + PatternGuards + PolyKinds + PostfixOperators + RankNTypes + RelaxedPolyRec + ScopedTypeVariables + StandaloneDeriving + StandaloneKindSignatures + StarIsType + TraditionalRecordSyntax + TupleSections + TypeApplications + TypeOperators + TypeSynonymInstances + + -- Extensions that we enable by default default-extensions: - FlexibleContexts - FlexibleInstances + DeriveAnyClass + DerivingStrategies + DerivingVia + ExplicitNamespaces GADTs - ImportQualifiedPost LambdaCase - MultiParamTypeClasses - QuantifiedConstraints - RankNTypes - ScopedTypeVariables - StandaloneDeriving - TupleSections - TypeApplications - TypeFamilies + RecordWildCards + RoleAnnotations + ViewPatterns - other-extensions: UndecidableInstances +common warnings ghc-options: - -Wall -Wprepositive-qualified-module -Wredundant-constraints + -Wall -Wcompat -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wpartial-fields -Widentities + -Wredundant-constraints -Wmissing-export-lists + -Wno-unticked-promoted-constructors -Wunused-packages + ghc-options: -Werror=missing-deriving-strategies + library - import: lang + import: language, warnings exposed-modules: Test.QuickCheck.StateModel.Lockstep Test.QuickCheck.StateModel.Lockstep.Defaults @@ -72,17 +139,17 @@ -- quickcheck-dynamic requires ghc 8.10 minimum build-depends: - , base >=4.14 && <4.22 - , constraints ^>=0.13 || ^>=0.14 - , containers ^>=0.6 || ^>=0.7 || ^>=0.8 - , mtl ^>=2.2 || ^>=2.3 - , QuickCheck ^>=2.14 || ^>=2.15 - , quickcheck-dynamic ^>=3.4.1 + , base >=4.14 && <4.22 + , constraints ^>=0.13 || ^>=0.14 + , containers ^>=0.6 || ^>=0.7 || ^>=0.8 + , mtl ^>=2.2 || ^>=2.3 + , QuickCheck ^>=2.14 || ^>=2.15 + , quickcheck-dynamic ^>=4.0 hs-source-dirs: src test-suite test-quickcheck-lockstep - import: lang + import: language, warnings type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs @@ -99,7 +166,7 @@ -- Version bounds determined by main lib build-depends: - , base < 5 + , base <5 , constraints , containers , directory @@ -115,7 +182,7 @@ , temporary test-suite test-internals - import: lang + import: language, warnings type: exitcode-stdio-1.0 hs-source-dirs: test-internals src main-is: Main.hs @@ -126,14 +193,10 @@ Test.QuickCheck.StateModel.Lockstep.Op.SumProd Test.Test.QuickCheck.StateModel.Lockstep.GVar - ghc-options: - -Wno-prepositive-qualified-module - -- Version bounds determined by main lib build-depends: - , base < 5 + , base <5 + , mtl , quickcheck-dynamic , tasty - , mtl , tasty-quickcheck - , QuickCheck diff --git a/src/Test/QuickCheck/StateModel/Lockstep.hs b/src/Test/QuickCheck/StateModel/Lockstep.hs --- a/src/Test/QuickCheck/StateModel/Lockstep.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep.hs @@ -39,8 +39,8 @@ , InterpretOp(..) ) where -import Prelude hiding (init) +import Prelude hiding (init) -import Test.QuickCheck.StateModel.Lockstep.API -import Test.QuickCheck.StateModel.Lockstep.Op -import Test.QuickCheck.StateModel.Lockstep.GVar +import Test.QuickCheck.StateModel.Lockstep.API +import Test.QuickCheck.StateModel.Lockstep.GVar +import Test.QuickCheck.StateModel.Lockstep.Op diff --git a/src/Test/QuickCheck/StateModel/Lockstep/API.hs b/src/Test/QuickCheck/StateModel/Lockstep/API.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/API.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/API.hs @@ -1,4 +1,5 @@ -{- HLINT ignore "Eta reduce" -} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE TypeFamilies #-} -- | Public API -- @@ -25,39 +26,29 @@ , realLookupVar ) where -import Data.Constraint (Dict(..)) -import Data.Kind -import Data.Typeable +import Control.Monad.Identity (Identity) -import Test.QuickCheck (Gen) -import Test.QuickCheck.StateModel (StateModel, Any, RunModel, Realized, Action, LookUp) +import Data.Constraint (Dict (..)) +import Data.Kind +import Data.Typeable -import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF) -import Test.QuickCheck.StateModel.Lockstep.GVar (GVar, AnyGVar(..), fromVar) -import Test.QuickCheck.StateModel.Lockstep.Op -import Test.QuickCheck.StateModel.Lockstep.Op.Identity qualified as Identity -import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF -import Test.QuickCheck.StateModel.Lockstep.GVar qualified as EnvF +import Test.QuickCheck (Gen) +import Test.QuickCheck.StateModel (Action, Any, LookUp, RunModel, + StateModel) +import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF +import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF) +import qualified Test.QuickCheck.StateModel.Lockstep.GVar as EnvF +import Test.QuickCheck.StateModel.Lockstep.GVar (AnyGVar (..), GVar, + fromVar) +import Test.QuickCheck.StateModel.Lockstep.Op +import qualified Test.QuickCheck.StateModel.Lockstep.Op.Identity as Identity + {------------------------------------------------------------------------------- Lockstep state @quickcheck-dynamic@ takes care of keeping track of the responses of the system under test, but not the model. We do that here. - - Implementation note: the 'RunModel' class in @quickcheck-dynamic@ uses a type - family 'Realized': for an @Action state a@, the response from the real system - is expected to be of type @Realized m a@. This allows the same tests to be run - against different "test execution backends"; for example, we could run the - tests in the real IO monad, or using an IO monad simulator. - - This is an orthogonal generalization to what Lockstep provides: no matter the - test execution backend, the /model/ will always be the same. We could perhaps - piggy-back on the same abstraction if we introduced a separate monad parameter - @n@ for the model, and then use @Realized n a@ instead of @ModelValue a@. This - might work, but it's less clear how to then also that for 'Observable'. - Overall, it seems cleaner to reserve 'Realized' exclusively for the - parameterization over test execution backends. -------------------------------------------------------------------------------} data Lockstep state = Lockstep { @@ -164,7 +155,7 @@ -- See also 'Observable' observeReal :: Proxy m - -> LockstepAction state a -> Realized m a -> Observable state a + -> LockstepAction state a -> a -> Observable state a -- | Show responses from the real system -- @@ -173,7 +164,7 @@ showRealResponse :: Proxy m -> LockstepAction state a - -> Maybe (Dict (Show (Realized m a))) + -> Maybe (Dict (Show a)) showRealResponse _ _ = Nothing {------------------------------------------------------------------------------- @@ -195,7 +186,7 @@ type ModelShrinkVar state = forall a. ModelVar state a -> [ModelVar state a] -- | See 'realLookupVar'. -type RealLookUp m op = forall a. Proxy m -> LookUp m -> GVar op a -> Realized m a +type RealLookUp op = forall a. LookUp -> GVar op a -> a -- | Variables with a "functor-esque" instance type ModelVar state = GVar (ModelOp state) @@ -242,8 +233,8 @@ -- | Look up a variable for execution of the real system. -- -- The type of the variable is the type in the /real/ system. -realLookupVar :: InterpretOp op (WrapRealized m) => RealLookUp m op -realLookupVar p lookUp gvar = case EnvF.lookUpGVar p lookUp gvar of +realLookupVar :: InterpretOp op Identity => RealLookUp op +realLookupVar lookUp gvar = case EnvF.lookUpGVar lookUp gvar of Just x -> x Nothing -> error "realLookupVar: the variable (GVar) must be well-defined and evaluable, \ diff --git a/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs b/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs @@ -18,21 +18,22 @@ , monitoring ) where -import Prelude hiding (init) +import Prelude hiding (init) -import Data.Constraint (Dict(..)) -import Data.Set qualified as Set -import Data.Typeable +import Data.Constraint (Dict (..)) +import qualified Data.Set as Set +import Data.Typeable -import Test.QuickCheck (Gen, Property) -import Test.QuickCheck qualified as QC -import Test.QuickCheck.StateModel ( Var, Any(..), LookUp, Realized, PostconditionM - , Action, monitorPost, StateModel (Error)) -import Test.QuickCheck.StateModel.Variables (VarContext, HasVariables (..)) +import qualified Test.QuickCheck as QC +import Test.QuickCheck (Gen, Property) +import Test.QuickCheck.StateModel (Action, Any (..), LookUp, + PostconditionM, RunModel (Error), Var, monitorPost) +import Test.QuickCheck.StateModel.Variables (HasVariables (..), + VarContext) -import Test.QuickCheck.StateModel.Lockstep.API -import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF -import Test.QuickCheck.StateModel.Lockstep.GVar +import Test.QuickCheck.StateModel.Lockstep.API +import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF +import Test.QuickCheck.StateModel.Lockstep.GVar {------------------------------------------------------------------------------- Default implementations for members of 'StateModel' @@ -97,8 +98,8 @@ RunLockstep state m => (Lockstep state, Lockstep state) -> LockstepAction state a - -> LookUp m - -> Realized m a + -> LookUp + -> a -> PostconditionM m Bool postcondition = postconditionWith True @@ -112,8 +113,8 @@ => Bool -- ^ Verbose output -> (Lockstep state, Lockstep state) -> LockstepAction state a - -> LookUp m - -> Realized m a + -> LookUp + -> a -> PostconditionM m Bool postconditionWith verbose (before, _after) action _lookUp a = case checkResponse (Proxy @m) before action a of @@ -127,8 +128,8 @@ => Proxy m -> (Lockstep state, Lockstep state) -> LockstepAction state a - -> LookUp m - -> Either (Error (Lockstep state)) (Realized m a) + -> LookUp + -> Either (Error (Lockstep state) m) a -> Property -> Property monitoring _p (before, after) action _lookUp _realResp = QC.counterexample ("State: " ++ show after) @@ -173,7 +174,7 @@ checkResponse :: forall m state a. RunLockstep state m => Proxy m - -> Lockstep state -> LockstepAction state a -> Realized m a -> Either String String + -> Lockstep state -> LockstepAction state a -> a -> Either String String checkResponse p (Lockstep state env) action a = compareEquality (a , observeReal p action a) @@ -183,7 +184,7 @@ modelResp = fst $ modelNextState action env state compareEquality :: - (Realized m a, Observable state a) + (a, Observable state a) -> (ModelValue state a, Observable state a) -> Either String String compareEquality (realResp, obsRealResp) (mockResp, obsMockResp) | obsRealResp == obsMockResp = Right $ concat [ diff --git a/src/Test/QuickCheck/StateModel/Lockstep/EnvF.hs b/src/Test/QuickCheck/StateModel/Lockstep/EnvF.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/EnvF.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/EnvF.hs @@ -20,14 +20,14 @@ , EnvEntry (..) ) where -import Prelude hiding (lookup) +import Prelude hiding (lookup) -import Control.Monad -import Data.Foldable (asum) -import Data.Maybe (mapMaybe) -import Data.Typeable +import Control.Monad +import Data.Foldable (asum) +import Data.Maybe (mapMaybe) +import Data.Typeable -import Test.QuickCheck.StateModel.Variables (Var, unsafeCoerceVar) +import Test.QuickCheck.StateModel.Variables (Var, unsafeCoerceVar) {------------------------------------------------------------------------------- Types diff --git a/src/Test/QuickCheck/StateModel/Lockstep/GVar.hs b/src/Test/QuickCheck/StateModel/Lockstep/GVar.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/GVar.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/GVar.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE UndecidableInstances #-} -- | Generalized variables -- @@ -21,19 +22,21 @@ , pattern GVar ) where -import Prelude hiding (map) +import Prelude hiding (map) -import Data.Maybe (isJust) -import Data.Typeable +import Control.Monad.Identity (Identity (..)) -import GHC.Show +import Data.Maybe (isJust) +import Data.Typeable -import Test.QuickCheck.StateModel (Var, LookUp, Realized, HasVariables (..)) +import GHC.Show -import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF) -import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF -import Test.QuickCheck.StateModel.Lockstep.Op +import Test.QuickCheck.StateModel (HasVariables (..), LookUp, Var) +import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF +import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF) +import Test.QuickCheck.StateModel.Lockstep.Op + {------------------------------------------------------------------------------- Main type -------------------------------------------------------------------------------} @@ -91,18 +94,18 @@ Interop with 'Env' -------------------------------------------------------------------------------} -lookUpWrapped :: Typeable a => Proxy m -> LookUp m -> Var a -> WrapRealized m a -lookUpWrapped _ m v = WrapRealized (m v) +lookUpWrapped :: Typeable a => LookUp -> Var a -> Identity a +lookUpWrapped m v = Identity (m v) -- | Lookup 'GVar' given a lookup function for 'Var' -- -- The result is 'Just' if the variable is in the environment and evaluation -- succeeds. This is normally guaranteed by the default test 'precondition'. lookUpGVar :: - InterpretOp op (WrapRealized m) - => Proxy m -> LookUp m -> GVar op a -> Maybe (Realized m a) -lookUpGVar p lookUp (GVar var op) = - unwrapRealized <$> intOp op (lookUpWrapped p lookUp var) + InterpretOp op Identity + => LookUp -> GVar op a -> Maybe a +lookUpGVar lookUp (GVar var op) = + runIdentity <$> intOp op (lookUpWrapped lookUp var) {------------------------------------------------------------------------------- Interop with EnvF diff --git a/src/Test/QuickCheck/StateModel/Lockstep/Op.hs b/src/Test/QuickCheck/StateModel/Lockstep/Op.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/Op.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/Op.hs @@ -1,15 +1,11 @@ -{-# LANGUAGE TypeOperators #-} - module Test.QuickCheck.StateModel.Lockstep.Op ( Operation(..) , InterpretOp(..) - , WrapRealized(..) - , intOpRealizedId - , intOpTransformer + , intOpIdentity ) where -import Test.QuickCheck.StateModel (Realized) -import Data.Coerce +import Control.Monad.Identity (Identity (..)) +import Data.Coerce {------------------------------------------------------------------------------- Operations @@ -27,42 +23,7 @@ class Operation op => InterpretOp op f where intOp :: op a b -> f a -> Maybe (f b) -{------------------------------------------------------------------------------- - Interop with 'Realized' - - We want to execute operations against 'Realized' values, but since that is a - type family, we need to wrap and unwrap in order to be able to give the - appropriate 'InterpretOp' instances. --------------------------------------------------------------------------------} - -newtype WrapRealized m a = WrapRealized { - unwrapRealized :: Realized m a - } - --- | Convenience function for defining 'InterpretOp' instances --- --- This can be used for monads like @IO@ where @Realized m a@ is just @a@. -intOpRealizedId :: - (Realized m a ~ a, Realized m b ~ b) - => (op a b -> a -> Maybe b) - -> op a b -> WrapRealized m a -> Maybe (WrapRealized m b) -intOpRealizedId = coerce - --- | Convenience function for defining 'InterpretOp' instances for monad --- transformer stacks. -intOpTransformer :: - forall t m a b op. - ( Realized (t m) a ~ Realized m a - , Realized (t m) b ~ Realized m b - , InterpretOp op (WrapRealized m) - ) - => op a b - -> WrapRealized (t m) a - -> Maybe (WrapRealized (t m) b) -intOpTransformer op wr = coerceOut <$> intOp op (coerceIn wr) - where - coerceIn :: WrapRealized (t m) a -> WrapRealized m a - coerceIn = coerce - - coerceOut :: WrapRealized m b -> WrapRealized (t m) b - coerceOut = coerce +intOpIdentity :: + (op a b -> a -> Maybe b) + -> op a b -> Identity a -> Maybe (Identity b) +intOpIdentity = coerce diff --git a/src/Test/QuickCheck/StateModel/Lockstep/Op/Identity.hs b/src/Test/QuickCheck/StateModel/Lockstep/Op/Identity.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/Op/Identity.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/Op/Identity.hs @@ -1,6 +1,6 @@ module Test.QuickCheck.StateModel.Lockstep.Op.Identity (Op(..)) where -import Test.QuickCheck.StateModel.Lockstep.Op +import Test.QuickCheck.StateModel.Lockstep.Op -- | Very simple operation type that supports identity only -- @@ -10,8 +10,8 @@ data Op a b where OpId :: Op a a -deriving instance Show (Op a b) -deriving instance Eq (Op a b) +deriving stock instance Show (Op a b) +deriving stock instance Eq (Op a b) instance Operation Op where opIdentity = OpId instance InterpretOp Op f where intOp OpId = Just diff --git a/src/Test/QuickCheck/StateModel/Lockstep/Op/SumProd.hs b/src/Test/QuickCheck/StateModel/Lockstep/Op/SumProd.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/Op/SumProd.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/Op/SumProd.hs @@ -1,11 +1,10 @@ module Test.QuickCheck.StateModel.Lockstep.Op.SumProd (Op(..), intOpId) where -import Control.Monad ((<=<)) -import Control.Monad.Reader (ReaderT) -import Control.Monad.State (StateT) -import GHC.Show (appPrec) +import Control.Monad ((<=<)) +import Control.Monad.Identity (Identity) +import GHC.Show (appPrec) -import Test.QuickCheck.StateModel.Lockstep.Op +import Test.QuickCheck.StateModel.Lockstep.Op {------------------------------------------------------------------------------- Example (but very useful) 'Operation' example @@ -44,16 +43,8 @@ instance Operation Op where opIdentity = OpId -instance InterpretOp Op (WrapRealized IO) where - intOp = intOpRealizedId intOpId - -instance InterpretOp Op (WrapRealized m) - => InterpretOp Op (WrapRealized (StateT s m)) where - intOp = intOpTransformer - -instance InterpretOp Op (WrapRealized m) - => InterpretOp Op (WrapRealized (ReaderT r m)) where - intOp = intOpTransformer +instance InterpretOp Op Identity where + intOp = intOpIdentity intOpId {------------------------------------------------------------------------------- 'Show' and 'Eq' instances diff --git a/src/Test/QuickCheck/StateModel/Lockstep/Run.hs b/src/Test/QuickCheck/StateModel/Lockstep/Run.hs --- a/src/Test/QuickCheck/StateModel/Lockstep/Run.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/Run.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE TypeOperators #-} -- | Run lockstep tests -- @@ -14,22 +15,22 @@ , runActionsBracket ) where -import Prelude hiding (init) +import Prelude hiding (init) -import Control.Exception -import Control.Monad (void) -import Data.Set (Set) -import Data.Set qualified as Set -import Data.Typeable -import Test.QuickCheck.Monadic +import Control.Exception +import Control.Monad (void) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Typeable +import Test.QuickCheck.Monadic -import Test.QuickCheck (Property, Testable) -import Test.QuickCheck qualified as QC -import Test.QuickCheck.StateModel hiding (runActions) -import Test.QuickCheck.StateModel qualified as StateModel +import qualified Test.QuickCheck as QC +import Test.QuickCheck (Property, Testable) +import qualified Test.QuickCheck.StateModel as StateModel +import Test.QuickCheck.StateModel hiding (runActions) -import Test.QuickCheck.StateModel.Lockstep.API -import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF +import Test.QuickCheck.StateModel.Lockstep.API +import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF {------------------------------------------------------------------------------- Finding labelled examples @@ -93,7 +94,7 @@ runActions :: ( RunLockstep state IO - , e ~ Error (Lockstep state) + , e ~ Error (Lockstep state) IO , forall a. IsPerformResult e a ) => Proxy state @@ -110,7 +111,7 @@ -- is a reasonable choice. runActionsBracket :: ( RunLockstep state m - , e ~ Error (Lockstep state) + , e ~ Error (Lockstep state) m , forall a. IsPerformResult e a ) => Proxy state diff --git a/test-internals/Test/Test/QuickCheck/StateModel/Lockstep/GVar.hs b/test-internals/Test/Test/QuickCheck/StateModel/Lockstep/GVar.hs --- a/test-internals/Test/Test/QuickCheck/StateModel/Lockstep/GVar.hs +++ b/test-internals/Test/Test/QuickCheck/StateModel/Lockstep/GVar.hs @@ -2,18 +2,14 @@ {-# OPTIONS_GHC -Wno-orphans #-} -module Test.Test.QuickCheck.StateModel.Lockstep.GVar where +module Test.Test.QuickCheck.StateModel.Lockstep.GVar (tests) where -import Data.Data (eqT, - (:~:) (Refl)) +import Data.Data (eqT, (:~:) (Refl)) import Data.Functor.Identity -import Test.QuickCheck.StateModel.Lockstep.EnvF hiding - (shrinkVar) +import Test.QuickCheck.StateModel.Lockstep.EnvF hiding (shrinkVar) import Test.QuickCheck.StateModel.Lockstep.GVar -import Test.QuickCheck.StateModel.Lockstep.Op import Test.QuickCheck.StateModel.Lockstep.Op.SumProd -import Test.QuickCheck.StateModel.Variables hiding - (shrinkVar) +import Test.QuickCheck.StateModel.Variables hiding (shrinkVar) import Test.Tasty import Test.Tasty.QuickCheck @@ -49,9 +45,6 @@ {------------------------------------------------------------------------------- Well-defined and evaluable shrinks: generators, shrinkers, printers -------------------------------------------------------------------------------} - -instance InterpretOp Op Identity where - intOp op = traverse (intOpId op) -- NOTE: both the environment and variables contain/are existential types, which -- can get a little bit complicated when writing generators, shrinkers and diff --git a/test/Test/Golden.hs b/test/Test/Golden.hs --- a/test/Test/Golden.hs +++ b/test/Test/Golden.hs @@ -1,11 +1,9 @@ -{- HLINT ignore "Use camelCase" -} - -module Test.Golden where +module Test.Golden (Test.Golden.tests) where -import Control.Exception (bracket_) +import Control.Exception (bracket_) import System.Directory import System.FilePath -import Test.MockFS as MockFS +import Test.MockFS as MockFS import Test.QuickCheck import Test.QuickCheck.Random (mkQCGen) import Test.Tasty diff --git a/test/Test/IORef/Full.hs b/test/Test/IORef/Full.hs --- a/test/Test/IORef/Full.hs +++ b/test/Test/IORef/Full.hs @@ -1,28 +1,29 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} module Test.IORef.Full (tests) where -import Control.Monad.Reader -import Data.Bifunctor -import Data.Constraint (Dict(..)) -import Data.IORef -import Data.Map (Map) -import Data.Map qualified as Map -import Data.Proxy -import Test.QuickCheck -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.QuickCheck (testProperty) +import Control.Monad.Reader +import Data.Bifunctor +import Data.Constraint (Dict (..)) +import Data.IORef +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Proxy +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck qualified as QC +import qualified Test.QuickCheck as QC -import Test.QuickCheck.StateModel -import Test.QuickCheck.StateModel.Lockstep -import Test.QuickCheck.StateModel.Lockstep.Defaults qualified as Lockstep -import Test.QuickCheck.StateModel.Lockstep.Run qualified as Lockstep -import Test.QuickCheck.StateModel.Lockstep.Run (labelActions) +import Test.QuickCheck.StateModel +import Test.QuickCheck.StateModel.Lockstep +import qualified Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep +import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep +import Test.QuickCheck.StateModel.Lockstep.Run (labelActions) {------------------------------------------------------------------------------- Model "M" @@ -39,7 +40,7 @@ -- This is used for tagging. , mWrites :: Map (MRef, Int) Int } - deriving (Show) + deriving stock (Show) initModel :: M initModel = M { @@ -174,20 +175,20 @@ Write{} -> Just Dict Read{} -> Just Dict -deriving instance Show (Action (Lockstep M) a) -deriving instance Show (Observable M a) -deriving instance Show (ModelValue M a) +deriving stock instance Show (Action (Lockstep M) a) +deriving stock instance Show (Observable M a) +deriving stock instance Show (ModelValue M a) -deriving instance Eq (Action (Lockstep M) a) -deriving instance Eq (Observable M a) -deriving instance Eq (ModelValue M a) +deriving stock instance Eq (Action (Lockstep M) a) +deriving stock instance Eq (Observable M a) +deriving stock instance Eq (ModelValue M a) {------------------------------------------------------------------------------- Interpreters against the real system and against the model -------------------------------------------------------------------------------} data Buggy = Buggy | NotBuggy - deriving (Show, Eq) + deriving stock (Show, Eq) instance Arbitrary Buggy where arbitrary = elements [Buggy, NotBuggy] @@ -200,7 +201,7 @@ type RealMonad = ReaderT (Buggy, IORef BrokenRef) IO -runIO :: Action (Lockstep M) a -> LookUp RealMonad -> RealMonad a +runIO :: Action (Lockstep M) a -> LookUp -> RealMonad a runIO action lookUp = ReaderT $ \(buggy, brokenRef) -> case action of New -> newIORef 0 @@ -208,11 +209,11 @@ Read v -> readIORef (lookUpRef v) where lookUpRef :: ModelVar M (IORef Int) -> IORef Int - lookUpRef = realLookupVar (Proxy @RealMonad) lookUp + lookUpRef = realLookupVar lookUp lookUpInt :: Either Int (ModelVar M Int) -> Int lookUpInt (Left x) = x - lookUpInt (Right v) = realLookupVar (Proxy @RealMonad) lookUp v + lookUpInt (Right v) = realLookupVar lookUp v -- | The second write to the same variable will be broken brokenWrite :: Buggy -> IORef BrokenRef -> IORef Int -> Int -> IO Int diff --git a/test/Test/IORef/Simple.hs b/test/Test/IORef/Simple.hs --- a/test/Test/IORef/Simple.hs +++ b/test/Test/IORef/Simple.hs @@ -1,23 +1,24 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} module Test.IORef.Simple (tests) where -import Data.Bifunctor -import Data.Constraint (Dict(..)) -import Data.IORef -import Data.Map (Map) -import Data.Map qualified as Map -import Data.Proxy -import Test.QuickCheck -import Test.Tasty -import Test.Tasty.QuickCheck (testProperty) +import Data.Bifunctor +import Data.Constraint (Dict (..)) +import Data.IORef +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Proxy +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck.StateModel -import Test.QuickCheck.StateModel.Lockstep -import Test.QuickCheck.StateModel.Lockstep.Defaults qualified as Lockstep -import Test.QuickCheck.StateModel.Lockstep.Run qualified as Lockstep +import Test.QuickCheck.StateModel +import Test.QuickCheck.StateModel.Lockstep +import qualified Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep +import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep {------------------------------------------------------------------------------- Model "M" @@ -25,11 +26,11 @@ type MRef = Int -data M = M { +newtype M = M { -- | Value of every var mValues :: Map MRef Int } - deriving (Show) + deriving stock (Show) initModel :: M initModel = M { mValues = Map.empty } @@ -133,13 +134,13 @@ Write{} -> Just Dict Read{} -> Just Dict -deriving instance Show (Action (Lockstep M) a) -deriving instance Show (Observable M a) -deriving instance Show (ModelValue M a) +deriving stock instance Show (Action (Lockstep M) a) +deriving stock instance Show (Observable M a) +deriving stock instance Show (ModelValue M a) -deriving instance Eq (Action (Lockstep M) a) -deriving instance Eq (Observable M a) -deriving instance Eq (ModelValue M a) +deriving stock instance Eq (Action (Lockstep M) a) +deriving stock instance Eq (Observable M a) +deriving stock instance Eq (ModelValue M a) {------------------------------------------------------------------------------- Interpreters against the real system and against the model @@ -147,7 +148,7 @@ type RealMonad = IO -runIO :: Action (Lockstep M) a -> LookUp RealMonad -> RealMonad a +runIO :: Action (Lockstep M) a -> LookUp -> RealMonad a runIO action lookUp = case action of New -> newIORef 0 @@ -155,7 +156,7 @@ Read v -> readIORef (lookUpRef v) where lookUpRef :: ModelVar M (IORef Int) -> IORef Int - lookUpRef = realLookupVar (Proxy @RealMonad) lookUp + lookUpRef = realLookupVar lookUp runModel :: Action (Lockstep M) a diff --git a/test/Test/MockFS.hs b/test/Test/MockFS.hs --- a/test/Test/MockFS.hs +++ b/test/Test/MockFS.hs @@ -23,38 +23,39 @@ , setPostconditionVerbose ) where -import Prelude hiding (init) +import Prelude hiding (init) -import Control.Exception (catch, throwIO) -import Control.Monad (replicateM, (<=<)) -import Control.Monad.Reader (ReaderT (..)) -import Control.Monad.Trans (lift) -import Data.Bifunctor -import Data.Constraint -import Data.IORef -import Data.Set (Set) -import Data.Set qualified as Set -import Data.Typeable -import System.Directory (removeDirectoryRecursive) -import System.Directory qualified as IO -import System.IO qualified as IO -import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory) -import System.IO.Unsafe (unsafePerformIO) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit -import Test.Tasty.QuickCheck (testProperty) +import Control.Exception (catch, throwIO) +import Control.Monad (replicateM, (<=<)) +import Control.Monad.Reader (ReaderT (..)) +import Control.Monad.Trans (lift) +import Data.Bifunctor +import Data.Constraint +import Data.IORef +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Typeable +import qualified System.Directory as IO +import System.Directory (removeDirectoryRecursive) +import qualified System.IO as IO +import System.IO.Temp (createTempDirectory, + getCanonicalTemporaryDirectory) +import System.IO.Unsafe (unsafePerformIO) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck (Gen) -import Test.QuickCheck qualified as QC -import Test.QuickCheck.StateModel hiding (vars) +import qualified Test.QuickCheck as QC +import Test.QuickCheck (Gen) +import Test.QuickCheck.StateModel hiding (vars) -import Test.QuickCheck.StateModel.Lockstep -import Test.QuickCheck.StateModel.Lockstep.Defaults qualified as Lockstep -import Test.QuickCheck.StateModel.Lockstep.Op.SumProd -import Test.QuickCheck.StateModel.Lockstep.Run qualified as Lockstep +import Test.QuickCheck.StateModel.Lockstep +import qualified Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep +import Test.QuickCheck.StateModel.Lockstep.Op.SumProd +import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep -import Test.MockFS.Mock (Mock, Dir(..), File(..), Err) -import Test.MockFS.Mock qualified as Mock +import qualified Test.MockFS.Mock as Mock +import Test.MockFS.Mock (Dir (..), Err, File (..), Mock) {------------------------------------------------------------------------------- Model state @@ -64,7 +65,7 @@ fsStateMock :: Mock , fsStateStats :: Stats } - deriving (Show) + deriving stock (Show) initState :: FsState initState = FsState { @@ -102,8 +103,8 @@ runPostcondition pc states action lookUp result monitoring = Lockstep.monitoring (Proxy @RealMonad) -deriving instance Show (Action (Lockstep FsState) a) -deriving instance Eq (Action (Lockstep FsState) a) +deriving stock instance Show (Action (Lockstep FsState) a) +deriving stock instance Eq (Action (Lockstep FsState) a) {------------------------------------------------------------------------------- InLockstep instance @@ -199,10 +200,10 @@ tagStep (_, FsState _ after) act = map show . tagFsAction after act -deriving instance Show (Observable FsState a) -deriving instance Eq (Observable FsState a) +deriving stock instance Show (Observable FsState a) +deriving stock instance Eq (Observable FsState a) -deriving instance Show (FsVal a) +deriving stock instance Show (FsVal a) {------------------------------------------------------------------------------- RunLockstep instance @@ -211,7 +212,7 @@ instance RunLockstep FsState RealMonad where observeReal :: Proxy RealMonad - -> LockstepAction FsState a -> Realized RealMonad a -> FsObs a + -> LockstepAction FsState a -> a -> FsObs a observeReal _ = \case MkDir{} -> OEither . bimap OId OId Open{} -> OEither . bimap OId (OPair . bimap (const OHandle) OId) @@ -330,7 +331,7 @@ Interpreter for IO -------------------------------------------------------------------------------} -runIO :: LockstepAction FsState a -> LookUp RealMonad -> RealMonad (Realized RealMonad a) +runIO :: LockstepAction FsState a -> LookUp -> RealMonad a runIO action lookUp = ReaderT $ \root -> aux root action where aux :: FilePath -> LockstepAction FsState a -> IO a @@ -351,7 +352,7 @@ _ -> pure s where lookUp' :: FsVar x -> x - lookUp' = realLookupVar (Proxy @RealMonad) lookUp + lookUp' = realLookupVar lookUp catchErr :: forall a. IO a -> IO (Either Err a) catchErr act = catch (Right <$> act) handler @@ -376,7 +377,7 @@ _otherwise -> id data Tag = OpenTwo | SuccessfulRead - deriving (Show) + deriving stock (Show) tagFsAction :: Stats -> LockstepAction FsState a -> FsVal a -> [Tag] tagFsAction openedFiles = \case @@ -412,7 +413,7 @@ -------------------------------------------------------------------------------} data Fault = Fault | NoFault - deriving Eq + deriving stock Eq {-# NOINLINE faultRef #-} -- | A mutable variable that can be set globally to induce test failures in @@ -450,12 +451,12 @@ Postcondition -> (Lockstep FsState, Lockstep FsState) -> Action (Lockstep FsState) a - -> LookUp RealMonad - -> Realized RealMonad a + -> LookUp + -> a -> PostconditionM RealMonad Bool -runPostcondition DefaultPostcondition = Lockstep.postcondition +runPostcondition DefaultPostcondition = Lockstep.postcondition runPostcondition NonVerbosePostcondition = Lockstep.postconditionWith False -runPostcondition VerbosePostcondition = Lockstep.postconditionWith True +runPostcondition VerbosePostcondition = Lockstep.postconditionWith True {-# NOINLINE postconditionRef #-} postconditionRef :: IORef Postcondition diff --git a/test/Test/MockFS/Mock.hs b/test/Test/MockFS/Mock.hs --- a/test/Test/MockFS/Mock.hs +++ b/test/Test/MockFS/Mock.hs @@ -18,28 +18,28 @@ , mRead ) where -import Data.List qualified as List -import Data.Map (Map) -import Data.Map qualified as Map -import Data.Set (Set) -import Data.Set qualified as Set -import GHC.Generics (Generic) -import GHC.IO.Exception qualified as GHC -import System.FilePath (()) -import System.IO.Error +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import GHC.Generics (Generic) +import qualified GHC.IO.Exception as GHC +import System.FilePath (()) +import System.IO.Error {------------------------------------------------------------------------------- Paths -------------------------------------------------------------------------------} -data Dir = Dir [String] - deriving (Show, Eq, Ord, Generic) +newtype Dir = Dir [String] + deriving stock (Show, Eq, Ord, Generic) parent :: Dir -> Dir parent (Dir fp) = Dir (init fp) data File = File {dir :: Dir, name :: String} - deriving (Show, Eq, Ord, Generic) + deriving stock (Show, Eq, Ord, Generic) dirFP :: FilePath -> Dir -> FilePath dirFP root (Dir d) = List.foldl' () root d @@ -56,7 +56,7 @@ | DoesNotExist | HandleClosed | Busy - deriving (Show, Eq) + deriving stock (Show, Eq) fromIOError :: IOError -> Maybe Err @@ -80,7 +80,7 @@ , open :: Map MHandle File , next :: MHandle } - deriving (Show, Generic) + deriving stock (Show, Generic) emptyMock :: Mock emptyMock = M (Set.singleton (Dir [])) Map.empty Map.empty 0