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 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 = a -> Maybe a
a -> Maybe b
forall a. a -> Maybe a
Just
intOpId Op a b
OpFst = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
(b, b) -> b
forall a b. (a, b) -> a
fst
intOpId Op a b
OpSnd = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
(b, b) -> b
forall a b. (a, b) -> b
snd
intOpId Op a b
OpLeft = (b -> Maybe b) -> (b -> Maybe b) -> Either b b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> b -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing)
intOpId Op a b
OpRight = (b -> Maybe b) -> (b -> Maybe b) -> Either b b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> b -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just
intOpId (OpComp Op b b
g Op a b
f) = Op b b -> b -> Maybe b
forall a b. Op a b -> a -> Maybe b
intOpId Op b b
g (b -> Maybe b) -> (a -> Maybe b) -> a -> Maybe b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Op a b -> a -> Maybe b
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 = Op a a
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 = (Op a b -> a -> Maybe b)
-> Op a b -> WrapRealized IO a -> Maybe (WrapRealized IO b)
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 Op a b -> a -> Maybe b
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 = Op a b
-> WrapRealized (StateT s m) a
-> Maybe (WrapRealized (StateT s m) b)
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 = Op a b
-> WrapRealized (ReaderT r m) a
-> Maybe (WrapRealized (ReaderT r m) b)
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 = Op a b -> Op c d -> Bool
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') = Op b b -> Op b d -> Bool
forall a b c d. Op a b -> Op c d -> Bool
go Op b b
g Op b d
g' Bool -> Bool -> Bool
&& Op a b -> Op c b -> 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
(==) = 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (Op a b -> ShowS
forall x y. Op x y -> ShowS
go Op a b
op)
Op a b
_ -> Op a b -> ShowS
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
"OpId"
go Op x y
OpFst = String -> ShowS
showString String
"OpFst"
go Op x y
OpSnd = String -> ShowS
showString String
"OpSnd"
go Op x y
OpLeft = String -> ShowS
showString String
"OpLeft"
go Op x y
OpRight = String -> ShowS
showString String
"OpRight"
go (OpComp Op b y
g Op x b
f) = Op b y -> ShowS
forall x y. Op x y -> ShowS
go Op b y
g ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" `OpComp` " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op x b -> ShowS
forall x y. Op x y -> ShowS
go Op x b
f