Skip to content

Add Eq1 and Ord1 instances, fix Eq/Ord #72

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 27, 2017
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 12 additions & 4 deletions src/Control/Comonad/Cofree.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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(..))

Expand Down Expand Up @@ -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))
Expand Down
23 changes: 19 additions & 4 deletions src/Control/Monad/Free.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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(..))

Expand All @@ -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
Expand Down
18 changes: 16 additions & 2 deletions src/Data/Coyoneda.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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

Expand Down
15 changes: 15 additions & 0 deletions src/Data/Yoneda.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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))

Expand Down