Fibonacci Histomorphism

FibHist.hs

module Fib where
import Control.Arrow((>>>),(&&&))
import Control.Comonad.Cofree

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

data NatF a = Z | S a deriving Show

-- Peano natural numbers as the least fixed point of functor NatF
type Nat = Fix NatF

z :: Nat 
z = In Z

suc :: Nat -> Nat
suc n = In $ S n

toNat :: Int -> Nat
toNat n | n <= 0 = z
toNat n = suc $ toNat (n-1)

instance Functor NatF where
    fmap f Z = Z
    fmap f (S n) = S (f n)

-- using Cofree Comonad as the 'cache'
type CVAlgebra f a = f(Cofree f a) -> a

histo :: Functor f => CVAlgebra f a -> Fix f -> a
histo cvalg = dp >>> \(a :< s) -> a where 
    dp = out >>> fmap dp >>> (cvalg &&& id) >>> uncurry (:<)
    
fibAlg :: CVAlgebra NatF Int
fibAlg Z = 0
fibAlg (S  (_ :< Z)) = 1
fibAlg (S (p :< (S (pp :< _)))) = p + pp

-- just a histomorphism over the peano naturals, whats the problem
fib :: Int -> Int
fib = toNat >>> (histo fibAlg)