```{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE Trustworthy               #-}

-- needed for Data instance
{-# LANGUAGE UndecidableInstances      #-}

#define HAS_POLY_TYPEABLE MIN_VERSION_base(4,7,0)

#if HAS_POLY_TYPEABLE
{-# LANGUAGE StandaloneDeriving        #-}
#endif

-- | Fixed points of a functor.
--
-- Type @f@ should be a 'Functor' if you want to use
-- simple recursion schemes or 'Traversable' if you want to
-- use monadic recursion schemes. This style allows you to express
-- recursive functions in non-recursive manner.
-- You can imagine that a non-recursive function
-- holds values of the previous iteration.
--
-- An example:
--
-- First we define a base functor. The arguments @b@ are recursion points.
--
-- >>> data ListF a b = Nil | Cons a b deriving (Show, Functor)
--
-- The list is then a fixed point of 'ListF'
--
-- >>> type List a = Fix (ListF a)
--
-- We can write @length@ function. Note that the function we give
-- to 'foldFix' is not recursive. Instead the results
-- of recursive calls are in @b@ positions, and we need to deal
-- only with one layer of the structure.
--
-- >>> :{
-- let length :: List a -> Int
--     length = foldFix \$ \x -> case x of
--         Nil      -> 0
--         Cons _ n -> n + 1
-- :}
--
-- If you already have recursive type, like '[Int]',
-- you can first convert it to `Fix (ListF a)` and then `foldFix`.
-- Alternatively you can use @recursion-schemes@ combinators
-- which work directly on recursive types.
--
module Data.Fix (
-- * Fix
Fix (..),
hoistFix,
hoistFix',
foldFix,
unfoldFix,
-- * Mu - least fixed point
Mu (..),
hoistMu,
foldMu,
unfoldMu,
-- * Nu - greatest fixed point
Nu (..),
hoistNu,
foldNu,
unfoldNu,
-- * Refolding
refold,
foldFixM,
unfoldFixM,
refoldM,
-- * Deprecated aliases
cata, ana, hylo,
cataM, anaM, hyloM,
) where

-- Explicit imports help dodge unused imports warnings,
-- as we say what we want from Prelude
import Data.Traversable (Traversable (..))
import Prelude (Eq (..), Functor (..), Monad (..), Ord (..), Read (..), Show (..), showParen, showString, (\$), (.), (=<<))

#if! HAS_POLY_TYPEABLE
import Prelude (const, error, undefined)
#endif
#endif

import Data.Function        (on)
import Data.Hashable        (Hashable (..))
import Data.Hashable.Lifted (Hashable1, hashWithSalt1)
import Data.Typeable        (Typeable)
import GHC.Generics         (Generic)

#if MIN_VERSION_deepseq(1,4,3)
import Control.DeepSeq (NFData (..), NFData1, rnf1)
#endif

#if HAS_POLY_TYPEABLE
import Data.Data (Data)
#else
import Data.Data
#endif

-- \$setup
-- >>> :set -XDeriveFunctor
-- >>> import Prelude (showChar, Int, Num (..))
-- >>> import Data.Functor.Classes
-- >>> data ListF a b = Nil | Cons a b deriving (Show, Functor)
--
-- >>> :{
-- >>> instance Show a => Show1 (ListF a) where
-- >>>     liftShowsPrec _  _ d Nil        = showString "Nil"
-- >>>     liftShowsPrec sp _ d (Cons a b) = showParen (d > 10) \$ showString "Cons " . showsPrec 11 a . showChar ' ' . sp 11 b
-- >>> :}
--
-- >>> :{
-- >>> let elimListF n c Nil        = 0
-- >>>     elimListF n c (Cons a b) = c a b
-- >>> :}

-------------------------------------------------------------------------------
-- Fix
-------------------------------------------------------------------------------

-- | A fix-point type.
newtype Fix f = Fix { Fix f -> f (Fix f)
unFix :: f (Fix f) }
deriving ((forall x. Fix f -> Rep (Fix f) x)
-> (forall x. Rep (Fix f) x -> Fix f) -> Generic (Fix f)
forall x. Rep (Fix f) x -> Fix f
forall x. Fix f -> Rep (Fix f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (Fix f) x -> Fix f
forall (f :: * -> *) x. Fix f -> Rep (Fix f) x
\$cto :: forall (f :: * -> *) x. Rep (Fix f) x -> Fix f
\$cfrom :: forall (f :: * -> *) x. Fix f -> Rep (Fix f) x
Generic)

-- | Change base functor in 'Fix'.
hoistFix :: Functor f => (forall a. f a -> g a) -> Fix f -> Fix g
hoistFix :: (forall a. f a -> g a) -> Fix f -> Fix g
hoistFix forall a. f a -> g a
nt = Fix f -> Fix g
go where go :: Fix f -> Fix g
go (Fix f (Fix f)
f) = g (Fix g) -> Fix g
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix g) -> g (Fix g)
forall a. f a -> g a
nt ((Fix f -> Fix g) -> f (Fix f) -> f (Fix g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> Fix g
go f (Fix f)
f))

-- | Like 'hoistFix' but 'fmap'ping over @g@.
hoistFix' :: Functor g => (forall a. f a -> g a) -> Fix f -> Fix g
hoistFix' :: (forall a. f a -> g a) -> Fix f -> Fix g
hoistFix' forall a. f a -> g a
nt = Fix f -> Fix g
go where go :: Fix f -> Fix g
go (Fix f (Fix f)
f) = g (Fix g) -> Fix g
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ((Fix f -> Fix g) -> g (Fix f) -> g (Fix g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> Fix g
go (f (Fix f) -> g (Fix f)
forall a. f a -> g a
nt f (Fix f)
f))

-- | Fold 'Fix'.
--
-- >>> let fp = unfoldFix (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> foldFix (elimListF 0 (+)) fp
-- 6
--
foldFix :: Functor f => (f a -> a) -> Fix f -> a
foldFix :: (f a -> a) -> Fix f -> a
foldFix f a -> a
f = Fix f -> a
go where go :: Fix f -> a
go = f a -> a
f (f a -> a) -> (Fix f -> f a) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> a) -> f (Fix f) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> a
go (f (Fix f) -> f a) -> (Fix f -> f (Fix f)) -> Fix f -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

-- | Unfold 'Fix'.
--
-- >>> unfoldFix (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int)
-- Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix (Cons 3 (Fix Nil))))))))
--
unfoldFix :: Functor f => (a -> f a) -> a -> Fix f
unfoldFix :: (a -> f a) -> a -> Fix f
unfoldFix a -> f a
f = a -> Fix f
go where go :: a -> Fix f
go = f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix f) -> Fix f) -> (a -> f (Fix f)) -> a -> Fix f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Fix f) -> f a -> f (Fix f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Fix f
go (f a -> f (Fix f)) -> (a -> f a) -> a -> f (Fix f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
f

-------------------------------------------------------------------------------
-- Functor instances
-------------------------------------------------------------------------------

instance Eq1 f => Eq (Fix f) where
Fix f (Fix f)
a == :: Fix f -> Fix f -> Bool
== Fix f (Fix f)
b = f (Fix f) -> f (Fix f) -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 f (Fix f)
a f (Fix f)
b

instance Ord1 f => Ord (Fix f) where
compare :: Fix f -> Fix f -> Ordering
compare (Fix f (Fix f)
a) (Fix f (Fix f)
b) = f (Fix f) -> f (Fix f) -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 f (Fix f)
a f (Fix f)
b

instance Show1 f => Show (Fix f) where
showsPrec :: Int -> Fix f -> ShowS
showsPrec Int
d (Fix f (Fix f)
a) =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
\$ String -> ShowS
showString String
"Fix "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f (Fix f) -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
11 f (Fix f)
a

forall a b. (a -> b) -> a -> b
prec Int
forall a b. (a -> b) -> a -> b
\$ do
Ident String
lexP
(f (Fix f) -> Fix f) -> ReadPrec (f (Fix f)) -> ReadPrec (Fix f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
step ((Int -> ReadS (f (Fix f))) -> ReadPrec (f (Fix f))
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
#endif

-------------------------------------------------------------------------------
-- hashable
-------------------------------------------------------------------------------

instance Hashable1 f => Hashable (Fix f) where
hashWithSalt :: Int -> Fix f -> Int
hashWithSalt Int
salt = Int -> f (Fix f) -> Int
forall (f :: * -> *) a.
(Hashable1 f, Hashable a) =>
Int -> f a -> Int
hashWithSalt1 Int
salt (f (Fix f) -> Int) -> (Fix f -> f (Fix f)) -> Fix f -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

#if MIN_VERSION_deepseq(1,4,3)
instance NFData1 f => NFData (Fix f) where
rnf :: Fix f -> ()
rnf = f (Fix f) -> ()
forall (f :: * -> *) a. (NFData1 f, NFData a) => f a -> ()
rnf1 (f (Fix f) -> ()) -> (Fix f -> f (Fix 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)
unFix
#endif

-------------------------------------------------------------------------------
-- Typeable and Data
-------------------------------------------------------------------------------

#if HAS_POLY_TYPEABLE
deriving instance Typeable Fix
deriving instance (Typeable f, Data (f (Fix f))) => Data (Fix f)
#else
instance Typeable1 f => Typeable (Fix f) where
typeOf t = mkTyConApp fixTyCon [typeOf1 (undefined `asArgsTypeOf` t)]
where asArgsTypeOf :: f a -> Fix f -> f a
asArgsTypeOf = const

fixTyCon :: TyCon
#if MIN_VERSION_base(4,4,0)
fixTyCon = mkTyCon3 "recursion-schemes" "Data.Functor.Foldable" "Fix"
#else
fixTyCon = mkTyCon "Data.Functor.Foldable.Fix"
#endif
{-# NOINLINE fixTyCon #-}

instance (Typeable1 f, Data (f (Fix f))) => Data (Fix f) where
gfoldl f z (Fix a) = z Fix `f` a
toConstr _ = fixConstr
gunfold k z c = case constrIndex c of
1 -> k (z (Fix))
_ -> error "gunfold"
dataTypeOf _ = fixDataType

fixConstr :: Constr
fixConstr = mkConstr fixDataType "Fix" [] Prefix

fixDataType :: DataType
fixDataType = mkDataType "Data.Functor.Foldable.Fix" [fixConstr]
#endif
#endif

-------------------------------------------------------------------------------
-- Mu
-------------------------------------------------------------------------------

-- | Least fixed point. Efficient folding.
newtype Mu f = Mu { Mu f -> forall a. (f a -> a) -> a
unMu :: forall a. (f a -> a) -> a }

instance (Functor f, Eq1 f) => Eq (Mu f) where
== :: Mu f -> Mu f -> Bool
(==) = Fix f -> Fix f -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Fix f -> Fix f -> Bool) -> (Mu f -> Fix f) -> Mu f -> Mu f -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (f (Fix f) -> Fix f) -> Mu f -> Fix f
forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix

instance (Functor f, Ord1 f) => Ord (Mu f) where
compare :: Mu f -> Mu f -> Ordering
compare = Fix f -> Fix f -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Fix f -> Fix f -> Ordering)
-> (Mu f -> Fix f) -> Mu f -> Mu f -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (f (Fix f) -> Fix f) -> Mu f -> Fix f
forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix

instance (Functor f, Show1 f) => Show (Mu f) where
showsPrec :: Int -> Mu f -> ShowS
showsPrec Int
d Mu f
f = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
\$
String -> ShowS
showString String
"unfoldMu unFix " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Fix f -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ((f (Fix f) -> Fix f) -> Mu f -> Fix f
forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix Mu f
f)

forall a b. (a -> b) -> a -> b
prec Int
forall a b. (a -> b) -> a -> b
\$ do
Ident String
lexP
Ident String
lexP
(Fix f -> Mu f) -> ReadPrec (Fix f) -> ReadPrec (Mu f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Fix f -> f (Fix f)) -> Fix f -> Mu f
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Mu f
unfoldMu Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
#endif

-- | Change base functor in 'Mu'.
hoistMu :: (forall a. f a -> g a) -> Mu f -> Mu g
hoistMu :: (forall a. f a -> g a) -> Mu f -> Mu g
hoistMu forall a. f a -> g a
n (Mu forall a. (f a -> a) -> a
mk) = (forall a. (g a -> a) -> a) -> Mu g
forall (f :: * -> *). (forall a. (f a -> a) -> a) -> Mu f
Mu ((forall a. (g a -> a) -> a) -> Mu g)
-> (forall a. (g a -> a) -> a) -> Mu g
forall a b. (a -> b) -> a -> b
\$ \g a -> a
roll -> (f a -> a) -> a
forall a. (f a -> a) -> a
mk (g a -> a
roll (g a -> a) -> (f a -> g a) -> f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> g a
forall a. f a -> g a
n)

-- | Fold 'Mu'.
--
-- >>> let mu = unfoldMu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> foldMu (elimListF 0 (+)) mu
-- 6
foldMu :: (f a -> a) -> Mu f -> a
foldMu :: (f a -> a) -> Mu f -> a
foldMu f a -> a
f (Mu forall a. (f a -> a) -> a
mk) = (f a -> a) -> a
forall a. (f a -> a) -> a
mk f a -> a
f

-- | Unfold 'Mu'.
--
-- >>> unfoldMu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int)
-- unfoldMu unFix (Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix (Cons 3 (Fix Nil)))))))))
unfoldMu :: Functor f => (a -> f a) -> a -> Mu f
unfoldMu :: (a -> f a) -> a -> Mu f
unfoldMu a -> f a
f a
x = (forall a. (f a -> a) -> a) -> Mu f
forall (f :: * -> *). (forall a. (f a -> a) -> a) -> Mu f
Mu ((forall a. (f a -> a) -> a) -> Mu f)
-> (forall a. (f a -> a) -> a) -> Mu f
forall a b. (a -> b) -> a -> b
\$ \f a -> a
mk -> (f a -> a) -> (a -> f a) -> a -> a
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
refold f a -> a
mk a -> f a
f a
x

-------------------------------------------------------------------------------
-- Nu
-------------------------------------------------------------------------------

-- | Greatest fixed point. Efficient unfolding.
data Nu f = forall a. Nu (a -> f a) a

instance (Functor f, Eq1 f) => Eq (Nu f) where
== :: Nu f -> Nu f -> Bool
(==) = Fix f -> Fix f -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Fix f -> Fix f -> Bool) -> (Nu f -> Fix f) -> Nu f -> Nu f -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (f (Fix f) -> Fix f) -> Nu f -> Fix f
forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
foldNu f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix

instance (Functor f, Ord1 f) => Ord (Nu f) where
compare :: Nu f -> Nu f -> Ordering
compare = Fix f -> Fix f -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Fix f -> Fix f -> Ordering)
-> (Nu f -> Fix f) -> Nu f -> Nu f -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (f (Fix f) -> Fix f) -> Nu f -> Fix f
forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
foldNu f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix

instance (Functor f, Show1 f) => Show (Nu f) where
showsPrec :: Int -> Nu f -> ShowS
showsPrec Int
d Nu f
f = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
\$
String -> ShowS
showString String
"unfoldNu unFix " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Fix f -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ((f (Fix f) -> Fix f) -> Nu f -> Fix f
forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
foldNu f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix Nu f
f)

forall a b. (a -> b) -> a -> b
prec Int
forall a b. (a -> b) -> a -> b
\$ do
Ident String
lexP
Ident String
lexP
(Fix f -> Nu f) -> ReadPrec (Fix f) -> ReadPrec (Nu f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Fix f -> f (Fix f)) -> Fix f -> Nu f
forall a (f :: * -> *). (a -> f a) -> a -> Nu f
unfoldNu Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
#endif

-- | Change base functor in 'Nu'.
hoistNu :: (forall a. f a -> g a) -> Nu f -> Nu g
hoistNu :: (forall a. f a -> g a) -> Nu f -> Nu g
hoistNu forall a. f a -> g a
n (Nu a -> f a
next a
seed) = (a -> g a) -> a -> Nu g
forall (f :: * -> *) a. (a -> f a) -> a -> Nu f
Nu (f a -> g a
forall a. f a -> g a
n (f a -> g a) -> (a -> f a) -> a -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
next) a
seed

-- | Fold 'Nu'.
--
-- >>> let nu = unfoldNu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> foldNu (elimListF 0 (+)) nu
-- 6
--
foldNu :: Functor f => (f a -> a) -> Nu f -> a
foldNu :: (f a -> a) -> Nu f -> a
foldNu f a -> a
f (Nu a -> f a
next a
seed) = (f a -> a) -> (a -> f a) -> a -> a
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
refold f a -> a
f a -> f a
next a
seed

-- | Unfold 'Nu'.
--
-- >>> unfoldNu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int)
-- unfoldNu unFix (Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix (Cons 3 (Fix Nil)))))))))
unfoldNu :: (a -> f a) -> a -> Nu f
unfoldNu :: (a -> f a) -> a -> Nu f
unfoldNu = (a -> f a) -> a -> Nu f
forall (f :: * -> *) a. (a -> f a) -> a -> Nu f
Nu

-------------------------------------------------------------------------------
-- refold
-------------------------------------------------------------------------------

-- | Refold one recursive type into another, one layer at the time.
--
refold :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
refold :: (f b -> b) -> (a -> f a) -> a -> b
refold f b -> b
f a -> f a
g = a -> b
h where h :: a -> b
h = f b -> b
f (f b -> b) -> (a -> f b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h (f a -> f b) -> (a -> f a) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
g

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

--
=> (t a -> m a) -> Fix t -> m a
foldFixM :: (t a -> m a) -> Fix t -> m a
foldFixM t a -> m a
f = Fix t -> m a
go where go :: Fix t -> m a
go = (t a -> m a
f (t a -> m a) -> m (t a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (t a) -> m a) -> (Fix t -> m (t a)) -> Fix t -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix t -> m a) -> t (Fix t) -> m (t a)
forall (t :: * -> *) (m :: * -> *) a b.
(a -> m b) -> t a -> m (t b)
mapM Fix t -> m a
go (t (Fix t) -> m (t a)) -> (Fix t -> t (Fix t)) -> Fix t -> m (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix t -> t (Fix t)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

unfoldFixM :: (Monad m, Traversable t)
=> (a -> m (t a)) -> (a -> m (Fix t))
unfoldFixM :: (a -> m (t a)) -> a -> m (Fix t)
unfoldFixM a -> m (t a)
f = a -> m (Fix t)
go where go :: a -> m (Fix t)
go = (t (Fix t) -> Fix t) -> m (t (Fix t)) -> m (Fix t)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM t (Fix t) -> Fix t
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (m (t (Fix t)) -> m (Fix t))
-> (a -> m (t (Fix t))) -> a -> m (Fix t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> m (Fix t)) -> t a -> m (t (Fix t))
forall (t :: * -> *) (m :: * -> *) a b.
(a -> m b) -> t a -> m (t b)
mapM a -> m (Fix t)
go (t a -> m (t (Fix t))) -> m (t a) -> m (t (Fix t))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (t a) -> m (t (Fix t))) -> (a -> m (t a)) -> a -> m (t (Fix t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (t a)
f

refoldM :: (Monad m, Traversable t)
=> (t b -> m b) -> (a -> m (t a)) -> (a -> m b)
refoldM :: (t b -> m b) -> (a -> m (t a)) -> a -> m b
refoldM t b -> m b
phi a -> m (t a)
psi = a -> m b
go where go :: a -> m b
go = (t b -> m b
phi (t b -> m b) -> m (t b) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (t b) -> m b) -> (a -> m (t b)) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> m b) -> t a -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(a -> m b) -> t a -> m (t b)
mapM a -> m b
go (t a -> m (t b)) -> m (t a) -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (t a) -> m (t b)) -> (a -> m (t a)) -> a -> m (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (t a)
psi

-------------------------------------------------------------------------------
-- Deprecated aliases
-------------------------------------------------------------------------------

-- | Catamorphism or generic function fold.
cata :: Functor f => (f a -> a) -> (Fix f -> a)
cata :: (f a -> a) -> Fix f -> a
cata = (f a -> a) -> Fix f -> a
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix
{-# DEPRECATED cata "Use foldFix" #-}

-- | Anamorphism or generic function unfold.
ana :: Functor f => (a -> f a) -> (a -> Fix f)
ana :: (a -> f a) -> a -> Fix f
ana = (a -> f a) -> a -> Fix f
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
unfoldFix
{-# DEPRECATED ana "Use unfoldFix" #-}

-- | Hylomorphism is anamorphism followed by catamorphism.
hylo :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b)
hylo :: (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
refold
{-# DEPRECATED hylo "Use refold" #-}

cataM :: (Monad m, Traversable t)
=> (t a -> m a) -> Fix t -> m a
cataM :: (t a -> m a) -> Fix t -> m a
cataM = (t a -> m a) -> Fix t -> m a
forall (m :: * -> *) (t :: * -> *) a.
(t a -> m a) -> Fix t -> m a
foldFixM
{-# DEPRECATED cataM "Use foldFixM" #-}

anaM :: (Monad m, Traversable t)
=> (a -> m (t a)) -> (a -> m (Fix t))
anaM :: (a -> m (t a)) -> a -> m (Fix t)
anaM = (a -> m (t a)) -> a -> m (Fix t)
forall (m :: * -> *) (t :: * -> *) a.
(a -> m (t a)) -> a -> m (Fix t)
unfoldFixM
{-# DEPRECATED anaM "Use unfoldFixM" #-}