From 8ecd2bb77a36d18bfed0f2c1afd09afa2f3ce019 Mon Sep 17 00:00:00 2001
From: M Farkas-Dyck <strake888@gmail.com>
Date: Sun, 29 Mar 2015 22:57:46 -0500
Subject: [PATCH] =?UTF-8?q?Allow=20arr=20=E2=88=A7=20(first=20=E2=88=A8=20?=
=?UTF-8?q?(***))=20as=20minimal=20definition=20of=20Arrow=20instance?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
libraries/base/Control/Arrow.hs | 11 ++++-------
1 file changed, 4 insertions(+), 7 deletions(-)
diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs
index e9dd781..b5bd6e3 100644
|
a
|
b
|
class Category a => Arrow a where |
| 90 | 90 | -- | Send the first component of the input through the argument |
| 91 | 91 | -- arrow, and copy the rest unchanged to the output. |
| 92 | 92 | first :: a b c -> a (b,d) (c,d) |
| | 93 | first = (*** id) |
| 93 | 94 | |
| 94 | 95 | -- | A mirror image of 'first'. |
| 95 | 96 | -- |
| 96 | 97 | -- The default definition may be overridden with a more efficient |
| 97 | 98 | -- version if desired. |
| 98 | 99 | second :: a b c -> a (d,b) (d,c) |
| 99 | | second f = arr swap >>> first f >>> arr swap |
| 100 | | where |
| 101 | | swap :: (x,y) -> (y,x) |
| 102 | | swap ~(x,y) = (y,x) |
| | 100 | second = (id ***) |
| 103 | 101 | |
| 104 | 102 | -- | Split the input between the two argument arrows and combine |
| 105 | 103 | -- their output. Note that this is in general not a functor. |
| … |
… |
class Category a => Arrow a where |
| 107 | 105 | -- The default definition may be overridden with a more efficient |
| 108 | 106 | -- version if desired. |
| 109 | 107 | (***) :: a b c -> a b' c' -> a (b,b') (c,c') |
| 110 | | f *** g = first f >>> second g |
| | 108 | f *** g = first f >>> arr swap >>> first g >>> arr swap |
| | 109 | where swap ~(x,y) = (y,x) |
| 111 | 110 | |
| 112 | 111 | -- | Fanout: send the input to both argument arrows and combine |
| 113 | 112 | -- their output. |
| … |
… |
class Category a => Arrow a where |
| 138 | 137 | |
| 139 | 138 | instance Arrow (->) where |
| 140 | 139 | arr f = f |
| 141 | | first f = f *** id |
| 142 | | second f = id *** f |
| 143 | 140 | -- (f *** g) ~(x,y) = (f x, g y) |
| 144 | 141 | -- sorry, although the above defn is fully H'98, nhc98 can't parse it. |
| 145 | 142 | (***) f g ~(x,y) = (f x, g y) |
