Merge pull request #72 from purescript/eq-ord-1

Add `Eq1` and `Ord1` instances, fix `Eq`/`Ord`

Author: garyb

src/Control/Comonad/Cofree.purs

@@ -18,8 +18,10 @@ import Control.Extend (class Extend)
 import Control.Monad.Free (Free, runFreeM)
 import Control.Monad.Rec.Class (class MonadRec)
 import Control.Monad.State (State, StateT(..), runState, runStateT, state)
+import Data.Eq (class Eq1, eq1)
 import Data.Foldable (class Foldable, foldr, foldl, foldMap)
 import Data.Lazy (Lazy, force, defer)
+import Data.Ord (class Ord1, compare1)
 import Data.Traversable (class Traversable, traverse)
 import Data.Tuple (Tuple(..))
 
@@ -104,15 +106,21 @@ exploreM pair m w =
     eval :: forall x y. Tuple (x -> y) (Cofree g x) -> y
     eval (Tuple f cof) = f (extract cof)
 
-instance eqCofree :: (Eq (f (Cofree f a)), Eq a) => Eq (Cofree f a) where
-  eq x y = head x == head y && tail x == tail y
+instance eqCofree :: (Eq1 f, Eq a) => Eq (Cofree f a) where
+  eq x y = head x == head y && tail x `eq1` tail y
 
-instance ordCofree :: (Ord (f (Cofree f a)), Ord a) => Ord (Cofree f a) where
+instance eq1Cofree :: Eq1 f => Eq1 (Cofree f) where
+  eq1 = eq
+
+instance ordCofree :: (Ord1 f, Ord a) => Ord (Cofree f a) where
   compare x y =
     case compare (head x) (head y) of
-      EQ -> compare (tail x) (tail y)
+      EQ -> compare1 (tail x) (tail y)
       r -> r
 
+instance ord1Cofree :: Ord1 f => Ord1 (Cofree f) where
+  compare1 = compare
+
 instance functorCofree :: Functor f => Functor (Cofree f) where
   map f = loop where
     loop fa = Cofree (f (head fa)) (_lift loop (_tail fa))

src/Control/Monad/Free.purs

@@ -17,8 +17,10 @@ import Control.Monad.Trans.Class (class MonadTrans)
 
 import Data.CatList (CatList, empty, snoc, uncons)
 import Data.Either (Either(..))
+import Data.Eq (class Eq1, eq1)
 import Data.Foldable (class Foldable, foldMap, foldl, foldr)
 import Data.Maybe (Maybe(..))
+import Data.Ord (class Ord1, compare1)
 import Data.Traversable (class Traversable, traverse)
 import Data.Tuple (Tuple(..))
 
@@ -38,11 +40,24 @@ data FreeView f a b = Return a | Bind (f b) (b -> Free f a)
 
 data Val
 
-instance eqFree :: (Functor f, Eq (f (Free f a)), Eq a) => Eq (Free f a) where
-  eq x y = resume x == resume y
+instance eqFree :: (Functor f, Eq1 f, Eq a) => Eq (Free f a) where
+  eq x y = case resume x, resume y of
+    Left fa, Left fb -> eq1 fa fb
+    Right a, Right b -> a == b
+    _, _ -> false
 
-instance ordFree :: (Functor f, Ord (f (Free f a)), Ord a) => Ord (Free f a) where
-  compare x y = compare (resume x) (resume y)
+instance eq1Free :: (Functor f, Eq1 f) => Eq1 (Free f) where
+  eq1 = eq
+
+instance ordFree :: (Functor f, Ord1 f, Ord a) => Ord (Free f a) where
+  compare x y = case resume x, resume y of
+    Left fa, Left fb -> compare1 fa fb
+    Left _, _ -> LT
+    _, Left _ -> GT
+    Right a, Right b -> compare a b
+
+instance ord1Free :: (Functor f, Ord1 f, Ord a) => Ord1 (Free f) where
+  compare1 = compare
 
 instance freeFunctor :: Functor (Free f) where
   map k f = pure <<< k =<< f

src/Data/Coyoneda.purs

@@ -10,12 +10,14 @@ module Data.Coyoneda
 
 import Prelude
 
-import Data.Exists (Exists, runExists, mkExists)
-
 import Control.Comonad (class Comonad, extract)
 import Control.Extend (class Extend, (<<=))
 import Control.Monad.Trans.Class (class MonadTrans)
 
+import Data.Eq (class Eq1, eq1)
+import Data.Exists (Exists, runExists, mkExists)
+import Data.Ord (class Ord1, compare1)
+
 -- | `Coyoneda` is encoded as an existential type using `Data.Exists`.
 -- |
 -- | This type constructor encodes the contents of the existential package.
@@ -27,6 +29,18 @@ data CoyonedaF f a i = CoyonedaF (i -> a) (f i)
 -- | it is the _free_ `Functor` for `f`.
 newtype Coyoneda f a = Coyoneda (Exists (CoyonedaF f a))
 
+instance eqCoyoneda :: (Functor f, Eq1 f, Eq a) => Eq (Coyoneda f a) where
+  eq x y = lowerCoyoneda x `eq1` lowerCoyoneda y
+
+instance eq1Coyoneda :: (Functor f, Eq1 f) => Eq1 (Coyoneda f) where
+  eq1 = eq
+
+instance ordCoyoneda :: (Functor f, Ord1 f, Ord a) => Ord (Coyoneda f a) where
+  compare x y = lowerCoyoneda x `compare1` lowerCoyoneda y
+
+instance ord1Coyoneda :: (Functor f, Ord1 f) => Ord1 (Coyoneda f) where
+  compare1 = compare
+
 instance functorCoyoneda :: Functor (Coyoneda f) where
   map f (Coyoneda e) = runExists (\(CoyonedaF k fi) -> coyoneda (f <<< k) fi) e
 

src/Data/Yoneda.purs

@@ -12,11 +12,26 @@ import Control.Comonad (class Comonad, extract)
 import Control.Extend (class Extend, (<<=))
 import Control.Monad.Trans.Class (class MonadTrans)
 
+import Data.Eq (class Eq1, eq1)
+import Data.Ord (class Ord1, compare1)
+
 -- | The Yoneda `Functor`
 -- |
 -- | `Yoneda f` is a `Functor` for any type constructor `f`.
 newtype Yoneda f a = Yoneda (forall b. (a -> b) -> f b)
 
+instance eqYoneda :: (Eq1 f, Eq a) => Eq (Yoneda f a) where
+  eq x y = lowerYoneda x `eq1` lowerYoneda y
+
+instance eq1Yoneda :: Eq1 f => Eq1 (Yoneda f) where
+  eq1 = eq
+
+instance ordYoneda :: (Ord1 f, Ord a) => Ord (Yoneda f a) where
+  compare x y = lowerYoneda x `compare1` lowerYoneda y
+
+instance ord1Yoneda :: Ord1 f => Ord1 (Yoneda f) where
+  compare1 = compare
+
 instance functorYoneda :: Functor (Yoneda f) where
   map f m = Yoneda (\k -> runYoneda m (k <<< f))