module Test.QuickCheck.StateModel.Lockstep.Op.SumProd (Op(..), intOpId) where
import Control.Monad.Reader (ReaderT)
import Control.Monad.State
import GHC.Show (appPrec)
import Test.QuickCheck.StateModel.Lockstep.Op
data Op a b where
OpId :: Op a a
OpFst :: Op (a, b) a
OpSnd :: Op (b, a) a
OpLeft :: Op (Either a b) a
OpRight :: Op (Either b a) a
OpComp :: Op b c -> Op a b -> Op a c
intOpId :: Op a b -> a -> Maybe b
intOpId :: forall a b. Op a b -> a -> Maybe b
intOpId Op a b
OpId = forall a. a -> Maybe a
Just
intOpId Op a b
OpFst = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
intOpId Op a b
OpSnd = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
intOpId Op a b
OpLeft = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
intOpId Op a b
OpRight = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
intOpId (OpComp Op b b
g Op a b
f) = forall a b. Op a b -> a -> Maybe b
intOpId Op b b
g forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a b. Op a b -> a -> Maybe b
intOpId Op a b
f
instance Operation Op where
opIdentity :: forall a. Op a a
opIdentity = forall a. Op a a
OpId
instance InterpretOp Op (WrapRealized IO) where
intOp :: forall a b.
Op a b -> WrapRealized IO a -> Maybe (WrapRealized IO b)
intOp = forall (m :: * -> *) a b (op :: * -> * -> *).
(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 forall a b. Op a b -> a -> Maybe b
intOpId
instance InterpretOp Op (WrapRealized m)
=> InterpretOp Op (WrapRealized (StateT s m)) where
intOp :: forall a b.
Op a b
-> WrapRealized (StateT s m) a
-> Maybe (WrapRealized (StateT s m) b)
intOp = 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
instance InterpretOp Op (WrapRealized m)
=> InterpretOp Op (WrapRealized (ReaderT r m)) where
intOp :: forall a b.
Op a b
-> WrapRealized (ReaderT r m) a
-> Maybe (WrapRealized (ReaderT r m) b)
intOp = 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
sameOp :: Op a b -> Op c d -> Bool
sameOp :: forall a b c d. Op a b -> Op c d -> Bool
sameOp = forall a b c d. Op a b -> Op c d -> Bool
go
where
go :: Op a b -> Op c d -> Bool
go :: forall a b c d. Op a b -> Op c d -> Bool
go Op a b
OpId Op c d
OpId = Bool
True
go Op a b
OpFst Op c d
OpFst = Bool
True
go Op a b
OpSnd Op c d
OpSnd = Bool
True
go Op a b
OpLeft Op c d
OpLeft = Bool
True
go Op a b
OpRight Op c d
OpRight = Bool
True
go (OpComp Op b b
g Op a b
f) (OpComp Op b d
g' Op c b
f') = forall a b c d. Op a b -> Op c d -> Bool
go Op b b
g Op b d
g' Bool -> Bool -> Bool
&& forall a b c d. Op a b -> Op c d -> Bool
go Op a b
f Op c b
f'
go Op a b
_ Op c d
_ = Bool
False
_coveredAllCases :: Op a b -> ()
_coveredAllCases :: forall a b. Op a b -> ()
_coveredAllCases = \case
Op a b
OpId -> ()
Op a b
OpFst -> ()
Op a b
OpSnd -> ()
Op a b
OpLeft -> ()
Op a b
OpRight -> ()
OpComp{} -> ()
instance Eq (Op a b) where
== :: Op a b -> Op a b -> Bool
(==) = forall a b c d. Op a b -> Op c d -> Bool
sameOp
instance Show (Op a b) where
showsPrec :: Int -> Op a b -> ShowS
showsPrec Int
p = \Op a b
op -> case Op a b
op of
OpComp{} -> Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
appPrec) (forall x y. Op x y -> ShowS
go Op a b
op)
Op a b
_ -> forall x y. Op x y -> ShowS
go Op a b
op
where
go :: Op x y -> String -> String
go :: forall x y. Op x y -> ShowS
go Op x y
OpId = String -> ShowS
showString String
"id"
go Op x y
OpFst = String -> ShowS
showString String
"fst"
go Op x y
OpSnd = String -> ShowS
showString String
"snd"
go Op x y
OpLeft = String -> ShowS
showString String
"fromLeft"
go Op x y
OpRight = String -> ShowS
showString String
"fromRight"
go (OpComp Op b y
g Op x b
f) = forall x y. Op x y -> ShowS
go Op b y
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" . " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. Op x y -> ShowS
go Op x b
f