module Data.TrieMap.Regular.Ord where
import Data.TrieMap.Regular.Base
import Data.TrieMap.Regular.Eq
import Data.TrieMap.Modifiers
import Data.Monoid
type Comparator a = a -> a -> Ordering
class EqT f => OrdT f where
compareT0 :: Comparator a -> Comparator (f a)
compareT :: (OrdT f, Ord a) => Comparator (f a)
compareT = compareT0 compare
instance Ord a => OrdT (K0 a) where
compareT0 _ (K0 a) (K0 b) = compare a b
instance Ord a => Ord (K0 a r) where
compare (K0 a) (K0 b) = compare a b
instance OrdT I0 where
compareT0 cmp (I0 a) (I0 b) = cmp a b
instance Ord r => Ord (I0 r) where
compare = compareT
instance (OrdT f, OrdT g) => OrdT (f :*: g) where
compareT0 cmp (x1 :*: y1) (x2 :*: y2) = compareT0 cmp x1 x2 `mappend` compareT0 cmp y1 y2
instance (OrdT f, OrdT g, Ord r) => Ord ((f :*: g) r) where
compare = compareT
instance (OrdT f, OrdT g) => OrdT (f `O` g) where
compareT0 cmp (O x) (O y) = compareT0 (compareT0 cmp) x y
instance (OrdT f, OrdT g, Ord r) => Ord ((f `O` g) r) where
compare = compareT
instance (OrdT f, OrdT g) => OrdT (f :+: g) where
compareT0 cmp x y = case (x, y) of
(L x, L y) -> compareT0 cmp x y
(R x, R y) -> compareT0 cmp x y
(L _, R _) -> LT
(R _, L _) -> GT
instance (OrdT f, OrdT g, Ord r) => Ord ((f :+: g) r) where
compare = compareT
instance OrdT U0 where
compareT0 _ = compare
instance Ord (U0 r) where
compare _ _ = EQ
instance OrdT f => OrdT (L f) where
compareT0 cmp (List xs) (List ys) = compareT0' xs ys where
cmpT' = compareT0 cmp
compareT0' (x:xs) (y:ys) = cmpT' x y `mappend` compareT0' xs ys
compareT0' [] [] = EQ
compareT0' [] _ = LT
compareT0' _ [] = GT
instance (OrdT f, Ord r) => Ord (L f r) where
compare = compareT
instance OrdT [] where
compareT0 cmp = cmpT' where
cmpT' (x:xs) (y:ys) = cmp x y `mappend` cmpT' xs ys
cmpT' [] [] = EQ
cmpT' [] _ = LT
cmpT' _ [] = GT
instance (Regular a, Functor (PF a), OrdT (PF a)) => Ord (Reg a) where
compare a b = compareT (from' a) (from' b)
instance Ord a => OrdT ((,) a) where
compareT0 cmp (a, b) (c, d) = compare a c `mappend` cmp b d
instance Ord a => OrdT (Either a) where
compareT0 cmp x y = case (x, y) of
(Left a, Left b) -> compare a b
(Right a, Right b) -> cmp a b
(Left{}, Right{}) -> LT
(Right{}, Left{}) -> GT
instance OrdT Rev where
compareT0 cmp (Rev x) (Rev y) = cmp y x
instance OrdT Ordered where
compareT0 cmp (Ord x) (Ord y) = cmp x y