-- For 'build', 'hmap', and 'hmapM'
{-# LANGUAGE Rank2Types #-}

{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
----------------------------------------------------------------
--                                                    2024-11-20
-- |
-- Module      :  Data.Functor.Fixedpoint
-- Copyright   :  Copyright (c) 2007--2024 wren gayle romano
-- License     :  BSD
-- Maintainer  :  wren@cpan.org
-- Stability   :  deprecated since unification-fd-0.12.0
-- Portability :  semi-portable (Rank2Types)
--
-- This module provides a backwards compatibility shim for users
-- of older versions of @unification-fd@, before we switched over
-- to using @data-fix@.  New users should prefer calling @data-fix@
-- functions directly, whenever possible.  If you use any of the
-- functions that aren't deprecated ('hoistFixM', 'ymap', 'ymapM',
-- 'ycata', 'ycataM', 'build'), please let the maintainer know,
-- so she can focus on getting those incorporated into @data-fix@.
-- Returning users should beware that this module used to provide
-- rewrite rules for fusing redundant traversals of data structures
-- (which @data-fix@ does not).  If you notice version >=0.12.0
-- introducing any performance loss compared to earlier versions,
-- please let the maintainer know, so she can focus on getting those
-- incorporated into @data-fix@.
--
-- This abstract nonsense is helpful in conjunction with other
-- category theoretic tricks like Swierstra's functor coproducts
-- (not provided by this package). For more on the utility of
-- two-level recursive types, see:
--
--     * Tim Sheard (2001) /Generic Unification via Two-Level Types/
--         /and Parameterized Modules/, Functional Pearl, ICFP.
--
--     * Tim Sheard & Emir Pasalic (2004) /Two-Level Types and/
--         /Parameterized Modules/. JFP 14(5): 547--587. This is
--         an expanded version of Sheard (2001) with new examples.
--
--     * Wouter Swierstra (2008) /Data types a la carte/, Functional
--         Pearl. JFP 18: 423--436.
----------------------------------------------------------------

module Data.Functor.Fixedpoint
    (
    -- * Fixed point operator for functors
      Data.Fix.Fix(..)
    -- * Maps
    , hmap,  hmapM, hoistFixM'
    , ymap,  ymapM
    -- * Builders
    , build
    -- * Catamorphisms
    , cata,  cataM
    , ycata, ycataM
    -- * Anamorphisms
    , ana,   anaM
    -- * Hylomorphisms
    , hylo,  hyloM
    ) where

import Prelude          hiding (mapM, sequence)
import Control.Monad    hiding (mapM, sequence)
import Data.Traversable
import Data.Fix (Fix())
import qualified Data.Fix

----------------------------------------------------------------
----------------------------------------------------------------

-- | A higher-order map taking a natural transformation @(f -> g)@
-- and lifting it to operate on @Fix@.
--
-- NOTE: The implementation of @hmap@ prior to version 0.12 was
-- based on 'ana', and therefore most closely matches the behavior
-- of 'Data.Fix.hoistFix''.  However, this definition is extensionally
-- equivalent to an implementation using 'cata' (and therefore most
-- closely matches the behavior of 'Data.Fix.hoistFix') instead.
hmap :: (Functor f, Functor g) => (forall a. f a -> g a) -> Fix f -> Fix g
hmap :: forall (f :: * -> *) (g :: * -> *).
(Functor f, Functor g) =>
(forall a. f a -> g a) -> Fix f -> Fix g
hmap = (forall a. f a -> g a) -> Fix f -> Fix g
forall (g :: * -> *) (f :: * -> *).
Functor g =>
(forall a. f a -> g a) -> Fix f -> Fix g
Data.Fix.hoistFix'
{-# DEPRECATED hmap "Use Data.Fix.hoistFix'" #-}

-- | A monadic variant of 'hmap'.
hmapM
    :: (Functor f, Traversable g, Monad m)
    => (forall a. f a -> m (g a)) -> Fix f -> m (Fix g)
hmapM :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *).
(Functor f, Traversable g, Monad m) =>
(forall a. f a -> m (g a)) -> Fix f -> m (Fix g)
hmapM = (forall a. f a -> m (g a)) -> Fix f -> m (Fix g)
forall (f :: * -> *) (g :: * -> *) (m :: * -> *).
(Functor f, Traversable g, Monad m) =>
(forall a. f a -> m (g a)) -> Fix f -> m (Fix g)
hoistFixM'
{-# DEPRECATED hmapM "Use hoistFixM'" #-}

-- | A monadic variant of 'Data.Fix.hoistFix''.
--
-- NOTE: The implementation of @hmapM@ prior to version 0.12 was
-- based on 'anaM', and therefore most closely matches the behavior
-- of 'Data.Fix.unfoldFixM'. However, there is another function
-- of the same type which is instead implemented via 'cataM',
-- which has different semantics for many monads.
hoistFixM'
    :: (Functor f, Traversable g, Monad m)
    => (forall a. f a -> m (g a)) -> Fix f -> m (Fix g)
hoistFixM' :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *).
(Functor f, Traversable g, Monad m) =>
(forall a. f a -> m (g a)) -> Fix f -> m (Fix g)
hoistFixM' forall a. f a -> m (g a)
eps = (Fix f -> m (g (Fix f))) -> Fix f -> m (Fix g)
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(a -> m (t a)) -> a -> m (Fix t)
Data.Fix.unfoldFixM (f (Fix f) -> m (g (Fix f))
forall a. f a -> m (g a)
eps (f (Fix f) -> m (g (Fix f)))
-> (Fix f -> f (Fix f)) -> Fix f -> m (g (Fix f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
Data.Fix.unFix)

-- | A version of 'fmap' for endomorphisms on the fixed point. That
-- is, this maps the function over the first layer of recursive
-- structure.
ymap :: (Functor f) => (Fix f -> Fix f) -> Fix f -> Fix f
ymap :: forall (f :: * -> *).
Functor f =>
(Fix f -> Fix f) -> Fix f -> Fix f
ymap Fix f -> Fix f
f = f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Data.Fix.Fix (f (Fix f) -> Fix f) -> (Fix f -> f (Fix f)) -> Fix f -> Fix f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> Fix f) -> f (Fix f) -> f (Fix f)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> Fix f
f (f (Fix f) -> f (Fix f))
-> (Fix f -> f (Fix f)) -> Fix f -> f (Fix f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
Data.Fix.unFix

-- | A monadic variant of 'ymap'.
ymapM :: (Traversable f, Monad m)
      => (Fix f -> m (Fix f)) -> Fix f -> m (Fix f)
ymapM :: forall (f :: * -> *) (m :: * -> *).
(Traversable f, Monad m) =>
(Fix f -> m (Fix f)) -> Fix f -> m (Fix f)
ymapM Fix f -> m (Fix f)
f = (f (Fix f) -> Fix f) -> m (f (Fix f)) -> m (Fix f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Data.Fix.Fix (m (f (Fix f)) -> m (Fix f))
-> (Fix f -> m (f (Fix f))) -> Fix f -> m (Fix f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> m (Fix f)) -> f (Fix f) -> m (f (Fix f))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM Fix f -> m (Fix f)
f (f (Fix f) -> m (f (Fix f)))
-> (Fix f -> f (Fix f)) -> Fix f -> m (f (Fix f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
Data.Fix.unFix


----------------------------------------------------------------
-- BUG: this isn't as helful as normal build\/fold fusion as in Data.Functor.Fusable
--
-- | Take a Church encoding of a fixed point into the data
-- representation of the fixed point.
build :: (Functor f) => (forall r. (f r -> r) -> r) -> Fix f
build :: forall (f :: * -> *).
Functor f =>
(forall r. (f r -> r) -> r) -> Fix f
build forall r. (f r -> r) -> r
g = (f (Fix f) -> Fix f) -> Fix f
forall r. (f r -> r) -> r
g f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Data.Fix.Fix

----------------------------------------------------------------
-- | A pure catamorphism over the least fixed point of a functor.
-- This function applies the @f@-algebra from the bottom up over
-- @Fix f@ to create some residual value.
cata :: (Functor f) => (f a -> a) -> (Fix f -> a)
cata :: forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata = (f a -> a) -> Fix f -> a
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
Data.Fix.foldFix
{-# DEPRECATED cata "Use Data.Fix.foldFix" #-}


-- | A catamorphism for monadic @f@-algebras. Alas, this isn't wholly
-- generic to @Functor@ since it requires distribution of @f@ over
-- @m@ (provided by 'sequence' or 'mapM' in 'Traversable').
--
-- N.B., this orders the side effects from the bottom up.
cataM :: (Traversable f, Monad m) => (f a -> m a) -> (Fix f -> m a)
cataM :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
(f a -> m a) -> Fix f -> m a
cataM = (f a -> m a) -> Fix f -> m a
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(t a -> m a) -> Fix t -> m a
Data.Fix.foldFixM
{-# DEPRECATED cataM "Use Data.Fix.foldFixM" #-}

-- TODO: remove this, or add similar versions for ana* and hylo*?
-- | A variant of 'cata' which restricts the return type to being
-- a new fixpoint. Though more restrictive, it can be helpful when
-- you already have an algebra which expects the outermost @Fix@.
--
-- If you don't like either @fmap@ or @cata@, then maybe this is
-- what you were thinking?
ycata :: (Functor f) => (Fix f -> Fix f) -> Fix f -> Fix f
ycata :: forall (f :: * -> *).
Functor f =>
(Fix f -> Fix f) -> Fix f -> Fix f
ycata Fix f -> Fix f
f = (f (Fix f) -> Fix f) -> Fix f -> Fix f
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
Data.Fix.foldFix (Fix f -> Fix f
f (Fix f -> Fix f) -> (f (Fix f) -> Fix f) -> f (Fix f) -> Fix f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Data.Fix.Fix)


-- TODO: remove this, or add similar versions for ana* and hylo*?
-- | Monadic variant of 'ycata'.
ycataM :: (Traversable f, Monad m)
       => (Fix f -> m (Fix f)) -> Fix f -> m (Fix f)
ycataM :: forall (f :: * -> *) (m :: * -> *).
(Traversable f, Monad m) =>
(Fix f -> m (Fix f)) -> Fix f -> m (Fix f)
ycataM Fix f -> m (Fix f)
f = (f (Fix f) -> m (Fix f)) -> Fix f -> m (Fix f)
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(t a -> m a) -> Fix t -> m a
Data.Fix.foldFixM (Fix f -> m (Fix f)
f (Fix f -> m (Fix f))
-> (f (Fix f) -> Fix f) -> f (Fix f) -> m (Fix f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Data.Fix.Fix)


----------------------------------------------------------------
-- | A pure anamorphism generating the greatest fixed point of a
-- functor. This function applies an @f@-coalgebra from the top
-- down to expand a seed into a @Fix f@.
ana :: (Functor f) => (a -> f a) -> (a -> Fix f)
ana :: forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
ana = (a -> f a) -> a -> Fix f
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
Data.Fix.unfoldFix
{-# DEPRECATED ana "Use Data.Fix.unfoldFix" #-}

-- | An anamorphism for monadic @f@-coalgebras. Alas, this isn't
-- wholly generic to @Functor@ since it requires distribution of
-- @f@ over @m@ (provided by 'sequence' or 'mapM' in 'Traversable').
--
-- N.B., this orders the side effects from the top down.
anaM :: (Traversable f, Monad m) => (a -> m (f a)) -> (a -> m (Fix f))
anaM :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
(a -> m (f a)) -> a -> m (Fix f)
anaM = (a -> m (f a)) -> a -> m (Fix f)
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(a -> m (t a)) -> a -> m (Fix t)
Data.Fix.unfoldFixM
{-# DEPRECATED anaM "Use Data.Fix.unfoldFixM" #-}


----------------------------------------------------------------
-- | @hylo phi psi == cata phi . ana psi@
hylo :: (Functor f) => (f b -> b) -> (a -> f a) -> (a -> b)
hylo :: forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
hylo = (f b -> b) -> (a -> f a) -> a -> b
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
Data.Fix.refold
{-# DEPRECATED hylo "Use Data.Fix.refold" #-}

-- | @hyloM phiM psiM == cataM phiM <=< anaM psiM@
hyloM :: (Traversable f, Monad m)
      => (f b -> m b) -> (a -> m (f a)) -> (a -> m b)
hyloM :: forall (f :: * -> *) (m :: * -> *) b a.
(Traversable f, Monad m) =>
(f b -> m b) -> (a -> m (f a)) -> a -> m b
hyloM = (f b -> m b) -> (a -> m (f a)) -> a -> m b
forall (m :: * -> *) (t :: * -> *) b a.
(Monad m, Traversable t) =>
(t b -> m b) -> (a -> m (t a)) -> a -> m b
Data.Fix.refoldM
{-# DEPRECATED hyloM "Use Data.Fix.refoldM" #-}

----------------------------------------------------------------
----------------------------------------------------------- fin.