{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-} #endif -- 'ListT' transformer is depreciated {-# OPTIONS_GHC -Wno-deprecations #-} module Control.Algebra.Free ( -- Higher free algebra class FreeAlgebra1 (..) -- ** Type level witnesses , Proof (..) -- ** Higher algebra type \/ constraints , AlgebraType0 , AlgebraType -- * Combinators , wrapFree , foldFree1 , unFoldNatFree , hoistFree1 , hoistFreeH , joinFree1 , bindFree1 , assocFree1 , iterFree1 , cataFree1 -- * Day convolution , DayF (..) , dayToAp , apToDay -- * Free construction in continuation passing style , Free1 (..) -- * Various classes (higher algebra types) , MonadList (..) , MonadMaybe (..) ) where import Control.Applicative ( Alternative (..) #if __GLASGOW_HASKELL__ >= 806 , liftA2 #endif ) import Control.Applicative.Free (Ap) import qualified Control.Applicative.Free as Ap import qualified Control.Applicative.Free.Fast as Fast import qualified Control.Applicative.Free.Final as Final import Control.Alternative.Free (Alt (..)) import qualified Control.Alternative.Free as Alt #if __GLASGOW_HASKELL__ >= 806 import Control.Monad ( MonadPlus (..), foldM, join) #else import Control.Monad ( foldM, join) #endif import Control.Monad.Except (ExceptT (..), MonadError (..)) import Control.Monad.Free (Free) import qualified Control.Monad.Free as Free import qualified Control.Monad.Free.Church as Church import Control.Monad.List (ListT (..)) import Control.Monad.Reader (MonadReader (..), ReaderT (..)) import Control.Monad.RWS.Class (MonadRWS) import Control.Monad.RWS.Lazy as L (RWST (..)) import Control.Monad.RWS.Strict as S (RWST (..)) import Control.Monad.State.Class (MonadState (..)) import qualified Control.Monad.State.Lazy as L (StateT (..)) import qualified Control.Monad.State.Strict as S (StateT (..)) import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Trans.Maybe (MaybeT (..)) import Control.Monad.Writer.Class (MonadWriter (..)) import qualified Control.Monad.Writer.Lazy as L (WriterT (..)) import qualified Control.Monad.Writer.Strict as S (WriterT (..)) #if __GLASGOW_HASKELL__ >= 806 import Control.Monad.Zip (MonadZip (..)) #endif import Data.Kind (Constraint, Type) import Data.Fix (Fix, cataM) import Data.Functor.Coyoneda (Coyoneda (..), liftCoyoneda) import Data.Functor.Day (Day (..)) import qualified Data.Functor.Day as Day import Data.Functor.Identity (Identity (..)) import Data.Algebra.Free (AlgebraType, AlgebraType0, Proof (..)) -- | Higher kinded version of @'FreeAlgebra'@. Instances includes free functors, -- free applicative functors, free monads, state monads etc. -- -- A lawful instance should guarantee that @'foldNatFree'@ is an isomorphism -- with inverses @'unFoldNatFree'@. -- -- This guaranties that @m@ is a left adjoint functor from the category of -- types of kind @Type -> Type@ which satisfy @'AlgebraType0' m@ constraint, to the -- category of types of kind @Type -> Type@ which satisfy the @'AlgebraType' m@ -- constraint. This functor is left adjoin to the forgetful functor (which is -- well defined if the laws on @'AlgebraType0'@ family are satisfied. This in -- turn guarantees that @m@ composed with this forgetful functor is a monad. -- In result we get monadic operations: -- -- * @return = 'liftFree'@ -- * @(>>=) = 'bindFree1'@ -- * @join = 'joinFree1'@ -- -- For @m@ such that @'AlgebraType0'@ subsumes @'Monad'@ this class implies: -- -- * @MFunctor@ via @hoist = hoistFree1@ -- * @MMonad@ via @embed = flip bindFree1@ -- * @MonadTrans@ via @lift = liftFree@ -- class FreeAlgebra1 (m :: (k -> Type) -> k -> Type) where {-# MINIMAL liftFree, foldNatFree #-} -- | Natural transformation that embeds generators into @m@. liftFree :: AlgebraType0 m f => f a -> m f a -- | The freeness property. -- -- prop> foldNatFree nat (liftFree m) = nat m -- prop> foldNatFree nat . foldNatFree nat' = foldNatFree (foldNatFree nat . nat') -- foldNatFree :: forall d f a . ( AlgebraType m d , AlgebraType0 m f ) => (forall x. f x -> d x) -- ^ a natural transformation which embeds generators of @m@ into @d@ -> (m f a -> d a) -- ^ a morphism from @m f@ to @d@ -- | A proof that @'AlgebraType' m (m f)@ holds for all @AlgebraType0 f => f@. -- Together with @'hoistFree1'@ this proves that @FreeAlgebra m => m@ is -- a functor from the full subcategory of types of kind @Type -> Type@ -- which satisfy @'AlgebraType0' m f@ to ones that satisfy @'AlgebraType' -- m f@. -- codom1 :: forall f. AlgebraType0 m f => Proof (AlgebraType m (m f)) (m f) default codom1 :: forall a. AlgebraType m (m a) => Proof (AlgebraType m (m a)) (m a) codom1 = Proof (AlgebraType m (m a)) (m a) forall l (c :: Constraint) (a :: l). c => Proof c a Proof -- | A proof that the forgetful functor from the full subcategory of types of -- kind @Type -> Type@ satisfying @'AlgebraType' m f@ constraint to types -- satisfying @'AlgebraType0' m f@ is well defined. -- forget1 :: forall f. AlgebraType m f => Proof (AlgebraType0 m f) (m f) default forget1 :: forall a. AlgebraType0 m a => Proof (AlgebraType0 m a) (m a) forget1 = Proof (AlgebraType0 m a) (m a) forall l (c :: Constraint) (a :: l). c => Proof c a Proof -- | Anything that carries @'FreeAlgebra1'@ constraint is also an instance of -- @'Control.Monad.Free.Class.MonadFree'@, but not vice versa. You can use -- @'wrap'@ to define a @'Control.Monad.Free.Class.MonadFree'@ instance. -- @'ContT'@ is an example of a monad which does have an @'FreeAlgebra1'@ -- instance, but has an @'MonadFree'@ instance. -- -- The @'Monad'@ constrain will be satisfied for many monads through the -- @'AlgebraType m'@ constraint. -- wrapFree :: forall (m :: (Type -> Type) -> Type -> Type) (f :: Type -> Type) a . ( FreeAlgebra1 m , AlgebraType0 m f , Monad (m f) ) => f (m f a) -> m f a wrapFree :: f (m f a) -> m f a wrapFree = m f (m f a) -> m f a forall (m :: * -> *) a. Monad m => m (m a) -> m a join (m f (m f a) -> m f a) -> (f (m f a) -> m f (m f a)) -> f (m f a) -> m f a forall b c a. (b -> c) -> (a -> b) -> a -> c . f (m f a) -> m f (m f a) forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType0 m f) => f a -> m f a liftFree {-# INLINABLE wrapFree #-} -- | @'FreeAlgebra1' m@ implies that @m f@ is a foldable. -- -- @ -- 'foldFree1' . 'liftFree' == 'id' :: f a -> f a -- @ -- -- @foldFree1@ is the -- [unit](https://ncatlab.org/nlab/show/unit+of+an+adjunction) of the -- adjunction imposed by @FreeAlgebra1@ constraint. -- -- It can be specialized to: -- -- * @'Data.Functor.Coyoneda.lowerCoyoneda' :: 'Functor' f => 'Coyoneda' f a -> f a@ -- * @'Control.Applicative.Free.retractAp' :: 'Applicative' f => 'Ap' f a -> f a@ -- * @'Control.Monad.Free.retract' :: 'Monad' f => 'Free' f a -> f a@ -- foldFree1 :: forall m f a . ( FreeAlgebra1 m , AlgebraType m f ) => m f a -> f a foldFree1 :: m f a -> f a foldFree1 = case Proof (AlgebraType0 m f) (m f) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType m f) => Proof (AlgebraType0 m f) (m f) forget1 :: Proof (AlgebraType0 m f) (m f) of Proof (AlgebraType0 m f) (m f) Proof -> (forall (x :: k). f x -> f x) -> m f a -> f a forall k (m :: (k -> *) -> k -> *) (d :: k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m d, AlgebraType0 m f) => (forall (x :: k). f x -> d x) -> m f a -> d a foldNatFree forall (x :: k). f x -> f x forall a. a -> a id {-# INLINABLE foldFree1 #-} -- | @'unFoldNatFree'@ is an inverse of @'foldNatFree'@ -- -- It is uniquelly determined by its universal property (by Yonneda lemma): -- -- prop> unFoldNatFree id = ruturnFree1 -- -- Note that @'unFoldNatFree' id@ is the -- [unit](https://ncatlab.org/nlab/show/unit+of+an+adjunction) of the -- adjunction imposed by the @'FreeAlgebra1'@ constraint. -- unFoldNatFree :: ( FreeAlgebra1 m , AlgebraType0 m f ) => (forall x . m f x -> d x) -> f a -> d a unFoldNatFree :: (forall (x :: k). m f x -> d x) -> f a -> d a unFoldNatFree forall (x :: k). m f x -> d x nat = m f a -> d a forall (x :: k). m f x -> d x nat (m f a -> d a) -> (f a -> m f a) -> f a -> d a forall b c a. (b -> c) -> (a -> b) -> a -> c . f a -> m f a forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType0 m f) => f a -> m f a liftFree -- | This is a functor instance for @m@ when considered as an endofuctor of some -- subcategory of @Type -> Type@ (e.g. endofunctors of /Hask/) and it satisfies -- the functor laws: -- -- prop> hoistFree1 id = id -- prop> hoistFree1 f . hoistFree1 g = hoistFree1 (f . g) -- -- It can be specialized to: -- -- * @'Control.Applicative.Free.hoistAp' :: (forall a. f a -> g a) -> 'Ap' f b -> 'Ap' g b @ -- * @'Control.Monad.Free.hoistFree' :: 'Functor' g => (forall a. f a -> g a) -> 'Free' f b -> 'Free' g b@ -- * @Control.Monad.Morph.hoist@ for @'FreeAlgebra1' m => m@ such that -- @'AlgebraType0' m@ subsumes @Monad m@, e.g. -- @'Control.Monad.State.Lazy.StateT'@, @'Control.Monad.Writer.Lazy.WriterT'@ -- or @'Control.Monad.Reader.ReaderT'@. -- hoistFree1 :: forall m f g a . ( FreeAlgebra1 m , AlgebraType0 m g , AlgebraType0 m f ) => (forall x. f x -> g x) -- ^ a natural transformation @f ~> g@ -> m f a -> m g a hoistFree1 :: (forall (x :: k). f x -> g x) -> m f a -> m g a hoistFree1 forall (x :: k). f x -> g x nat = case Proof (AlgebraType m (m g)) (m g) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType0 m f) => Proof (AlgebraType m (m f)) (m f) codom1 :: Proof (AlgebraType m (m g)) (m g) of Proof (AlgebraType m (m g)) (m g) Proof -> (forall (x :: k). f x -> m g x) -> m f a -> m g a forall k (m :: (k -> *) -> k -> *) (d :: k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m d, AlgebraType0 m f) => (forall (x :: k). f x -> d x) -> m f a -> d a foldNatFree (g x -> m g x forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType0 m f) => f a -> m f a liftFree (g x -> m g x) -> (f x -> g x) -> f x -> m g x forall b c a. (b -> c) -> (a -> b) -> a -> c . f x -> g x forall (x :: k). f x -> g x nat) {-# INLINABLE [1] hoistFree1 #-} {-# RULES "hositFree1/foldNatFree" forall (nat :: forall (x :: k). g x -> c x) (nat0 :: forall (x :: k). f x -> g x) (f :: m f a). foldNatFree nat (hoistFree1 nat0 f) = foldNatFree (nat . nat0) f #-} -- | -- @ -- 'hoistFreeH' . 'hoistFreeH' = 'hoistFreeH' -- @ -- -- and when @'FreeAlgebra1' m ~ 'FreeAlgebra1' n@: -- -- @ -- 'hoistFreeH' = 'id' -- @ hoistFreeH :: forall m n f a . ( FreeAlgebra1 m , FreeAlgebra1 n , AlgebraType0 m f , AlgebraType0 n f , AlgebraType m (n f) ) => m f a -> n f a hoistFreeH :: m f a -> n f a hoistFreeH = (forall (x :: k). f x -> n f x) -> m f a -> n f a forall k (m :: (k -> *) -> k -> *) (d :: k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m d, AlgebraType0 m f) => (forall (x :: k). f x -> d x) -> m f a -> d a foldNatFree forall (x :: k). f x -> n f x forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType0 m f) => f a -> m f a liftFree {-# INLINABLE [1] hoistFreeH #-} {-# RULES "hoistFreeH/foldNatFree" forall (nat :: forall (x :: k). f x -> c x) (f :: AlgebraType m c => m f a). foldNatFree nat (hoistFreeH f) = foldNatFree nat f #-} -- | @'joinFree1'@ makes @m@ a monad in some subcatgory of types of kind @Type -> Type@ -- (usually the endo-functor category of @Hask@). It is just a specialization -- of @'foldFree1'@. -- joinFree1 :: forall m f a . ( FreeAlgebra1 m , AlgebraType0 m f ) => m (m f) a -> m f a joinFree1 :: m (m f) a -> m f a joinFree1 = case Proof (AlgebraType m (m f)) (m f) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType0 m f) => Proof (AlgebraType m (m f)) (m f) codom1 :: Proof (AlgebraType m (m f)) (m f) of Proof (AlgebraType m (m f)) (m f) Proof -> case Proof (AlgebraType0 m (m f)) (m (m f)) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType m f) => Proof (AlgebraType0 m f) (m f) forget1 :: Proof (AlgebraType0 m (m f)) (m (m f)) of Proof (AlgebraType0 m (m f)) (m (m f)) Proof -> m (m f) a -> m f a forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m f) => m f a -> f a foldFree1 {-# INLINABLE joinFree1 #-} -- | Bind operator for the @'joinFree1'@ monad, this is just @'foldNatFree'@ in -- disguise. -- -- For @'Control.Monad.State.Lazy.StateT'@, -- @'Control.Monad.Writer.Lazy.WriterT'@ or -- @'Control.Monad.Reader.Lazy.ReaderT'@ (or any @'FreeAlgebra1' m => m@ such -- that @'AlgebraType0' m@ subsumes @'Monad' m@), this is the @>>=@ version of -- @Control.Monad.Morph.embed@. -- bindFree1 :: forall m f g a . ( FreeAlgebra1 m , AlgebraType0 m g , AlgebraType0 m f ) => m f a -> (forall x . f x -> m g x) -- ^ natural transformation @f ~> m g@ -> m g a bindFree1 :: m f a -> (forall (x :: k). f x -> m g x) -> m g a bindFree1 m f a mfa forall (x :: k). f x -> m g x nat = case Proof (AlgebraType m (m g)) (m g) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType0 m f) => Proof (AlgebraType m (m f)) (m f) codom1 :: Proof (AlgebraType m (m g)) (m g) of Proof (AlgebraType m (m g)) (m g) Proof -> (forall (x :: k). f x -> m g x) -> m f a -> m g a forall k (m :: (k -> *) -> k -> *) (d :: k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m d, AlgebraType0 m f) => (forall (x :: k). f x -> d x) -> m f a -> d a foldNatFree forall (x :: k). f x -> m g x nat m f a mfa {-# INLINABLE bindFree1 #-} assocFree1 :: forall m f a . ( FreeAlgebra1 m , AlgebraType m f , Functor (m (m f)) ) => m f (m f a) -> m (m f) (f a) assocFree1 :: m f (m f a) -> m (m f) (f a) assocFree1 = case Proof (AlgebraType0 m f) (m f) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType m f) => Proof (AlgebraType0 m f) (m f) forget1 :: Proof (AlgebraType0 m f) (m f) of Proof (AlgebraType0 m f) (m f) Proof -> case Proof (AlgebraType m (m f)) (m f) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType0 m f) => Proof (AlgebraType m (m f)) (m f) codom1 :: Proof (AlgebraType m (m f)) (m f) of Proof (AlgebraType m (m f)) (m f) Proof -> case Proof (AlgebraType0 m (m f)) (m (m f)) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType m f) => Proof (AlgebraType0 m f) (m f) forget1 :: Proof (AlgebraType0 m (m f)) (m (m f)) of Proof (AlgebraType0 m (m f)) (m (m f)) Proof -> case Proof (AlgebraType m (m (m f))) (m (m f)) forall k (m :: (k -> *) -> k -> *) (f :: k -> *). (FreeAlgebra1 m, AlgebraType0 m f) => Proof (AlgebraType m (m f)) (m f) codom1 :: Proof (AlgebraType m (m (m f))) (m (m f)) of Proof (AlgebraType m (m (m f))) (m (m f)) Proof -> (m f a -> f a) -> m (m f) (m f a) -> m (m f) (f a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap m f a -> f a forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m f) => m f a -> f a foldFree1 (m (m f) (m f a) -> m (m f) (f a)) -> (m f (m f a) -> m (m f) (m f a)) -> m f (m f a) -> m (m f) (f a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall x. f x -> m (m f) x) -> m f (m f a) -> m (m f) (m f a) forall k (m :: (k -> *) -> k -> *) (d :: k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m d, AlgebraType0 m f) => (forall (x :: k). f x -> d x) -> m f a -> d a foldNatFree ((forall x. f x -> m f x) -> m f x -> m (m f) x forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType0 m g, AlgebraType0 m f) => (forall (x :: k). f x -> g x) -> m f a -> m g a hoistFree1 forall x. f x -> m f x forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType0 m f) => f a -> m f a liftFree (m f x -> m (m f) x) -> (f x -> m f x) -> f x -> m (m f) x forall b c a. (b -> c) -> (a -> b) -> a -> c . f x -> m f x forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType0 m f) => f a -> m f a liftFree) {-# INLINABLE assocFree1 #-} -- | @'Fix' (m f)@ is the initial /algebra/ of type @'AlgebraType' m@ and -- @'AlgebraType0' f@. -- cataFree1 :: forall m f a . ( FreeAlgebra1 m , AlgebraType m f , Monad f , Traversable (m f) ) => Fix (m f) -> f a cataFree1 :: Fix (m f) -> f a cataFree1 = (m f a -> f a) -> Fix (m f) -> f a forall (m :: * -> *) (t :: * -> *) a. (Monad m, Traversable t) => (t a -> m a) -> Fix t -> m a cataM m f a -> f a forall k (m :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m f) => m f a -> f a foldFree1 -- | Specialization of @'foldNatFree' \@_ \@'Identity'@; it will further specialize to: -- -- * @\\_ -> 'runIdentity' . 'Data.Functor.Coyoneda.lowerCoyoneda'@ -- * @'Control.Applicative.Free.iterAp' :: 'Functor' g => (g a -> a) -> 'Ap' g a -> a@ -- * @'Control.Monad.Free.iter' :: 'Functor' f => (f a -> a) -> 'Free' f a -> a@ -- iterFree1 :: forall m f a . ( FreeAlgebra1 m , AlgebraType0 m f , AlgebraType m Identity ) => (forall x . f x -> x) -> m f a -> a iterFree1 :: (forall x. f x -> x) -> m f a -> a iterFree1 forall x. f x -> x f = Identity a -> a forall a. Identity a -> a runIdentity (Identity a -> a) -> (m f a -> Identity a) -> m f a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall x. f x -> Identity x) -> m f a -> Identity a forall k (m :: (k -> *) -> k -> *) (d :: k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, AlgebraType m d, AlgebraType0 m f) => (forall (x :: k). f x -> d x) -> m f a -> d a foldNatFree (x -> Identity x forall a. a -> Identity a Identity (x -> Identity x) -> (f x -> x) -> f x -> Identity x forall b c a. (b -> c) -> (a -> b) -> a -> c . f x -> x forall x. f x -> x f) {-# INLINABLE iterFree1 #-} -- Instances -- | Algebras of the same type as @'Coyoneda'@ are all functors. -- type instance AlgebraType0 Coyoneda g = () type instance AlgebraType Coyoneda g = Functor g instance FreeAlgebra1 Coyoneda where liftFree :: f a -> Coyoneda f a liftFree = f a -> Coyoneda f a forall (f :: * -> *) a. f a -> Coyoneda f a liftCoyoneda foldNatFree :: (forall x. f x -> d x) -> Coyoneda f a -> d a foldNatFree forall x. f x -> d x nat (Coyoneda b -> a ba f b fx) = b -> a ba (b -> a) -> d b -> d a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f b -> d b forall x. f x -> d x nat f b fx -- | Algebras of the same type as @'Ap'@ are the applicative functors. -- type instance AlgebraType0 Ap g = Functor g type instance AlgebraType Ap g = Applicative g -- | @'Ap'@ is a free in the class of applicative functors, over any functor -- (@'Ap' f@ is applicative whenever @f@ is a functor) -- instance FreeAlgebra1 Ap where liftFree :: f a -> Ap f a liftFree = f a -> Ap f a forall (f :: * -> *) a. f a -> Ap f a Ap.liftAp foldNatFree :: (forall x. f x -> d x) -> Ap f a -> d a foldNatFree = (forall x. f x -> d x) -> Ap f a -> d a forall (g :: * -> *) (f :: * -> *) a. Applicative g => (forall x. f x -> g x) -> Ap f a -> g a Ap.runAp type instance AlgebraType0 Fast.Ap g = Functor g type instance AlgebraType Fast.Ap g = Applicative g instance FreeAlgebra1 Fast.Ap where liftFree :: f a -> Ap f a liftFree = f a -> Ap f a forall (f :: * -> *) a. f a -> Ap f a Fast.liftAp foldNatFree :: (forall x. f x -> d x) -> Ap f a -> d a foldNatFree = (forall x. f x -> d x) -> Ap f a -> d a forall (g :: * -> *) (f :: * -> *) a. Applicative g => (forall x. f x -> g x) -> Ap f a -> g a Fast.runAp type instance AlgebraType0 Final.Ap g = Functor g type instance AlgebraType Final.Ap g = Applicative g instance FreeAlgebra1 Final.Ap where liftFree :: f a -> Ap f a liftFree = f a -> Ap f a forall (f :: * -> *) a. f a -> Ap f a Final.liftAp foldNatFree :: (forall x. f x -> d x) -> Ap f a -> d a foldNatFree = (forall x. f x -> d x) -> Ap f a -> d a forall (g :: * -> *) (f :: * -> *) a. Applicative g => (forall x. f x -> g x) -> Ap f a -> g a Final.runAp -- | @'Day' f f@ newtype wrapper. It is isomorphic with @'Ap' f@ for -- applicative functors @f@ via @'dayToAp'@ (and @'apToDay'@). -- newtype DayF f a = DayF { DayF f a -> Day f f a runDayF :: Day f f a} deriving (a -> DayF f b -> DayF f a (a -> b) -> DayF f a -> DayF f b (forall a b. (a -> b) -> DayF f a -> DayF f b) -> (forall a b. a -> DayF f b -> DayF f a) -> Functor (DayF f) forall a b. a -> DayF f b -> DayF f a forall a b. (a -> b) -> DayF f a -> DayF f b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f forall (f :: * -> *) a b. a -> DayF f b -> DayF f a forall (f :: * -> *) a b. (a -> b) -> DayF f a -> DayF f b <$ :: a -> DayF f b -> DayF f a $c<$ :: forall (f :: * -> *) a b. a -> DayF f b -> DayF f a fmap :: (a -> b) -> DayF f a -> DayF f b $cfmap :: forall (f :: * -> *) a b. (a -> b) -> DayF f a -> DayF f b Functor, Functor (DayF f) a -> DayF f a Functor (DayF f) -> (forall a. a -> DayF f a) -> (forall a b. DayF f (a -> b) -> DayF f a -> DayF f b) -> (forall a b c. (a -> b -> c) -> DayF f a -> DayF f b -> DayF f c) -> (forall a b. DayF f a -> DayF f b -> DayF f b) -> (forall a b. DayF f a -> DayF f b -> DayF f a) -> Applicative (DayF f) DayF f a -> DayF f b -> DayF f b DayF f a -> DayF f b -> DayF f a DayF f (a -> b) -> DayF f a -> DayF f b (a -> b -> c) -> DayF f a -> DayF f b -> DayF f c forall a. a -> DayF f a forall a b. DayF f a -> DayF f b -> DayF f a forall a b. DayF f a -> DayF f b -> DayF f b forall a b. DayF f (a -> b) -> DayF f a -> DayF f b forall a b c. (a -> b -> c) -> DayF f a -> DayF f b -> DayF f c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f forall (f :: * -> *). Applicative f => Functor (DayF f) forall (f :: * -> *) a. Applicative f => a -> DayF f a forall (f :: * -> *) a b. Applicative f => DayF f a -> DayF f b -> DayF f a forall (f :: * -> *) a b. Applicative f => DayF f a -> DayF f b -> DayF f b forall (f :: * -> *) a b. Applicative f => DayF f (a -> b) -> DayF f a -> DayF f b forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> DayF f a -> DayF f b -> DayF f c <* :: DayF f a -> DayF f b -> DayF f a $c<* :: forall (f :: * -> *) a b. Applicative f => DayF f a -> DayF f b -> DayF f a *> :: DayF f a -> DayF f b -> DayF f b $c*> :: forall (f :: * -> *) a b. Applicative f => DayF f a -> DayF f b -> DayF f b liftA2 :: (a -> b -> c) -> DayF f a -> DayF f b -> DayF f c $cliftA2 :: forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> DayF f a -> DayF f b -> DayF f c <*> :: DayF f (a -> b) -> DayF f a -> DayF f b $c<*> :: forall (f :: * -> *) a b. Applicative f => DayF f (a -> b) -> DayF f a -> DayF f b pure :: a -> DayF f a $cpure :: forall (f :: * -> *) a. Applicative f => a -> DayF f a $cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (DayF f) Applicative) dayToAp :: Applicative f => Day f f a -> Ap f a dayToAp :: Day f f a -> Ap f a dayToAp = DayF f a -> Ap f a forall k (m :: (k -> *) -> k -> *) (n :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, FreeAlgebra1 n, AlgebraType0 m f, AlgebraType0 n f, AlgebraType m (n f)) => m f a -> n f a hoistFreeH (DayF f a -> Ap f a) -> (Day f f a -> DayF f a) -> Day f f a -> Ap f a forall b c a. (b -> c) -> (a -> b) -> a -> c . Day f f a -> DayF f a forall (f :: * -> *) a. Day f f a -> DayF f a DayF apToDay :: Applicative f => Ap f a -> Day f f a apToDay :: Ap f a -> Day f f a apToDay = DayF f a -> Day f f a forall (f :: * -> *) a. DayF f a -> Day f f a runDayF (DayF f a -> Day f f a) -> (Ap f a -> DayF f a) -> Ap f a -> Day f f a forall b c a. (b -> c) -> (a -> b) -> a -> c . Ap f a -> DayF f a forall k (m :: (k -> *) -> k -> *) (n :: (k -> *) -> k -> *) (f :: k -> *) (a :: k). (FreeAlgebra1 m, FreeAlgebra1 n, AlgebraType0 m f, AlgebraType0 n f, AlgebraType m (n f)) => m f a -> n f a hoistFreeH -- | Algebras of the same type as @'DayF'@ are all the applicative functors. -- type instance AlgebraType0 DayF g = Applicative g type instance AlgebraType DayF g = Applicative g -- | @'DayF'@, as @'Ap'@ is a free applicative functor, but over applicative functors -- (@'DayF' f@ is applicative if @f@ is an applicative functor). -- instance FreeAlgebra1 DayF where liftFree :: f a -> DayF f a liftFree f a fa = Day f f a -> DayF f a forall (f :: * -> *) a. Day f f a -> DayF f a DayF (Day f f a -> DayF f a) -> Day f f a -> DayF f a forall a b. (a -> b) -> a -> b $ f a -> f a -> (a -> a -> a) -> Day f f a forall (f :: * -> *) (g :: * -> *) a b c. f b -> g c -> (b -> c -> a) -> Day f g a Day f a fa f a fa a -> a -> a forall a b. a -> b -> a const foldNatFree :: (forall x. f x -> d x) -> DayF f a -> d a foldNatFree forall x. f x -> d x nat (DayF Day f f a day) = Day d d a -> d a forall (f :: * -> *) a. Applicative f => Day f f a -> f a Day.dap (Day d d a -> d a) -> (Day f f a -> Day d d a) -> Day f f a -> d a forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall x. f x -> d x) -> Day d f a -> Day d d a forall (g :: * -> *) (h :: * -> *) (f :: * -> *) a. (forall x. g x -> h x) -> Day f g a -> Day f h a Day.trans2 forall x. f x -> d x nat (Day d f a -> Day d d a) -> (Day f f a -> Day d f a) -> Day f f a -> Day d d a forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall x. f x -> d x) -> Day f f a -> Day d f a forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a. (forall x. f x -> g x) -> Day f h a -> Day g h a Day.trans1 forall x. f x -> d x nat (Day f f a -> d a) -> Day f f a -> d a forall a b. (a -> b) -> a -> b $ Day f f a day -- | Algebras of the same type as @'Free'@ monad is the class of all monads. -- type instance AlgebraType0 Free f = Functor f type instance AlgebraType Free m = Monad m -- | @'Free'@ monad is free in the class of monad over the class of functors. -- instance FreeAlgebra1 Free where liftFree :: f a -> Free f a liftFree = f a -> Free f a forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a Free.liftF foldNatFree :: (forall x. f x -> d x) -> Free f a -> d a foldNatFree = (forall x. f x -> d x) -> Free f a -> d a forall (m :: * -> *) (f :: * -> *) a. Monad m => (forall x. f x -> m x) -> Free f a -> m a Free.foldFree type instance AlgebraType0 Church.F f = Functor f type instance AlgebraType Church.F m = Monad m instance FreeAlgebra1 Church.F where liftFree :: f a -> F f a liftFree = f a -> F f a forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a Church.liftF foldNatFree :: (forall x. f x -> d x) -> F f a -> d a foldNatFree = (forall x. f x -> d x) -> F f a -> d a forall (m :: * -> *) (f :: * -> *) a. Monad m => (forall x. f x -> m x) -> F f a -> m a Church.foldF type instance AlgebraType0 Alt f = Functor f type instance AlgebraType Alt m = Alternative m instance FreeAlgebra1 Alt where liftFree :: f a -> Alt f a liftFree = f a -> Alt f a forall (f :: * -> *) a. f a -> Alt f a Alt.liftAlt foldNatFree :: (forall x. f x -> d x) -> Alt f a -> d a foldNatFree = (forall x. f x -> d x) -> Alt f a -> d a forall (f :: * -> *) (g :: * -> *) a. Alternative g => (forall x. f x -> g x) -> Alt f a -> g a Alt.runAlt -- | Algebras of the same type as @'L.StateT'@ monad is the class of all state -- monads. -- type instance AlgebraType0 (L.StateT s) m = Monad m type instance AlgebraType (L.StateT s) m = ( MonadState s m ) -- | Lazy @'L.StateT'@ monad transformer is a free algebra in the class of monads -- which satisfy the @'MonadState'@ constraint. Note that this instance -- captures that @'L.StateT' s@ is a monad transformer: -- -- @ -- 'liftFree' = 'lift' -- @ -- -- This is also true for all the other monad transformers. -- instance FreeAlgebra1 (L.StateT s) where liftFree :: f a -> StateT s f a liftFree = f a -> StateT s f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> StateT s f a -> d a foldNatFree forall x. f x -> d x nat StateT s f a ma = do (a a, s s) <- d s forall s (m :: * -> *). MonadState s m => m s get d s -> (s -> d (a, s)) -> d (a, s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= f (a, s) -> d (a, s) forall x. f x -> d x nat (f (a, s) -> d (a, s)) -> (s -> f (a, s)) -> s -> d (a, s) forall b c a. (b -> c) -> (a -> b) -> a -> c . StateT s f a -> s -> f (a, s) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) L.runStateT StateT s f a ma s -> d () forall s (m :: * -> *). MonadState s m => s -> m () put s s a -> d a forall (m :: * -> *) a. Monad m => a -> m a return a a -- | Algebras of the same type as @'S.StateT'@ monad is the class of all state -- monads. -- type instance AlgebraType0 (S.StateT s) m = Monad m type instance AlgebraType (S.StateT s) m = ( MonadState s m ) -- | Strict @'S.StateT'@ monad transformer is also a free algebra, thus -- @'hoistFreeH'@ is an isomorphism between the strict and lazy versions. -- instance FreeAlgebra1 (S.StateT s) where liftFree :: Monad m => m a -> S.StateT s m a liftFree :: m a -> StateT s m a liftFree = m a -> StateT s m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> StateT s f a -> d a foldNatFree forall x. f x -> d x nat StateT s f a ma = do (a a, s s) <- d s forall s (m :: * -> *). MonadState s m => m s get d s -> (s -> d (a, s)) -> d (a, s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= f (a, s) -> d (a, s) forall x. f x -> d x nat (f (a, s) -> d (a, s)) -> (s -> f (a, s)) -> s -> d (a, s) forall b c a. (b -> c) -> (a -> b) -> a -> c . StateT s f a -> s -> f (a, s) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) S.runStateT StateT s f a ma s -> d () forall s (m :: * -> *). MonadState s m => s -> m () put s s a -> d a forall (m :: * -> *) a. Monad m => a -> m a return a a -- | Algebras of the same type as @'L.WriterT'@ monad is the class of all -- writer monads. -- type instance AlgebraType0 (L.WriterT w) m = ( Monad m, Monoid w ) type instance AlgebraType (L.WriterT w) m = ( MonadWriter w m ) -- | Lazy @'L.WriterT'@ is free for algebras of type @'MonadWriter'@. -- instance FreeAlgebra1 (L.WriterT w) where liftFree :: f a -> WriterT w f a liftFree = f a -> WriterT w f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> WriterT w f a -> d a foldNatFree forall x. f x -> d x nat (L.WriterT f (a, w) m) = (a, w) -> a forall a b. (a, b) -> a fst ((a, w) -> a) -> d (a, w) -> d a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (a, w) -> d (a, w) forall x. f x -> d x nat f (a, w) m -- | Algebras of the same type as @'S.WriterT'@ monad is the class of all -- writer monads. -- type instance AlgebraType0 (S.WriterT w) m = ( Monad m, Monoid w ) type instance AlgebraType (S.WriterT w) m = ( MonadWriter w m ) -- | Strict @'S.WriterT'@ monad transformer is a free algebra among all -- @'MonadWriter'@s. -- instance FreeAlgebra1 (S.WriterT w) where liftFree :: f a -> WriterT w f a liftFree = f a -> WriterT w f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> WriterT w f a -> d a foldNatFree forall x. f x -> d x nat (S.WriterT f (a, w) m) = (a, w) -> a forall a b. (a, b) -> a fst ((a, w) -> a) -> d (a, w) -> d a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (a, w) -> d (a, w) forall x. f x -> d x nat f (a, w) m -- | Algebras of the same type as @'L.ReaderT'@ monad is the class of all -- reader monads. -- -- TODO: take advantage of poly-kinded `ReaderT` -- type instance AlgebraType0 (ReaderT r) m = ( Monad m ) type instance AlgebraType (ReaderT r) m = ( MonadReader r m ) -- | @'ReaderT'@ is a free monad in the class of all @'MonadReader'@ monads. -- instance FreeAlgebra1 (ReaderT r :: (Type -> Type) -> Type -> Type) where liftFree :: f a -> ReaderT r f a liftFree = f a -> ReaderT r f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> ReaderT r f a -> d a foldNatFree forall x. f x -> d x nat (ReaderT r -> f a g) = d r forall r (m :: * -> *). MonadReader r m => m r ask d r -> (r -> d a) -> d a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= f a -> d a forall x. f x -> d x nat (f a -> d a) -> (r -> f a) -> r -> d a forall b c a. (b -> c) -> (a -> b) -> a -> c . r -> f a g -- | Algebras of the same type as @'S.ReaderT'@ monad is the class of all -- reader monads. -- type instance AlgebraType0 (ExceptT e) m = ( Monad m ) type instance AlgebraType (ExceptT e) m = ( MonadError e m ) -- | @'ExceptT' e@ is a free algebra among all @'MonadError' e@ monads. -- instance FreeAlgebra1 (ExceptT e) where liftFree :: f a -> ExceptT e f a liftFree = f a -> ExceptT e f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> ExceptT e f a -> d a foldNatFree forall x. f x -> d x nat (ExceptT f (Either e a) m) = do Either e a ea <- f (Either e a) -> d (Either e a) forall x. f x -> d x nat f (Either e a) m case Either e a ea of Left e e -> e -> d a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError e e Right a a -> a -> d a forall (m :: * -> *) a. Monad m => a -> m a return a a type instance AlgebraType0 (L.RWST r w s) m = ( Monad m, Monoid w ) type instance AlgebraType (L.RWST r w s) m = MonadRWS r w s m instance FreeAlgebra1 (L.RWST r w s) where liftFree :: f a -> RWST r w s f a liftFree = f a -> RWST r w s f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> RWST r w s f a -> d a foldNatFree forall x. f x -> d x nat (L.RWST r -> s -> f (a, s, w) fn) = do r r <- d r forall r (m :: * -> *). MonadReader r m => m r ask s s <- d s forall s (m :: * -> *). MonadState s m => m s get (a a, s s', w w) <- f (a, s, w) -> d (a, s, w) forall x. f x -> d x nat (f (a, s, w) -> d (a, s, w)) -> f (a, s, w) -> d (a, s, w) forall a b. (a -> b) -> a -> b $ r -> s -> f (a, s, w) fn r r s s s -> d () forall s (m :: * -> *). MonadState s m => s -> m () put s s' w -> d () forall w (m :: * -> *). MonadWriter w m => w -> m () tell w w a -> d a forall (m :: * -> *) a. Monad m => a -> m a return a a type instance AlgebraType0 (S.RWST r w s) m = ( Monad m, Monoid w ) type instance AlgebraType (S.RWST r w s) m = MonadRWS r w s m instance FreeAlgebra1 (S.RWST r w s) where liftFree :: f a -> RWST r w s f a liftFree = f a -> RWST r w s f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> RWST r w s f a -> d a foldNatFree forall x. f x -> d x nat (S.RWST r -> s -> f (a, s, w) fn) = do r r <- d r forall r (m :: * -> *). MonadReader r m => m r ask s s <- d s forall s (m :: * -> *). MonadState s m => m s get (a a, s s', w w) <- f (a, s, w) -> d (a, s, w) forall x. f x -> d x nat (f (a, s, w) -> d (a, s, w)) -> f (a, s, w) -> d (a, s, w) forall a b. (a -> b) -> a -> b $ r -> s -> f (a, s, w) fn r r s s s -> d () forall s (m :: * -> *). MonadState s m => s -> m () put s s' w -> d () forall w (m :: * -> *). MonadWriter w m => w -> m () tell w w a -> d a forall (m :: * -> *) a. Monad m => a -> m a return a a -- | Algebra type for @'ListT'@ monad transformer. -- class Monad m => MonadList m where mempty1 :: m a mappend1 :: m a -> m a -> m a mappend1_ :: MonadList m => a -> a -> m a mappend1_ :: a -> a -> m a mappend1_ a a a b = a -> m a forall (m :: * -> *) a. Monad m => a -> m a return a a m a -> m a -> m a forall (m :: * -> *) a. MonadList m => m a -> m a -> m a `mappend1` a -> m a forall (m :: * -> *) a. Monad m => a -> m a return a b {-# INLINABLE mappend1_ #-} instance Monad m => MonadList (ListT m) where mempty1 :: ListT m a mempty1 = m [a] -> ListT m a forall (m :: * -> *) a. m [a] -> ListT m a ListT ([a] -> m [a] forall (m :: * -> *) a. Monad m => a -> m a return []) mappend1 :: ListT m a -> ListT m a -> ListT m a mappend1 (ListT m [a] ma) (ListT m [a] mb) = m [a] -> ListT m a forall (m :: * -> *) a. m [a] -> ListT m a ListT (m [a] -> ListT m a) -> m [a] -> ListT m a forall a b. (a -> b) -> a -> b $ [a] -> [a] -> [a] forall a. Monoid a => a -> a -> a mappend ([a] -> [a] -> [a]) -> m [a] -> m ([a] -> [a]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m [a] ma m ([a] -> [a]) -> m [a] -> m [a] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> m [a] mb type instance AlgebraType0 ListT f = ( Monad f ) type instance AlgebraType ListT m = ( MonadList m ) instance FreeAlgebra1 ListT where liftFree :: f a -> ListT f a liftFree = f a -> ListT f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> ListT f a -> d a foldNatFree forall x. f x -> d x nat (ListT f [a] mas) = do [a] as <- f [a] -> d [a] forall x. f x -> d x nat f [a] mas a empty1 <- d a forall (m :: * -> *) a. MonadList m => m a mempty1 (a -> a -> d a) -> a -> [a] -> d a forall (t :: * -> *) (m :: * -> *) b a. (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldM (\a x a y -> a x a -> a -> d a forall (m :: * -> *) a. MonadList m => a -> a -> m a `mappend1_` a y) a empty1 [a] as -- | Free construction for kinds @'Type' -> 'Type'@. @'Free1' 'Functor'@ is -- isomorhpic to @'Coyoneda'@ via @'hoistFreeH'@, and @'Free1' 'Applicative'@ -- is isomorphic to @'Ap'@ (also via @'hoistFreeH'@). -- -- Note: useful instance are only provided for ghc-8.6 using quantified -- constraints. -- newtype Free1 (c :: (Type -> Type) -> Constraint) (f :: Type -> Type) a = Free1 { Free1 c f a -> forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a runFree1 :: forall g. c g => (forall x. f x -> g x) -> g a } #if __GLASGOW_HASKELL__ >= 806 -- -- instances for @'Free1'@ using quantified constraints -- -- | @'Free1'@ is a functor whenever @c f@ implies @'Functor' f@ . -- instance (forall h. c h => Functor h) => Functor (Free1 c f) where fmap :: forall a b. (a -> b) -> Free1 c f a -> Free1 c f b fmap :: (a -> b) -> Free1 c f a -> Free1 c f b fmap a -> b f (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g) = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (a -> b) -> g a -> g b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f ((forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g forall x. f x -> g x h) a a <$ :: a -> Free1 c f b -> Free1 c f a <$ Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> a a a -> g b -> g a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ (forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g forall x. f x -> g x h -- | @'Free1'@ is an applicative functor whenever @c f@ implies @'Applicative' -- f@. -- instance (forall h. c h => Applicative h, c (Free1 c f)) => Applicative (Free1 c f) where pure :: a -> Free1 c f a pure a a = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x _ -> a -> g a forall (f :: * -> *) a. Applicative f => a -> f a pure a a Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a -> b) f <*> :: Free1 c f (a -> b) -> Free1 c f a -> Free1 c f b <*> Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g (a -> b) forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a -> b) f forall x. f x -> g x h g (a -> b) -> g a -> g b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g forall x. f x -> g x h liftA2 :: (a -> b -> c) -> Free1 c f a -> Free1 c f b -> Free1 c f c liftA2 a -> b -> c f (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a x) (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b y) = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g c) -> Free1 c f c forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g c) -> Free1 c f c) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g c) -> Free1 c f c forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (a -> b -> c) -> g a -> g b -> g c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> b -> c f ((forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a x forall x. f x -> g x h) ((forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b y forall x. f x -> g x h) Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f *> :: Free1 c f a -> Free1 c f b -> Free1 c f b *> Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h g a -> g b -> g b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g forall x. f x -> g x h Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f <* :: Free1 c f a -> Free1 c f b -> Free1 c f a <* Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h g a -> g b -> g a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* (forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g forall x. f x -> g x h -- | @'Free1'@ is a monad whenever @c f@ implies @'Monad' f@. -- instance (forall h. c h => Monad h, c (Free1 c f)) => Monad (Free1 c f) where return :: a -> Free1 c f a return = a -> Free1 c f a forall (f :: * -> *) a. Applicative f => a -> f a pure Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f >>= :: Free1 c f a -> (a -> Free1 c f b) -> Free1 c f b >>= a -> Free1 c f b k = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h g a -> (a -> g b) -> g b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (\a a -> case a -> Free1 c f b k a a of Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b l -> (forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b l forall x. f x -> g x h) Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f >> :: Free1 c f a -> Free1 c f b -> Free1 c f b >> Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h g a -> g b -> g b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> (forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g forall x. f x -> g x h #if __GLASGOW_HASKELL__ < 808 fail s = Free1 $ \_ -> fail s #endif instance (forall h. c h => Alternative h, c (Free1 c f)) => Alternative (Free1 c f) where empty :: Free1 c f a empty = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x _ -> g a forall (f :: * -> *) a. Alternative f => f a empty Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f <|> :: Free1 c f a -> Free1 c f a -> Free1 c f a <|> Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h g a -> g a -> g a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g forall x. f x -> g x h some :: Free1 c f a -> Free1 c f [a] some (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f) = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g [a]) -> Free1 c f [a] forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g [a]) -> Free1 c f [a]) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g [a]) -> Free1 c f [a] forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> g a -> g [a] forall (f :: * -> *) a. Alternative f => f a -> f [a] some ((forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h) many :: Free1 c f a -> Free1 c f [a] many (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f) = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g [a]) -> Free1 c f [a] forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g [a]) -> Free1 c f [a]) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g [a]) -> Free1 c f [a] forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> g a -> g [a] forall (f :: * -> *) a. Alternative f => f a -> f [a] many ((forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h) instance (forall h. c h => MonadPlus h, c (Free1 c f)) => MonadPlus (Free1 c f) where mzero :: Free1 c f a mzero = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x _ -> g a forall (m :: * -> *) a. MonadPlus m => m a mzero Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f mplus :: Free1 c f a -> Free1 c f a -> Free1 c f a `mplus` Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h g a -> g a -> g a forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a `mplus` (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a g forall x. f x -> g x h instance (forall h. c h => MonadZip h, c (Free1 c f)) => MonadZip (Free1 c f) where Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f mzip :: Free1 c f a -> Free1 c f b -> Free1 c f (a, b) `mzip` Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a, b)) -> Free1 c f (a, b) forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a, b)) -> Free1 c f (a, b)) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a, b)) -> Free1 c f (a, b) forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h g a -> g b -> g (a, b) forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b) `mzip` (forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g forall x. f x -> g x h mzipWith :: (a -> b -> c) -> Free1 c f a -> Free1 c f b -> Free1 c f c mzipWith a -> b -> c k (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f) (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g) = (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g c) -> Free1 c f c forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g c) -> Free1 c f c) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g c) -> Free1 c f c forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (a -> b -> c) -> g a -> g b -> g c forall (m :: * -> *) a b c. MonadZip m => (a -> b -> c) -> m a -> m b -> m c mzipWith a -> b -> c k ((forall x. f x -> g x) -> g a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> g x h) ((forall x. f x -> g x) -> g b forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b g forall x. f x -> g x h) munzip :: Free1 c f (a, b) -> (Free1 c f a, Free1 c f b) munzip (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a, b) f) = ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (g a, g b) -> g a forall a b. (a, b) -> a fst (g (a, b) -> (g a, g b) forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b) munzip ((forall x. f x -> g x) -> g (a, b) forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a, b) f forall x. f x -> g x h)), (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g b) -> Free1 c f b forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x h -> (g a, g b) -> g b forall a b. (a, b) -> b snd (g (a, b) -> (g a, g b) forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b) munzip ((forall x. f x -> g x) -> g (a, b) forall (g :: * -> *). c g => (forall x. f x -> g x) -> g (a, b) f forall x. f x -> g x h))) type instance AlgebraType0 (Free1 c) f = () type instance AlgebraType (Free1 c) f = (c f) instance (forall f. c (Free1 c f)) => FreeAlgebra1 (Free1 c) where liftFree :: f a -> Free1 c f a liftFree = \f a fa -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall (c :: (* -> *) -> Constraint) (f :: * -> *) a. (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a Free1 ((forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a) -> (forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a) -> Free1 c f a forall a b. (a -> b) -> a -> b $ \forall x. f x -> g x g -> f a -> g a forall x. f x -> g x g f a fa foldNatFree :: (forall x. f x -> d x) -> Free1 c f a -> d a foldNatFree forall x. f x -> d x nat (Free1 forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f) = (forall x. f x -> d x) -> d a forall (g :: * -> *). c g => (forall x. f x -> g x) -> g a f forall x. f x -> d x nat #endif -- $monadContT -- -- @'ContT' r m@ is not functorial in @m@, so there is no chance it can admit -- an instance of @'FreeAlgebra1'@ -- | A higher version @'Data.Algebra.Pointed'@ class. -- -- With @'QuantifiedConstraints'@ this class will be redundant. class MonadMaybe m where point :: forall a. m a instance Monad m => MonadMaybe (MaybeT m) where point :: MaybeT m a point = m (Maybe a) -> MaybeT m a forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a MaybeT (Maybe a -> m (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return Maybe a forall a. Maybe a Nothing) type instance AlgebraType0 MaybeT m = ( Monad m ) type instance AlgebraType MaybeT m = ( Monad m, MonadMaybe m ) instance FreeAlgebra1 MaybeT where liftFree :: f a -> MaybeT f a liftFree = f a -> MaybeT f a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift foldNatFree :: (forall x. f x -> d x) -> MaybeT f a -> d a foldNatFree forall x. f x -> d x nat (MaybeT f (Maybe a) mma) = f (Maybe a) -> d (Maybe a) forall x. f x -> d x nat f (Maybe a) mma d (Maybe a) -> (Maybe a -> d a) -> d a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Maybe a ma -> case Maybe a ma of Maybe a Nothing -> d a forall k (m :: k -> *) (a :: k). MonadMaybe m => m a point Just a a -> a -> d a forall (m :: * -> *) a. Monad m => a -> m a return a a