{-# LANGUAGE RankNTypes, LambdaCase, DeriveFunctor, BangPatterns #-}
module Control.Monad.Tangle
(TangleFT(..), hitchF
, evalTangleFT
, liftTangles
, blank
, hitch
, gather
, TangleF
, evalTangleF
, TangleT
, evalTangleT
, Tangle
, evalTangle
) where
import Barbies
import Control.Applicative
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Functor.Identity
import Data.Functor.Compose
newtype TangleFT t f m a = TangleFT
{ TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
runTangleFT :: t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a) }
deriving a -> TangleFT t f m b -> TangleFT t f m a
(a -> b) -> TangleFT t f m a -> TangleFT t f m b
(forall a b. (a -> b) -> TangleFT t f m a -> TangleFT t f m b)
-> (forall a b. a -> TangleFT t f m b -> TangleFT t f m a)
-> Functor (TangleFT t f m)
forall a b. a -> TangleFT t f m b -> TangleFT t f m a
forall a b. (a -> b) -> TangleFT t f m a -> TangleFT t f m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> TangleFT t f m b -> TangleFT t f m a
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> TangleFT t f m a -> TangleFT t f m b
<$ :: a -> TangleFT t f m b -> TangleFT t f m a
$c<$ :: forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> TangleFT t f m b -> TangleFT t f m a
fmap :: (a -> b) -> TangleFT t f m a -> TangleFT t f m b
$cfmap :: forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> TangleFT t f m a -> TangleFT t f m b
Functor
instance Monad m => Applicative (TangleFT t f m) where
pure :: a -> TangleFT t f m a
pure a
a = (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
(t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
TangleFT ((t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a)
-> (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
forall a b. (a -> b) -> a -> b
$ \t (Compose (TangleFT t f m) f)
_ t (Compose Maybe f)
mem -> (t (Compose Maybe f), a) -> m (t (Compose Maybe f), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t (Compose Maybe f)
mem, a
a)
TangleFT t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a -> b)
m <*> :: TangleFT t f m (a -> b) -> TangleFT t f m a -> TangleFT t f m b
<*> TangleFT t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a)
n = (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), b))
-> TangleFT t f m b
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
(t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
TangleFT ((t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), b))
-> TangleFT t f m b)
-> (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), b))
-> TangleFT t f m b
forall a b. (a -> b) -> a -> b
$ \t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem -> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a -> b)
m t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem
m (t (Compose Maybe f), a -> b)
-> ((t (Compose Maybe f), a -> b) -> m (t (Compose Maybe f), b))
-> m (t (Compose Maybe f), b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(t (Compose Maybe f)
mem', a -> b
f) -> (\(t (Compose Maybe f)
mem'', a
a) -> (t (Compose Maybe f)
mem'', a -> b
f a
a)) ((t (Compose Maybe f), a) -> (t (Compose Maybe f), b))
-> m (t (Compose Maybe f), a) -> m (t (Compose Maybe f), b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a)
n t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem'
instance Monad m => Monad (TangleFT t f m) where
TangleFT t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a)
m >>= :: TangleFT t f m a -> (a -> TangleFT t f m b) -> TangleFT t f m b
>>= a -> TangleFT t f m b
k = (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), b))
-> TangleFT t f m b
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
(t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
TangleFT ((t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), b))
-> TangleFT t f m b)
-> (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), b))
-> TangleFT t f m b
forall a b. (a -> b) -> a -> b
$ \t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem -> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a)
m t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem m (t (Compose Maybe f), a)
-> ((t (Compose Maybe f), a) -> m (t (Compose Maybe f), b))
-> m (t (Compose Maybe f), b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(t (Compose Maybe f)
mem', a
a) -> TangleFT t f m b
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), b)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
runTangleFT (a -> TangleFT t f m b
k a
a) t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem'
instance (Monad m, Semigroup a) => Semigroup (TangleFT t f m a) where
<> :: TangleFT t f m a -> TangleFT t f m a -> TangleFT t f m a
(<>) = (a -> a -> a)
-> TangleFT t f m a -> TangleFT t f m a -> TangleFT t f m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Monad m, Monoid a) => Monoid (TangleFT t f m a) where
mempty :: TangleFT t f m a
mempty = a -> TangleFT t f m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
instance MonadTrans (TangleFT t f) where
lift :: m a -> TangleFT t f m a
lift m a
m = (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
(t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
TangleFT ((t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a)
-> (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
forall a b. (a -> b) -> a -> b
$ \t (Compose (TangleFT t f m) f)
_ t (Compose Maybe f)
mem -> (a -> (t (Compose Maybe f), a))
-> m a -> m (t (Compose Maybe f), a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) t (Compose Maybe f)
mem) m a
m
instance MonadIO m => MonadIO (TangleFT t f m) where
liftIO :: IO a -> TangleFT t f m a
liftIO IO a
m = (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
(t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
TangleFT ((t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a)
-> (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
forall a b. (a -> b) -> a -> b
$ \t (Compose (TangleFT t f m) f)
_ t (Compose Maybe f)
mem -> (a -> (t (Compose Maybe f), a))
-> m a -> m (t (Compose Maybe f), a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) t (Compose Maybe f)
mem) (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m)
gather :: (TraversableB t, Monad m) => TangleFT t f m (t f)
gather :: TangleFT t f m (t f)
gather = (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), t f))
-> TangleFT t f m (t f)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
(t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
TangleFT ((t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), t f))
-> TangleFT t f m (t f))
-> (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), t f))
-> TangleFT t f m (t f)
forall a b. (a -> b) -> a -> b
$ \t (Compose (TangleFT t f m) f)
env t (Compose Maybe f)
prev -> TangleFT t f m (t f)
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), t f)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
runTangleFT ((forall a. Compose (TangleFT t f m) f a -> TangleFT t f m (f a))
-> t (Compose (TangleFT t f m) f) -> TangleFT t f m (t f)
forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
(g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse forall a. Compose (TangleFT t f m) f a -> TangleFT t f m (f a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose t (Compose (TangleFT t f m) f)
env) t (Compose (TangleFT t f m) f)
env t (Compose Maybe f)
prev
hitchF :: Monad m
=> (forall h g. Functor g => (h a -> g (h a)) -> t h -> g (t h))
-> TangleFT t f m (f a)
hitchF :: (forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h))
-> TangleFT t f m (f a)
hitchF forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h)
l = (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), f a))
-> TangleFT t f m (f a)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
(t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), a))
-> TangleFT t f m a
TangleFT ((t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), f a))
-> TangleFT t f m (f a))
-> (t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f) -> m (t (Compose Maybe f), f a))
-> TangleFT t f m (f a)
forall a b. (a -> b) -> a -> b
$ \t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem -> Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f))
-> m (t (Compose Maybe f), f a)
forall a k (b :: k). Const a b -> a
getConst (Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f))
-> m (t (Compose Maybe f), f a))
-> Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f))
-> m (t (Compose Maybe f), f a)
forall a b. (a -> b) -> a -> b
$ ((Compose Maybe f a
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a))
-> t (Compose Maybe f)
-> Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f)))
-> t (Compose Maybe f)
-> (Compose Maybe f a
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a))
-> Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Compose Maybe f a
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a))
-> t (Compose Maybe f)
-> Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f))
forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h)
l t (Compose Maybe f)
mem ((Compose Maybe f a
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a))
-> Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f)))
-> (Compose Maybe f a
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a))
-> Const (m (t (Compose Maybe f), f a)) (t (Compose Maybe f))
forall a b. (a -> b) -> a -> b
$ \case
Compose (Just f a
a) -> m (t (Compose Maybe f), f a)
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a)
forall k a (b :: k). a -> Const a b
Const (m (t (Compose Maybe f), f a)
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a))
-> m (t (Compose Maybe f), f a)
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a)
forall a b. (a -> b) -> a -> b
$ (t (Compose Maybe f), f a) -> m (t (Compose Maybe f), f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t (Compose Maybe f)
mem, f a
a)
Compose Maybe (f a)
Nothing -> m (t (Compose Maybe f), f a)
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a)
forall k a (b :: k). a -> Const a b
Const
(m (t (Compose Maybe f), f a)
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a))
-> m (t (Compose Maybe f), f a)
-> Const (m (t (Compose Maybe f), f a)) (Compose Maybe f a)
forall a b. (a -> b) -> a -> b
$ ((t (Compose Maybe f), f a) -> (t (Compose Maybe f), f a))
-> m (t (Compose Maybe f), f a) -> m (t (Compose Maybe f), f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(t (Compose Maybe f)
mem', f a
a) -> let !(Identity t (Compose Maybe f)
mem'') = (Compose Maybe f a -> Identity (Compose Maybe f a))
-> t (Compose Maybe f) -> Identity (t (Compose Maybe f))
forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h)
l (Identity (Compose Maybe f a)
-> Compose Maybe f a -> Identity (Compose Maybe f a)
forall a b. a -> b -> a
const (Identity (Compose Maybe f a)
-> Compose Maybe f a -> Identity (Compose Maybe f a))
-> Identity (Compose Maybe f a)
-> Compose Maybe f a
-> Identity (Compose Maybe f a)
forall a b. (a -> b) -> a -> b
$ Compose Maybe f a -> Identity (Compose Maybe f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compose Maybe f a -> Identity (Compose Maybe f a))
-> Compose Maybe f a -> Identity (Compose Maybe f a)
forall a b. (a -> b) -> a -> b
$ Maybe (f a) -> Compose Maybe f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Maybe (f a) -> Compose Maybe f a)
-> Maybe (f a) -> Compose Maybe f a
forall a b. (a -> b) -> a -> b
$ f a -> Maybe (f a)
forall a. a -> Maybe a
Just f a
a) t (Compose Maybe f)
mem' in (t (Compose Maybe f)
mem'', f a
a))
(m (t (Compose Maybe f), f a) -> m (t (Compose Maybe f), f a))
-> m (t (Compose Maybe f), f a) -> m (t (Compose Maybe f), f a)
forall a b. (a -> b) -> a -> b
$ TangleFT t f m (f a)
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), f a)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
runTangleFT (Compose (TangleFT t f m) f a -> TangleFT t f m (f a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (TangleFT t f m) f a -> TangleFT t f m (f a))
-> Compose (TangleFT t f m) f a -> TangleFT t f m (f a)
forall a b. (a -> b) -> a -> b
$ Const
(Compose (TangleFT t f m) f a) (t (Compose (TangleFT t f m) f))
-> Compose (TangleFT t f m) f a
forall a k (b :: k). Const a b -> a
getConst (Const
(Compose (TangleFT t f m) f a) (t (Compose (TangleFT t f m) f))
-> Compose (TangleFT t f m) f a)
-> Const
(Compose (TangleFT t f m) f a) (t (Compose (TangleFT t f m) f))
-> Compose (TangleFT t f m) f a
forall a b. (a -> b) -> a -> b
$ (Compose (TangleFT t f m) f a
-> Const
(Compose (TangleFT t f m) f a) (Compose (TangleFT t f m) f a))
-> t (Compose (TangleFT t f m) f)
-> Const
(Compose (TangleFT t f m) f a) (t (Compose (TangleFT t f m) f))
forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h)
l Compose (TangleFT t f m) f a
-> Const
(Compose (TangleFT t f m) f a) (Compose (TangleFT t f m) f a)
forall k a (b :: k). a -> Const a b
Const t (Compose (TangleFT t f m) f)
ts) t (Compose (TangleFT t f m) f)
ts t (Compose Maybe f)
mem
{-# INLINE hitchF #-}
evalTangleFT :: (ApplicativeB t, Functor m) => TangleFT t f m a -> t (Compose (TangleFT t f m) f) -> m a
evalTangleFT :: TangleFT t f m a -> t (Compose (TangleFT t f m) f) -> m a
evalTangleFT TangleFT t f m a
m t (Compose (TangleFT t f m) f)
t = (t (Compose Maybe f), a) -> a
forall a b. (a, b) -> b
snd ((t (Compose Maybe f), a) -> a)
-> m (t (Compose Maybe f), a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
runTangleFT TangleFT t f m a
m t (Compose (TangleFT t f m) f)
t t (Compose Maybe f)
forall (b :: (* -> *) -> *) (f :: * -> *).
ApplicativeB b =>
b (Compose Maybe f)
blank
{-# INLINE evalTangleFT #-}
liftTangles :: (FunctorB b, Functor m) => b (TangleT b m) -> b (Compose (TangleT b m) Identity)
liftTangles :: b (TangleT b m) -> b (Compose (TangleT b m) Identity)
liftTangles = (forall a. TangleT b m a -> Compose (TangleT b m) Identity a)
-> b (TangleT b m) -> b (Compose (TangleT b m) Identity)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
bmap (TangleT b m (Identity a) -> Compose (TangleT b m) Identity a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (TangleT b m (Identity a) -> Compose (TangleT b m) Identity a)
-> (TangleT b m a -> TangleT b m (Identity a))
-> TangleT b m a
-> Compose (TangleT b m) Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity a) -> TangleT b m a -> TangleT b m (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity)
{-# INLINE liftTangles #-}
blank :: ApplicativeB b => b (Compose Maybe f)
blank :: b (Compose Maybe f)
blank = (forall a. Compose Maybe f a) -> b (Compose Maybe f)
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
bpure ((forall a. Compose Maybe f a) -> b (Compose Maybe f))
-> (forall a. Compose Maybe f a) -> b (Compose Maybe f)
forall a b. (a -> b) -> a -> b
$ Maybe (f a) -> Compose Maybe f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Maybe (f a)
forall a. Maybe a
Nothing
type TangleT t = TangleFT t Identity
type TangleF t f = TangleFT t f Identity
type Tangle t = TangleFT t Identity Identity
hitch :: Monad m
=> (forall h g. Functor g => (h a -> g (h a)) -> t h -> g (t h))
-> TangleT t m a
hitch :: (forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h))
-> TangleT t m a
hitch forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h)
l = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> TangleFT t Identity m (Identity a) -> TangleT t m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h))
-> TangleFT t Identity m (Identity a)
forall (m :: * -> *) a (t :: (* -> *) -> *) (f :: * -> *).
Monad m =>
(forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h))
-> TangleFT t f m (f a)
hitchF forall (h :: * -> *) (g :: * -> *).
Functor g =>
(h a -> g (h a)) -> t h -> g (t h)
l
{-# INLINE hitch #-}
evalTangleF :: ApplicativeB t => TangleF t f a -> t (Compose (TangleF t f) f) -> a
evalTangleF :: TangleF t f a -> t (Compose (TangleF t f) f) -> a
evalTangleF TangleF t f a
m t (Compose (TangleF t f) f)
t = (t (Compose Maybe f), a) -> a
forall a b. (a, b) -> b
snd ((t (Compose Maybe f), a) -> a) -> (t (Compose Maybe f), a) -> a
forall a b. (a -> b) -> a -> b
$ Identity (t (Compose Maybe f), a) -> (t (Compose Maybe f), a)
forall a. Identity a -> a
runIdentity (Identity (t (Compose Maybe f), a) -> (t (Compose Maybe f), a))
-> Identity (t (Compose Maybe f), a) -> (t (Compose Maybe f), a)
forall a b. (a -> b) -> a -> b
$ TangleF t f a
-> t (Compose (TangleF t f) f)
-> t (Compose Maybe f)
-> Identity (t (Compose Maybe f), a)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
runTangleFT TangleF t f a
m t (Compose (TangleF t f) f)
t t (Compose Maybe f)
forall (b :: (* -> *) -> *) (f :: * -> *).
ApplicativeB b =>
b (Compose Maybe f)
blank
{-# INLINE evalTangleF #-}
evalTangleT :: (Functor m, ApplicativeB t) => TangleT t m a -> t (TangleT t m) -> m a
evalTangleT :: TangleT t m a -> t (TangleT t m) -> m a
evalTangleT TangleT t m a
m t (TangleT t m)
t = ((t (Compose Maybe Identity), a) -> a)
-> m (t (Compose Maybe Identity), a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t (Compose Maybe Identity), a) -> a
forall a b. (a, b) -> b
snd (m (t (Compose Maybe Identity), a) -> m a)
-> m (t (Compose Maybe Identity), a) -> m a
forall a b. (a -> b) -> a -> b
$ TangleT t m a
-> t (Compose (TangleT t m) Identity)
-> t (Compose Maybe Identity)
-> m (t (Compose Maybe Identity), a)
forall (t :: (* -> *) -> *) (f :: * -> *) (m :: * -> *) a.
TangleFT t f m a
-> t (Compose (TangleFT t f m) f)
-> t (Compose Maybe f)
-> m (t (Compose Maybe f), a)
runTangleFT TangleT t m a
m (t (TangleT t m) -> t (Compose (TangleT t m) Identity)
forall (b :: (* -> *) -> *) (m :: * -> *).
(FunctorB b, Functor m) =>
b (TangleT b m) -> b (Compose (TangleT b m) Identity)
liftTangles t (TangleT t m)
t) t (Compose Maybe Identity)
forall (b :: (* -> *) -> *) (f :: * -> *).
ApplicativeB b =>
b (Compose Maybe f)
blank
{-# INLINE evalTangleT #-}
evalTangle :: (ApplicativeB t) => Tangle t a -> t (Tangle t) -> a
evalTangle :: Tangle t a -> t (Tangle t) -> a
evalTangle Tangle t a
m t (Tangle t)
t = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ Tangle t a -> t (Tangle t) -> Identity a
forall (m :: * -> *) (t :: (* -> *) -> *) a.
(Functor m, ApplicativeB t) =>
TangleT t m a -> t (TangleT t m) -> m a
evalTangleT Tangle t a
m t (Tangle t)
t
{-# INLINE evalTangle #-}