{-# LANGUAGE FlexibleInstances, UndecidableInstances, FlexibleContexts, TypeOperators #-}

module Data.TrieMap.Regular.Ord where

import Data.TrieMap.Regular.Base
import Data.TrieMap.Regular.Eq
-- import Data.TrieMap.MultiRec.Base(Family(..))
-- import Data.TrieMap.MultiRec.Ord(HOrd0(..))
-- import Data.TrieMap.TrieKey
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 HOrd0 KeyFam r => OrdT (FamT KeyFam r) where

-- instance OrdT (Family phi) where
-- 	compareT0 cmp (F a) (F b) = cmp a b

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