{-# LANGUAGE LambdaCase #-}
-- | Oblivious unfolds.

--

-- The usual "@_@" suffix is omitted since it's obvious that they are oblivious.

module Weave.Unfold.Oblivious where

import Data.Functor ((<&>))
import Weave.Oblivious

-- | Weave an @f@-tree.

weave_BF :: (Foldable f, Applicative m) => (s -> m (f s)) -> s -> m (Weave m)
weave_BF :: forall (f :: * -> *) (m :: * -> *) s.
(Foldable f, Applicative m) =>
(s -> m (f s)) -> s -> m (Weave m)
weave_BF s -> m (f s)
f s
s = s -> m (f s)
f s
s m (f s) -> (f s -> Weave m) -> m (Weave m)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \f s
t -> (s -> Weave m) -> f s -> Weave m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m (Weave m) -> Weave m
forall (m :: * -> *). m (Weave m) -> Weave m
weft (m (Weave m) -> Weave m) -> (s -> m (Weave m)) -> s -> Weave m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> m (f s)) -> s -> m (Weave m)
forall (f :: * -> *) (m :: * -> *) s.
(Foldable f, Applicative m) =>
(s -> m (f s)) -> s -> m (Weave m)
weave_BF s -> m (f s)
f) f s
t

-- | Unfold an @f@-tree.

unfold_BF :: (Foldable f, Monad m) => (s -> m (f s)) -> s -> m ()
unfold_BF :: forall (f :: * -> *) (m :: * -> *) s.
(Foldable f, Monad m) =>
(s -> m (f s)) -> s -> m ()
unfold_BF s -> m (f s)
f s
s = (s -> m (f s)) -> s -> m (Weave m)
forall (f :: * -> *) (m :: * -> *) s.
(Foldable f, Applicative m) =>
(s -> m (f s)) -> s -> m (Weave m)
weave_BF s -> m (f s)
f s
s m (Weave m) -> (Weave m -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Weave m -> m ()
forall (m :: * -> *). Monad m => Weave m -> m ()
mesh_

-- | Weave a binary tree.

weave_BF_Binary :: Applicative m => (s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
weave_BF_Binary :: forall (m :: * -> *) s unit.
Applicative m =>
(s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
weave_BF_Binary s -> m (Maybe (unit, s, s))
f s
s = s -> m (Maybe (unit, s, s))
f s
s m (Maybe (unit, s, s))
-> (Maybe (unit, s, s) -> Weave m) -> m (Weave m)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Maybe (unit, s, s)
Nothing -> Weave m
forall a. Monoid a => a
mempty
  Just (unit
_, s
l, s
r) -> m (Weave m) -> Weave m
forall (m :: * -> *). m (Weave m) -> Weave m
weft ((s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
forall (m :: * -> *) s unit.
Applicative m =>
(s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
weave_BF_Binary s -> m (Maybe (unit, s, s))
f s
l) Weave m -> Weave m -> Weave m
forall a. Semigroup a => a -> a -> a
<> m (Weave m) -> Weave m
forall (m :: * -> *). m (Weave m) -> Weave m
weft ((s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
forall (m :: * -> *) s unit.
Applicative m =>
(s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
weave_BF_Binary s -> m (Maybe (unit, s, s))
f s
r)

-- | Unfold a binary tree.

unfold_BF_Binary :: Monad m => (s -> m (Maybe (unit, s, s))) -> s -> m ()
unfold_BF_Binary :: forall (m :: * -> *) s unit.
Monad m =>
(s -> m (Maybe (unit, s, s))) -> s -> m ()
unfold_BF_Binary s -> m (Maybe (unit, s, s))
f s
s = (s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
forall (m :: * -> *) s unit.
Applicative m =>
(s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
weave_BF_Binary s -> m (Maybe (unit, s, s))
f s
s m (Weave m) -> (Weave m -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Weave m -> m ()
forall (m :: * -> *). Monad m => Weave m -> m ()
mesh_

-- | Weave a rose tree.

weave_BF_Tree :: Applicative m => (s -> m (unit, [s])) -> s -> m (Weave m)
weave_BF_Tree :: forall (m :: * -> *) s unit.
Applicative m =>
(s -> m (unit, [s])) -> s -> m (Weave m)
weave_BF_Tree s -> m (unit, [s])
f s
s = s -> m (unit, [s])
f s
s m (unit, [s]) -> ((unit, [s]) -> Weave m) -> m (Weave m)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(unit
_, [s]
bs) -> (s -> Weave m) -> [s] -> Weave m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m (Weave m) -> Weave m
forall (m :: * -> *). m (Weave m) -> Weave m
weft (m (Weave m) -> Weave m) -> (s -> m (Weave m)) -> s -> Weave m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> m (unit, [s])) -> s -> m (Weave m)
forall (m :: * -> *) s unit.
Applicative m =>
(s -> m (unit, [s])) -> s -> m (Weave m)
weave_BF_Tree s -> m (unit, [s])
f) [s]
bs

-- | Weave a rose tree.

unfold_BF_Tree :: Monad m => (s -> m (unit, [s])) -> s -> m ()
unfold_BF_Tree :: forall (m :: * -> *) s unit.
Monad m =>
(s -> m (unit, [s])) -> s -> m ()
unfold_BF_Tree s -> m (unit, [s])
f s
s = (s -> m (unit, [s])) -> s -> m (Weave m)
forall (m :: * -> *) s unit.
Applicative m =>
(s -> m (unit, [s])) -> s -> m (Weave m)
weave_BF_Tree s -> m (unit, [s])
f s
s m (Weave m) -> (Weave m -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Weave m -> m ()
forall (m :: * -> *). Monad m => Weave m -> m ()
mesh_