Add Eq1 and Ord1 instances, fix Eq/Ord

Author: garyb

bower.json

@@ -27,6 +27,7 @@
     "purescript-catenable-lists": "^3.0.0",
     "purescript-exists": "^2.0.0",
     "purescript-inject": "^3.0.0",
+    "purescript-prelude": "^2.4.0",
     "purescript-transformers": "^2.0.0",
     "purescript-unsafe-coerce": "^2.0.0"
   },

src/Control/Comonad/Cofree.purs

@@ -11,13 +11,15 @@ module Control.Comonad.Cofree
   ) where
 
 import Prelude
-import Control.Monad.Free (Free, runFreeM)
 import Control.Alternative (class Alternative, (<|>), empty)
 import Control.Comonad (class Comonad, extract)
 import Control.Extend (class Extend)
+import Control.Monad.Free (Free, runFreeM)
 import Control.Monad.State (State, runState, 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(..))
 
@@ -83,15 +85,21 @@ explore pair m w =
     step :: f (Free f (a -> b)) -> State (Cofree g a) (Free f (a -> b))
     step ff = state \cof -> pair (map Tuple ff) (tail 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

@@ -19,9 +19,11 @@ 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.Inject (class Inject, inj)
 import Data.Maybe (Maybe(..))
+import Data.Ord (class Ord1, compare1)
 import Data.Traversable (class Traversable, traverse)
 import Data.Tuple (Tuple(..))
 
@@ -41,11 +43,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))