dropWhileCata.hs

{-#LANGUAGE DeriveFunctor#-}

module Main where

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)

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


dropWhileD :: Functor f => (f (a, Fix f) -> a) -> Fix f -> a
dropWhileD f = fst . cataRec (\v -> (f v, In (fmap snd v)))

alg :: (a -> Bool) -> ListF a (Fix (ListF a), Fix (ListF a)) -> Fix (ListF a)
alg p v@(Cons x (xs, _)) = if p x then xs else In (fmap snd v)
alg _ xs = In (fmap fst xs)

main :: IO ()
main = print (cataList(dropWhileD (alg (> 4)) (genList 10)))