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) |