{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}

module Unison.Util.Recursion
  ( Algebra,
    Recursive (..),
    cataM,
    para,
    Fix (..),
    Cofree' (..),
  )
where

import Control.Arrow ((&&&))
import Control.Comonad.Cofree (Cofree ((:<)))
import Control.Monad ((<=<))

type Algebra f a = f a -> a

class Recursive t f | t -> f where
  cata :: (Algebra f a) -> t -> a
  default cata :: (Functor f) => (f a -> a) -> t -> a
  cata f a -> a
φ = f a -> a
φ (f a -> a) -> (t -> f a) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> a) -> f t -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> a) -> t -> a
forall a. Algebra f a -> t -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata f a -> a
φ) (f t -> f a) -> (t -> f t) -> t -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> f t
forall t (f :: * -> *). Recursive t f => t -> f t
project
  project :: t -> f t
  default project :: (Functor f) => t -> f t
  project = Algebra f (f t) -> t -> f t
forall a. Algebra f a -> t -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata ((f t -> t) -> Algebra f (f t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f t -> t
forall t (f :: * -> *). Recursive t f => f t -> t
embed)
  embed :: f t -> t
  {-# MINIMAL embed, (cata | project) #-}

cataM :: (Recursive t f, Traversable f, Monad m) => (f a -> m a) -> t -> m a
cataM :: forall t (f :: * -> *) (m :: * -> *) a.
(Recursive t f, Traversable f, Monad m) =>
(f a -> m a) -> t -> m a
cataM f a -> m a
φ = Algebra f (m a) -> t -> m a
forall a. Algebra f a -> t -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata (Algebra f (m a) -> t -> m a) -> Algebra f (m a) -> t -> m a
forall a b. (a -> b) -> a -> b
$ f a -> m a
φ (f a -> m a) -> (f (m a) -> m (f a)) -> Algebra f (m a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f (m a) -> m (f a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => f (f a) -> f (f a)
sequenceA

para :: (Recursive t f, Functor f) => (f (t, a) -> a) -> t -> a
para :: forall t (f :: * -> *) a.
(Recursive t f, Functor f) =>
(f (t, a) -> a) -> t -> a
para f (t, a) -> a
φ = (t, a) -> a
forall a b. (a, b) -> b
snd ((t, a) -> a) -> (t -> (t, a)) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra f (t, a) -> t -> (t, a)
forall a. Algebra f a -> t -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata (f t -> t
forall t (f :: * -> *). Recursive t f => f t -> t
embed (f t -> t) -> (f (t, a) -> f t) -> f (t, a) -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t, a) -> t) -> f (t, a) -> f t
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t, a) -> t
forall a b. (a, b) -> a
fst (f (t, a) -> t) -> (f (t, a) -> a) -> Algebra f (t, a)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& f (t, a) -> a
φ)

newtype Fix f = Fix (f (Fix f))

deriving instance (forall a. (Show a) => Show (f a)) => Show (Fix f)

deriving instance (forall a. (Eq a) => Eq (f a)) => Eq (Fix f)

deriving instance (Eq (Fix f), forall a. (Ord a) => Ord (f a)) => Ord (Fix f)

instance (Functor f) => Recursive (Fix f) f where
  embed :: f (Fix f) -> Fix f
embed = f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
  project :: Fix f -> f (Fix f)
project (Fix f (Fix f)
f) = f (Fix f)
f

data Cofree' f a x = a :<< f x
  deriving ((forall m. Monoid m => Cofree' f a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Cofree' f a a -> m)
-> (forall m a. Monoid m => (a -> m) -> Cofree' f a a -> m)
-> (forall a b. (a -> b -> b) -> b -> Cofree' f a a -> b)
-> (forall a b. (a -> b -> b) -> b -> Cofree' f a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Cofree' f a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Cofree' f a a -> b)
-> (forall a. (a -> a -> a) -> Cofree' f a a -> a)
-> (forall a. (a -> a -> a) -> Cofree' f a a -> a)
-> (forall a. Cofree' f a a -> [a])
-> (forall a. Cofree' f a a -> Bool)
-> (forall a. Cofree' f a a -> Int)
-> (forall a. Eq a => a -> Cofree' f a a -> Bool)
-> (forall a. Ord a => Cofree' f a a -> a)
-> (forall a. Ord a => Cofree' f a a -> a)
-> (forall a. Num a => Cofree' f a a -> a)
-> (forall a. Num a => Cofree' f a a -> a)
-> Foldable (Cofree' f a)
forall a. Eq a => a -> Cofree' f a a -> Bool
forall a. Num a => Cofree' f a a -> a
forall a. Ord a => Cofree' f a a -> a
forall m. Monoid m => Cofree' f a m -> m
forall a. Cofree' f a a -> Bool
forall a. Cofree' f a a -> Int
forall a. Cofree' f a a -> [a]
forall a. (a -> a -> a) -> Cofree' f a a -> a
forall m a. Monoid m => (a -> m) -> Cofree' f a a -> m
forall b a. (b -> a -> b) -> b -> Cofree' f a a -> b
forall a b. (a -> b -> b) -> b -> Cofree' f a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (f :: * -> *) a a.
(Foldable f, Eq a) =>
a -> Cofree' f a a -> Bool
forall (f :: * -> *) a a. (Foldable f, Num a) => Cofree' f a a -> a
forall (f :: * -> *) a a. (Foldable f, Ord a) => Cofree' f a a -> a
forall (f :: * -> *) a m.
(Foldable f, Monoid m) =>
Cofree' f a m -> m
forall (f :: * -> *) a a. Foldable f => Cofree' f a a -> Bool
forall (f :: * -> *) a a. Foldable f => Cofree' f a a -> Int
forall (f :: * -> *) a a. Foldable f => Cofree' f a a -> [a]
forall (f :: * -> *) a a.
Foldable f =>
(a -> a -> a) -> Cofree' f a a -> a
forall (f :: * -> *) a m a.
(Foldable f, Monoid m) =>
(a -> m) -> Cofree' f a a -> m
forall (f :: * -> *) a b a.
Foldable f =>
(b -> a -> b) -> b -> Cofree' f a a -> b
forall (f :: * -> *) a a b.
Foldable f =>
(a -> b -> b) -> b -> Cofree' f a a -> b
$cfold :: forall (f :: * -> *) a m.
(Foldable f, Monoid m) =>
Cofree' f a m -> m
fold :: forall m. Monoid m => Cofree' f a m -> m
$cfoldMap :: forall (f :: * -> *) a m a.
(Foldable f, Monoid m) =>
(a -> m) -> Cofree' f a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Cofree' f a a -> m
$cfoldMap' :: forall (f :: * -> *) a m a.
(Foldable f, Monoid m) =>
(a -> m) -> Cofree' f a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Cofree' f a a -> m
$cfoldr :: forall (f :: * -> *) a a b.
Foldable f =>
(a -> b -> b) -> b -> Cofree' f a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Cofree' f a a -> b
$cfoldr' :: forall (f :: * -> *) a a b.
Foldable f =>
(a -> b -> b) -> b -> Cofree' f a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Cofree' f a a -> b
$cfoldl :: forall (f :: * -> *) a b a.
Foldable f =>
(b -> a -> b) -> b -> Cofree' f a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Cofree' f a a -> b
$cfoldl' :: forall (f :: * -> *) a b a.
Foldable f =>
(b -> a -> b) -> b -> Cofree' f a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Cofree' f a a -> b
$cfoldr1 :: forall (f :: * -> *) a a.
Foldable f =>
(a -> a -> a) -> Cofree' f a a -> a
foldr1 :: forall a. (a -> a -> a) -> Cofree' f a a -> a
$cfoldl1 :: forall (f :: * -> *) a a.
Foldable f =>
(a -> a -> a) -> Cofree' f a a -> a
foldl1 :: forall a. (a -> a -> a) -> Cofree' f a a -> a
$ctoList :: forall (f :: * -> *) a a. Foldable f => Cofree' f a a -> [a]
toList :: forall a. Cofree' f a a -> [a]
$cnull :: forall (f :: * -> *) a a. Foldable f => Cofree' f a a -> Bool
null :: forall a. Cofree' f a a -> Bool
$clength :: forall (f :: * -> *) a a. Foldable f => Cofree' f a a -> Int
length :: forall a. Cofree' f a a -> Int
$celem :: forall (f :: * -> *) a a.
(Foldable f, Eq a) =>
a -> Cofree' f a a -> Bool
elem :: forall a. Eq a => a -> Cofree' f a a -> Bool
$cmaximum :: forall (f :: * -> *) a a. (Foldable f, Ord a) => Cofree' f a a -> a
maximum :: forall a. Ord a => Cofree' f a a -> a
$cminimum :: forall (f :: * -> *) a a. (Foldable f, Ord a) => Cofree' f a a -> a
minimum :: forall a. Ord a => Cofree' f a a -> a
$csum :: forall (f :: * -> *) a a. (Foldable f, Num a) => Cofree' f a a -> a
sum :: forall a. Num a => Cofree' f a a -> a
$cproduct :: forall (f :: * -> *) a a. (Foldable f, Num a) => Cofree' f a a -> a
product :: forall a. Num a => Cofree' f a a -> a
Foldable, (forall a b. (a -> b) -> Cofree' f a a -> Cofree' f a b)
-> (forall a b. a -> Cofree' f a b -> Cofree' f a a)
-> Functor (Cofree' f a)
forall a b. a -> Cofree' f a b -> Cofree' f a a
forall a b. (a -> b) -> Cofree' f a a -> Cofree' f a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> *) a a b.
Functor f =>
a -> Cofree' f a b -> Cofree' f a a
forall (f :: * -> *) a a b.
Functor f =>
(a -> b) -> Cofree' f a a -> Cofree' f a b
$cfmap :: forall (f :: * -> *) a a b.
Functor f =>
(a -> b) -> Cofree' f a a -> Cofree' f a b
fmap :: forall a b. (a -> b) -> Cofree' f a a -> Cofree' f a b
$c<$ :: forall (f :: * -> *) a a b.
Functor f =>
a -> Cofree' f a b -> Cofree' f a a
<$ :: forall a b. a -> Cofree' f a b -> Cofree' f a a
Functor, Functor (Cofree' f a)
Foldable (Cofree' f a)
(Functor (Cofree' f a), Foldable (Cofree' f a)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Cofree' f a a -> f (Cofree' f a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Cofree' f a (f a) -> f (Cofree' f a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Cofree' f a a -> m (Cofree' f a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Cofree' f a (m a) -> m (Cofree' f a a))
-> Traversable (Cofree' f a)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Cofree' f a (m a) -> m (Cofree' f a a)
forall (f :: * -> *) a.
Applicative f =>
Cofree' f a (f a) -> f (Cofree' f a a)
forall (f :: * -> *) a. Traversable f => Functor (Cofree' f a)
forall (f :: * -> *) a. Traversable f => Foldable (Cofree' f a)
forall (f :: * -> *) a (m :: * -> *) a.
(Traversable f, Monad m) =>
Cofree' f a (m a) -> m (Cofree' f a a)
forall (f :: * -> *) a (f :: * -> *) a.
(Traversable f, Applicative f) =>
Cofree' f a (f a) -> f (Cofree' f a a)
forall (f :: * -> *) a (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> Cofree' f a a -> m (Cofree' f a b)
forall (f :: * -> *) a (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> Cofree' f a a -> f (Cofree' f a b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cofree' f a a -> m (Cofree' f a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cofree' f a a -> f (Cofree' f a b)
$ctraverse :: forall (f :: * -> *) a (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> Cofree' f a a -> f (Cofree' f a b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cofree' f a a -> f (Cofree' f a b)
$csequenceA :: forall (f :: * -> *) a (f :: * -> *) a.
(Traversable f, Applicative f) =>
Cofree' f a (f a) -> f (Cofree' f a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Cofree' f a (f a) -> f (Cofree' f a a)
$cmapM :: forall (f :: * -> *) a (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> Cofree' f a a -> m (Cofree' f a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cofree' f a a -> m (Cofree' f a b)
$csequence :: forall (f :: * -> *) a (m :: * -> *) a.
(Traversable f, Monad m) =>
Cofree' f a (m a) -> m (Cofree' f a a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Cofree' f a (m a) -> m (Cofree' f a a)
Traversable)

-- |
--
--  __NB__: `Cofree` from “free” is lazy, so this instance is technically partial.
instance (Functor f) => Recursive (Cofree f a) (Cofree' f a) where
  embed :: Cofree' f a (Cofree f a) -> Cofree f a
embed (a
a :<< f (Cofree f a)
fco) = 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)
fco
  project :: Cofree f a -> Cofree' f a (Cofree f a)
project (a
a :< f (Cofree f a)
fco) = a
a a -> f (Cofree f a) -> Cofree' f a (Cofree f a)
forall (f :: * -> *) a x. a -> f x -> Cofree' f a x
:<< f (Cofree f a)
fco