head, tail, init and last implemented by paramorphism

ByPara.hs

{-# LANGUAGE TypeSynonymInstances,
             FlexibleInstances
#-}
module FixPrimeTest where

import Prelude hiding (Functor(..), map, succ, either, head, tail, init, last)
import FixPrime

-- | List a
data ListF a x = Nil | Cons a x deriving (Show)
type List a = Fix (ListF a)

nil :: List a
nil = In Nil
cons :: a -> List a -> List a
cons x xs = In (Cons x xs)

instance Show a => Show (List a) where
  show x = "(" ++ show (out x) ++ ")"

instance Bifunctor ListF where
  bimap (f, g) Nil = Nil
  bimap (f, g) (Cons a x) = Cons (f a) (g x)

instance Functor (ListF a) where
  fmap f = bimap (id, f)

init :: List a -> List a
init = para phi
  where
    phi (Cons x (In Nil, _)) = nil
    phi (Cons x (xs,    ys)) = cons x ys

last :: List a -> a
last = para phi
  where
    phi (Cons x (In Nil, _)) = x
    phi (Cons _ (xs,     _)) = last xs

head :: List a -> a
head = para phi
  where
    phi (Cons x _) = x

tail :: List a -> List a
tail = para phi
  where
    phi Nil = nil
    phi (Cons _ (xs, _)) = xs

gen :: Int -> List Int
gen = ana phi
  where
    phi :: Int -> ListF Int Int
    phi n = if n == 0 then Nil else Cons n (n-1)