Oblivious.hs

{-# 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 f s = f s <&> \t -> foldMap (weft . weave_BF f) t

-- | Unfold an @f@-tree.
unfold_BF :: (Foldable f, Monad m) => (s -> m (f s)) -> s -> m ()
unfold_BF f s = weave_BF f s >>= mesh_

-- | Weave a binary tree.
weave_BF_Binary :: Applicative m => (s -> m (Maybe (unit, s, s))) -> s -> m (Weave m)
weave_BF_Binary f s = f s <&> \case
  Nothing -> mempty
  Just (_, l, r) -> weft (weave_BF_Binary f l) <> weft (weave_BF_Binary f r)

-- | Unfold a binary tree.
unfold_BF_Binary :: Monad m => (s -> m (Maybe (unit, s, s))) -> s -> m ()
unfold_BF_Binary f s = weave_BF_Binary f s >>= mesh_

-- | Weave a rose tree.
weave_BF_Tree :: Applicative m => (s -> m (unit, [s])) -> s -> m (Weave m)
weave_BF_Tree f s = f s <&> \(_, bs) -> foldMap (weft . weave_BF_Tree f) bs

-- | Weave a rose tree.
unfold_BF_Tree :: Monad m => (s -> m (unit, [s])) -> s -> m ()
unfold_BF_Tree f s = weave_BF_Tree f s >>= mesh_