Hello Cafè,

I'd like to share a piece of code I've found useful to nest ordering on EQ.

{-# language GADTs #-}

import Data.Monoid (mconcat)
import Data.Ord (comparing)

data Orderings t where
  Ascending :: Ord a => (t -> a) -> Orderings t
  Descending :: Ord a => (t -> a) -> Orderings t

comparings :: [Orderings t] -> t -> t -> Ordering
comparings c x y = mconcat $ map g c where
  g (Ascending f) = comparing f x y
  g (Descending f) = comparing f y x
 

I couldn't find a simpler solution, maybe somebody else has one.

I've tried using
comparings :: [forall a. Ord a =>  t -> a]  -> t -> t -> Ordering
which is not compiling for impredicativity and I'd like to understand better.

An example on sorting (Ord a, Ord b, Ord c) => [(a,(b,c)] with 'a' in opposite order, then 'c' and 'b' in ascending order goes like

sortBy (comparings [Descending fst, Ascending $ snd . snd, Ascending $ fst . snd])

Thanks for help/comments

paolino