module Control.Monad.Freer.Church (
Free(..), reFree
, liftFree, interpretFree, retractFree, hoistFree
, foldFree, foldFree', foldFreeC
, Free1(.., DoneF1, MoreF1)
, reFree1, toFree
, liftFree1, interpretFree1, retractFree1, hoistFree1
, free1Comp, matchFree1
, foldFree1, foldFree1', foldFree1C
, Comp(.., Comp, unComp), comp
) where
import Control.Applicative
import Control.Monad
import Control.Natural
import Data.Foldable
import Data.Functor
import Data.Functor.Bind
import Data.Functor.Classes
import Data.Functor.Coyoneda
import Data.Pointed
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import GHC.Generics
import Text.Read
import qualified Control.Monad.Free as M
newtype Free f a = Free
{ Free f a
-> forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
runFree :: forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
}
instance Functor (Free f) where
fmap :: (a -> b) -> Free f a -> Free f b
fmap f :: a -> b
f x :: Free f a
x = (forall r. (b -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f b
forall (f :: * -> *) a.
(forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
Free ((forall r. (b -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f b)
-> (forall r. (b -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f b
forall a b. (a -> b) -> a -> b
$ \p :: b -> r
p b :: forall s. f s -> (s -> r) -> r
b -> Free f a -> (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
forall (f :: * -> *) a.
Free f a
-> forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
runFree Free f a
x (b -> r
p (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall s. f s -> (s -> r) -> r
b
instance Apply (Free f) where
<.> :: Free f (a -> b) -> Free f a -> Free f b
(<.>) = Free f (a -> b) -> Free f a -> Free f b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Applicative (Free f) where
pure :: a -> Free f a
pure = a -> Free f a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: Free f (a -> b) -> Free f a -> Free f b
(<*>) = Free f (a -> b) -> Free f a -> Free f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
instance Pointed (Free f) where
point :: a -> Free f a
point = a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Bind (Free f) where
x :: Free f a
x >>- :: Free f a -> (a -> Free f b) -> Free f b
>>- f :: a -> Free f b
f = (forall r. (b -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f b
forall (f :: * -> *) a.
(forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
Free ((forall r. (b -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f b)
-> (forall r. (b -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f b
forall a b. (a -> b) -> a -> b
$ \p :: b -> r
p b :: forall s. f s -> (s -> r) -> r
b -> Free f a -> (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
forall (f :: * -> *) a.
Free f a
-> forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
runFree Free f a
x (\y :: a
y -> Free f b -> (b -> r) -> (forall s. f s -> (s -> r) -> r) -> r
forall (f :: * -> *) a.
Free f a
-> forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
runFree (a -> Free f b
f a
y) b -> r
p forall s. f s -> (s -> r) -> r
b) forall s. f s -> (s -> r) -> r
b
instance Monad (Free f) where
return :: a -> Free f a
return x :: a
x = (forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
forall (f :: * -> *) a.
(forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
Free ((forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a)
-> (forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
forall a b. (a -> b) -> a -> b
$ \p :: a -> r
p _ -> a -> r
p a
x
>>= :: Free f a -> (a -> Free f b) -> Free f b
(>>=) = Free f a -> (a -> Free f b) -> Free f b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)
instance M.MonadFree f (Free f) where
wrap :: f (Free f a) -> Free f a
wrap x :: f (Free f a)
x = (forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
forall (f :: * -> *) a.
(forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
Free ((forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a)
-> (forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
forall a b. (a -> b) -> a -> b
$ \p :: a -> r
p b :: forall s. f s -> (s -> r) -> r
b -> f (Free f a) -> (Free f a -> r) -> r
forall s. f s -> (s -> r) -> r
b f (Free f a)
x ((Free f a -> r) -> r) -> (Free f a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \y :: Free f a
y -> Free f a -> (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
forall (f :: * -> *) a.
Free f a
-> forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
runFree Free f a
y a -> r
p forall s. f s -> (s -> r) -> r
b
instance Foldable f => Foldable (Free f) where
foldMap :: (a -> m) -> Free f a -> m
foldMap f :: a -> m
f = (a -> m) -> (Coyoneda f m -> m) -> Free f a -> m
forall a r (f :: * -> *).
(a -> r) -> (Coyoneda f r -> r) -> Free f a -> r
foldFreeC a -> m
f Coyoneda f m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
instance Traversable f => Traversable (Free f) where
traverse :: (a -> f b) -> Free f a -> f (Free f b)
traverse f :: a -> f b
f = (a -> f (Free f b))
-> (f (f (Free f b)) -> f (Free f b)) -> Free f a -> f (Free f b)
forall (f :: * -> *) a r.
Functor f =>
(a -> r) -> (f r -> r) -> Free f a -> r
foldFree ((b -> Free f b) -> f b -> f (Free f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Free f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f b -> f (Free f b)) -> (a -> f b) -> a -> f (Free f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f )
((f (Free f b) -> Free f b) -> f (f (Free f b)) -> f (Free f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Free f b) -> Free f b
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
M.wrap (f (f (Free f b)) -> f (Free f b))
-> (f (f (Free f b)) -> f (f (Free f b)))
-> f (f (Free f b))
-> f (Free f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (Free f b)) -> f (f (Free f b))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA)
instance (Functor f, Eq1 f) => Eq1 (Free f) where
liftEq :: (a -> b -> Bool) -> Free f a -> Free f b -> Bool
liftEq eq :: a -> b -> Bool
eq x :: Free f a
x y :: Free f b
y = (a -> b -> Bool) -> Free f a -> Free f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq @(M.Free f) a -> b -> Bool
eq (Free f a -> Free f a
forall (f :: * -> *) (m :: * -> *) a.
(MonadFree f m, Functor f) =>
Free f a -> m a
reFree Free f a
x) (Free f b -> Free f b
forall (f :: * -> *) (m :: * -> *) a.
(MonadFree f m, Functor f) =>
Free f a -> m a
reFree Free f b
y)
instance (Functor f, Ord1 f) => Ord1 (Free f) where
liftCompare :: (a -> b -> Ordering) -> Free f a -> Free f b -> Ordering
liftCompare c :: a -> b -> Ordering
c x :: Free f a
x y :: Free f b
y = (a -> b -> Ordering) -> Free f a -> Free f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare @(M.Free f) a -> b -> Ordering
c (Free f a -> Free f a
forall (f :: * -> *) (m :: * -> *) a.
(MonadFree f m, Functor f) =>
Free f a -> m a
reFree Free f a
x) (Free f b -> Free f b
forall (f :: * -> *) (m :: * -> *) a.
(MonadFree f m, Functor f) =>
Free f a -> m a
reFree Free f b
y)
instance (Functor f, Eq1 f, Eq a) => Eq (Free f a) where
== :: Free f a -> Free f a -> Bool
(==) = Free f a -> Free f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
instance (Functor f, Ord1 f, Ord a) => Ord (Free f a) where
compare :: Free f a -> Free f a -> Ordering
compare = Free f a -> Free f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
instance (Functor f, Show1 f) => Show1 (Free f) where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Free f a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d x :: Free f a
x = case Free f a -> Free f a
forall (f :: * -> *) (m :: * -> *) a.
(MonadFree f m, Functor f) =>
Free f a -> m a
reFree Free f a
x of
M.Pure y :: a
y -> (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp "pure" Int
d a
y
M.Free ys :: f (Free f a)
ys -> (Int -> f (Free f a) -> ShowS)
-> String -> Int -> f (Free f a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> Free f a -> ShowS)
-> ([Free f a] -> ShowS) -> Int -> f (Free f a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Free f a -> ShowS
sp' [Free f a] -> ShowS
sl') "wrap" Int
d f (Free f a)
ys
where
sp' :: Int -> Free f a -> ShowS
sp' = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Free f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl
sl' :: [Free f a] -> ShowS
sl' = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Free f a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
instance (Functor f, Show1 f, Show a) => Show (Free f a) where
showsPrec :: Int -> Free f a -> ShowS
showsPrec = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Free f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance (Functor f, Read1 f) => Read1 (Free f) where
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Free f a)
liftReadsPrec rp :: Int -> ReadS a
rp rl :: ReadS [a]
rl = Int -> ReadS (Free f a)
go
where
go :: Int -> ReadS (Free f a)
go = (String -> ReadS (Free f a)) -> Int -> ReadS (Free f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Free f a)) -> Int -> ReadS (Free f a))
-> (String -> ReadS (Free f a)) -> Int -> ReadS (Free f a)
forall a b. (a -> b) -> a -> b
$
(Int -> ReadS a)
-> String -> (a -> Free f a) -> String -> ReadS (Free f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS a
rp "pure" a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(String -> ReadS (Free f a))
-> (String -> ReadS (Free f a)) -> String -> ReadS (Free f a)
forall a. Semigroup a => a -> a -> a
<> (Int -> ReadS (f (Free f a)))
-> String
-> (f (Free f a) -> Free f a)
-> String
-> ReadS (Free f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS (Free f a))
-> ReadS [Free f a] -> Int -> ReadS (f (Free f a))
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (Free f a)
go ((Int -> ReadS a) -> ReadS [a] -> ReadS [Free f a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl)) "wrap" f (Free f a) -> Free f a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
M.wrap
instance (Functor f, Read1 f, Read a) => Read (Free f a) where
readPrec :: ReadPrec (Free f a)
readPrec = ReadPrec (Free f a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1
readListPrec :: ReadPrec [Free f a]
readListPrec = ReadPrec [Free f a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
readList :: ReadS [Free f a]
readList = ReadS [Free f a]
forall a. Read a => ReadS [a]
readListDefault
reFree
:: (M.MonadFree f m, Functor f)
=> Free f a
-> m a
reFree :: Free f a -> m a
reFree = (a -> m a) -> (f (m a) -> m a) -> Free f a -> m a
forall (f :: * -> *) a r.
Functor f =>
(a -> r) -> (f r -> r) -> Free f a -> r
foldFree a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f (m a) -> m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
M.wrap
liftFree :: f ~> Free f
liftFree :: f x -> Free f x
liftFree x :: f x
x = (forall r. (x -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f x
forall (f :: * -> *) a.
(forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
Free ((forall r. (x -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f x)
-> (forall r. (x -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f x
forall a b. (a -> b) -> a -> b
$ \p :: x -> r
p b :: forall s. f s -> (s -> r) -> r
b -> f x -> (x -> r) -> r
forall s. f s -> (s -> r) -> r
b f x
x x -> r
p
interpretFree :: Monad g => (f ~> g) -> Free f ~> g
interpretFree :: (f ~> g) -> Free f ~> g
interpretFree f :: f ~> g
f = (x -> g x)
-> (forall s. f s -> (s -> g x) -> g x) -> Free f x -> g x
forall a r (f :: * -> *).
(a -> r) -> (forall s. f s -> (s -> r) -> r) -> Free f a -> r
foldFree' x -> g x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (g s -> (s -> g x) -> g x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (g s -> (s -> g x) -> g x)
-> (f s -> g s) -> f s -> (s -> g x) -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f s -> g s
f ~> g
f)
retractFree :: Monad f => Free f ~> f
retractFree :: Free f ~> f
retractFree = (x -> f x)
-> (forall s. f s -> (s -> f x) -> f x) -> Free f x -> f x
forall a r (f :: * -> *).
(a -> r) -> (forall s. f s -> (s -> r) -> r) -> Free f a -> r
foldFree' x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall s. f s -> (s -> f x) -> f x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
hoistFree :: (f ~> g) -> Free f ~> Free g
hoistFree :: (f ~> g) -> Free f ~> Free g
hoistFree f :: f ~> g
f x :: Free f x
x = (forall r. (x -> r) -> (forall s. g s -> (s -> r) -> r) -> r)
-> Free g x
forall (f :: * -> *) a.
(forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
Free ((forall r. (x -> r) -> (forall s. g s -> (s -> r) -> r) -> r)
-> Free g x)
-> (forall r. (x -> r) -> (forall s. g s -> (s -> r) -> r) -> r)
-> Free g x
forall a b. (a -> b) -> a -> b
$ \p :: x -> r
p b :: forall s. g s -> (s -> r) -> r
b -> Free f x -> (x -> r) -> (forall s. f s -> (s -> r) -> r) -> r
forall (f :: * -> *) a.
Free f a
-> forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
runFree Free f x
x x -> r
p (g s -> (s -> r) -> r
forall s. g s -> (s -> r) -> r
b (g s -> (s -> r) -> r) -> (f s -> g s) -> f s -> (s -> r) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f s -> g s
f ~> g
f)
foldFree'
:: (a -> r)
-> (forall s. f s -> (s -> r) -> r)
-> Free f a
-> r
foldFree' :: (a -> r) -> (forall s. f s -> (s -> r) -> r) -> Free f a -> r
foldFree' f :: a -> r
f g :: forall s. f s -> (s -> r) -> r
g x :: Free f a
x = Free f a -> (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
forall (f :: * -> *) a.
Free f a
-> forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r
runFree Free f a
x a -> r
f forall s. f s -> (s -> r) -> r
g
foldFreeC
:: (a -> r)
-> (Coyoneda f r -> r)
-> Free f a
-> r
foldFreeC :: (a -> r) -> (Coyoneda f r -> r) -> Free f a -> r
foldFreeC f :: a -> r
f g :: Coyoneda f r -> r
g = (a -> r) -> (forall s. f s -> (s -> r) -> r) -> Free f a -> r
forall a r (f :: * -> *).
(a -> r) -> (forall s. f s -> (s -> r) -> r) -> Free f a -> r
foldFree' a -> r
f (\y :: f s
y n :: s -> r
n -> Coyoneda f r -> r
g ((s -> r) -> f s -> Coyoneda f r
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda s -> r
n f s
y))
foldFree
:: Functor f
=> (a -> r)
-> (f r -> r)
-> Free f a
-> r
foldFree :: (a -> r) -> (f r -> r) -> Free f a -> r
foldFree f :: a -> r
f g :: f r -> r
g = (a -> r) -> (Coyoneda f r -> r) -> Free f a -> r
forall a r (f :: * -> *).
(a -> r) -> (Coyoneda f r -> r) -> Free f a -> r
foldFreeC a -> r
f (f r -> r
g (f r -> r) -> (Coyoneda f r -> f r) -> Coyoneda f r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda f r -> f r
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda)
newtype Free1 f a = Free1
{ Free1 f a
-> forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r
runFree1 :: forall r. (forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> r
}
instance Functor (Free1 f) where
fmap :: (a -> b) -> Free1 f a -> Free1 f b
fmap f :: a -> b
f x :: Free1 f a
x = (forall r.
(forall s. f s -> (s -> b) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f b
forall (f :: * -> *) a.
(forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f a
Free1 ((forall r.
(forall s. f s -> (s -> b) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f b)
-> (forall r.
(forall s. f s -> (s -> b) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f b
forall a b. (a -> b) -> a -> b
$ \p :: forall s. f s -> (s -> b) -> r
p b :: forall s. f s -> (s -> r) -> r
b -> Free1 f a
-> (forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> r
forall (f :: * -> *) a.
Free1 f a
-> forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r
runFree1 Free1 f a
x (\y :: f s
y c :: s -> a
c -> f s -> (s -> b) -> r
forall s. f s -> (s -> b) -> r
p f s
y (a -> b
f (a -> b) -> (s -> a) -> s -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a
c)) forall s. f s -> (s -> r) -> r
b
instance Apply (Free1 f) where
<.> :: Free1 f (a -> b) -> Free1 f a -> Free1 f b
(<.>) = Free1 f (a -> b) -> Free1 f a -> Free1 f b
forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
instance Bind (Free1 f) where
x :: Free1 f a
x >>- :: Free1 f a -> (a -> Free1 f b) -> Free1 f b
>>- f :: a -> Free1 f b
f = (forall r.
(forall s. f s -> (s -> b) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f b
forall (f :: * -> *) a.
(forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f a
Free1 ((forall r.
(forall s. f s -> (s -> b) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f b)
-> (forall r.
(forall s. f s -> (s -> b) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f b
forall a b. (a -> b) -> a -> b
$ \p :: forall s. f s -> (s -> b) -> r
p b :: forall s. f s -> (s -> r) -> r
b ->
Free1 f a
-> (forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> r
forall (f :: * -> *) a.
Free1 f a
-> forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r
runFree1 Free1 f a
x (\y :: f s
y c :: s -> a
c -> f s -> (s -> r) -> r
forall s. f s -> (s -> r) -> r
b f s
y ((\q :: Free1 f b
q -> Free1 f b
-> (forall s. f s -> (s -> b) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> r
forall (f :: * -> *) a.
Free1 f a
-> forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r
runFree1 Free1 f b
q forall s. f s -> (s -> b) -> r
p forall s. f s -> (s -> r) -> r
b) (Free1 f b -> r) -> (s -> Free1 f b) -> s -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Free1 f b
f (a -> Free1 f b) -> (s -> a) -> s -> Free1 f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a
c)) forall s. f s -> (s -> r) -> r
b
instance Foldable f => Foldable (Free1 f) where
foldMap :: (a -> m) -> Free1 f a -> m
foldMap f :: a -> m
f = (Coyoneda f a -> m) -> (Coyoneda f m -> m) -> Free1 f a -> m
forall (f :: * -> *) a r.
(Coyoneda f a -> r) -> (Coyoneda f r -> r) -> Free1 f a -> r
foldFree1C ((a -> m) -> Coyoneda f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) Coyoneda f m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
instance Traversable f => Traversable (Free1 f) where
traverse :: (a -> f b) -> Free1 f a -> f (Free1 f b)
traverse f :: a -> f b
f = (f a -> f (Free1 f b))
-> (f (f (Free1 f b)) -> f (Free1 f b))
-> Free1 f a
-> f (Free1 f b)
forall (f :: * -> *) a r.
Functor f =>
(f a -> r) -> (f r -> r) -> Free1 f a -> r
foldFree1 ((f b -> Free1 f b) -> f (f b) -> f (Free1 f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> Free1 f b
forall (f :: * -> *) a. Functor f => f a -> Free1 f a
DoneF1 (f (f b) -> f (Free1 f b))
-> (f a -> f (f b)) -> f a -> f (Free1 f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f)
((f (Free1 f b) -> Free1 f b) -> f (f (Free1 f b)) -> f (Free1 f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Free1 f b) -> Free1 f b
forall (f :: * -> *) a. Functor f => f (Free1 f a) -> Free1 f a
MoreF1 (f (f (Free1 f b)) -> f (Free1 f b))
-> (f (f (Free1 f b)) -> f (f (Free1 f b)))
-> f (f (Free1 f b))
-> f (Free1 f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (Free1 f b)) -> f (f (Free1 f b))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA )
instance Foldable1 f => Foldable1 (Free1 f) where
foldMap1 :: (a -> m) -> Free1 f a -> m
foldMap1 f :: a -> m
f = (Coyoneda f a -> m) -> (Coyoneda f m -> m) -> Free1 f a -> m
forall (f :: * -> *) a r.
(Coyoneda f a -> r) -> (Coyoneda f r -> r) -> Free1 f a -> r
foldFree1C ((a -> m) -> Coyoneda f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) Coyoneda f m -> m
forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => t m -> m
fold1
instance Traversable1 f => Traversable1 (Free1 f) where
traverse1 :: (a -> f b) -> Free1 f a -> f (Free1 f b)
traverse1 f :: a -> f b
f = (f a -> f (Free1 f b))
-> (f (f (Free1 f b)) -> f (Free1 f b))
-> Free1 f a
-> f (Free1 f b)
forall (f :: * -> *) a r.
Functor f =>
(f a -> r) -> (f r -> r) -> Free1 f a -> r
foldFree1 ((f b -> Free1 f b) -> f (f b) -> f (Free1 f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> Free1 f b
forall (f :: * -> *) a. Functor f => f a -> Free1 f a
DoneF1 (f (f b) -> f (Free1 f b))
-> (f a -> f (f b)) -> f a -> f (Free1 f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 a -> f b
f)
((f (Free1 f b) -> Free1 f b) -> f (f (Free1 f b)) -> f (Free1 f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Free1 f b) -> Free1 f b
forall (f :: * -> *) a. Functor f => f (Free1 f a) -> Free1 f a
MoreF1 (f (f (Free1 f b)) -> f (Free1 f b))
-> (f (f (Free1 f b)) -> f (f (Free1 f b)))
-> f (f (Free1 f b))
-> f (Free1 f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (Free1 f b)) -> f (f (Free1 f b))
forall (t :: * -> *) (f :: * -> *) b.
(Traversable1 t, Apply f) =>
t (f b) -> f (t b)
sequence1 )
instance (Functor f, Eq1 f) => Eq1 (Free1 f) where
liftEq :: (a -> b -> Bool) -> Free1 f a -> Free1 f b -> Bool
liftEq eq :: a -> b -> Bool
eq x :: Free1 f a
x y :: Free1 f b
y = (a -> b -> Bool) -> Free f a -> Free f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq @(Free f) a -> b -> Bool
eq (Free1 f a -> Free f a
forall (f :: * -> *). Free1 f ~> Free f
toFree Free1 f a
x) (Free1 f b -> Free f b
forall (f :: * -> *). Free1 f ~> Free f
toFree Free1 f b
y)
instance (Functor f, Ord1 f) => Ord1 (Free1 f) where
liftCompare :: (a -> b -> Ordering) -> Free1 f a -> Free1 f b -> Ordering
liftCompare c :: a -> b -> Ordering
c x :: Free1 f a
x y :: Free1 f b
y = (a -> b -> Ordering) -> Free f a -> Free f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare @(Free f) a -> b -> Ordering
c (Free1 f a -> Free f a
forall (f :: * -> *). Free1 f ~> Free f
toFree Free1 f a
x) (Free1 f b -> Free f b
forall (f :: * -> *). Free1 f ~> Free f
toFree Free1 f b
y)
instance (Functor f, Eq1 f, Eq a) => Eq (Free1 f a) where
== :: Free1 f a -> Free1 f a -> Bool
(==) = Free1 f a -> Free1 f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
instance (Functor f, Ord1 f, Ord a) => Ord (Free1 f a) where
compare :: Free1 f a -> Free1 f a -> Ordering
compare = Free1 f a -> Free1 f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
instance (Functor f, Show1 f) => Show1 (Free1 f) where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Free1 f a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d = \case
DoneF1 x :: f a
x -> (Int -> f a -> ShowS) -> String -> Int -> f a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl ) "DoneF1" Int
d f a
x
MoreF1 x :: f (Free1 f a)
x -> (Int -> f (Free1 f a) -> ShowS)
-> String -> Int -> f (Free1 f a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> Free1 f a -> ShowS)
-> ([Free1 f a] -> ShowS) -> Int -> f (Free1 f a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Free1 f a -> ShowS
sp' [Free1 f a] -> ShowS
sl') "MoreF1" Int
d f (Free1 f a)
x
where
sp' :: Int -> Free1 f a -> ShowS
sp' = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Free1 f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl
sl' :: [Free1 f a] -> ShowS
sl' = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Free1 f a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
instance (Functor f, Show1 f, Show a) => Show (Free1 f a) where
showsPrec :: Int -> Free1 f a -> ShowS
showsPrec = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Free1 f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance (Functor f, Read1 f) => Read1 (Free1 f) where
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Free1 f a)
liftReadsPrec rp :: Int -> ReadS a
rp rl :: ReadS [a]
rl = Int -> ReadS (Free1 f a)
go
where
go :: Int -> ReadS (Free1 f a)
go = (String -> ReadS (Free1 f a)) -> Int -> ReadS (Free1 f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Free1 f a)) -> Int -> ReadS (Free1 f a))
-> (String -> ReadS (Free1 f a)) -> Int -> ReadS (Free1 f a)
forall a b. (a -> b) -> a -> b
$
(Int -> ReadS (f a))
-> String -> (f a -> Free1 f a) -> String -> ReadS (Free1 f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) "DoneF1" f a -> Free1 f a
forall (f :: * -> *) a. Functor f => f a -> Free1 f a
DoneF1
(String -> ReadS (Free1 f a))
-> (String -> ReadS (Free1 f a)) -> String -> ReadS (Free1 f a)
forall a. Semigroup a => a -> a -> a
<> (Int -> ReadS (f (Free1 f a)))
-> String
-> (f (Free1 f a) -> Free1 f a)
-> String
-> ReadS (Free1 f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS (Free1 f a))
-> ReadS [Free1 f a] -> Int -> ReadS (f (Free1 f a))
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (Free1 f a)
go ((Int -> ReadS a) -> ReadS [a] -> ReadS [Free1 f a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl)) "MoreF1" f (Free1 f a) -> Free1 f a
forall (f :: * -> *) a. Functor f => f (Free1 f a) -> Free1 f a
MoreF1
instance (Functor f, Read1 f, Read a) => Read (Free1 f a) where
readPrec :: ReadPrec (Free1 f a)
readPrec = ReadPrec (Free1 f a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1
readListPrec :: ReadPrec [Free1 f a]
readListPrec = ReadPrec [Free1 f a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
readList :: ReadS [Free1 f a]
readList = ReadS [Free1 f a]
forall a. Read a => ReadS [a]
readListDefault
pattern DoneF1 :: Functor f => f a -> Free1 f a
pattern $bDoneF1 :: f a -> Free1 f a
$mDoneF1 :: forall r (f :: * -> *) a.
Functor f =>
Free1 f a -> (f a -> r) -> (Void# -> r) -> r
DoneF1 x <- (matchFree1 -> L1 x)
where
DoneF1 x :: f a
x = f a -> Free1 f a
forall (f :: * -> *). f ~> Free1 f
liftFree1 f a
x
pattern MoreF1 :: Functor f => f (Free1 f a) -> Free1 f a
pattern $bMoreF1 :: f (Free1 f a) -> Free1 f a
$mMoreF1 :: forall r (f :: * -> *) a.
Functor f =>
Free1 f a -> (f (Free1 f a) -> r) -> (Void# -> r) -> r
MoreF1 x <- (matchFree1 -> R1 (Comp x))
where
MoreF1 x :: f (Free1 f a)
x = f (Free1 f a) -> Free1 f (Free1 f a)
forall (f :: * -> *). f ~> Free1 f
liftFree1 f (Free1 f a)
x Free1 f (Free1 f a) -> (Free1 f a -> Free1 f a) -> Free1 f a
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- Free1 f a -> Free1 f a
forall a. a -> a
id
{-# COMPLETE DoneF1, MoreF1 #-}
reFree1
:: (M.MonadFree f m, Functor f)
=> Free1 f a
-> m a
reFree1 :: Free1 f a -> m a
reFree1 = (f a -> m a) -> (f (m a) -> m a) -> Free1 f a -> m a
forall (f :: * -> *) a r.
Functor f =>
(f a -> r) -> (f r -> r) -> Free1 f a -> r
foldFree1 (f (m a) -> m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
M.wrap (f (m a) -> m a) -> (f a -> f (m a)) -> f a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m a) -> f a -> f (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) f (m a) -> m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
M.wrap
toFree :: Free1 f ~> Free f
toFree :: Free1 f x -> Free f x
toFree x :: Free1 f x
x = (forall r. (x -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f x
forall (f :: * -> *) a.
(forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f a
Free ((forall r. (x -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f x)
-> (forall r. (x -> r) -> (forall s. f s -> (s -> r) -> r) -> r)
-> Free f x
forall a b. (a -> b) -> a -> b
$ \p :: x -> r
p b :: forall s. f s -> (s -> r) -> r
b -> Free1 f x
-> (forall s. f s -> (s -> x) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> r
forall (f :: * -> *) a.
Free1 f a
-> forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r
runFree1 Free1 f x
x (\y :: f s
y c :: s -> x
c -> f s -> (s -> r) -> r
forall s. f s -> (s -> r) -> r
b f s
y (x -> r
p (x -> r) -> (s -> x) -> s -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> x
c)) forall s. f s -> (s -> r) -> r
b
hoistFree1 :: (f ~> g) -> Free1 f ~> Free1 g
hoistFree1 :: (f ~> g) -> Free1 f ~> Free1 g
hoistFree1 f :: f ~> g
f x :: Free1 f x
x = (forall r.
(forall s. g s -> (s -> x) -> r)
-> (forall s. g s -> (s -> r) -> r) -> r)
-> Free1 g x
forall (f :: * -> *) a.
(forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f a
Free1 ((forall r.
(forall s. g s -> (s -> x) -> r)
-> (forall s. g s -> (s -> r) -> r) -> r)
-> Free1 g x)
-> (forall r.
(forall s. g s -> (s -> x) -> r)
-> (forall s. g s -> (s -> r) -> r) -> r)
-> Free1 g x
forall a b. (a -> b) -> a -> b
$ \p :: forall s. g s -> (s -> x) -> r
p b :: forall s. g s -> (s -> r) -> r
b -> Free1 f x
-> (forall s. f s -> (s -> x) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> r
forall (f :: * -> *) a.
Free1 f a
-> forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r
runFree1 Free1 f x
x (g s -> (s -> x) -> r
forall s. g s -> (s -> x) -> r
p (g s -> (s -> x) -> r) -> (f s -> g s) -> f s -> (s -> x) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f s -> g s
f ~> g
f) (g s -> (s -> r) -> r
forall s. g s -> (s -> r) -> r
b (g s -> (s -> r) -> r) -> (f s -> g s) -> f s -> (s -> r) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f s -> g s
f ~> g
f)
free1Comp :: Free1 f ~> Comp f (Free f)
free1Comp :: Free1 f x -> Comp f (Free f) x
free1Comp = (forall s. f s -> (s -> x) -> Comp f (Free f) x)
-> (forall s. f s -> (s -> Comp f (Free f) x) -> Comp f (Free f) x)
-> Free1 f x
-> Comp f (Free f) x
forall (f :: * -> *) a r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> Free1 f a -> r
foldFree1' (\y :: f s
y c :: s -> x
c -> f s
y f s -> (s -> Free f x) -> Comp f (Free f) x
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= (x -> Free f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> Free f x) -> (s -> x) -> s -> Free f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> x
c)) ((forall s. f s -> (s -> Comp f (Free f) x) -> Comp f (Free f) x)
-> Free1 f x -> Comp f (Free f) x)
-> (forall s. f s -> (s -> Comp f (Free f) x) -> Comp f (Free f) x)
-> Free1 f x
-> Comp f (Free f) x
forall a b. (a -> b) -> a -> b
$ \y :: f s
y n :: s -> Comp f (Free f) x
n ->
f s
y f s -> (s -> Free f x) -> Comp f (Free f) x
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= \z :: s
z -> case s -> Comp f (Free f) x
n s
z of
q :>>= m -> f x -> Free f x
forall (f :: * -> *). f ~> Free f
liftFree f x
q Free f x -> (x -> Free f x) -> Free f x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> Free f x
m
liftFree1 :: f ~> Free1 f
liftFree1 :: f x -> Free1 f x
liftFree1 x :: f x
x = (forall r.
(forall s. f s -> (s -> x) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f x
forall (f :: * -> *) a.
(forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f a
Free1 ((forall r.
(forall s. f s -> (s -> x) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f x)
-> (forall r.
(forall s. f s -> (s -> x) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r)
-> Free1 f x
forall a b. (a -> b) -> a -> b
$ \p :: forall s. f s -> (s -> x) -> r
p _ -> f x -> (x -> x) -> r
forall s. f s -> (s -> x) -> r
p f x
x x -> x
forall a. a -> a
id
retractFree1 :: Bind f => Free1 f ~> f
retractFree1 :: Free1 f ~> f
retractFree1 = (forall s. f s -> (s -> x) -> f x)
-> (forall s. f s -> (s -> f x) -> f x) -> Free1 f x -> f x
forall (f :: * -> *) a r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> Free1 f a -> r
foldFree1' forall s. f s -> (s -> x) -> f x
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
(<&>) forall s. f s -> (s -> f x) -> f x
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)
interpretFree1 :: Bind g => (f ~> g) -> Free1 f ~> g
interpretFree1 :: (f ~> g) -> Free1 f ~> g
interpretFree1 f :: f ~> g
f = (forall s. f s -> (s -> x) -> g x)
-> (forall s. f s -> (s -> g x) -> g x) -> Free1 f x -> g x
forall (f :: * -> *) a r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> Free1 f a -> r
foldFree1' (\y :: f s
y c :: s -> x
c -> s -> x
c (s -> x) -> g s -> g x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f s -> g s
f ~> g
f f s
y)
(\y :: f s
y n :: s -> g x
n -> f s -> g s
f ~> g
f f s
y g s -> (s -> g x) -> g x
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- s -> g x
n)
matchFree1 :: forall f. Functor f => Free1 f ~> f :+: Comp f (Free1 f)
matchFree1 :: Free1 f ~> (f :+: Comp f (Free1 f))
matchFree1 = (f x -> (:+:) f (Comp f (Free1 f)) x)
-> (f ((:+:) f (Comp f (Free1 f)) x)
-> (:+:) f (Comp f (Free1 f)) x)
-> Free1 f x
-> (:+:) f (Comp f (Free1 f)) x
forall (f :: * -> *) a r.
Functor f =>
(f a -> r) -> (f r -> r) -> Free1 f a -> r
foldFree1 f x -> (:+:) f (Comp f (Free1 f)) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Comp f (Free1 f) x -> (:+:) f (Comp f (Free1 f)) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Comp f (Free1 f) x -> (:+:) f (Comp f (Free1 f)) x)
-> (f ((:+:) f (Comp f (Free1 f)) x) -> Comp f (Free1 f) x)
-> f ((:+:) f (Comp f (Free1 f)) x)
-> (:+:) f (Comp f (Free1 f)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Free1 f x) -> Comp f (Free1 f) x
forall k (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
f (g a) -> Comp f g a
Comp (f (Free1 f x) -> Comp f (Free1 f) x)
-> (f ((:+:) f (Comp f (Free1 f)) x) -> f (Free1 f x))
-> f ((:+:) f (Comp f (Free1 f)) x)
-> Comp f (Free1 f) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((:+:) f (Comp f (Free1 f)) x -> Free1 f x)
-> f ((:+:) f (Comp f (Free1 f)) x) -> f (Free1 f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) f (Comp f (Free1 f)) x -> Free1 f x
(f :+: Comp f (Free1 f)) ~> Free1 f
shuffle)
where
shuffle :: f :+: Comp f (Free1 f) ~> Free1 f
shuffle :: (:+:) f (Comp f (Free1 f)) x -> Free1 f x
shuffle (L1 y :: f x
y ) = f x -> Free1 f x
forall (f :: * -> *). f ~> Free1 f
liftFree1 f x
y
shuffle (R1 (y :: f x
y :>>= n :: x -> Free1 f x
n)) = f x -> Free1 f x
forall (f :: * -> *). f ~> Free1 f
liftFree1 f x
y Free1 f x -> (x -> Free1 f x) -> Free1 f x
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- x -> Free1 f x
n
foldFree1'
:: (forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> Free1 f a
-> r
foldFree1' :: (forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> Free1 f a -> r
foldFree1' f :: forall s. f s -> (s -> a) -> r
f g :: forall s. f s -> (s -> r) -> r
g x :: Free1 f a
x = Free1 f a
-> (forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r)
-> r
forall (f :: * -> *) a.
Free1 f a
-> forall r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> r
runFree1 Free1 f a
x forall s. f s -> (s -> a) -> r
f forall s. f s -> (s -> r) -> r
g
foldFree1C
:: (Coyoneda f a -> r)
-> (Coyoneda f r -> r)
-> Free1 f a
-> r
foldFree1C :: (Coyoneda f a -> r) -> (Coyoneda f r -> r) -> Free1 f a -> r
foldFree1C f :: Coyoneda f a -> r
f g :: Coyoneda f r -> r
g = (forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> Free1 f a -> r
forall (f :: * -> *) a r.
(forall s. f s -> (s -> a) -> r)
-> (forall s. f s -> (s -> r) -> r) -> Free1 f a -> r
foldFree1' (\y :: f s
y c :: s -> a
c -> Coyoneda f a -> r
f ((s -> a) -> f s -> Coyoneda f a
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda s -> a
c f s
y))
(\y :: f s
y n :: s -> r
n -> Coyoneda f r -> r
g ((s -> r) -> f s -> Coyoneda f r
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda s -> r
n f s
y))
foldFree1
:: Functor f
=> (f a -> r)
-> (f r -> r)
-> Free1 f a
-> r
foldFree1 :: (f a -> r) -> (f r -> r) -> Free1 f a -> r
foldFree1 f :: f a -> r
f g :: f r -> r
g = (Coyoneda f a -> r) -> (Coyoneda f r -> r) -> Free1 f a -> r
forall (f :: * -> *) a r.
(Coyoneda f a -> r) -> (Coyoneda f r -> r) -> Free1 f a -> r
foldFree1C (f a -> r
f (f a -> r) -> (Coyoneda f a -> f a) -> Coyoneda f a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda f a -> f a
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda)
(f r -> r
g (f r -> r) -> (Coyoneda f r -> f r) -> Coyoneda f r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda f r -> f r
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda)
data Comp f g a =
forall x. f x :>>= (x -> g a)
instance Functor g => Functor (Comp f g) where
fmap :: (a -> b) -> Comp f g a -> Comp f g b
fmap f :: a -> b
f (x :: f x
x :>>= h :: x -> g a
h) = f x
x f x -> (x -> g b) -> Comp f g b
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (g a -> g b) -> (x -> g a) -> x -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> g a
h)
instance (Applicative f, Applicative g) => Applicative (Comp f g) where
pure :: a -> Comp f g a
pure x :: a
x = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () f () -> (() -> g a) -> Comp f g a
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= (a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> g a) -> (() -> a) -> () -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> () -> a
forall a b. a -> b -> a
const a
x)
(x :: f x
x :>>= f :: x -> g (a -> b)
f) <*> :: Comp f g (a -> b) -> Comp f g a -> Comp f g b
<*> (y :: f x
y :>>= g :: x -> g a
g) = ((,) (x -> x -> (x, x)) -> f x -> f (x -> (x, x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x
x f (x -> (x, x)) -> f x -> f (x, x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f x
y)
f (x, x) -> ((x, x) -> g b) -> Comp f g b
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= (\(x' :: x
x', y' :: x
y') -> x -> g (a -> b)
f x
x' g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> g a
g x
y')
liftA2 :: (a -> b -> c) -> Comp f g a -> Comp f g b -> Comp f g c
liftA2 h :: a -> b -> c
h (x :: f x
x :>>= f :: x -> g a
f) (y :: f x
y :>>= g :: x -> g b
g)
= ((,) (x -> x -> (x, x)) -> f x -> f (x -> (x, x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x
x f (x -> (x, x)) -> f x -> f (x, x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f x
y)
f (x, x) -> ((x, x) -> g c) -> Comp f g c
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= (\(x' :: x
x', y' :: x
y') -> (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
h (x -> g a
f x
x') (x -> g b
g x
y'))
instance (Foldable f, Foldable g) => Foldable (Comp f g) where
foldMap :: (a -> m) -> Comp f g a -> m
foldMap f :: a -> m
f (x :: f x
x :>>= h :: x -> g a
h) = (x -> m) -> f x -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (g a -> m) -> (x -> g a) -> x -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> g a
h) f x
x
instance (Traversable f, Traversable g) => Traversable (Comp f g) where
traverse :: (a -> f b) -> Comp f g a -> f (Comp f g b)
traverse f :: a -> f b
f (x :: f x
x :>>= h :: x -> g a
h) = (f (g b) -> (g b -> g b) -> Comp f g b
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= g b -> g b
forall a. a -> a
id)
(f (g b) -> Comp f g b) -> f (f (g b)) -> f (Comp f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (x -> f (g b)) -> f x -> f (f (g b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> g a -> f (g b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f (g a -> f (g b)) -> (x -> g a) -> x -> f (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> g a
h) f x
x
instance (Alternative f, Alternative g) => Alternative (Comp f g) where
empty :: Comp f g a
empty = f (g a)
forall (f :: * -> *) a. Alternative f => f a
empty f (g a) -> (g a -> g a) -> Comp f g a
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= g a -> g a
forall a. a -> a
id
(x :: f x
x :>>= f :: x -> g a
f) <|> :: Comp f g a -> Comp f g a -> Comp f g a
<|> (y :: f x
y :>>= g :: x -> g a
g) = ((x -> g a
f (x -> g a) -> f x -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x
x) f (g a) -> f (g a) -> f (g a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (x -> g a
g (x -> g a) -> f x -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x
y)) f (g a) -> (g a -> g a) -> Comp f g a
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= g a -> g a
forall a. a -> a
id
instance (Functor f, Show1 f, Show1 g) => Show1 (Comp f g) where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Comp f g a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d (Comp x :: f (g a)
x) =
(Int -> f (g a) -> ShowS) -> String -> Int -> f (g a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> g a -> ShowS)
-> ([g a] -> ShowS) -> Int -> f (g a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> g a -> ShowS
sp' [g a] -> ShowS
sl') "Comp" Int
d f (g a)
x
where
sp' :: Int -> g a -> ShowS
sp' = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl
sl' :: [g a] -> ShowS
sl' = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [g a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
instance (Functor f, Show1 f, Show1 g, Show a) => Show (Comp f g a) where
showsPrec :: Int -> Comp f g a -> ShowS
showsPrec = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Comp f g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance (Functor f, Read1 f, Read1 g) => Read1 (Comp f g) where
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Comp f g a)
liftReadPrec rp :: ReadPrec a
rp rl :: ReadPrec [a]
rl = ReadPrec (Comp f g a) -> ReadPrec (Comp f g a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Comp f g a) -> ReadPrec (Comp f g a))
-> ReadPrec (Comp f g a) -> ReadPrec (Comp f g a)
forall a b. (a -> b) -> a -> b
$
ReadPrec (f (g a))
-> String -> (f (g a) -> Comp f g a) -> ReadPrec (Comp f g a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (ReadPrec (g a) -> ReadPrec [g a] -> ReadPrec (f (g a))
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec (g a)
rp' ReadPrec [g a]
rl') "Comp" f (g a) -> Comp f g a
forall k (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
f (g a) -> Comp f g a
Comp
where
rp' :: ReadPrec (g a)
rp' = ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl
rl' :: ReadPrec [g a]
rl' = ReadPrec a -> ReadPrec [a] -> ReadPrec [g a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrec ReadPrec a
rp ReadPrec [a]
rl
instance (Functor f, Read1 f, Read1 g, Read a) => Read (Comp f g a) where
readPrec :: ReadPrec (Comp f g a)
readPrec = ReadPrec (Comp f g a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1
readListPrec :: ReadPrec [Comp f g a]
readListPrec = ReadPrec [Comp f g a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
readList :: ReadS [Comp f g a]
readList = ReadS [Comp f g a]
forall a. Read a => ReadS [a]
readListDefault
instance (Functor f, Eq1 f, Eq1 g) => Eq1 (Comp f g) where
liftEq :: (a -> b -> Bool) -> Comp f g a -> Comp f g b -> Bool
liftEq eq :: a -> b -> Bool
eq (Comp x :: f (g a)
x) (Comp y :: f (g b)
y) = (g a -> g b -> Bool) -> f (g a) -> f (g b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq) f (g a)
x f (g b)
y
instance (Functor f, Ord1 f, Ord1 g) => Ord1 (Comp f g) where
liftCompare :: (a -> b -> Ordering) -> Comp f g a -> Comp f g b -> Ordering
liftCompare c :: a -> b -> Ordering
c (Comp x :: f (g a)
x) (Comp y :: f (g b)
y) = (g a -> g b -> Ordering) -> f (g a) -> f (g b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
c) f (g a)
x f (g b)
y
instance (Functor f, Eq1 f, Eq1 g, Eq a) => Eq (Comp f g a) where
== :: Comp f g a -> Comp f g a -> Bool
(==) = Comp f g a -> Comp f g a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
instance (Functor f, Ord1 f, Ord1 g, Ord a) => Ord (Comp f g a) where
compare :: Comp f g a -> Comp f g a -> Ordering
compare = Comp f g a -> Comp f g a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
comp :: f (g a) -> Comp f g a
comp :: f (g a) -> Comp f g a
comp = (f (g a) -> (g a -> g a) -> Comp f g a
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= g a -> g a
forall a. a -> a
id)
pattern Comp :: Functor f => f (g a) -> Comp f g a
pattern $bComp :: f (g a) -> Comp f g a
$mComp :: forall r k (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
Comp f g a -> (f (g a) -> r) -> (Void# -> r) -> r
Comp { Comp f g a -> Functor f => f (g a)
unComp } <- ((\case x :>>= f -> f <$> x)->unComp)
where
Comp x :: f (g a)
x = f (g a) -> Comp f g a
forall k (f :: * -> *) (g :: k -> *) (a :: k).
f (g a) -> Comp f g a
comp f (g a)
x
{-# COMPLETE Comp #-}