{-# LANGUAGE DeriveFunctor #-} module Test.Hspec.Core.Formatters.V1.Free where import Prelude () import Test.Hspec.Core.Compat data Free f a = Free (f (Free f a)) | Pure a deriving (forall a b. (a -> b) -> Free f a -> Free f b) -> (forall a b. a -> Free f b -> Free f a) -> Functor (Free f) forall a b. a -> Free f b -> Free f a forall a b. (a -> b) -> Free f a -> Free f b forall (f :: * -> *) a b. Functor f => a -> Free f b -> Free f a forall (f :: * -> *) a b. Functor f => (a -> b) -> Free f a -> Free f b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> Free f a -> Free f b fmap :: forall a b. (a -> b) -> Free f a -> Free f b $c<$ :: forall (f :: * -> *) a b. Functor f => a -> Free f b -> Free f a <$ :: forall a b. a -> Free f b -> Free f a Functor instance Functor f => Applicative (Free f) where pure :: forall a. a -> Free f a pure = a -> Free f a forall (f :: * -> *) a. a -> Free f a Pure Pure a -> b f <*> :: forall a b. Free f (a -> b) -> Free f a -> Free f b <*> Pure a a = b -> Free f b forall (f :: * -> *) a. a -> Free f a Pure (a -> b f a a) Pure a -> b f <*> Free f (Free f a) m = f (Free f b) -> Free f b forall (f :: * -> *) a. f (Free f a) -> Free f a Free ((a -> b) -> Free f a -> Free f b forall a b. (a -> b) -> Free f a -> Free f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f (Free f a -> Free f b) -> f (Free f a) -> f (Free f b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (Free f a) m) Free f (Free f (a -> b)) m <*> Free f a b = f (Free f b) -> Free f b forall (f :: * -> *) a. f (Free f a) -> Free f a Free ((Free f (a -> b) -> Free f b) -> f (Free f (a -> b)) -> f (Free f b) forall a b. (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Free f (a -> b) -> Free f a -> Free f b forall a b. Free f (a -> b) -> Free f a -> Free f b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Free f a b) f (Free f (a -> b)) m) instance Functor f => Monad (Free f) where return :: forall a. a -> Free f a return = a -> Free f a forall a. a -> Free f a forall (f :: * -> *) a. Applicative f => a -> f a pure Pure a a >>= :: forall a b. Free f a -> (a -> Free f b) -> Free f b >>= a -> Free f b f = a -> Free f b f a a Free f (Free f a) m >>= a -> Free f b f = f (Free f b) -> Free f b forall (f :: * -> *) a. f (Free f a) -> Free f a Free ((Free f a -> Free f b) -> f (Free f a) -> f (Free f b) forall a b. (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Free f a -> (a -> Free f b) -> Free f b forall a b. Free f a -> (a -> Free f b) -> Free f b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= a -> Free f b f) f (Free f a) m) liftF :: Functor f => f a -> Free f a liftF :: forall (f :: * -> *) a. Functor f => f a -> Free f a liftF f a command = f (Free f a) -> Free f a forall (f :: * -> *) a. f (Free f a) -> Free f a Free ((a -> Free f a) -> f a -> f (Free f a) forall a b. (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Free f a forall (f :: * -> *) a. a -> Free f a Pure f a command)