{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# LANGUAGE
RankNTypes
, TypeOperators
, ConstraintKinds
, TemplateHaskell
, UndecidableInstances
, QuantifiedConstraints
#-}
module Data.Functor.HFree where
import Control.Applicative
import Control.Monad (join)
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Language.Haskell.TH.Syntax (Q, Name, Dec)
import Data.Functor.Free.Internal
type f :~> g = forall b. f b -> g b
newtype HFree c f a = HFree { HFree c f a -> forall (g :: * -> *). c g => (f :~> g) -> g a
runHFree :: forall g. c g => (f :~> g) -> g a }
deriveHFreeInstance :: Name -> Q [Dec]
deriveHFreeInstance :: Name -> Q [Dec]
deriveHFreeInstance = Name -> Name -> Name -> Name -> Q [Dec]
deriveFreeInstance' ''HFree 'HFree 'runHFree
unit :: f :~> HFree c f
unit :: f b -> HFree c f b
unit f b
fa = (forall (g :: * -> *). c g => (f :~> g) -> g b) -> HFree c f b
forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (g :: * -> *). c g => (f :~> g) -> g a) -> HFree c f a
HFree ((forall (g :: * -> *). c g => (f :~> g) -> g b) -> HFree c f b)
-> (forall (g :: * -> *). c g => (f :~> g) -> g b) -> HFree c f b
forall a b. (a -> b) -> a -> b
$ \f :~> g
k -> f b -> g b
f :~> g
k f b
fa
rightAdjunct :: c g => (f :~> g) -> HFree c f :~> g
rightAdjunct :: (f :~> g) -> HFree c f :~> g
rightAdjunct f :~> g
f HFree c f b
h = HFree c f b -> (f :~> g) -> g b
forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
HFree c f a -> forall (g :: * -> *). c g => (f :~> g) -> g a
runHFree HFree c f b
h f :~> g
f
counit :: c f => HFree c f :~> f
counit :: HFree c f :~> f
counit = (f :~> f) -> HFree c f :~> f
forall (c :: (* -> *) -> Constraint) (g :: * -> *) (f :: * -> *).
c g =>
(f :~> g) -> HFree c f :~> g
rightAdjunct forall a. a -> a
f :~> f
id
leftAdjunct :: (HFree c f :~> g) -> f :~> g
leftAdjunct :: (HFree c f :~> g) -> f :~> g
leftAdjunct HFree c f :~> g
f = HFree c f b -> g b
HFree c f :~> g
f (HFree c f b -> g b) -> (f b -> HFree c f b) -> f b -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> HFree c f b
forall (f :: * -> *) (c :: (* -> *) -> Constraint). f :~> HFree c f
unit
transform :: (forall r. c r => (g :~> r) -> f :~> r) -> HFree c f :~> HFree c g
transform :: (forall (r :: * -> *). c r => (g :~> r) -> f :~> r)
-> HFree c f :~> HFree c g
transform forall (r :: * -> *). c r => (g :~> r) -> f :~> r
t HFree c f b
h = (forall (g :: * -> *). c g => (g :~> g) -> g b) -> HFree c g b
forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (g :: * -> *). c g => (f :~> g) -> g a) -> HFree c f a
HFree ((forall (g :: * -> *). c g => (g :~> g) -> g b) -> HFree c g b)
-> (forall (g :: * -> *). c g => (g :~> g) -> g b) -> HFree c g b
forall a b. (a -> b) -> a -> b
$ \g :~> g
k -> (f :~> g) -> HFree c f b -> g b
forall (c :: (* -> *) -> Constraint) (g :: * -> *) (f :: * -> *).
c g =>
(f :~> g) -> HFree c f :~> g
rightAdjunct ((g :~> g) -> f :~> g
forall (r :: * -> *). c r => (g :~> r) -> f :~> r
t g :~> g
k) HFree c f b
h
hfmap :: (f :~> g) -> HFree c f :~> HFree c g
hfmap :: (f :~> g) -> HFree c f :~> HFree c g
hfmap f :~> g
f = (forall (r :: * -> *). c r => (g :~> r) -> f :~> r)
-> HFree c f :~> HFree c g
forall (c :: (* -> *) -> Constraint) (g :: * -> *) (f :: * -> *).
(forall (r :: * -> *). c r => (g :~> r) -> f :~> r)
-> HFree c f :~> HFree c g
transform ((g b -> r b) -> (f b -> g b) -> f b -> r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> g b
f :~> g
f)
bind :: (f :~> HFree c g) -> HFree c f :~> HFree c g
bind :: (f :~> HFree c g) -> HFree c f :~> HFree c g
bind f :~> HFree c g
f = (forall (r :: * -> *). c r => (g :~> r) -> f :~> r)
-> HFree c f :~> HFree c g
forall (c :: (* -> *) -> Constraint) (g :: * -> *) (f :: * -> *).
(forall (r :: * -> *). c r => (g :~> r) -> f :~> r)
-> HFree c f :~> HFree c g
transform (\g :~> r
k -> (g :~> r) -> HFree c g :~> r
forall (c :: (* -> *) -> Constraint) (g :: * -> *) (f :: * -> *).
c g =>
(f :~> g) -> HFree c f :~> g
rightAdjunct g :~> r
k (HFree c g b -> r b) -> (f b -> HFree c g b) -> f b -> r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> HFree c g b
f :~> HFree c g
f)
liftFree :: f a -> HFree c f a
liftFree :: f a -> HFree c f a
liftFree = f a -> HFree c f a
forall (f :: * -> *) (c :: (* -> *) -> Constraint). f :~> HFree c f
unit
lowerFree :: c f => HFree c f a -> f a
lowerFree :: HFree c f a -> f a
lowerFree = HFree c f a -> f a
forall (c :: (* -> *) -> Constraint) (f :: * -> *).
c f =>
HFree c f :~> f
counit
convert :: (c (t f), Monad f, MonadTrans t) => HFree c f a -> t f a
convert :: HFree c f a -> t f a
convert = (f :~> t f) -> HFree c f :~> t f
forall (c :: (* -> *) -> Constraint) (g :: * -> *) (f :: * -> *).
c g =>
(f :~> g) -> HFree c f :~> g
rightAdjunct f :~> t f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
iter :: c Identity => (forall b. f b -> b) -> HFree c f a -> a
iter :: (forall b. f b -> b) -> HFree c f a -> a
iter forall b. f b -> b
f = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (HFree c f a -> Identity a) -> HFree c f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f :~> Identity) -> HFree c f :~> Identity
forall (c :: (* -> *) -> Constraint) (g :: * -> *) (f :: * -> *).
c g =>
(f :~> g) -> HFree c f :~> g
rightAdjunct (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (f b -> b) -> f b -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> b
forall b. f b -> b
f)
wrap :: f (HFree Monad f a) -> HFree Monad f a
wrap :: f (HFree Monad f a) -> HFree Monad f a
wrap f (HFree Monad f a)
as = HFree Monad f (HFree Monad f a) -> HFree Monad f a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (HFree Monad f a) -> HFree Monad f (HFree Monad f a)
forall (f :: * -> *) (c :: (* -> *) -> Constraint). f :~> HFree c f
unit f (HFree Monad f a)
as)
deriveFreeInstance' ''HFree 'HFree 'runHFree ''Functor
deriveFreeInstance' ''HFree 'HFree 'runHFree ''Applicative
deriveFreeInstance' ''HFree 'HFree 'runHFree ''Alternative
deriveFreeInstance' ''HFree 'HFree 'runHFree ''Monad
deriveFreeInstance' ''HFree 'HFree 'runHFree ''Contravariant
deriveFreeInstance' ''HFree 'HFree 'runHFree ''Divisible
deriveFreeInstance' ''HFree 'HFree 'runHFree ''Decidable