insertionSort :: (Ord a) => (a -> a -> Bool) -> [a] -> [a]
insertionSort p [] = []
insertionSort p (x:xs) = insertionSort' [x] xs
    where
        insertionSort' os [] = os
        insertionSort' os us = insertionSort' os'' us''
            where
                (os', us', olast) = separateSorted us 
                (ls, us'') = span (\x -> p x olast) us'
                os'' = insertAll (os++os') ls

        separateSorted xs@(x:[]) = (xs, [], x)
        separateSorted xs@(x:xs'@(x':_))
            | x <= x'   = (x:os, us, m)
            | otherwise = ([x], xs', x)
                where
                    (os, us, m) = separateSorted xs'

        insertAll os [] = os
        insertAll os (l:ls) = insertAll (insert os l) ls

        insert os u = ls ++ (u:hs)
            where
                (ls, hs) = span (\x -> p x u) os

main = print $ insertionSort (<) [3,4,5,3,2,1,4]

[1,2,3,3,4,4,5]