From b9dc6cec15d5c5c29ba295da14d56e499ae9c81b Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 9 Jun 2017 12:14:33 +0100 Subject: [PATCH 1/5] Add some bifunctors-style newtypes --- bower.json | 1 + src/Data/Profunctor/Clown.purs | 23 +++++++++++++++++++++++ src/Data/Profunctor/Cowrap.purs | 20 ++++++++++++++++++++ src/Data/Profunctor/Join.purs | 21 +++++++++++++++++++++ src/Data/Profunctor/Joker.purs | 22 ++++++++++++++++++++++ src/Data/Profunctor/Wrap.purs | 19 +++++++++++++++++++ 6 files changed, 106 insertions(+) create mode 100644 src/Data/Profunctor/Clown.purs create mode 100644 src/Data/Profunctor/Cowrap.purs create mode 100644 src/Data/Profunctor/Join.purs create mode 100644 src/Data/Profunctor/Joker.purs create mode 100644 src/Data/Profunctor/Wrap.purs diff --git a/bower.json b/bower.json index 73d7d5f..b2fea77 100644 --- a/bower.json +++ b/bower.json @@ -22,6 +22,7 @@ "package.json" ], "dependencies": { + "purescript-contravariant": "^3.0.0", "purescript-distributive": "^3.0.0", "purescript-either": "^3.0.0", "purescript-tuples": "^4.0.0" diff --git a/src/Data/Profunctor/Clown.purs b/src/Data/Profunctor/Clown.purs new file mode 100644 index 0000000..cd90ab6 --- /dev/null +++ b/src/Data/Profunctor/Clown.purs @@ -0,0 +1,23 @@ +module Data.Profunctor.Clown where + +import Prelude + +import Data.Profunctor (class Profunctor) +import Data.Newtype (class Newtype) +import Data.Functor.Contravariant (class Contravariant, cmap) + +-- | Makes a trivial `Profunctor` for a `Contravariant` functor. +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 profunctorClown :: Contravariant f => Profunctor (Clown f) where + dimap f g (Clown a) = Clown (cmap f a) diff --git a/src/Data/Profunctor/Cowrap.purs b/src/Data/Profunctor/Cowrap.purs new file mode 100644 index 0000000..90e45e3 --- /dev/null +++ b/src/Data/Profunctor/Cowrap.purs @@ -0,0 +1,20 @@ +module Data.Profunctor.Cowrap where + +import Prelude + +import Data.Newtype (class Newtype) +import Data.Functor.Contravariant (class Contravariant) +import Data.Profunctor (class Profunctor, lmap) + +-- | Provides a `Contravariant` over the first argument of a `Profunctor`. +newtype Cowrap p b a = Cowrap (p a b) + +derive instance newtypeCowrap :: Newtype (Cowrap p b a) _ +derive newtype instance eqCowrap :: Eq (p a b) => Eq (Cowrap p b a) +derive newtype instance ordCowrap :: Ord (p a b) => Ord (Cowrap p b a) + +instance showCowrap :: Show (p a b) => Show (Cowrap p b a) where + show (Cowrap x) = "(Cowrap " <> show x <> ")" + +instance contravariantCowrap :: Profunctor p => Contravariant (Cowrap p b) where + cmap f (Cowrap a) = Cowrap (lmap f a) diff --git a/src/Data/Profunctor/Join.purs b/src/Data/Profunctor/Join.purs new file mode 100644 index 0000000..45293ec --- /dev/null +++ b/src/Data/Profunctor/Join.purs @@ -0,0 +1,21 @@ +module Data.Profunctor.Join where + +import Prelude + +import Data.Functor.Invariant (class Invariant) +import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor, dimap) + +-- | Turns a `Profunctor` into a `Invariant` functor by equating the two type +-- | arguments. +newtype Join p a = Join (p a a) + +derive instance newtypeJoin :: Newtype (Join p a) _ +derive newtype instance eqJoin :: Eq (p a a) => Eq (Join p a) +derive newtype instance ordJoin :: Ord (p a a) => Ord (Join p a) + +instance showJoin :: Show (p a a) => Show (Join p a) where + show (Join x) = "(Join " <> show x <> ")" + +instance invariantJoin :: Profunctor p => Invariant (Join p) where + imap f g (Join a) = Join (dimap g f a) diff --git a/src/Data/Profunctor/Joker.purs b/src/Data/Profunctor/Joker.purs new file mode 100644 index 0000000..fd0d872 --- /dev/null +++ b/src/Data/Profunctor/Joker.purs @@ -0,0 +1,22 @@ +module Data.Profunctor.Joker where + +import Prelude + +import Data.Profunctor (class Profunctor) +import Data.Newtype (class Newtype) + +-- | Makes a trivial `Profunctor` for a covariant `Functor`. +newtype Joker f a b = Joker (f b) + +derive instance newtypeJoker :: Newtype (Joker f a b) _ +derive newtype instance eqJoker :: Eq (f b) => Eq (Joker f a b) +derive newtype instance ordJoker :: Ord (f b) => Ord (Joker f a b) + +instance showJoker :: Show (f b) => Show (Joker f a b) where + show (Joker x) = "(Joker " <> show x <> ")" + +instance functorJoker :: Functor f => Functor (Joker f a) where + map f (Joker a) = Joker (map f a) + +instance profunctorJoker :: Functor f => Profunctor (Joker f) where + dimap f g (Joker a) = Joker (map g a) diff --git a/src/Data/Profunctor/Wrap.purs b/src/Data/Profunctor/Wrap.purs new file mode 100644 index 0000000..64e8e91 --- /dev/null +++ b/src/Data/Profunctor/Wrap.purs @@ -0,0 +1,19 @@ +module Data.Profunctor.Wrap where + +import Prelude + +import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor, rmap) + +-- | Provides a `Functor` over the second argument of a `Profunctor`. +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 :: Profunctor p => Functor (Wrap p a) where + map f (Wrap a) = Wrap (rmap f a) From 9f1fc8b727ed8de6e295db6721c15b1065086eeb Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 9 Jun 2017 18:25:32 +0100 Subject: [PATCH 2/5] Add `Endo` style instances for `Join` --- src/Data/Profunctor/Join.purs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Data/Profunctor/Join.purs b/src/Data/Profunctor/Join.purs index 45293ec..2892726 100644 --- a/src/Data/Profunctor/Join.purs +++ b/src/Data/Profunctor/Join.purs @@ -5,6 +5,7 @@ import Prelude import Data.Functor.Invariant (class Invariant) import Data.Newtype (class Newtype) import Data.Profunctor (class Profunctor, dimap) +import Data.Monoid (class Monoid) -- | Turns a `Profunctor` into a `Invariant` functor by equating the two type -- | arguments. @@ -17,5 +18,11 @@ derive newtype instance ordJoin :: Ord (p a a) => Ord (Join p a) instance showJoin :: Show (p a a) => Show (Join p a) where show (Join x) = "(Join " <> show x <> ")" +instance semigroupJoin :: Semigroupoid p => Semigroup (Join p a) where + append (Join a) (Join b) = Join (a <<< b) + +instance monoidJoin :: Category p => Monoid (Join p a) where + mempty = Join id + instance invariantJoin :: Profunctor p => Invariant (Join p) where imap f g (Join a) = Join (dimap g f a) From 8353b58fa379339e0a0e2d2d66ec2a6eafe88f57 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 9 Jun 2017 19:26:15 +0100 Subject: [PATCH 3/5] Add `Split` --- bower.json | 1 + src/Data/Profunctor/Split.purs | 29 +++++++++++++++++++++++++++++ 2 files changed, 30 insertions(+) create mode 100644 src/Data/Profunctor/Split.purs diff --git a/bower.json b/bower.json index b2fea77..990aea9 100644 --- a/bower.json +++ b/bower.json @@ -25,6 +25,7 @@ "purescript-contravariant": "^3.0.0", "purescript-distributive": "^3.0.0", "purescript-either": "^3.0.0", + "purescript-exists": "^3.0.0", "purescript-tuples": "^4.0.0" } } diff --git a/src/Data/Profunctor/Split.purs b/src/Data/Profunctor/Split.purs new file mode 100644 index 0000000..e5dc7c6 --- /dev/null +++ b/src/Data/Profunctor/Split.purs @@ -0,0 +1,29 @@ +module Data.Profunctor.Split where + +import Prelude + +import Data.Exists (Exists, mkExists, runExists) +import Data.Functor.Invariant (class Invariant, imap) +import Data.Profunctor (class Profunctor) + +newtype Split f a b = Split (Exists (SplitF f a b)) + +data SplitF f a b x = SplitF (a -> x) (x -> b) (f x) + +instance profunctorSplit :: Profunctor (Split f) where + dimap f g = unSplit \h i -> split (h <<< f) (g <<< i) + +split :: forall f a b x. (a -> x) -> (x -> b) -> f x -> Split f a b +split f g fx = Split (mkExists (SplitF f g fx)) + +unSplit :: forall f a b r. (forall x. (a -> x) -> (x -> b) -> f x -> r) -> Split f a b -> r +unSplit f (Split e) = runExists (\(SplitF g h fx) -> f g h fx) e + +liftSplit :: forall f a. f a -> Split f a a +liftSplit = split id id + +lowerSplit :: forall f a. Invariant f => Split f a a -> f a +lowerSplit = unSplit (flip imap) + +hoistSplit :: forall f g a b. (f ~> g) -> Split f a b -> Split g a b +hoistSplit nat = unSplit (\f g -> split f g <<< nat) From 82244de701aade721846948578d859616068fb3f Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 9 Jun 2017 20:25:24 +0100 Subject: [PATCH 4/5] Hide implementation details of Split --- src/Data/Profunctor/Split.purs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/Data/Profunctor/Split.purs b/src/Data/Profunctor/Split.purs index e5dc7c6..b68b09d 100644 --- a/src/Data/Profunctor/Split.purs +++ b/src/Data/Profunctor/Split.purs @@ -1,4 +1,11 @@ -module Data.Profunctor.Split where +module Data.Profunctor.Split + ( Split + , split + , unSplit + , liftSplit + , lowerSplit + , hoistSplit + ) where import Prelude From 0f7bb5bf90b09c217b6e3f1889695c6c3f9cb922 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 9 Jun 2017 20:25:41 +0100 Subject: [PATCH 5/5] Add `Functor` instance for `Split` --- src/Data/Profunctor/Split.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Profunctor/Split.purs b/src/Data/Profunctor/Split.purs index b68b09d..3664431 100644 --- a/src/Data/Profunctor/Split.purs +++ b/src/Data/Profunctor/Split.purs @@ -17,6 +17,9 @@ newtype Split f a b = Split (Exists (SplitF f a b)) data SplitF f a b x = SplitF (a -> x) (x -> b) (f x) +instance functorSplit :: Functor (Split f a) where + map f = unSplit \g h fx -> split g (f <<< h) fx + instance profunctorSplit :: Profunctor (Split f) where dimap f g = unSplit \h i -> split (h <<< f) (g <<< i)