module Data.Sort
(
L.sort
, L.sortBy
, L.sortOn
, monoidSortAssocs
, monoidSortAssocsBy
, groupSortAssocs
, groupSortAssocsBy
, monoidSort
, monoidSortOn
, monoidSortBy
, uniqueSort
, uniqueSortOn
, uniqueSortBy
, groupSort
, groupSortOn
, groupSortBy
) where
import qualified Data.List as L
import Data.Monoid
import Data.Ord
monoidSortAssocs :: (Monoid a,Ord k)
=> [(k,a)]
-> [(k,a)]
monoidSortAssocs = monoidSortAssocsBy compare
monoidSortAssocsBy :: (Monoid a)
=> (k->k->Ordering)
-> [(k,a)]
-> [(k,a)]
monoidSortAssocsBy cmp = groupSortAssocsBy cmp $ const monoid_group
groupSortAssocs :: Ord k
=> (k->a->[a]->b)
-> [(k,a)]
-> [(k,b)]
groupSortAssocs = groupSortAssocsBy compare
groupSortAssocsBy :: (k->k->Ordering)
-> (k->a->[a]->b)
-> [(k,a)]
-> [(k,b)]
groupSortAssocsBy cmp0 grp0 = groupSortBy cmp grp
where
cmp (k,_) (k',_) = cmp0 k k'
grp (k,y) ps = (,) k $ grp0 k y $ map snd ps
monoidSort :: (Monoid a,Ord a) => [a] -> [a]
monoidSort = monoidSortBy compare
monoidSortOn :: (Monoid a,Ord k) => (a->k) -> [a] -> [a]
monoidSortOn chg = groupSortOn chg $ const monoid_group
monoidSortBy :: Monoid a => (a->a->Ordering) -> [a] -> [a]
monoidSortBy cmp = groupSortBy cmp monoid_group
uniqueSort :: Ord a => [a] -> [a]
uniqueSort = uniqueSortBy compare
uniqueSortOn :: Ord k => (a->k) -> [a] -> [a]
uniqueSortOn chg = groupSortOn chg $ const const
uniqueSortBy :: (a->a->Ordering) -> [a] -> [a]
uniqueSortBy cmp = groupSortBy cmp const
groupSort :: (Ord a) => (a->[a]->b) -> [a] -> [b]
groupSort = groupSortBy compare
groupSortOn :: Ord k
=> (a->k)
-> (k->a->[a]->b)
-> [a]
-> [b]
groupSortOn chg grp = groupSortBy (comparing fst) grp_val . map inj
where
grp_val a as = grp k (snd a) $ map snd as
where
k = fst a
inj x = k `seq` (k,x)
where
k = chg x
groupSortBy :: (a->a->Ordering)
-> (a->[a]->b)
-> [a]
-> [b]
groupSortBy cmp grp = aggregate . L.sortBy cmp
where
aggregate [] = []
aggregate (h:t) = seq g $ g : aggregate rst
where
g = grp h eqs
(eqs,rst) = span is_le t
is_le x = case cmp x h of
LT -> True
EQ -> True
GT -> False
monoid_group :: Monoid a => a -> [a] -> a
monoid_group x xs = x <> mconcat xs