{-# 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,
    wrapFix,
    unwrapFix,
    -- * Mu - least fixed point
    Mu (..),
    hoistMu,
    foldMu,
    unfoldMu,
    wrapMu,
    unwrapMu,
    -- * Nu - greatest fixed point
    Nu (..),
    hoistNu,
    foldNu,
    unfoldNu,
    wrapNu,
    unwrapNu,
    -- * Refolding
    refold,
    -- * Monadic variants
    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, ($), (.), (=<<))

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

import Control.Monad        (liftM)
import Data.Function        (on)
import Data.Functor.Classes (Eq1, Ord1, Read1, Show1, compare1, eq1, readsPrec1, showsPrec1)
import Data.Hashable        (Hashable (..))
import Data.Hashable.Lifted (Hashable1, hashWithSalt1)
import Data.Typeable        (Typeable)
import GHC.Generics         (Generic)
import Text.Read            (Lexeme (Ident), Read (..), lexP, parens, prec, readS_to_Prec, step)

#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
-- >>> 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 { forall (f :: * -> *). Fix f -> f (Fix f)
unFix :: f (Fix f) }
  deriving (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 (f :: * -> *) (g :: * -> *).
Functor f =>
(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) = forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall a. f a -> g a
nt (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 (g :: * -> *) (f :: * -> *).
Functor g =>
(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) = forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> Fix g
go (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 :: forall (f :: * -> *) a. Functor f => (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
unfoldFix a -> f a
f = a -> Fix f
go where go :: a -> Fix f
go = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Fix f
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
f

-- | Wrap 'Fix'.
--
-- >>> let x = unfoldFix (\i -> if i < 3 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> wrapFix (Cons 10 x)
-- Fix (Cons 10 (Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix Nil))))))))
--
-- @since 0.3.2
--
wrapFix :: f (Fix f) -> Fix f
wrapFix :: forall (f :: * -> *). f (Fix f) -> Fix f
wrapFix = forall (f :: * -> *). f (Fix f) -> Fix f
Fix

-- | Unwrap 'Fix'.
--
-- >>> let x = unfoldFix (\i -> if i < 3 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> unwrapFix x
-- Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix Nil)))))
--
-- @since 0.3.2
--
unwrapFix :: Fix f -> f (Fix f)
unwrapFix :: forall (f :: * -> *). Fix f -> f (Fix f)
unwrapFix = forall (f :: * -> *). Fix f -> f (Fix f)
unFix

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

instance Eq1 f => Eq (Fix f) where
    Fix f (Fix f)
a == :: Fix f -> Fix f -> Bool
== Fix f (Fix f)
b = 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) = 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 forall a. Ord a => a -> a -> Bool
>= Int
11)
            forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Fix "
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
11 f (Fix f)
a

#ifdef __GLASGOW_HASKELL__
instance Read1 f => Read (Fix f) where
    readPrec :: ReadPrec (Fix f)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
        Ident String
"Fix" <- ReadPrec Lexeme
lexP
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall a. ReadPrec a -> ReadPrec a
step (forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1))
#endif

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

instance Hashable1 f => Hashable (Fix f) where
    hashWithSalt :: Int -> Fix f -> Int
hashWithSalt Int
salt = forall (f :: * -> *) a.
(Hashable1 f, Hashable a) =>
Int -> f a -> Int
hashWithSalt1 Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. (NFData1 f, NFData a) => f a -> ()
rnf1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Fix f -> f (Fix f)
unFix
#endif

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

#ifdef __GLASGOW_HASKELL__
#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 { forall (f :: * -> *). 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
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu forall (f :: * -> *). f (Fix f) -> Fix f
Fix

instance (Functor f, Ord1 f) => Ord (Mu f) where
    compare :: Mu f -> Mu f -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"unfoldMu unFix " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu forall (f :: * -> *). f (Fix f) -> Fix f
Fix Mu f
f)

#ifdef __GLASGOW_HASKELL__
instance (Functor f, Read1 f) => Read (Mu f) where
    readPrec :: ReadPrec (Mu f)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
        Ident String
"unfoldMu" <- ReadPrec Lexeme
lexP
        Ident String
"unFix" <- ReadPrec Lexeme
lexP
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Mu f
unfoldMu forall (f :: * -> *). Fix f -> f (Fix f)
unFix) (forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec)
#endif

-- | Change base functor in 'Mu'.
hoistMu :: (forall a. f a -> g a) -> Mu f -> Mu g
hoistMu :: forall (f :: * -> *) (g :: * -> *).
(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 (f :: * -> *). (forall a. (f a -> a) -> a) -> Mu f
Mu forall a b. (a -> b) -> a -> b
$ \g a -> a
roll -> forall a. (f a -> a) -> a
mk (g a -> a
roll forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu f a -> a
f (Mu forall a. (f a -> a) -> a
mk) = 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 :: forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Mu f
unfoldMu a -> f a
f a
x = forall (f :: * -> *). (forall a. (f a -> a) -> a) -> Mu f
Mu forall a b. (a -> b) -> a -> b
$ \f a -> a
mk -> 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

-- | Wrap 'Mu'.
--
-- >>> let x = unfoldMu (\i -> if i < 3 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> wrapMu (Cons 10 x)
-- unfoldMu unFix (Fix (Cons 10 (Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix Nil)))))))))
--
-- @since 0.3.2
--
wrapMu :: Functor f => f (Mu f) -> Mu f
wrapMu :: forall (f :: * -> *). Functor f => f (Mu f) -> Mu f
wrapMu f (Mu f)
fx = forall (f :: * -> *). (forall a. (f a -> a) -> a) -> Mu f
Mu forall a b. (a -> b) -> a -> b
$ \f a -> a
f -> f a -> a
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu f a -> a
f) f (Mu f)
fx)

-- | Unwrap 'Mu'.
--
-- >>> let x = unfoldMu (\i -> if i < 3 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> unwrapMu x
-- Cons 0 (unfoldMu unFix (Fix (Cons 1 (Fix (Cons 2 (Fix Nil))))))
--
-- @since 0.3.2
--
unwrapMu :: Functor f => Mu f -> f (Mu f)
unwrapMu :: forall (f :: * -> *). Functor f => Mu f -> f (Mu f)
unwrapMu = forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
foldMu (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *). Functor f => f (Mu f) -> Mu f
wrapMu)

-------------------------------------------------------------------------------
-- 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
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
foldNu forall (f :: * -> *). f (Fix f) -> Fix f
Fix

instance (Functor f, Ord1 f) => Ord (Nu f) where
    compare :: Nu f -> Nu f -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
foldNu 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"unfoldNu unFix " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
foldNu forall (f :: * -> *). f (Fix f) -> Fix f
Fix Nu f
f)

#ifdef __GLASGOW_HASKELL__
instance (Functor f, Read1 f) => Read (Nu f) where
    readPrec :: ReadPrec (Nu f)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
        Ident String
"unfoldNu" <- ReadPrec Lexeme
lexP
        Ident String
"unFix" <- ReadPrec Lexeme
lexP
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a (f :: * -> *). (a -> f a) -> a -> Nu f
unfoldNu forall (f :: * -> *). Fix f -> f (Fix f)
unFix) (forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec)
#endif

-- | Change base functor in 'Nu'.
hoistNu :: (forall a. f a -> g a) -> Nu f -> Nu g
hoistNu :: forall (f :: * -> *) (g :: * -> *).
(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) = forall (f :: * -> *) a. (a -> f a) -> a -> Nu f
Nu (forall a. f a -> g a
n 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 :: forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
foldNu f a -> a
f (Nu a -> f a
next a
seed) = 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 :: forall a (f :: * -> *). (a -> f a) -> a -> Nu f
unfoldNu = forall (f :: * -> *) a. (a -> f a) -> a -> Nu f
Nu

-- | Wrap 'Nu'.
--
-- >>> let x = unfoldNu (\i -> if i < 3 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> wrapNu (Cons 10 x)
-- unfoldNu unFix (Fix (Cons 10 (Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix Nil)))))))))
--
-- @since 0.3.2
--
wrapNu :: Functor f => f (Nu f) -> Nu f
wrapNu :: forall (f :: * -> *). Functor f => f (Nu f) -> Nu f
wrapNu = forall a (f :: * -> *). (a -> f a) -> a -> Nu f
unfoldNu (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *). Functor f => Nu f -> f (Nu f)
unwrapNu)

-- | Unwrap 'Nu'.
--
-- >>> let x = unfoldNu (\i -> if i < 3 then Cons i (i + 1) else Nil) (0 :: Int)
-- >>> unwrapNu x
-- Cons 0 (unfoldNu unFix (Fix (Cons 1 (Fix (Cons 2 (Fix Nil))))))
--
-- @since 0.3.2
--
unwrapNu :: Functor f => Nu f -> f (Nu f)
unwrapNu :: forall (f :: * -> *). Functor f => Nu f -> f (Nu f)
unwrapNu (Nu a -> f a
f a
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. (a -> f a) -> a -> Nu f
Nu a -> f a
f) (a -> f a
f a
x)

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

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

-------------------------------------------------------------------------------
-- Monadic variants
-------------------------------------------------------------------------------

-- | Monadic 'foldFix'.
--
foldFixM:: (Monad m, Traversable t)
    => (t a -> m a) -> Fix t -> m a
foldFixM :: forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Fix t -> m a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Fix f -> f (Fix f)
unFix

-- | Monadic anamorphism.
unfoldFixM :: (Monad m, Traversable t)
    => (a -> m (t a)) -> (a -> m (Fix t))
unfoldFixM :: forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m (Fix t)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (t a)
f

-- | Monadic hylomorphism.
refoldM :: (Monad m, Traversable t)
    => (t b -> m b) -> (a -> m (t a)) -> (a -> m b)
refoldM :: forall (m :: * -> *) (t :: * -> *) b a.
(Monad m, Traversable t) =>
(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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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 :: forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata = 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 :: forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
ana = 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 :: forall (f :: * -> *) b a.
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
refold
{-# DEPRECATED hylo "Use refold" #-}

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

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

-- | Monadic hylomorphism.
hyloM :: (Monad m, Traversable t)
    => (t b -> m b) -> (a -> m (t a)) -> (a -> m b)
hyloM :: forall (m :: * -> *) (t :: * -> *) b a.
(Monad m, Traversable t) =>
(t b -> m b) -> (a -> m (t a)) -> a -> m b
hyloM = forall (m :: * -> *) (t :: * -> *) b a.
(Monad m, Traversable t) =>
(t b -> m b) -> (a -> m (t a)) -> a -> m b
refoldM
{-# DEPRECATED hyloM "Use refoldM" #-}