-- | This shows how `Data.Foldable.Foldable` is basically `Recursive`
--   specialized to lists. The true operation of `Data.Foldable.Foldable` is
--  `Data.Foldable.toList`.
--
--   As these few operations have the usual signatures, the rest of the type
--   class can be implemented in the as in @base@.
module Yaya.Experimental.Foldable where

import Control.Monad.Trans.Free
import Yaya.Fold
import Yaya.Fold.Common
import Yaya.Pattern

foldMap :: (Recursive (->) t (XNor a), Monoid m) => (a -> m) -> t -> m
foldMap :: (a -> m) -> t -> m
foldMap = Algebra (->) (XNor a) m -> t -> m
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (Algebra (->) (XNor a) m -> t -> m)
-> ((a -> m) -> Algebra (->) (XNor a) m) -> (a -> m) -> t -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m) -> Algebra (->) (XNor a) m
forall m a. Monoid m => (a -> m) -> XNor a m -> m
lowerMonoid

-- | This class represents the ability of a structure to be converted to a
--   list. It is equivalent to `Data.Foldable.Foldable`, but designed to
--   illustrate the representation of `Data.Foldable.Foldable` as `Recursive`
--   specialized to lists.
class Listable f where
  naturalList :: f a b -> Free (XNor a) b

-- toColist :: (Projectable t (f a), Corecursive (->) u (XNor a)) => t -> u
-- toColist = elgotAna seqFree (naturalList . project)
-- toList :: (Recursive (->) t (f a), Steppable u (XNor a)) => t -> u
-- toList = cata (embed . unFree . naturalList)

-- FIXME: Use @cata . liftCoEnv@  instead of `iter`.

-- | This is simply `cata` applied to a list – the function is the @Cons@
--   case, while the initial value is the @Nil@ case.
foldr :: (Listable f, Recursive (->) t (f a)) => (a -> b -> b) -> b -> t -> b
foldr :: (a -> b -> b) -> b -> t -> b
foldr a -> b -> b
f b
b =
  Algebra (->) (f a) b -> t -> b
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata
    ( (XNor a b -> b) -> Free (XNor a) b -> b
forall (f :: * -> *) a. Functor f => (f a -> a) -> Free f a -> a
iter
        ( \case
            XNor a b
Neither -> b
b
            Both a
a b
r -> a -> b -> b
f a
a b
r
        )
        (Free (XNor a) b -> b)
-> (f a b -> Free (XNor a) b) -> Algebra (->) (f a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a b -> Free (XNor a) b
forall (f :: * -> * -> *) a b.
Listable f =>
f a b -> Free (XNor a) b
naturalList
    )

-- | Simply `cata` with a carrier of @b -> b@.
foldl :: (Listable f, Recursive (->) t (f a)) => (b -> a -> b) -> b -> t -> b
foldl :: (b -> a -> b) -> b -> t -> b
foldl b -> a -> b
f =
  (t -> b -> b) -> b -> t -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
    ( Algebra (->) (f a) (b -> b) -> t -> b -> b
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata
        ( (XNor a (b -> b) -> b -> b) -> Free (XNor a) (b -> b) -> b -> b
forall (f :: * -> *) a. Functor f => (f a -> a) -> Free f a -> a
iter
            ( \case
                XNor a (b -> b)
Neither -> b -> b
forall a. a -> a
id
                Both a
a b -> b
g -> b -> b
g (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f a
a
            )
            (Free (XNor a) (b -> b) -> b -> b)
-> (f a (b -> b) -> Free (XNor a) (b -> b))
-> Algebra (->) (f a) (b -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a (b -> b) -> Free (XNor a) (b -> b)
forall (f :: * -> * -> *) a b.
Listable f =>
f a b -> Free (XNor a) b
naturalList
        )
    )