module Test.QuickCheck.StateModel.Lockstep.Op.Identity (Op(..)) where

import           Test.QuickCheck.StateModel.Lockstep.Op

-- | Very simple operation type that supports identity only
--
-- This can be used by tests that don't need to map over variables. That is,
-- where variables always refer to the /exact/ result of previously executed
-- commands. Such tests will not need to define any 'InterpretOp' instances.
data Op a b where
  OpId :: Op a a

deriving stock instance Show (Op a b)
deriving stock instance Eq   (Op a b)

instance Operation   Op   where opIdentity :: forall (a :: k). Op a a
opIdentity = Op a a
forall k (a :: k). Op a a
OpId
instance InterpretOp Op f where intOp :: forall (a :: k) (b :: k). Op a b -> f a -> Maybe (f b)
intOp Op a b
OpId = f a -> Maybe (f a)
f a -> Maybe (f b)
forall a. a -> Maybe a
Just