module Data.TrieMap.MultiRec.Ord where
import Data.TrieMap.MultiRec.Eq
import Generics.MultiRec
import Data.Monoid
type Comparator a = a -> a -> Ordering
class HEq phi f => HOrd phi f where
compareH :: (forall ix . phi ix -> Comparator (r ix)) -> phi ix -> Comparator (f r ix)
hcompare :: (HOrd phi f, HOrd0 phi r) => phi ix -> Comparator (f r ix)
hcompare = compareH compareH0
class HEq0 phi r => HOrd0 phi r where
compareH0 :: phi ix -> Comparator (r ix)
instance Ord k => HOrd phi (K k) where
compareH _ = compareH0
instance Ord k => HOrd0 phi (K k r) where
compareH0 _ (K a) (K b) = compare a b
instance El phi xi => HOrd phi (I xi) where
compareH cmp _ (I a) (I b) = cmp proof a b
instance (El phi xi, HOrd0 phi r) => HOrd0 phi (I xi r) where
compareH0 = hcompare
instance HOrd phi U where
compareH _ = compareH0
instance HOrd0 phi (U r) where
compareH0 _ _ _ = EQ
instance (HOrd phi f, HOrd phi g) => HOrd phi (f :*: g) where
compareH cmp pf (x1 :*: y1) (x2 :*: y2) = compareH cmp pf x1 x2 `mappend` compareH cmp pf y1 y2
instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :*: g) r) where
compareH0 = hcompare
instance (HOrd phi f, HOrd phi g) => HOrd phi (f :+: g) where
compareH cmp pf x y = case (x, y) of
(L x, L y) -> compareH cmp pf x y
(R x, R y) -> compareH cmp pf x y
(L _, R _) -> LT
(R _, L _) -> GT
instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :+: g) r) where
compareH0 = hcompare
instance HOrd phi f => HOrd phi (f :>: ix) where
compareH cmp pf (Tag a) (Tag b) = compareH cmp pf a b
instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi ((f :>: ix) r) where
compareH0 pf (Tag a) (Tag b) = hcompare pf a b
instance HOrd phi f => HOrd0 phi (HFix f) where
compareH0 pf (HIn a) (HIn b) = hcompare pf a b