Permalink
Browse files

Added a bunch of Ord and Eq instances.

  • Loading branch information...
1 parent 3d479a1 commit 05cdcb1accccff9fae70057bb0c47d606aaa2f9e @tomlokhorst committed Jan 21, 2010
Showing with 32 additions and 2 deletions.
  1. +1 −1 src/Generic/Data/Eq.hs
  2. +13 −0 src/Generic/Data/Maybe.hs
  3. +18 −1 src/Generic/Data/Ord.hs
View
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
module Generic.Data.Eq where
View
@@ -3,7 +3,10 @@
module Generic.Data.Maybe where
import Prelude ()
+import Generic.Data.Bool
+import Generic.Data.Eq
import Generic.Data.List
+import Generic.Data.Ord
import Generic.Control.Function
import Generic.Control.Category
import Generic.Control.Functor
@@ -14,6 +17,16 @@ class MaybeC j where
just :: j a -> j (Maybe a)
maybe :: j r -> (j a -> j r) -> j (Maybe a) -> j r
+instance (BoolC j, FunC j, MaybeC j, Eq j a) => Eq j (Maybe a) where
+ mx == my = maybe (maybe true (const false) my)
+ (\x -> maybe false (\y -> x == y) my)
+ mx
+
+instance (BoolC j, FunC j, MaybeC j, Ord j a) => Ord j (Maybe a) where
+ mx <= my = maybe true -- (maybe true (const true) my)
+ (\x -> maybe false (\y -> x <= y) my)
+ mx
+
instance (FunC j, MaybeC j) => Functor j Maybe where
fmap f = maybe nothing (just . f)
View
@@ -1,4 +1,4 @@
-{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
module Generic.Data.Ord where
@@ -32,6 +32,23 @@ class OrderingC j where
gt :: j Ordering
ordering :: j a -> j a -> j a -> j Ordering -> j a
+instance (BoolC j) => Ord j Bool where
+ x <= y = bool true -- (bool true true y)
+ (bool false true y)
+ x
+
+instance (BoolC j, OrderingC j) => Eq j Ordering where
+ x == y = ordering (ordering true false false y)
+ (ordering false true false y)
+ (ordering false false true y)
+ x
+
+instance (BoolC j, OrderingC j) => Ord j Ordering where
+ x <= y = ordering true -- (ordering true true true y)
+ (ordering false true true y)
+ (ordering false false true y)
+ x
+
comparing :: (Ord j a, BoolC j, OrderingC j)
=> (b -> j a) -> b -> b -> j Ordering
comparing p x y = compare (p x) (p y)

0 comments on commit 05cdcb1

Please sign in to comment.