takeWhileApo.hs

{-#LANGUAGE DeriveFunctor#-}

module Main where

import Prelude hiding (takeWhile)

fix :: ((a -> b) -> a -> b) -> a -> b
fix f = f (fix f)

data Fix f = In { out :: f (Fix f) }

ana :: Functor f => (a -> f a) -> (a -> Fix f) -> a -> Fix f
ana psi f = In . fmap f . psi

anaRec :: Functor f => (a -> f a) -> a -> Fix f
anaRec psi = fix (ana psi)

cata :: Functor f => (f a -> a) -> (Fix f -> a) -> Fix f -> a
cata psi f = psi . fmap f . out

cataRec :: Functor f => (f a -> a) -> Fix f -> a
cataRec psi = fix (cata psi)

apo :: Functor f => (a -> f (Either (Fix f) a)) -> (a -> Fix f) -> a -> Fix f
apo psi f = In . fmap worker . psi
  where worker (Left t) = t
        worker (Right a) = f a

apoRec :: Functor f => (a -> f (Either (Fix f) a)) -> a -> Fix f
apoRec psi = fix (apo psi)

data ListF a b = Empty | Cons a b deriving Functor

type ListR a = Fix (ListF a)

genList :: Int -> ListR Int
genList = anaRec psi
  where psi 0 = Empty
        psi n = Cons n (n - 1)

cataList :: ListR Int -> String
cataList = cataRec psi
  where psi Empty = "[]"
        psi (Cons n x) = show n ++ ":" ++ x

takeWhile :: (Int -> Bool) -> ListR Int -> ListR Int
takeWhile p = apoRec (psi . out)
  where psi (Cons x xs) | p x = Cons x (Right xs)
        psi _ =  fmap Left Empty

main :: IO ()
main = print (cataList (takeWhile (>5) (genList 10)))