hylomorphism.hs

hylomorphism.hs

{-# LANGUAGE GADTs, TypeFamilies, DeriveFunctor, LambdaCase #-}

module Hylo
where

import Data.Functor.Foldable
import Data.List

data TreeF a r = Leaf | Node a r r deriving (Functor, Show)

{-
lf         = Leaf
leaf a     = Node a Leaf Leaf
node a l r = Node a l r

d1 = node 4 (leaf 7) (node 3 (leaf 7) lf)
-}

split :: Ord a => [a] -> TreeF a [a]
split []       = Leaf
split (a:as)   = Node a l r
  where (l, r) = partition (<a) as

{-
 > split [4,5,3,6,2,8,1]
Node 4 [3,2,1] [5,6,8]                  <----- one step
it :: (Ord a, Num a) => TreeF a [a]
-}

join :: TreeF a [a] -> [a]
join Leaf         = []
join (Node a l r) = l ++ [a] ++ r

{-
 > join $ Node 4 [3,2,1] [5,6,8]
[3,2,1,4,5,6,8]                         <----- one step
it :: Num a => [a]
-}

qsort :: Ord a => [a] -> [a]
qsort = hylo join split

{-
 > qsort [4,5,3,6,2,8,1]
[1,2,3,4,5,6,8]
it :: (Ord a, Num a) => [a]
-}