{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Zipper.Recursive.Internal where

import qualified Control.Comonad as Comonad
import Control.Comonad.Cofree
import qualified Control.Comonad.Cofree as Cofree
import qualified Control.Comonad.Trans.Cofree as CofreeF
import Control.Lens hiding (children, (:<))
import Control.Monad
import Data.Functor.Classes
import qualified Data.Functor.Foldable as FF
import Data.Maybe

-- | Alias for constraints required for many zipper operations.
type Idx i f a = (Ixed (f (Cofree f a)), IxValue (f (Cofree f a)) ~ (Cofree f a), Index (f (Cofree f a)) ~ i)

-- | The core zipper type
data Zipper i (f :: * -> *) a = Zipper
  { Zipper i f a -> [(i, Cofree f a)]
parents :: [(i, Cofree f a)],
    Zipper i f a -> Cofree f a
focus :: Cofree f a
  }
  deriving (a -> Zipper i f b -> Zipper i f a
(a -> b) -> Zipper i f a -> Zipper i f b
(forall a b. (a -> b) -> Zipper i f a -> Zipper i f b)
-> (forall a b. a -> Zipper i f b -> Zipper i f a)
-> Functor (Zipper i f)
forall a b. a -> Zipper i f b -> Zipper i f a
forall a b. (a -> b) -> Zipper i f a -> Zipper i f b
forall i (f :: * -> *) a b.
Functor f =>
a -> Zipper i f b -> Zipper i f a
forall i (f :: * -> *) a b.
Functor f =>
(a -> b) -> Zipper i f a -> Zipper i f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Zipper i f b -> Zipper i f a
$c<$ :: forall i (f :: * -> *) a b.
Functor f =>
a -> Zipper i f b -> Zipper i f a
fmap :: (a -> b) -> Zipper i f a -> Zipper i f b
$cfmap :: forall i (f :: * -> *) a b.
Functor f =>
(a -> b) -> Zipper i f a -> Zipper i f b
Functor)

deriving instance (Eq1 f, Eq i, Eq a) => Eq (Zipper i f a)

deriving instance (Ord1 f, Ord i, Ord a) => Ord (Zipper i f a)

-- | Get the location of the current selection within its parent if we have one.
--
-- @O(1)@
currentIndex :: Zipper i f a -> Maybe i
currentIndex :: Zipper i f a -> Maybe i
currentIndex (Zipper ((i
i, Cofree f a
_) : [(i, Cofree f a)]
_) Cofree f a
_) = i -> Maybe i
forall a. a -> Maybe a
Just i
i
currentIndex Zipper i f a
_ = Maybe i
forall a. Maybe a
Nothing

-- | Get the path to the current value from the root of the structure.
--
-- @O(depth)
currentPath :: Zipper i f a -> [i]
currentPath :: Zipper i f a -> [i]
currentPath (Zipper [(i, Cofree f a)]
parents Cofree f a
_) = [i] -> [i]
forall a. [a] -> [a]
reverse ([i] -> [i]) -> [i] -> [i]
forall a b. (a -> b) -> a -> b
$ ((i, Cofree f a) -> i) -> [(i, Cofree f a)] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i, Cofree f a) -> i
forall a b. (a, b) -> a
fst [(i, Cofree f a)]
parents

-- | Focus the tag at the current position.
focus_ :: Lens' (Zipper i f a) a
focus_ :: (a -> f a) -> Zipper i f a -> f (Zipper i f a)
focus_ a -> f a
f (Zipper [(i, Cofree f a)]
parents Cofree f a
foc) = [(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper [(i, Cofree f a)]
parents (Cofree f a -> Zipper i f a) -> f (Cofree f a) -> f (Zipper i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cofree f a
foc Cofree f a -> (Cofree f a -> f (Cofree f a)) -> f (Cofree f a)
forall a b. a -> (a -> b) -> b
& (a -> f a) -> Cofree f a -> f (Cofree f a)
forall (f :: * -> *) a (g :: * -> *).
Functor f =>
(a -> f a) -> Cofree g a -> f (Cofree g a)
_extract ((a -> f a) -> Cofree f a -> f (Cofree f a))
-> (a -> f a) -> Cofree f a -> f (Cofree f a)
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ a -> f a
f)

-- | Focus the currently selected sub-tree as a 'Cofree'
unwrapped_ :: Lens' (Zipper i f a) (Cofree f a)
unwrapped_ :: (Cofree f a -> f (Cofree f a)) -> Zipper i f a -> f (Zipper i f a)
unwrapped_ Cofree f a -> f (Cofree f a)
f (Zipper [(i, Cofree f a)]
parents Cofree f a
foc) = [(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper [(i, Cofree f a)]
parents (Cofree f a -> Zipper i f a) -> f (Cofree f a) -> f (Zipper i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cofree f a -> f (Cofree f a)
f Cofree f a
foc

-- TODO: implement proper comonad instance
-- extract :: Zipper i f a -> a
-- extract (Zipper _ (a :< _)) = a

-- instance Functor f => Comonad (Zipper i f) where
--   extract = extract . _focus
--   duplicate :: forall f a. (Zipper i f a) -> Zipper i f (Zipper i f a)
--   duplicate z@(Zipper parents foc) = Zipper (zipWith (\z (i,_) -> (i, z)) rezippedParents parents) (foc $> z)
--     where
--       rezippedParents :: [Zipper i f a]
--       rezippedParents = unfoldr go z
--       go current =
--         let x = up current
--          in liftA2 (,) x x
--       -- go (current, []) = Nothing
--       -- go :: (Zipper i f a, [(i, Cofree f a)]) -> Maybe (_, Cofree f a)
--       -- go = _

-- | A useful combinator for chaining operations which might fail.
-- If an operation fails, the original zipper is returned.
--
-- E.g.
--
-- >>> tug up z
tug :: (a -> Maybe a) -> a -> a
tug :: (a -> Maybe a) -> a -> a
tug a -> Maybe a
f a
a = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
a (a -> Maybe a
f a
a)

-- | Create a zipper over a cofree structure
zipper :: Cofree f a -> Zipper i f a
zipper :: Cofree f a -> Zipper i f a
zipper Cofree f a
f = [(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper [] Cofree f a
f

-- | Create a zipper from a recursive type, tagging it with '()'
fromRecursive :: FF.Recursive t => t -> Zipper i (FF.Base t) ()
fromRecursive :: t -> Zipper i (Base t) ()
fromRecursive t
t = Cofree (Base t) () -> Zipper i (Base t) ()
forall (f :: * -> *) a i. Cofree f a -> Zipper i f a
zipper (Cofree (Base t) () -> Zipper i (Base t) ())
-> Cofree (Base t) () -> Zipper i (Base t) ()
forall a b. (a -> b) -> a -> b
$ (t -> ((), Base t t)) -> t -> Cofree (Base t) ()
forall (f :: * -> *) b a.
Functor f =>
(b -> (a, f b)) -> b -> Cofree f a
Cofree.unfold (((),) (Base t t -> ((), Base t t))
-> (t -> Base t t) -> t -> ((), Base t t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Base t t
forall t. Recursive t => t -> Base t t
FF.project) t
t

-- | Create a zipper from a recursive type, given a function to generate annotations.
tagged :: FF.Recursive t => (t -> a) -> t -> Zipper i (FF.Base t) a
tagged :: (t -> a) -> t -> Zipper i (Base t) a
tagged t -> a
f t
t = Cofree (Base t) a -> Zipper i (Base t) a
forall (f :: * -> *) a i. Cofree f a -> Zipper i f a
zipper (Cofree (Base t) a -> Zipper i (Base t) a)
-> Cofree (Base t) a -> Zipper i (Base t) a
forall a b. (a -> b) -> a -> b
$ (t -> (a, Base t t)) -> t -> Cofree (Base t) a
forall (f :: * -> *) b a.
Functor f =>
(b -> (a, f b)) -> b -> Cofree f a
Cofree.unfold (\t
x -> (t -> a
f t
x, t -> Base t t
forall t. Recursive t => t -> Base t t
FF.project t
x)) t
t

-- | Select the subtree at the given location.
--
-- @O(1)@
down :: (Idx i f a) => i -> Zipper i f a -> Maybe (Zipper i f a)
down :: i -> Zipper i f a -> Maybe (Zipper i f a)
down i
i (Zipper [(i, Cofree f a)]
parents Cofree f a
current) = [(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper ((i
i, Cofree f a
current) (i, Cofree f a) -> [(i, Cofree f a)] -> [(i, Cofree f a)]
forall a. a -> [a] -> [a]
: [(i, Cofree f a)]
parents) (Cofree f a -> Zipper i f a)
-> Maybe (Cofree f a) -> Maybe (Zipper i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cofree f a
current Cofree f a
-> Getting (First (Cofree f a)) (Cofree f a) (Cofree f a)
-> Maybe (Cofree f a)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (f (Cofree f a) -> Const (First (Cofree f a)) (f (Cofree f a)))
-> Cofree f a -> Const (First (Cofree f a)) (Cofree f a)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap ((f (Cofree f a) -> Const (First (Cofree f a)) (f (Cofree f a)))
 -> Cofree f a -> Const (First (Cofree f a)) (Cofree f a))
-> ((Cofree f a -> Const (First (Cofree f a)) (Cofree f a))
    -> f (Cofree f a) -> Const (First (Cofree f a)) (f (Cofree f a)))
-> Getting (First (Cofree f a)) (Cofree f a) (Cofree f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (f (Cofree f a))
-> Traversal' (f (Cofree f a)) (IxValue (f (Cofree f a)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix i
Index (f (Cofree f a))
i)

-- | Select the parent of the current location.
--
-- @O(1)@
up :: Idx i f a => Zipper i f a -> Maybe (Zipper i f a)
up :: Zipper i f a -> Maybe (Zipper i f a)
up (Zipper ((i
i, Cofree f a
p) : [(i, Cofree f a)]
parents) Cofree f a
current) = Zipper i f a -> Maybe (Zipper i f a)
forall a. a -> Maybe a
Just (Zipper i f a -> Maybe (Zipper i f a))
-> Zipper i f a -> Maybe (Zipper i f a)
forall a b. (a -> b) -> a -> b
$ [(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper [(i, Cofree f a)]
parents (Cofree f a
p Cofree f a -> (Cofree f a -> Cofree f a) -> Cofree f a
forall a b. a -> (a -> b) -> b
& (f (Cofree f a) -> Identity (f (Cofree f a)))
-> Cofree f a -> Identity (Cofree f a)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap ((f (Cofree f a) -> Identity (f (Cofree f a)))
 -> Cofree f a -> Identity (Cofree f a))
-> ((Cofree f a -> Identity (Cofree f a))
    -> f (Cofree f a) -> Identity (f (Cofree f a)))
-> (Cofree f a -> Identity (Cofree f a))
-> Cofree f a
-> Identity (Cofree f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (f (Cofree f a))
-> Traversal' (f (Cofree f a)) (IxValue (f (Cofree f a)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix i
Index (f (Cofree f a))
i ((Cofree f a -> Identity (Cofree f a))
 -> Cofree f a -> Identity (Cofree f a))
-> Cofree f a -> Cofree f a -> Cofree f a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Cofree f a
current)
up Zipper i f a
_ = Maybe (Zipper i f a)
forall a. Maybe a
Nothing

-- | Re-zip the entire tree.
--
-- @O(d)@
rezip :: Idx i f a => Zipper i f a -> Cofree f a
rezip :: Zipper i f a -> Cofree f a
rezip Zipper i f a
z = case Zipper i f a -> Maybe (Zipper i f a)
forall i (f :: * -> *) a.
Idx i f a =>
Zipper i f a -> Maybe (Zipper i f a)
up Zipper i f a
z of
  Maybe (Zipper i f a)
Nothing -> Zipper i f a -> Cofree f a
forall i (f :: * -> *) a. Zipper i f a -> Cofree f a
focus Zipper i f a
z
  Just Zipper i f a
p -> Zipper i f a -> Cofree f a
forall i (f :: * -> *) a. Idx i f a => Zipper i f a -> Cofree f a
rezip Zipper i f a
p

-- | Rezip, forget all tags, and flatten the structure.
--
-- @O(d)@
flatten :: (FF.Corecursive f, Idx i (FF.Base f) a) => Zipper i (FF.Base f) a -> f
flatten :: Zipper i (Base f) a -> f
flatten = (Base (Cofree (Base f) a) f -> f) -> Cofree (Base f) a -> f
forall t a. Recursive t => (Base t a -> a) -> t -> a
FF.cata Base (Cofree (Base f) a) f -> f
forall t a. Corecursive t => CofreeF (Base t) a t -> t
alg (Cofree (Base f) a -> f)
-> (Zipper i (Base f) a -> Cofree (Base f) a)
-> Zipper i (Base f) a
-> f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper i (Base f) a -> Cofree (Base f) a
forall i (f :: * -> *) a. Idx i f a => Zipper i f a -> Cofree f a
rezip
  where
    alg :: CofreeF (Base t) a t -> t
alg (a
_ CofreeF.:< Base t t
fv) = Base t t -> t
forall t. Corecursive t => Base t t -> t
FF.embed Base t t
fv

-- | Move to the sibling which is located at 'i' in its parent.
--
-- @O(1)@
--
-- @
-- sibling i = up >=> down i
-- @
sibling :: Idx i f a => i -> Zipper i f a -> Maybe (Zipper i f a)
sibling :: i -> Zipper i f a -> Maybe (Zipper i f a)
sibling i
i = Zipper i f a -> Maybe (Zipper i f a)
forall i (f :: * -> *) a.
Idx i f a =>
Zipper i f a -> Maybe (Zipper i f a)
up (Zipper i f a -> Maybe (Zipper i f a))
-> (Zipper i f a -> Maybe (Zipper i f a))
-> Zipper i f a
-> Maybe (Zipper i f a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> i -> Zipper i f a -> Maybe (Zipper i f a)
forall i (f :: * -> *) a.
Idx i f a =>
i -> Zipper i f a -> Maybe (Zipper i f a)
down i
i

-- parentTags :: Traversal' (Zipper i f a) a
-- parentTags f (Zipper parents foc) = Zipper <$> (forwards (parents & traversed . _2 . _extract %%~ Backwards . f)) <*> pure foc

-- | Traversal over all subtrees of the current location.
children_ :: Traversable f => Traversal' (Zipper i f a) (Cofree f a)
children_ :: Traversal' (Zipper i f a) (Cofree f a)
children_ Cofree f a -> f (Cofree f a)
f (Zipper [(i, Cofree f a)]
parents Cofree f a
current) = [(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper [(i, Cofree f a)]
parents (Cofree f a -> Zipper i f a) -> f (Cofree f a) -> f (Zipper i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cofree f a
current Cofree f a -> (Cofree f a -> f (Cofree f a)) -> f (Cofree f a)
forall a b. a -> (a -> b) -> b
& (f (Cofree f a) -> f (f (Cofree f a)))
-> Cofree f a -> f (Cofree f a)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap ((f (Cofree f a) -> f (f (Cofree f a)))
 -> Cofree f a -> f (Cofree f a))
-> ((Cofree f a -> f (Cofree f a))
    -> f (Cofree f a) -> f (f (Cofree f a)))
-> (Cofree f a -> f (Cofree f a))
-> Cofree f a
-> f (Cofree f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cofree f a -> f (Cofree f a))
-> f (Cofree f a) -> f (f (Cofree f a))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((Cofree f a -> f (Cofree f a)) -> Cofree f a -> f (Cofree f a))
-> (Cofree f a -> f (Cofree f a)) -> Cofree f a -> f (Cofree f a)
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ Cofree f a -> f (Cofree f a)
f)

-- | Indexed traversal over all subtrees of the current location.
ichildren_ :: TraversableWithIndex i f => IndexedTraversal' i (Zipper i f a) (Cofree f a)
ichildren_ :: IndexedTraversal' i (Zipper i f a) (Cofree f a)
ichildren_ p (Cofree f a) (f (Cofree f a))
f (Zipper [(i, Cofree f a)]
parents Cofree f a
current) = [(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper [(i, Cofree f a)]
parents (Cofree f a -> Zipper i f a) -> f (Cofree f a) -> f (Zipper i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cofree f a
current Cofree f a -> (Cofree f a -> f (Cofree f a)) -> f (Cofree f a)
forall a b. a -> (a -> b) -> b
& (f (Cofree f a) -> f (f (Cofree f a)))
-> Cofree f a -> f (Cofree f a)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap ((f (Cofree f a) -> f (f (Cofree f a)))
 -> Cofree f a -> f (Cofree f a))
-> (Indexed i (Cofree f a) (f (Cofree f a))
    -> f (Cofree f a) -> f (f (Cofree f a)))
-> Indexed i (Cofree f a) (f (Cofree f a))
-> Cofree f a
-> f (Cofree f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indexed i (Cofree f a) (f (Cofree f a))
-> f (Cofree f a) -> f (f (Cofree f a))
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed (Indexed i (Cofree f a) (f (Cofree f a))
 -> Cofree f a -> f (Cofree f a))
-> (i -> Cofree f a -> f (Cofree f a))
-> Cofree f a
-> f (Cofree f a)
forall k i (f :: k -> *) s (t :: k) a (b :: k).
Over (Indexed i) f s t a b -> (i -> a -> f b) -> s -> f t
%%@~ \i
i Cofree f a
a -> p (Cofree f a) (f (Cofree f a))
-> i -> Cofree f a -> f (Cofree f a)
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (Cofree f a) (f (Cofree f a))
f i
i Cofree f a
a)

-- | Get the base-functor at the current location.
--
-- @O(1)@
branches :: Zipper i f a -> f (Cofree f a)
branches :: Zipper i f a -> f (Cofree f a)
branches (Zipper [(i, Cofree f a)]
_ (a
_ :< f (Cofree f a)
cs)) = f (Cofree f a)
cs

-- | A lens over the base-functor at the current location.
branches_ :: Lens' (Zipper i f a) (f (Cofree f a))
branches_ :: (f (Cofree f a) -> f (f (Cofree f a)))
-> Zipper i f a -> f (Zipper i f a)
branches_ = (Zipper i f a -> f (Cofree f a))
-> (Zipper i f a -> f (Cofree f a) -> Zipper i f a)
-> Lens
     (Zipper i f a) (Zipper i f a) (f (Cofree f a)) (f (Cofree f a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Zipper i f a -> f (Cofree f a)
forall i (f :: * -> *) a. Zipper i f a -> f (Cofree f a)
getter Zipper i f a -> f (Cofree f a) -> Zipper i f a
forall i (f :: * -> *) a.
Zipper i f a -> f (Cofree f a) -> Zipper i f a
setter
  where
    getter :: Zipper i f a -> f (Cofree f a)
getter (Zipper [(i, Cofree f a)]
_ (a
_ :< f (Cofree f a)
f)) = f (Cofree f a)
f
    setter :: Zipper i f a -> f (Cofree f a) -> Zipper i f a
setter (Zipper [(i, Cofree f a)]
p (a
a :< f (Cofree f a)
_)) f (Cofree f a)
f = ([(i, Cofree f a)] -> Cofree f a -> Zipper i f a
forall i (f :: * -> *) a.
[(i, Cofree f a)] -> Cofree f a -> Zipper i f a
Zipper [(i, Cofree f a)]
p (a
a a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f a)
f))

-- retag :: Functor f => (a -> f b -> b) -> Cofree f a -> Cofree f b
-- retag f (a :< fr) =
--   let cs = fmap (retag f) fr
--    in (f a $ fmap Comonad.extract cs) :< cs

-- | Fold a zipper from bottom to top.
--
-- @O(n)@
fold :: (Functor f, Idx i f a) => (a -> f r -> r) -> Zipper i f a -> r
fold :: (a -> f r -> r) -> Zipper i f a -> r
fold a -> f r -> r
f = (Base (Cofree f a) r -> r) -> Cofree f a -> r
forall t a. Recursive t => (Base t a -> a) -> t -> a
FF.cata (\(a CofreeF.:< fr) -> a -> f r -> r
f a
a f r
fr) (Cofree f a -> r)
-> (Zipper i f a -> Cofree f a) -> Zipper i f a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper i f a -> Cofree f a
forall i (f :: * -> *) a. Idx i f a => Zipper i f a -> Cofree f a
rezip