From 5ccc3b56c6c03dede5f53a26804c54ba4a7efc20 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Wed, 3 Feb 2021 13:33:13 -0500 Subject: [PATCH] Refactor functors and related packages This is part of a set of commits that rearrange the dependencies between multiple packages. The immediate motivation is to allow certain newtypes to be reused between `profunctor` and `bifunctors`, but this particular approach goes a little beyond that in two ways: first, it attempts to move data types (`either`, `tuple`) toward the bottom of the dependency stack; and second, it tries to ensure no package comes between `functors` and the packages most closely related to it, in order to open the possibility of merging those packages together (which may be desirable if at some point in the future additional newtypes are added which reveal new and exciting constraints on the module dependency graph). --- CHANGELOG.md | 3 +++ bower.json | 5 ++++- src/Control/Biapplicative.purs | 4 ++++ src/Control/Biapply.purs | 4 ++++ src/Data/Bifunctor.purs | 13 +++++++++++++ src/Data/Bifunctor/Clown.purs | 34 --------------------------------- src/Data/Bifunctor/Flip.purs | 34 --------------------------------- src/Data/Bifunctor/Joker.purs | 34 --------------------------------- src/Data/Bifunctor/Product.purs | 28 --------------------------- src/Data/Bifunctor/Wrap.purs | 34 --------------------------------- 10 files changed, 28 insertions(+), 165 deletions(-) delete mode 100644 src/Data/Bifunctor/Clown.purs delete mode 100644 src/Data/Bifunctor/Flip.purs delete mode 100644 src/Data/Bifunctor/Joker.purs delete mode 100644 src/Data/Bifunctor/Product.purs delete mode 100644 src/Data/Bifunctor/Wrap.purs diff --git a/CHANGELOG.md b/CHANGELOG.md index 2b483b6..0e4bef8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,8 @@ Notable changes to this project are documented in this file. The format is based Breaking changes: - Added support for PureScript 0.14 and dropped support for all previous versions (#16) + - `Clown`, `Flip`, `Joker`, and `Product` have been moved to the `Data.Functors` module in the `purescript-functors` package, so that the same types can also be used as profunctors; `Product` was renamed to `Product2` (#22) + - `Wrap` was deleted; it is expected that any instances of `Bifunctor` will be accompanied by a corresponding instance of `Functor` (#22) New features: @@ -14,6 +16,7 @@ Bugfixes: Other improvements: - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#18) - Added a CHANGELOG.md file and pull request template (#19, #20) + - This package now depends on the `purescript-const`, `purescript-either`, and `purescript-tuples` packages, and contains instances previously in those packages (#22) ## [v4.0.0](https://github.com/purescript/purescript-bifunctors/releases/tag/v4.0.0) - 2018-05-23 diff --git a/bower.json b/bower.json index f4bc2e8..1d59c3e 100644 --- a/bower.json +++ b/bower.json @@ -17,7 +17,10 @@ "package.json" ], "dependencies": { + "purescript-const": "master", + "purescript-either": "master", + "purescript-newtype": "master", "purescript-prelude": "master", - "purescript-newtype": "master" + "purescript-tuples": "master" } } diff --git a/src/Control/Biapplicative.purs b/src/Control/Biapplicative.purs index f1d3c68..b6e01ac 100644 --- a/src/Control/Biapplicative.purs +++ b/src/Control/Biapplicative.purs @@ -1,8 +1,12 @@ module Control.Biapplicative where import Control.Biapply (class Biapply) +import Data.Tuple (Tuple(..)) -- | `Biapplicative` captures type constructors of two arguments which support lifting of -- | functions of zero or more arguments, in the sense of `Applicative`. class Biapply w <= Biapplicative w where bipure :: forall a b. a -> b -> w a b + +instance biapplicativeTuple :: Biapplicative Tuple where + bipure = Tuple diff --git a/src/Control/Biapply.purs b/src/Control/Biapply.purs index 47a64c7..6bb247c 100644 --- a/src/Control/Biapply.purs +++ b/src/Control/Biapply.purs @@ -3,6 +3,7 @@ module Control.Biapply where import Data.Function (const, identity) import Data.Bifunctor (class Bifunctor, bimap) +import Data.Tuple (Tuple(..)) -- | A convenience operator which can be used to apply the result of `bipure` in -- | the style of `Applicative`: @@ -53,3 +54,6 @@ bilift3 -> w c g -> w d h bilift3 f g a b c = bimap f g <<$>> a <<*>> b <<*>> c + +instance biapplyTuple :: Biapply Tuple where + biapply (Tuple f g) (Tuple a b) = Tuple (f a) (g b) diff --git a/src/Data/Bifunctor.purs b/src/Data/Bifunctor.purs index 331f238..c254aea 100644 --- a/src/Data/Bifunctor.purs +++ b/src/Data/Bifunctor.purs @@ -1,6 +1,9 @@ module Data.Bifunctor where import Control.Category (identity) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Tuple (Tuple(..)) -- | A `Bifunctor` is a `Functor` from the pair category `(Type, Type)` to `Type`. -- | @@ -25,3 +28,13 @@ lmap f = bimap f identity -- | Map a function over the second type arguments of a `Bifunctor`. rmap :: forall f a b c. Bifunctor f => (b -> c) -> f a b -> f a c rmap = bimap identity + +instance bifunctorEither :: Bifunctor Either where + bimap f _ (Left l) = Left (f l) + bimap _ g (Right r) = Right (g r) + +instance bifunctorTuple :: Bifunctor Tuple where + bimap f g (Tuple x y) = Tuple (f x) (g y) + +instance bifunctorConst :: Bifunctor Const where + bimap f _ (Const a) = Const (f a) diff --git a/src/Data/Bifunctor/Clown.purs b/src/Data/Bifunctor/Clown.purs deleted file mode 100644 index 7a57f59..0000000 --- a/src/Data/Bifunctor/Clown.purs +++ /dev/null @@ -1,34 +0,0 @@ -module Data.Bifunctor.Clown where - -import Prelude - -import Control.Biapplicative (class Biapplicative) -import Control.Biapply (class Biapply) - -import Data.Bifunctor (class Bifunctor) -import Data.Newtype (class Newtype) - --- | Make a `Functor` over the first argument of a `Bifunctor` -newtype Clown :: forall k1 k2. (k1 -> Type) -> k1 -> k2 -> Type -newtype Clown f a b = Clown (f a) - -derive instance newtypeClown :: Newtype (Clown f a b) _ - -derive newtype instance eqClown :: Eq (f a) => Eq (Clown f a b) - -derive newtype instance ordClown :: Ord (f a) => Ord (Clown f a b) - -instance showClown :: Show (f a) => Show (Clown f a b) where - show (Clown x) = "(Clown " <> show x <> ")" - -instance functorClown :: Functor (Clown f a) where - map _ (Clown a) = Clown a - -instance bifunctorClown :: Functor f => Bifunctor (Clown f) where - bimap f _ (Clown a) = Clown (map f a) - -instance biapplyClown :: Apply f => Biapply (Clown f) where - biapply (Clown fg) (Clown xy) = Clown (fg <*> xy) - -instance biapplicativeClown :: Applicative f => Biapplicative (Clown f) where - bipure a _ = Clown (pure a) diff --git a/src/Data/Bifunctor/Flip.purs b/src/Data/Bifunctor/Flip.purs deleted file mode 100644 index 6da5488..0000000 --- a/src/Data/Bifunctor/Flip.purs +++ /dev/null @@ -1,34 +0,0 @@ -module Data.Bifunctor.Flip where - -import Prelude - -import Control.Biapplicative (class Biapplicative, bipure) -import Control.Biapply (class Biapply, (<<*>>)) - -import Data.Bifunctor (class Bifunctor, bimap, lmap) -import Data.Newtype (class Newtype) - --- | Flips the order of the type arguments of a `Bifunctor`. -newtype Flip :: forall k1 k2. (k1 -> k2 -> Type) -> k2 -> k1 -> Type -newtype Flip p a b = Flip (p b a) - -derive instance newtypeFlip :: Newtype (Flip p a b) _ - -derive newtype instance eqFlip :: Eq (p b a) => Eq (Flip p a b) - -derive newtype instance ordFlip :: Ord (p b a) => Ord (Flip p a b) - -instance showFlip :: Show (p a b) => Show (Flip p b a) where - show (Flip x) = "(Flip " <> show x <> ")" - -instance functorFlip :: Bifunctor p => Functor (Flip p a) where - map f (Flip a) = Flip (lmap f a) - -instance bifunctorFlip :: Bifunctor p => Bifunctor (Flip p) where - bimap f g (Flip a) = Flip (bimap g f a) - -instance biapplyFlip :: Biapply p => Biapply (Flip p) where - biapply (Flip fg) (Flip xy) = Flip (fg <<*>> xy) - -instance biapplicativeFlip :: Biapplicative p => Biapplicative (Flip p) where - bipure a b = Flip (bipure b a) diff --git a/src/Data/Bifunctor/Joker.purs b/src/Data/Bifunctor/Joker.purs deleted file mode 100644 index a09e522..0000000 --- a/src/Data/Bifunctor/Joker.purs +++ /dev/null @@ -1,34 +0,0 @@ -module Data.Bifunctor.Joker where - -import Prelude - -import Control.Biapplicative (class Biapplicative) -import Control.Biapply (class Biapply) - -import Data.Bifunctor (class Bifunctor) -import Data.Newtype (class Newtype) - --- | Make a `Functor` over the second argument of a `Bifunctor` -newtype Joker :: forall k1 k2. (k2 -> Type) -> k1 -> k2 -> Type -newtype Joker g a b = Joker (g b) - -derive instance newtypeJoker :: Newtype (Joker g a b) _ - -derive newtype instance eqJoker :: Eq (g b) => Eq (Joker g a b) - -derive newtype instance ordJoker :: Ord (g b) => Ord (Joker g a b) - -instance showJoker :: Show (g b) => Show (Joker g a b) where - show (Joker x) = "(Joker " <> show x <> ")" - -instance functorJoker :: Functor g => Functor (Joker g a) where - map g (Joker a) = Joker (map g a) - -instance bifunctorJoker :: Functor g => Bifunctor (Joker g) where - bimap _ g (Joker a) = Joker (map g a) - -instance biapplyJoker :: Apply g => Biapply (Joker g) where - biapply (Joker fg) (Joker xy) = Joker (fg <*> xy) - -instance biapplicativeJoker :: Applicative g => Biapplicative (Joker g) where - bipure _ b = Joker (pure b) diff --git a/src/Data/Bifunctor/Product.purs b/src/Data/Bifunctor/Product.purs deleted file mode 100644 index d8b59d6..0000000 --- a/src/Data/Bifunctor/Product.purs +++ /dev/null @@ -1,28 +0,0 @@ -module Data.Bifunctor.Product where - -import Prelude - -import Control.Biapplicative (class Biapplicative, bipure) -import Control.Biapply (class Biapply, biapply) - -import Data.Bifunctor (class Bifunctor, bimap) - --- | The product of two `Bifunctor`s. -data Product :: forall k1 k2. (k1 -> k2 -> Type) -> (k1 -> k2 -> Type) -> k1 -> k2 -> Type -data Product f g a b = Product (f a b) (g a b) - -derive instance eqProduct :: (Eq (f a b), Eq (g a b)) => Eq (Product f g a b) - -derive instance ordProduct :: (Ord (f a b), Ord (g a b)) => Ord (Product f g a b) - -instance showProduct :: (Show (f a b), Show (g a b)) => Show (Product f g a b) where - show (Product x y) = "(Product " <> show x <> " " <> show y <> ")" - -instance bifunctorProduct :: (Bifunctor f, Bifunctor g) => Bifunctor (Product f g) where - bimap f g (Product x y) = Product (bimap f g x) (bimap f g y) - -instance biapplyProduct :: (Biapply f, Biapply g) => Biapply (Product f g) where - biapply (Product w x) (Product y z) = Product (biapply w y) (biapply x z) - -instance biapplicativeProduct :: (Biapplicative f, Biapplicative g) => Biapplicative (Product f g) where - bipure a b = Product (bipure a b) (bipure a b) diff --git a/src/Data/Bifunctor/Wrap.purs b/src/Data/Bifunctor/Wrap.purs deleted file mode 100644 index b98896a..0000000 --- a/src/Data/Bifunctor/Wrap.purs +++ /dev/null @@ -1,34 +0,0 @@ -module Data.Bifunctor.Wrap where - -import Prelude - -import Control.Biapplicative (class Biapplicative, bipure) -import Control.Biapply (class Biapply, (<<*>>)) - -import Data.Bifunctor (class Bifunctor, bimap, rmap) -import Data.Newtype (class Newtype) - --- | Provides a `Functor` over the second argument of a `Bifunctor`. -newtype Wrap :: forall k1 k2. (k1 -> k2 -> Type) -> k1 -> k2 -> Type -newtype Wrap p a b = Wrap (p a b) - -derive instance newtypeWrap :: Newtype (Wrap p a b) _ - -derive newtype instance eqWrap :: Eq (p a b) => Eq (Wrap p a b) - -derive newtype instance ordWrap :: Ord (p a b) => Ord (Wrap p a b) - -instance showWrap :: Show (p a b) => Show (Wrap p a b) where - show (Wrap x) = "(Wrap " <> show x <> ")" - -instance functorWrap :: Bifunctor p => Functor (Wrap p a) where - map f (Wrap a) = Wrap (rmap f a) - -instance bifunctorWrap :: Bifunctor p => Bifunctor (Wrap p) where - bimap f g (Wrap a) = Wrap (bimap f g a) - -instance biapplyWrap :: Biapply p => Biapply (Wrap p) where - biapply (Wrap fg) (Wrap xy) = Wrap (fg <<*>> xy) - -instance biapplicativeWrap :: Biapplicative p => Biapplicative (Wrap p) where - bipure a b = Wrap (bipure a b)