hylomorphism factorial, no external dependencies

fact2.hs

{-# LANGUAGE TemplateHaskell, DeriveFunctor #-}

fact1 :: Integer -> Integer
fact1 n = product [1..n]

reduceProduct [] = []
reduceProduct [x] = [x]
reduceProduct (a:b:xs) = (a*b) : reduceProduct xs

product' [] = 1
product' [x] = x
product' xs = product' (reduceProduct xs)

fact2 :: Integer -> Integer
fact2 n = product' [1..n]

data BTreeF a = LfF Integer | TF a a deriving (Functor, Show)

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo f g = h where h = f . fmap h . g

fact3 :: Integer -> Integer
fact3 i = hylo cpsi apsi (1, i)
    where
        cpsi (LfF i) = i
        cpsi (TF l r) = l * r

        apsi (f, t) = if f >= t
                        then LfF f
                        else let r = (t + f) `div` 2
                              in TF (f, r) (r+1, t)
                
main :: IO ()
main = do
    print $ fact3 100000