From 8ecd2bb77a36d18bfed0f2c1afd09afa2f3ce019 Mon Sep 17 00:00:00 2001
From: M FarkasDyck <strake888@gmail.com>
Date: Sun, 29 Mar 2015 22:57:46 0500
Subject: [PATCH] =?UTF8?q?Allow=20arr=20=E2=88=A7=20(first=20=E2=88=A8=20?=
=?UTF8?q?(***))=20as=20minimal=20definition=20of=20Arrow=20instance?=
MIMEVersion: 1.0
ContentType: text/plain; charset=UTF8
ContentTransferEncoding: 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) 