{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
module Data.Diagram
(
Diagram,
runDiagram,
compress,
Free (Pure),
free,
fromFree,
retract,
map,
bind,
fold,
)
where
import Control.Monad.State hiding (foldM)
import Data.Functor.Classes
import Data.Functor.Identity
import qualified Data.HashMap.Lazy as H
import Data.Hashable
import Data.Hashable.Lifted
import qualified Data.IntMap as I
import GHC.Generics (Generic)
import Prelude hiding (lookup, map)
newtype Diagram f a s m r = Diagram
{ Diagram f a s m r
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m r
getState ::
StateT
( Int,
H.HashMap (Free_ f a s) Int,
I.IntMap (Free_ f a s)
)
m
r
}
deriving (a -> Diagram f a s m b -> Diagram f a s m a
(a -> b) -> Diagram f a s m a -> Diagram f a s m b
(forall a b. (a -> b) -> Diagram f a s m a -> Diagram f a s m b)
-> (forall a b. a -> Diagram f a s m b -> Diagram f a s m a)
-> Functor (Diagram f a s m)
forall a b. a -> Diagram f a s m b -> Diagram f a s m a
forall a b. (a -> b) -> Diagram f a s m a -> Diagram f a s m 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 s (m :: * -> *) a b.
Functor m =>
a -> Diagram f a s m b -> Diagram f a s m a
forall (f :: * -> *) a s (m :: * -> *) a b.
Functor m =>
(a -> b) -> Diagram f a s m a -> Diagram f a s m b
<$ :: a -> Diagram f a s m b -> Diagram f a s m a
$c<$ :: forall (f :: * -> *) a s (m :: * -> *) a b.
Functor m =>
a -> Diagram f a s m b -> Diagram f a s m a
fmap :: (a -> b) -> Diagram f a s m a -> Diagram f a s m b
$cfmap :: forall (f :: * -> *) a s (m :: * -> *) a b.
Functor m =>
(a -> b) -> Diagram f a s m a -> Diagram f a s m b
Functor, Functor (Diagram f a s m)
a -> Diagram f a s m a
Functor (Diagram f a s m) =>
(forall a. a -> Diagram f a s m a)
-> (forall a b.
Diagram f a s m (a -> b) -> Diagram f a s m a -> Diagram f a s m b)
-> (forall a b c.
(a -> b -> c)
-> Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m c)
-> (forall a b.
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b)
-> (forall a b.
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m a)
-> Applicative (Diagram f a s m)
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m a
Diagram f a s m (a -> b) -> Diagram f a s m a -> Diagram f a s m b
(a -> b -> c)
-> Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m c
forall a. a -> Diagram f a s m a
forall a b.
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m a
forall a b.
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
forall a b.
Diagram f a s m (a -> b) -> Diagram f a s m a -> Diagram f a s m b
forall a b c.
(a -> b -> c)
-> Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m 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 :: * -> *) a s (m :: * -> *).
Monad m =>
Functor (Diagram f a s m)
forall (f :: * -> *) a s (m :: * -> *) a.
Monad m =>
a -> Diagram f a s m a
forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m a
forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m (a -> b) -> Diagram f a s m a -> Diagram f a s m b
forall (f :: * -> *) a s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m c
<* :: Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m a
$c<* :: forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m a
*> :: Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
$c*> :: forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
liftA2 :: (a -> b -> c)
-> Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m c
$cliftA2 :: forall (f :: * -> *) a s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m c
<*> :: Diagram f a s m (a -> b) -> Diagram f a s m a -> Diagram f a s m b
$c<*> :: forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m (a -> b) -> Diagram f a s m a -> Diagram f a s m b
pure :: a -> Diagram f a s m a
$cpure :: forall (f :: * -> *) a s (m :: * -> *) a.
Monad m =>
a -> Diagram f a s m a
$cp1Applicative :: forall (f :: * -> *) a s (m :: * -> *).
Monad m =>
Functor (Diagram f a s m)
Applicative, Applicative (Diagram f a s m)
a -> Diagram f a s m a
Applicative (Diagram f a s m) =>
(forall a b.
Diagram f a s m a -> (a -> Diagram f a s m b) -> Diagram f a s m b)
-> (forall a b.
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b)
-> (forall a. a -> Diagram f a s m a)
-> Monad (Diagram f a s m)
Diagram f a s m a -> (a -> Diagram f a s m b) -> Diagram f a s m b
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
forall a. a -> Diagram f a s m a
forall a b.
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
forall a b.
Diagram f a s m a -> (a -> Diagram f a s m b) -> Diagram f a s m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (f :: * -> *) a s (m :: * -> *).
Monad m =>
Applicative (Diagram f a s m)
forall (f :: * -> *) a s (m :: * -> *) a.
Monad m =>
a -> Diagram f a s m a
forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> (a -> Diagram f a s m b) -> Diagram f a s m b
return :: a -> Diagram f a s m a
$creturn :: forall (f :: * -> *) a s (m :: * -> *) a.
Monad m =>
a -> Diagram f a s m a
>> :: Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
$c>> :: forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> Diagram f a s m b -> Diagram f a s m b
>>= :: Diagram f a s m a -> (a -> Diagram f a s m b) -> Diagram f a s m b
$c>>= :: forall (f :: * -> *) a s (m :: * -> *) a b.
Monad m =>
Diagram f a s m a -> (a -> Diagram f a s m b) -> Diagram f a s m b
$cp1Monad :: forall (f :: * -> *) a s (m :: * -> *).
Monad m =>
Applicative (Diagram f a s m)
Monad, m a -> Diagram f a s m a
(forall (m :: * -> *) a. Monad m => m a -> Diagram f a s m a)
-> MonadTrans (Diagram f a s)
forall (m :: * -> *) a. Monad m => m a -> Diagram f a s m a
forall (f :: * -> *) a s (m :: * -> *) a.
Monad m =>
m a -> Diagram f a s m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Diagram f a s m a
$clift :: forall (f :: * -> *) a s (m :: * -> *) a.
Monad m =>
m a -> Diagram f a s m a
MonadTrans)
runDiagram :: Monad m => (forall s. Diagram f a s m b) -> m b
runDiagram :: (forall s. Diagram f a s m b) -> m b
runDiagram (Diagram d) = StateT
(Int, HashMap (Free_ f a Any) Int, IntMap (Free_ f a Any)) m b
-> (Int, HashMap (Free_ f a Any) Int, IntMap (Free_ f a Any))
-> m b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
(Int, HashMap (Free_ f a Any) Int, IntMap (Free_ f a Any)) m b
d (0, HashMap (Free_ f a Any) Int
forall k v. HashMap k v
H.empty, IntMap (Free_ f a Any)
forall a. IntMap a
I.empty)
compress :: Monad m => Diagram f a s m b -> Diagram f a s Identity (m b)
compress :: Diagram f a s m b -> Diagram f a s Identity (m b)
compress = StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
Identity
(m b)
-> Diagram f a s Identity (m b)
forall (f :: * -> *) a s (m :: * -> *) r.
StateT (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m r
-> Diagram f a s m r
Diagram (StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
Identity
(m b)
-> Diagram f a s Identity (m b))
-> (Diagram f a s m b
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
Identity
(m b))
-> Diagram f a s m b
-> Diagram f a s Identity (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) -> m b)
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
Identity
(m b)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) -> m b)
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
Identity
(m b))
-> (Diagram f a s m b
-> (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) -> m b)
-> Diagram f a s m b
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
Identity
(m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m b
-> (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) -> m b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m b
-> (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) -> m b)
-> (Diagram f a s m b
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m b)
-> Diagram f a s m b
-> (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Diagram f a s m b
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m b
forall (f :: * -> *) a s (m :: * -> *) r.
Diagram f a s m r
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m r
getState
lookup :: Monad m => Int -> Diagram f a s m (f (Free f a s))
lookup :: Int -> Diagram f a s m (f (Free f a s))
lookup i :: Int
i = StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(f (Free f a s))
-> Diagram f a s m (f (Free f a s))
forall (f :: * -> *) a s (m :: * -> *) r.
StateT (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m r
-> Diagram f a s m r
Diagram (StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(f (Free f a s))
-> Diagram f a s m (f (Free f a s)))
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(f (Free f a s))
-> Diagram f a s m (f (Free f a s))
forall a b. (a -> b) -> a -> b
$ do
(_, _, fs :: IntMap (Free_ f a s)
fs) <- StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
forall s (m :: * -> *). MonadState s m => m s
get
case Int -> IntMap (Free_ f a s) -> Maybe (Free_ f a s)
forall a. Int -> IntMap a -> Maybe a
I.lookup Int
i IntMap (Free_ f a s)
fs of
Nothing -> [Char]
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(f (Free f a s))
forall a. HasCallStack => [Char] -> a
error "No free with that id!"
Just f :: Free_ f a s
f -> f (Free f a s)
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(f (Free f a s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Free_ f a s -> f (Free f a s)
forall (f :: * -> *) a s. Free_ f a s -> f (Free f a s)
inner Free_ f a s
f)
data Free (f :: * -> *) a s
= Pure a
| ID Int
deriving (Free f a s -> Free f a s -> Bool
(Free f a s -> Free f a s -> Bool)
-> (Free f a s -> Free f a s -> Bool) -> Eq (Free f a s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a s. Eq a => Free f a s -> Free f a s -> Bool
/= :: Free f a s -> Free f a s -> Bool
$c/= :: forall (f :: * -> *) a s. Eq a => Free f a s -> Free f a s -> Bool
== :: Free f a s -> Free f a s -> Bool
$c== :: forall (f :: * -> *) a s. Eq a => Free f a s -> Free f a s -> Bool
Eq, Eq (Free f a s)
Eq (Free f a s) =>
(Free f a s -> Free f a s -> Ordering)
-> (Free f a s -> Free f a s -> Bool)
-> (Free f a s -> Free f a s -> Bool)
-> (Free f a s -> Free f a s -> Bool)
-> (Free f a s -> Free f a s -> Bool)
-> (Free f a s -> Free f a s -> Free f a s)
-> (Free f a s -> Free f a s -> Free f a s)
-> Ord (Free f a s)
Free f a s -> Free f a s -> Bool
Free f a s -> Free f a s -> Ordering
Free f a s -> Free f a s -> Free f a s
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) a s. Ord a => Eq (Free f a s)
forall (f :: * -> *) a s. Ord a => Free f a s -> Free f a s -> Bool
forall (f :: * -> *) a s.
Ord a =>
Free f a s -> Free f a s -> Ordering
forall (f :: * -> *) a s.
Ord a =>
Free f a s -> Free f a s -> Free f a s
min :: Free f a s -> Free f a s -> Free f a s
$cmin :: forall (f :: * -> *) a s.
Ord a =>
Free f a s -> Free f a s -> Free f a s
max :: Free f a s -> Free f a s -> Free f a s
$cmax :: forall (f :: * -> *) a s.
Ord a =>
Free f a s -> Free f a s -> Free f a s
>= :: Free f a s -> Free f a s -> Bool
$c>= :: forall (f :: * -> *) a s. Ord a => Free f a s -> Free f a s -> Bool
> :: Free f a s -> Free f a s -> Bool
$c> :: forall (f :: * -> *) a s. Ord a => Free f a s -> Free f a s -> Bool
<= :: Free f a s -> Free f a s -> Bool
$c<= :: forall (f :: * -> *) a s. Ord a => Free f a s -> Free f a s -> Bool
< :: Free f a s -> Free f a s -> Bool
$c< :: forall (f :: * -> *) a s. Ord a => Free f a s -> Free f a s -> Bool
compare :: Free f a s -> Free f a s -> Ordering
$ccompare :: forall (f :: * -> *) a s.
Ord a =>
Free f a s -> Free f a s -> Ordering
$cp1Ord :: forall (f :: * -> *) a s. Ord a => Eq (Free f a s)
Ord, (forall x. Free f a s -> Rep (Free f a s) x)
-> (forall x. Rep (Free f a s) x -> Free f a s)
-> Generic (Free f a s)
forall x. Rep (Free f a s) x -> Free f a s
forall x. Free f a s -> Rep (Free f a s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a s x. Rep (Free f a s) x -> Free f a s
forall (f :: * -> *) a s x. Free f a s -> Rep (Free f a s) x
$cto :: forall (f :: * -> *) a s x. Rep (Free f a s) x -> Free f a s
$cfrom :: forall (f :: * -> *) a s x. Free f a s -> Rep (Free f a s) x
Generic)
newtype Free_ f a s = Free
{ Free_ f a s -> f (Free f a s)
inner :: f (Free f a s)
}
instance Hashable a => Hashable (Free f a s)
instance (Eq a, Eq1 f) => Eq (Free_ f a s) where
Free f :: f (Free f a s)
f == :: Free_ f a s -> Free_ f a s -> Bool
== Free g :: f (Free f a s)
g = (Free f a s -> Free f a s -> Bool)
-> f (Free f a s) -> f (Free f a s) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq Free f a s -> Free f a s -> Bool
forall a. Eq a => a -> a -> Bool
(==) f (Free f a s)
f f (Free f a s)
g
instance (Hashable a, Hashable1 f) => Hashable (Free_ f a s) where
hashWithSalt :: Int -> Free_ f a s -> Int
hashWithSalt s :: Int
s (Free f :: f (Free f a s)
f) = (Int -> Free f a s -> Int) -> Int -> f (Free f a s) -> Int
forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> Free f a s -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s f (Free f a s)
f
free :: (Monad m, Hashable1 f, Hashable a, Eq1 f, Eq a) => f (Free f a s) -> Diagram f a s m (Free f a s)
free :: f (Free f a s) -> Diagram f a s m (Free f a s)
free f :: f (Free f a s)
f = StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(Free f a s)
-> Diagram f a s m (Free f a s)
forall (f :: * -> *) a s (m :: * -> *) r.
StateT (Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m r
-> Diagram f a s m r
Diagram (StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(Free f a s)
-> Diagram f a s m (Free f a s))
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(Free f a s)
-> Diagram f a s m (Free f a s)
forall a b. (a -> b) -> a -> b
$ do
(i :: Int
i, h :: HashMap (Free_ f a s) Int
h, fs :: IntMap (Free_ f a s)
fs) <- StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
forall s (m :: * -> *). MonadState s m => m s
get
case Free_ f a s -> HashMap (Free_ f a s) Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (f (Free f a s) -> Free_ f a s
forall (f :: * -> *) a s. f (Free f a s) -> Free_ f a s
Free f (Free f a s)
f) HashMap (Free_ f a s) Int
h of
Just j :: Int
j -> Free f a s
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(Free f a s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Free f a s
forall (f :: * -> *) a s. Int -> Free f a s
ID Int
j)
Nothing -> do
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s)) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, Free_ f a s
-> Int -> HashMap (Free_ f a s) Int -> HashMap (Free_ f a s) Int
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (f (Free f a s) -> Free_ f a s
forall (f :: * -> *) a s. f (Free f a s) -> Free_ f a s
Free f (Free f a s)
f) Int
i HashMap (Free_ f a s) Int
h, Int -> Free_ f a s -> IntMap (Free_ f a s) -> IntMap (Free_ f a s)
forall a. Int -> a -> IntMap a -> IntMap a
I.insert Int
i (f (Free f a s) -> Free_ f a s
forall (f :: * -> *) a s. f (Free f a s) -> Free_ f a s
Free f (Free f a s)
f) IntMap (Free_ f a s)
fs)
Free f a s
-> StateT
(Int, HashMap (Free_ f a s) Int, IntMap (Free_ f a s))
m
(Free f a s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Free f a s
forall (f :: * -> *) a s. Int -> Free f a s
ID Int
i)
{-# INLINE fromFree #-}
fromFree :: Monad m => Free f a s -> (f (Free f a s) -> Diagram f a s m b) -> (a -> Diagram f a s m b) -> Diagram f a s m b
fromFree :: Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
fromFree (Pure a :: a
a) _ b :: a -> Diagram f a s m b
b = a -> Diagram f a s m b
b a
a
fromFree (ID i :: Int
i) f :: f (Free f a s) -> Diagram f a s m b
f _ = Int -> Diagram f a s m (f (Free f a s))
forall (m :: * -> *) (f :: * -> *) a s.
Monad m =>
Int -> Diagram f a s m (f (Free f a s))
lookup Int
i Diagram f a s m (f (Free f a s))
-> (f (Free f a s) -> Diagram f a s m b) -> Diagram f a s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f (Free f a s) -> Diagram f a s m b
f
retract :: (Monad f, Traversable f) => Free f a s -> Diagram f a s f a
{-# INLINE retract #-}
retract :: Free f a s -> Diagram f a s f a
retract = (f a -> Diagram f a s f a)
-> (a -> Diagram f a s f a) -> Free f a s -> Diagram f a s f a
forall (m :: * -> *) (f :: * -> *) b a s.
(Monad m, Traversable f) =>
(f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
fold f a -> Diagram f a s f a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f a -> Diagram f a s f a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f a -> Diagram f a s f a) -> (a -> f a) -> a -> Diagram f a s f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return)
{-# INLINE map #-}
map :: (Hashable1 f, Hashable a, Eq1 f, Eq a, Monad m, Traversable f) => (a -> Diagram f a s m a) -> Free f a s -> Diagram f a s m (Free f a s)
map :: (a -> Diagram f a s m a)
-> Free f a s -> Diagram f a s m (Free f a s)
map f :: a -> Diagram f a s m a
f = (f (Free f a s) -> Diagram f a s m (Free f a s))
-> (a -> Diagram f a s m (Free f a s))
-> Free f a s
-> Diagram f a s m (Free f a s)
forall (m :: * -> *) (f :: * -> *) b a s.
(Monad m, Traversable f) =>
(f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
fold f (Free f a s) -> Diagram f a s m (Free f a s)
forall (m :: * -> *) (f :: * -> *) a s.
(Monad m, Hashable1 f, Hashable a, Eq1 f, Eq a) =>
f (Free f a s) -> Diagram f a s m (Free f a s)
free ((a -> Free f a s)
-> Diagram f a s m a -> Diagram f a s m (Free f a s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Free f a s
forall (f :: * -> *) a s. a -> Free f a s
Pure (Diagram f a s m a -> Diagram f a s m (Free f a s))
-> (a -> Diagram f a s m a) -> a -> Diagram f a s m (Free f a s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Diagram f a s m a
f)
{-# INLINE bind #-}
bind :: (Hashable1 f, Hashable a, Eq1 f, Eq a, Monad m, Traversable f) => Free f a s -> (a -> Diagram f a s m (Free f a s)) -> Diagram f a s m (Free f a s)
bind :: Free f a s
-> (a -> Diagram f a s m (Free f a s))
-> Diagram f a s m (Free f a s)
bind = ((a -> Diagram f a s m (Free f a s))
-> Free f a s -> Diagram f a s m (Free f a s))
-> Free f a s
-> (a -> Diagram f a s m (Free f a s))
-> Diagram f a s m (Free f a s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((f (Free f a s) -> Diagram f a s m (Free f a s))
-> (a -> Diagram f a s m (Free f a s))
-> Free f a s
-> Diagram f a s m (Free f a s)
forall (m :: * -> *) (f :: * -> *) b a s.
(Monad m, Traversable f) =>
(f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
fold f (Free f a s) -> Diagram f a s m (Free f a s)
forall (m :: * -> *) (f :: * -> *) a s.
(Monad m, Hashable1 f, Hashable a, Eq1 f, Eq a) =>
f (Free f a s) -> Diagram f a s m (Free f a s)
free)
{-# INLINE fold #-}
fold :: (Monad m, Traversable f) => (f b -> Diagram f a s m b) -> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
fold :: (f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
fold f :: f b -> Diagram f a s m b
f b :: a -> Diagram f a s m b
b x :: Free f a s
x = Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
fromFree Free f a s
x ((Free f a s -> Diagram f a s m b)
-> f (Free f a s) -> Diagram f a s m (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
forall (m :: * -> *) (f :: * -> *) b a s.
(Monad m, Traversable f) =>
(f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
fold f b -> Diagram f a s m b
f a -> Diagram f a s m b
b) (f (Free f a s) -> Diagram f a s m (f b))
-> (f b -> Diagram f a s m b)
-> f (Free f a s)
-> Diagram f a s m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> f b -> Diagram f a s m b
f) a -> Diagram f a s m b
b