{-# LANGUAGE Safe #-}

-- | 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
  ( Listable (naturalList),
    foldMap,
    foldl,
    foldr,
  )
where

import "base" Control.Category (Category (id, (.)))
import "base" Data.Function (flip)
import "base" Data.Monoid (Monoid)
import "free" Control.Monad.Trans.Free (Free, iter)
import "this" Yaya.Fold (Recursive (cata))
import "this" Yaya.Fold.Common (lowerMonoid)
import "this" Yaya.Pattern (XNor (Both, Neither))

foldMap :: (Recursive (->) t (XNor a), Monoid m) => (a -> m) -> t -> m
foldMap :: forall t a m.
(Recursive (->) t (XNor a), Monoid m) =>
(a -> m) -> t -> m
foldMap = Algebra (->) (XNor a) m -> t -> m
forall a. Algebra (->) (XNor a) a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 :: forall (f :: * -> * -> *) t a b.
(Listable f, Recursive (->) t (f a)) =>
(a -> b -> b) -> b -> t -> b
foldr a -> b -> b
f b
b =
  Algebra (->) (f a) b -> t -> b
forall a. Algebra (->) (f a) a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a b -> Free (XNor a) b
forall a b. 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 :: forall (f :: * -> * -> *) t a b.
(Listable f, Recursive (->) t (f a)) =>
(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 a. Algebra (->) (f a) a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
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
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a (b -> b) -> Free (XNor a) (b -> b)
forall a b. f a b -> Free (XNor a) b
forall (f :: * -> * -> *) a b.
Listable f =>
f a b -> Free (XNor a) b
naturalList
        )
    )