Sorting (Slowly) With Style

apo.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}

import Data.Functor.Foldable

data ListF a r =
    ConsF a r
  | NilF
  deriving (Show, Functor)

type List a = Fix (ListF a)

fromList :: [a] -> List a
fromList = ana coalg . project where
  coalg Nil        = NilF
  coalg (Cons h t) = ConsF h (project t)

mapHead :: (a -> a) -> List a -> List a
mapHead f = apo coalg . project where
  coalg NilF        = NilF
  coalg (ConsF h t) = ConsF (f h) (Left t)

cat :: List a -> List a -> List a
cat l0 l1 = apo coalg (project l0) where
  coalg NilF = case project l1 of
    NilF      -> NilF
    ConsF h t -> ConsF h (Left t)

  coalg (ConsF x l) = case project l of
    NilF      -> ConsF x (Left l1)
    ConsF h t -> ConsF x (Right (ConsF h t))

knockback :: Ord a => List a -> List a
knockback = apo coalg . project where
  coalg NilF        = NilF
  coalg (ConsF x l) = case project l of
      NilF          -> ConsF x (Left l)
      ConsF h t
        | x <= h    -> ConsF x (Left l)
        | otherwise -> ConsF h (Right (ConsF x t))

insertionSort :: Ord a => List a -> List a
insertionSort = cata (knockback . embed)

knockbackL :: Ord a => [a] -> [a]
knockbackL = apo coalg . project where
  coalg Nil        = Nil
  coalg (Cons x l) = case project l of
      Nil           -> Cons x (Left l)
      Cons h t
        | x <= h    -> Cons x (Left l)
        | otherwise -> Cons h (Right (Cons x t))

insertionSortL :: Ord a => [a] -> [a]
insertionSortL = cata (knockbackL . embed)