{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

{-|

Module      : RecursionSchemes
Description : Examples of Ana/Cata/Para-morphisms recursion schemes
Copyright   : © Frank Jung, 2021-2023
License     : GPL-3

A collection of recursion scheme examples.

= Examples

== Anamorphism

Using a non-recursive coalgebra to create a `ListF`.

@
test = buildListF 4
show test
"ConsF 4 (ConsF 3 (ConsF 2 (ConsF 1 NilF)))"

λ> :t unFix test
unFix test :: ListF Int (Fix (ListF Int))

λ> :t test
test :: Fix (ListF Int)
@

== Catamorphism

Using a non-recursive algebra to measure length of `ListF` entry, use a
catamorphism over the alegra to measure length of the entire `ListF`.

@
test :: Int a => Fix (ListF a)
test = Fix (ConsF 4 (Fix (ConsF 3 (Fix (ConsF 2 (Fix (ConsF 1 (Fix NilF))))))))

lengthListF test
4
@

== Paramorphism

The paramorphism examples come from "Making Sense of Recursion Patterns".
A paramorphism is like a catamorphism, but it preserves the initial data
structure.

= References

* <https://stackoverflow.com/questions/48023348/deriving-a-functor-for-an-infinite-stream Deriving a functor for an infinite stream>
* <https://dl.acm.org/doi/abs/10.5555/2663689.2663693 Making Sense of Recursion Patterns by Paul Bailes and Leighton Brough>

-}

module RecursionSchemes (
                        -- * Data constructors
                          Fix(..)
                        , ListF(..)
                        , NatF(..)
                        , Nat
                        , RAlgebra
                        -- * Recursion schemes
                        , ana
                        , cata
                        , para
                        , para'
                        , para''
                        -- * Coalgebra's
                        , buildListF
                        , buildCoalg
                        -- * Algebra's
                        , lengthAlg
                        , lengthListF
                        , lengthListF'
                        , fromNat
                        , toNat
                        -- * Utilities
                        , insert
                        , insert'
                        , toList
                        , idx0
                        , idx1
                        , idx2
                        , idx3
                        , idx4
                        ) where

import           Data.Bool     (bool)
import           Data.Function ((&))

-- | Generalised fixed point for any functor /f/.
-- Note that @unFix (Fix x) == x@
newtype Fix f = Fix { forall (f :: * -> *). Fix f -> f (Fix f)
unFix :: f (Fix f) }

-- This requires UndecidableInstances because the context is larger
-- than the head and so GHC can't guarantee that the instance safely
-- terminates. (Copied from Data.Functor.Fixedpoint).
instance Show (f (Fix f)) => Show (Fix f) where
  showsPrec :: Int -> Fix f -> ShowS
showsPrec Int
p (Fix f (Fix f)
f) = Int -> f (Fix f) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p f (Fix f)
f

instance Eq (f (Fix f)) => Eq (Fix f) where
  Fix f (Fix f)
x == :: Fix f -> Fix f -> Bool
== Fix f (Fix f)
y = f (Fix f)
x f (Fix f) -> f (Fix f) -> Bool
forall a. Eq a => a -> a -> Bool
== f (Fix f)
y
  Fix f (Fix f)
x /= :: Fix f -> Fix f -> Bool
/= Fix f (Fix f)
y = f (Fix f)
x f (Fix f) -> f (Fix f) -> Bool
forall a. Eq a => a -> a -> Bool
/= f (Fix f)
y

-- | List Functor where r is the carrier type.
data ListF a r = NilF | ConsF a r deriving ((forall a b. (a -> b) -> ListF a a -> ListF a b)
-> (forall a b. a -> ListF a b -> ListF a a) -> Functor (ListF a)
forall a b. a -> ListF a b -> ListF a a
forall a b. (a -> b) -> ListF a a -> ListF a b
forall a a b. a -> ListF a b -> ListF a a
forall a a b. (a -> b) -> ListF a a -> ListF a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> ListF a a -> ListF a b
fmap :: forall a b. (a -> b) -> ListF a a -> ListF a b
$c<$ :: forall a a b. a -> ListF a b -> ListF a a
<$ :: forall a b. a -> ListF a b -> ListF a a
Functor, Int -> ListF a r -> ShowS
[ListF a r] -> ShowS
ListF a r -> String
(Int -> ListF a r -> ShowS)
-> (ListF a r -> String)
-> ([ListF a r] -> ShowS)
-> Show (ListF a r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a r. (Show a, Show r) => Int -> ListF a r -> ShowS
forall a r. (Show a, Show r) => [ListF a r] -> ShowS
forall a r. (Show a, Show r) => ListF a r -> String
$cshowsPrec :: forall a r. (Show a, Show r) => Int -> ListF a r -> ShowS
showsPrec :: Int -> ListF a r -> ShowS
$cshow :: forall a r. (Show a, Show r) => ListF a r -> String
show :: ListF a r -> String
$cshowList :: forall a r. (Show a, Show r) => [ListF a r] -> ShowS
showList :: [ListF a r] -> ShowS
Show, ListF a r -> ListF a r -> Bool
(ListF a r -> ListF a r -> Bool)
-> (ListF a r -> ListF a r -> Bool) -> Eq (ListF a r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a r. (Eq a, Eq r) => ListF a r -> ListF a r -> Bool
$c== :: forall a r. (Eq a, Eq r) => ListF a r -> ListF a r -> Bool
== :: ListF a r -> ListF a r -> Bool
$c/= :: forall a r. (Eq a, Eq r) => ListF a r -> ListF a r -> Bool
/= :: ListF a r -> ListF a r -> Bool
Eq)

-- | Natural numbers Functor.
data NatF r = ZeroF | SuccF r deriving (Int -> NatF r -> ShowS
[NatF r] -> ShowS
NatF r -> String
(Int -> NatF r -> ShowS)
-> (NatF r -> String) -> ([NatF r] -> ShowS) -> Show (NatF r)
forall r. Show r => Int -> NatF r -> ShowS
forall r. Show r => [NatF r] -> ShowS
forall r. Show r => NatF r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> NatF r -> ShowS
showsPrec :: Int -> NatF r -> ShowS
$cshow :: forall r. Show r => NatF r -> String
show :: NatF r -> String
$cshowList :: forall r. Show r => [NatF r] -> ShowS
showList :: [NatF r] -> ShowS
Show, (forall a b. (a -> b) -> NatF a -> NatF b)
-> (forall a b. a -> NatF b -> NatF a) -> Functor NatF
forall a b. a -> NatF b -> NatF a
forall a b. (a -> b) -> NatF a -> NatF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NatF a -> NatF b
fmap :: forall a b. (a -> b) -> NatF a -> NatF b
$c<$ :: forall a b. a -> NatF b -> NatF a
<$ :: forall a b. a -> NatF b -> NatF a
Functor)

-- | Natural numbers type.
type Nat = Fix NatF

-- | The code defines a type synonym RAlgebra that represents a recursive
-- algebra for a functor f. An R-algebra is a function that takes a fixed point
-- of a functor Fix f and a value of type f a, and returns a value of type a.
--
-- The Fix type is used to define recursive data structures in Haskell. It is a
-- type constructor that takes a functor f as an argument and returns a fixed
-- point of f. The Fix type is used to define recursive data structures by
-- wrapping a value of type f (Fix f) in a Fix constructor.
--
-- The RAlgebra type synonym is used to define a function that takes a fixed
-- point of a functor Fix f and a value of type f a, and returns a value of type
-- a. This function is used to define recursive functions that operate on data
-- structures defined using Fix.
--
-- The RAlgebra type synonym is a higher-order type that takes two type
-- arguments: f, which is a functor, and a, which is the return type of the
-- algebra. The RAlgebra type synonym is used to define recursive functions that
-- operate on data structures defined using Fix.
type RAlgebra f a = Fix f -> f a -> a

-- | Anamorphism - produce a structure.
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
coalg = 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 a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> f a) -> a -> Fix f
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
ana a -> f a
coalg) (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
coalg

-- | Catamorphism - consume a structure.
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
alg = f a -> a
alg (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 a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> a) -> Fix f -> a
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata f a -> a
alg) (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

-- | Paramorphism - improved consumption of a structure.
para :: Functor f => RAlgebra f a -> Fix f -> a
para :: forall (f :: * -> *) a. Functor f => RAlgebra f a -> Fix f -> a
para RAlgebra f a
ralg Fix f
t = Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix f
t f (Fix f) -> (f (Fix f) -> f a) -> f a
forall a b. a -> (a -> b) -> b
& (Fix f -> a) -> f (Fix f) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RAlgebra f a -> Fix f -> a
forall (f :: * -> *) a. Functor f => RAlgebra f a -> Fix f -> a
para RAlgebra f a
ralg) f a -> (f a -> a) -> a
forall a b. a -> (a -> b) -> b
& RAlgebra f a
ralg Fix f
t

-- | Paramorphism where input list is the first parameter.
-- This comes from
-- [Making Sense of Recursion Patterns](https://dl.acm.org/doi/abs/10.5555/2663689.2663693)
-- by Paul Bailes and Leighton Brough. It extends `foldr` by supplying to the
-- combining operation (op) the unprocessed list tail, in addition to the head
-- and the result of recursion on the tail as provided by `foldr`.
--
-- Sum a list:
--
-- >>> para' (const . (+)) 0 [1,2,3]
-- 6
--
-- Suffixes of a list:
--
-- >>> para' (const (:)) [] "abcd"
-- ["bcd","cd","d",""]
--
para' :: (a -> [a] -> b -> b) -> b -> [a] -> b
para' :: forall a b. (a -> [a] -> b -> b) -> b -> [a] -> b
para' a -> [a] -> b -> b
_ b
b []      = b
b
para' a -> [a] -> b -> b
op b
b (a
x:[a]
xs) = a -> [a] -> b -> b
op a
x [a]
xs ((a -> [a] -> b -> b) -> b -> [a] -> b
forall a b. (a -> [a] -> b -> b) -> b -> [a] -> b
para' a -> [a] -> b -> b
op b
b [a]
xs)

-- | Paramorphism using `foldr`.
-- This comes from
-- [Making Sense of Recursion Patterns](https://dl.acm.org/doi/abs/10.5555/2663689.2663693)
-- by Paul Bailes and Leighton Brough.
--
-- The following shows how to get a catamorphism from a paramorphism.
-- In this example, we are calculating the sum of items from a list.
--
-- Sum a list:
--
-- >>> para'' (const . (+)) 0 [1,2,3]
-- 6
--
-- Suffixes of a list:
--
-- >>> para'' (\ _ xs xss -> xs : xss) [] "abcd"
-- ["bcd","cd","d",""]
--
-- >>> para'' (const (:)) [] "abcd"
-- ["bcd","cd","d",""]
--
para'' :: (a -> [a] -> b -> b) -> b -> [a] -> b
para'' :: forall a b. (a -> [a] -> b -> b) -> b -> [a] -> b
para'' a -> [a] -> b -> b
op b
b [a]
xs = ([a], b) -> b
forall a b. (a, b) -> b
snd (([a], b) -> b) -> ([a], b) -> b
forall a b. (a -> b) -> a -> b
$ (a -> ([a], b) -> ([a], b)) -> ([a], b) -> [a] -> ([a], b)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([a], b) -> ([a], b)
go ([], b
b) [a]
xs
  where
    go :: a -> ([a], b) -> ([a], b)
go a
y ([a]
ys, b
ys') = (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, a -> [a] -> b -> b
op a
y [a]
ys b
ys')

-- | Coalgebra is a non-recursive function to generate a `ListF` entry.
buildCoalg :: Int -> ListF Int Int
buildCoalg :: Int -> ListF Int Int
buildCoalg Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
1    = ListF Int Int
forall a r. ListF a r
NilF
  | Bool
otherwise = Int -> Int -> ListF Int Int
forall a r. a -> r -> ListF a r
ConsF Int
n (Int -> Int
forall a. Enum a => a -> a
pred Int
n)

-- | Feed coalgebra to anamorphism.
-- This will build a list.
--
-- >>> buildListF 4 :: Fix (ListF Int)
-- ConsF 4 (ConsF 3 (ConsF 2 (ConsF 1 NilF)))
buildListF :: Int -> Fix (ListF Int)
buildListF :: Int -> Fix (ListF Int)
buildListF = (Int -> ListF Int Int) -> Int -> Fix (ListF Int)
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
ana Int -> ListF Int Int
buildCoalg

-- | An alegbra over `ListF` to get list length.
lengthAlg :: ListF a Int -> Int
lengthAlg :: forall a. ListF a Int -> Int
lengthAlg ListF a Int
ls = case ListF a Int
ls of
                ListF a Int
NilF      -> Int
0
                ConsF a
_ Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Length is a folding operation, i.e. a Catamorphism.
--
-- >>> (lengthListF . buildListF) 4
-- 4
lengthListF :: Fix (ListF a) -> Int
lengthListF :: forall a. Fix (ListF a) -> Int
lengthListF = (ListF a Int -> Int) -> Fix (ListF a) -> Int
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata ListF a Int -> Int
forall a. ListF a Int -> Int
lengthAlg

-- | Length using special case of paramorphism.
--
-- >>> lengthListF' (buildListF 4)
-- 4
lengthListF' :: Fix (ListF a) -> Int
lengthListF' :: forall a. Fix (ListF a) -> Int
lengthListF' = RAlgebra (ListF a) Int -> Fix (ListF a) -> Int
forall (f :: * -> *) a. Functor f => RAlgebra f a -> Fix f -> a
para ((ListF a Int -> Int) -> RAlgebra (ListF a) Int
forall a b. a -> b -> a
const ListF a Int -> Int
forall a. ListF a Int -> Int
lengthAlg)

-- | Convert Natural number to an integer.
--
-- >>> fromNat (toNat 4)
-- 4
fromNat :: Nat -> Int
fromNat :: Nat -> Int
fromNat = (NatF Int -> Int) -> Nat -> Int
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata NatF Int -> Int
forall {a}. Num a => NatF a -> a
alg where
  alg :: NatF a -> a
alg NatF a
ZeroF     = a
0
  alg (SuccF a
n) = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1

-- | Build a natural number from an interger.
--
-- >>> toNat 4
-- SuccF (SuccF (SuccF (SuccF ZeroF)))
toNat :: Int -> Nat
toNat :: Int -> Nat
toNat = (Int -> NatF Int) -> Int -> Nat
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Fix f
ana Int -> NatF Int
forall {r}. (Ord r, Num r) => r -> NatF r
coalg where
  coalg :: r -> NatF r
coalg r
n
    | r
n r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
0    = NatF r
forall r. NatF r
ZeroF
    | Bool
otherwise = r -> NatF r
forall r. r -> NatF r
SuccF (r
n r -> r -> r
forall a. Num a => a -> a -> a
- r
1)

-- | Insert element into list at correct ordered position using `foldr`.
--
-- >>> insert 1 [2,3,4]
-- [1,2,3,4]
--
-- >>> insert 'c' "abde"
-- "abcde"
--
-- >>> insert 'f' "abcde"
-- "abcdef"
--
-- >>> insert 'o' "oa"
-- "ooa"
--
insert :: Ord a => a -> [a] -> [a]
insert :: forall a. Ord a => a -> [a] -> [a]
insert a
e = ([a], [a]) -> [a]
forall a b. (a, b) -> b
snd (([a], [a]) -> [a]) -> ([a] -> ([a], [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([a], [a]) -> ([a], [a])
go ([], [a
e])
  where
    go :: a -> ([a], [a]) -> ([a], [a])
go a
y ([a]
ys, [a]
yse) = (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, [a] -> [a] -> Bool -> [a]
forall a. a -> a -> Bool -> a
bool (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
yse) (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) (a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y))

-- | Insert element into list at correct ordered position.
--
-- >>> insert' 1 [2,3,4]
-- [1,2,3,4]
--
-- >>> insert' 1 []
-- [1]
--
-- >>> insert' 'c' "abde"
-- "abcde"
--
-- >>> insert' 'c' "abde" == "abcde"
-- True
--
-- >>> insert' 'o' "oa"
-- "ooa"
--
insert' :: Ord a => a -> [a] -> [a]
insert' :: forall a. Ord a => a -> [a] -> [a]
insert' a
e = (a -> [a] -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> [a] -> b -> b) -> b -> [a] -> b
para' a -> [a] -> [a] -> [a]
go [a
e]
  where
    go :: a -> [a] -> [a] -> [a]
go a
y [a]
ys [a]
yse = [a] -> [a] -> Bool -> [a]
forall a. a -> a -> Bool -> a
bool (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
yse) (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) (a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y)

-- | Convert a `ListF` to a standard list.
toList :: Fix (ListF a) -> [a]
toList :: forall a. Fix (ListF a) -> [a]
toList = (ListF a [a] -> [a]) -> Fix (ListF a) -> [a]
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata ListF a [a] -> [a]
forall {a}. ListF a [a] -> [a]
alg
  where alg :: ListF a [a] -> [a]
alg ListF a [a]
ls = case ListF a [a]
ls of
                  ListF a [a]
NilF      -> []
                  ConsF a
a [a]
r -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r

-- | Indexing a list.
--
-- >>> idx0 "abcde"
-- [0,1,2,3,4]
idx0 :: (Foldable t, Num b) => t a -> [b]
idx0 :: forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> [b]
idx0 t a
as = t a -> (a -> (b -> [b]) -> b -> [b]) -> (b -> [b]) -> b -> [b]
forall (t :: * -> *) a b.
Foldable t =>
t a -> (a -> b -> b) -> b -> b
foldXs t a
as (\ a
_ b -> [b]
f b
m -> b
m b -> [b] -> [b]
forall a. a -> [a] -> [a]
: b -> [b]
f (b
m b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)) ([b] -> b -> [b]
forall a b. a -> b -> a
const []) b
0
  where
    -- | `foldXs` is `foldr` with the structure moved as the first parameter.
    foldXs :: Foldable t => t a -> (a -> b -> b) -> b -> b
    foldXs :: forall (t :: * -> *) a b.
Foldable t =>
t a -> (a -> b -> b) -> b -> b
foldXs t a
xs a -> b -> b
op b
b = (a -> b -> b) -> b -> t a -> b
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
op b
b t a
xs

-- | Alternate list indexing using `foldr`.
--
-- >>> idx1 "abcde"
-- [0,1,2,3,4]
idx1 :: (Foldable t, Num b) => t a -> [b]
idx1 :: forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> [b]
idx1 t a
xs = (a -> (b -> [b]) -> b -> [b]) -> (b -> [b]) -> t a -> b -> [b]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
_ b -> [b]
f b
m -> b
m b -> [b] -> [b]
forall a. a -> [a] -> [a]
: b -> [b]
f (b
m b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)) ([b] -> b -> [b]
forall a b. a -> b -> a
const []) t a
xs b
0

-- | Alternate list indexing using `zipWith`.
--
-- >>> idx2 "abcde"
-- [0,1,2,3,4]
idx2 :: [b] -> [Integer]
idx2 :: forall b. [b] -> [Integer]
idx2 = (Integer -> b -> Integer) -> [Integer] -> [b] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> b -> Integer
forall a b. a -> b -> a
const [Integer
0..]

-- | List indexing using `foldr`.
--
-- >>> idx3 "abcde"
-- [0,1,2,3,4]
idx3 :: (Foldable t) => t a -> [Integer]
idx3 :: forall (t :: * -> *) a. Foldable t => t a -> [Integer]
idx3 t a
xs = (a -> ([Integer] -> [Integer]) -> [Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> t a -> [Integer] -> [Integer]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
_ [Integer] -> [Integer]
f (Integer
y:[Integer]
ys) -> Integer
y Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer]
f [Integer]
ys) ([Integer] -> [Integer] -> [Integer]
forall a b. a -> b -> a
const []) t a
xs [Integer
0..]

-- | List indexing using `foldr` with parameter last.
--
-- >>> idx4 "abcde"
-- [0,1,2,3,4]
idx4 :: [b] -> [Integer]
idx4 :: forall b. [b] -> [Integer]
idx4 = (Integer -> ([b] -> [Integer]) -> [b] -> [Integer])
-> ([b] -> [Integer]) -> [Integer] -> [b] -> [Integer]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> ([b] -> [Integer]) -> [b] -> [Integer]
forall {a} {a}. a -> ([a] -> [a]) -> [a] -> [a]
step ([Integer] -> [b] -> [Integer]
forall a b. a -> b -> a
const []) [Integer
0..]
  where
    step :: a -> ([a] -> [a]) -> [a] -> [a]
step a
_ [a] -> [a]
_ []     = []
    step a
y [a] -> [a]
f (a
_:[a]
xs) = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
f [a]
xs