{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE FlexibleContexts           #-}

module Generics.Regular.Functions.GOrd where

import Generics.Regular
import Data.Monoid (mappend)

--------------------------------------------------------------------------------
-- Generic Ord
--------------------------------------------------------------------------------

class GOrd f where
  comparef :: (a -> a -> Ordering) -> f a -> f a -> Ordering

instance GOrd I where
  comparef f (I x) (I y) = f x y

instance Ord a => GOrd (K a) where
  comparef _ (K x) (K y) = compare x y

instance GOrd U where
  comparef _ U U = EQ

instance (GOrd f, GOrd g) => GOrd (f :+: g) where
  comparef _ (L _) (R _) = LT
  comparef _ (R _) (L _) = GT
  comparef f (L x) (L y) = comparef f x y
  comparef f (R x) (R y) = comparef f x y

instance (GOrd f, GOrd g) => GOrd (f :*: g) where
  comparef f (x1 :*: y1) (x2 :*: y2) = comparef f x1 x2 `mappend` comparef f y1 y2

instance GOrd f => GOrd (C c f) where
  comparef f (C x) (C y) = comparef f x y

instance GOrd f => GOrd (S s f) where
  comparef f (S x) (S y) = comparef f x y

gcompare :: (Regular a, GOrd (PF a)) => a -> a -> Ordering
gcompare x y = comparef gcompare (from x) (from y)