{-# LANGUAGE OverlappingInstances, TypeOperators, FlexibleInstances #-}
module Test.IOSpec.Types
(
IOSpec(..)
, foldIOSpec
, (:+:)(..)
, (:<:)
, inject
) where
import Control.Monad (ap)
data IOSpec f a =
Pure a
| Impure (f (IOSpec f a))
instance (Functor f) => Functor (IOSpec f) where
fmap :: (a -> b) -> IOSpec f a -> IOSpec f b
fmap a -> b
f (Pure a
x) = b -> IOSpec f b
forall (f :: * -> *) a. a -> IOSpec f a
Pure (a -> b
f a
x)
fmap a -> b
f (Impure f (IOSpec f a)
t) = f (IOSpec f b) -> IOSpec f b
forall (f :: * -> *) a. f (IOSpec f a) -> IOSpec f a
Impure ((IOSpec f a -> IOSpec f b) -> f (IOSpec f a) -> f (IOSpec f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> IOSpec f a -> IOSpec f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (IOSpec f a)
t)
instance (Functor f) => Applicative (IOSpec f) where
pure :: a -> IOSpec f a
pure = a -> IOSpec f a
forall (f :: * -> *) a. a -> IOSpec f a
Pure
<*> :: IOSpec f (a -> b) -> IOSpec f a -> IOSpec f b
(<*>) = IOSpec f (a -> b) -> IOSpec f a -> IOSpec f b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Functor f) => Monad (IOSpec f) where
return :: a -> IOSpec f a
return = a -> IOSpec f a
forall (f :: * -> *) a. a -> IOSpec f a
Pure
(Pure a
x) >>= :: IOSpec f a -> (a -> IOSpec f b) -> IOSpec f b
>>= a -> IOSpec f b
f = a -> IOSpec f b
f a
x
(Impure f (IOSpec f a)
t) >>= a -> IOSpec f b
f = f (IOSpec f b) -> IOSpec f b
forall (f :: * -> *) a. f (IOSpec f a) -> IOSpec f a
Impure ((IOSpec f a -> IOSpec f b) -> f (IOSpec f a) -> f (IOSpec f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IOSpec f a -> (a -> IOSpec f b) -> IOSpec f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IOSpec f b
f) f (IOSpec f a)
t)
foldIOSpec :: Functor f => (a -> b) -> (f b -> b) -> IOSpec f a -> b
foldIOSpec :: (a -> b) -> (f b -> b) -> IOSpec f a -> b
foldIOSpec a -> b
pure f b -> b
_ (Pure a
x) = a -> b
pure a
x
foldIOSpec a -> b
pure f b -> b
impure (Impure f (IOSpec f a)
t) = f b -> b
impure ((IOSpec f a -> b) -> f (IOSpec f a) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (f b -> b) -> IOSpec f a -> b
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> IOSpec f a -> b
foldIOSpec a -> b
pure f b -> b
impure) f (IOSpec f a)
t)
data (f :+: g) x = Inl (f x) | Inr (g x)
infixr 5 :+:
instance (Functor f, Functor g) => Functor (f :+: g) where
fmap :: (a -> b) -> (:+:) f g a -> (:+:) f g b
fmap a -> b
f (Inl f a
x) = f b -> (:+:) f g b
forall (f :: * -> *) (g :: * -> *) x. f x -> (:+:) f g x
Inl ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
fmap a -> b
f (Inr g a
y) = g b -> (:+:) f g b
forall (f :: * -> *) (g :: * -> *) x. g x -> (:+:) f g x
Inr ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f g a
y)
class (Functor sub, Functor sup) => sub :<: sup where
inj :: sub a -> sup a
instance Functor f => (:<:) f f where
inj :: f a -> f a
inj = f a -> f a
forall a. a -> a
id
instance (Functor f, Functor g) => (:<:) f (f :+: g) where
inj :: f a -> (:+:) f g a
inj = f a -> (:+:) f g a
forall (f :: * -> *) (g :: * -> *) x. f x -> (:+:) f g x
Inl
instance ((:<:) f g, Functor f, Functor g, Functor h)
=> (:<:) f (h :+: g) where
inj :: f a -> (:+:) h g a
inj = g a -> (:+:) h g a
forall (f :: * -> *) (g :: * -> *) x. g x -> (:+:) f g x
Inr (g a -> (:+:) h g a) -> (f a -> g a) -> f a -> (:+:) h g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> g a
forall (sub :: * -> *) (sup :: * -> *) a.
(sub :<: sup) =>
sub a -> sup a
inj
inject :: (g :<: f) => g (IOSpec f a) -> IOSpec f a
inject :: g (IOSpec f a) -> IOSpec f a
inject = f (IOSpec f a) -> IOSpec f a
forall (f :: * -> *) a. f (IOSpec f a) -> IOSpec f a
Impure (f (IOSpec f a) -> IOSpec f a)
-> (g (IOSpec f a) -> f (IOSpec f a))
-> g (IOSpec f a)
-> IOSpec f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (IOSpec f a) -> f (IOSpec f a)
forall (sub :: * -> *) (sup :: * -> *) a.
(sub :<: sup) =>
sub a -> sup a
inj