Merge pull request #4 from purescript/arrow-combinators

Add arrow combinators
purescript · Mar 6, 2015 · d2dee78 · d2dee78
2 parents 1265470 + c8c2ce2
commit d2dee78
Show file tree

Hide file tree

Showing 3 changed files with 56 additions and 3 deletions.
diff --git a/README.md b/README.md
@@ -50,6 +50,20 @@ instance choiceArr :: Choice Prim.Function
 ```
 
 
+#### `(+++)`
+
+``` purescript
+(+++) :: forall p a b c d. (Category p, Choice p) => p a b -> p c d -> p (Either a c) (Either b d)
+```
+
+
+#### `(|||)`
+
+``` purescript
+(|||) :: forall p a b c. (Category p, Choice p) => p a c -> p b c -> p (Either a b) c
+```
+
+
 
 ## Module Data.Profunctor.Strong
 
@@ -66,4 +80,18 @@ class (Profunctor p) <= Strong p where
 
 ``` purescript
 instance strongArr :: Strong Prim.Function
+```
+
+
+#### `(***)`
+
+``` purescript
+(***) :: forall p a b c d. (Category p, Strong p) => p a b -> p c d -> p (Tuple a c) (Tuple b d)
+```
+
+
+#### `(&&&)`
+
+``` purescript
+(&&&) :: forall p a b c. (Category p, Strong p) => p a b -> p a c -> p a (Tuple b c)
 ```
diff --git a/src/Data/Profunctor/Choice.purs b/src/Data/Profunctor/Choice.purs
@@ -1,7 +1,7 @@
 module Data.Profunctor.Choice where
 
-  import Data.Either (Either(..))
-  import Data.Profunctor (Profunctor)
+  import Data.Either (Either(..), either)
+  import Data.Profunctor
 
   class (Profunctor p) <= Choice p where
     left :: forall a b c. p a b -> p (Either a c) (Either b c)
@@ -12,3 +12,15 @@ module Data.Profunctor.Choice where
     left _   (Right c) = Right c
 
     right = (<$>)
+
+  infixr 2 +++
+  infixr 2 ||| 
+
+  (+++) :: forall p a b c d. (Category p, Choice p) => p a b -> p c d -> p (Either a c) (Either b d)
+  (+++) l r = left l >>> right r
+
+  (|||) :: forall p a b c. (Category p, Choice p) => p a c -> p b c -> p (Either a b) c 
+  (|||) l r = (l +++ r) >>> join
+    where
+    join :: p (Either c c) c
+    join = dimap (either id id) id id
diff --git a/src/Data/Profunctor/Strong.purs b/src/Data/Profunctor/Strong.purs
@@ -1,6 +1,6 @@
 module Data.Profunctor.Strong where
 
-  import Data.Profunctor (Profunctor)
+  import Data.Profunctor
   import Data.Tuple (Tuple(..))
 
   class (Profunctor p) <= Strong p where
@@ -10,3 +10,16 @@ module Data.Profunctor.Strong where
   instance strongArr :: Strong (->) where
     first a2b (Tuple a c) = Tuple (a2b a) c
     second = (<$>)
+
+  infixr 3 ***
+  infixr 3 &&&
+
+  (***) :: forall p a b c d. (Category p, Strong p) => p a b -> p c d -> p (Tuple a c) (Tuple b d)
+  (***) l r = first l >>> second r
+
+  (&&&) :: forall p a b c. (Category p, Strong p) => p a b -> p a c -> p a (Tuple b c)
+  (&&&) l r = split >>> (l *** r)
+    where
+    split :: p a (Tuple a a)
+    split = dimap id (\a -> Tuple a a) id
+