module Algebra.Indexable (
C(compare),
ordCompare,
liftCompare,
ToOrd,
toOrd,
fromOrd,
) where
import Prelude hiding (compare)
import qualified Prelude as P
class Eq a => C a where
compare :: a -> a -> Ordering
ordCompare :: Ord a => a -> a -> Ordering
ordCompare = P.compare
liftCompare :: C b => (a -> b) -> a -> a -> Ordering
liftCompare f x y = compare (f x) (f y)
instance (C a, C b) => C (a,b) where
compare (x0,x1) (y0,y1) =
let res = compare x0 y0
in case res of
EQ -> compare x1 y1
_ -> res
instance C a => C [a] where
compare [] [] = EQ
compare [] _ = LT
compare _ [] = GT
compare (x:xs) (y:ys) = compare (x,xs) (y,ys)
instance C Integer where
compare = ordCompare
newtype ToOrd a = ToOrd {fromOrd :: a} deriving (Eq, Show)
toOrd :: a -> ToOrd a
toOrd = ToOrd
instance C a => Ord (ToOrd a) where
compare (ToOrd x) (ToOrd y) = compare x y