DeepArrow 0.3.7 → 0.4.0
raw patch · 4 files changed
+56/−56 lines, 4 files
Files
- DeepArrow.cabal +2/−2
- src/Control/Arrow/DeepArrow.hs +33/−33
- src/Control/Arrow/DeepArrow/Examples.hs +16/−16
- src/Data/FunArr.hs +5/−5
DeepArrow.cabal view
@@ -1,5 +1,5 @@ Name: DeepArrow-Version: 0.3.7+Version: 0.4.0 Synopsis: Arrows for "deep application" Category: Combinators, Control Cabal-Version: >= 1.6@@ -30,7 +30,7 @@ © 2007-2012 by Conal Elliott (<http://conal.net>); BSD3 license. Author: Conal Elliott <conal@conal.net> Maintainer: conal@conal.net-Copyright: (c) 2007-2012 by Conal Elliott+Copyright: (c) 2007-2013 by Conal Elliott Homepage: http://haskell.org/haskellwiki/DeepArrow License: BSD3 License-File: COPYING
src/Control/Arrow/DeepArrow.hs view
@@ -4,7 +4,7 @@ ---------------------------------------------------------------------- -- | -- Module : Control.Arrow.DeepArrow--- Copyright : (c) Conal Elliott 2006+-- Copyright : (c) Conal Elliott 2006-2013 -- License : BSD3 -- -- Maintainer : conal@conal.net@@ -80,43 +80,43 @@ -} -class Arrow (~>) => DeepArrow (~>) where+class Arrow ar => DeepArrow ar where -- | Direct arrow into a function's result. Analogous to 'first' and -- 'second'.- result :: (b ~> b') -> ((a->b) ~> (a->b'))+ result :: (b `ar` b') -> ((a->b) `ar` (a->b')) -- Complicates OFun considerably and not used. -- Direct arrow into a function's argument. Note contravariance.- -- argument :: (a' ~> a ) -> ((a->b) ~> (a'->b))+ -- argument :: (a' `ar` a ) -> ((a->b) `ar` (a'->b)) -- -- | Identity. Unnecessary now that we have Category --- idA :: a ~> a+-- idA :: a `ar` a -- idA = id -- | Duplicate.- dupA :: a ~> (a,a)+ dupA :: a `ar` (a,a) -- | Extract first.- fstA :: (a,b) ~> a+ fstA :: (a,b) `ar` a -- | Extract second.- sndA :: (a,b) ~> b+ sndA :: (a,b) `ar` b -- | Extract function from first element.- funF :: (c->a, b) ~> (c->(a,b))+ funF :: (c->a, b) `ar` (c->(a,b)) -- | Extract function from second element.- funS :: (a, c->b) ~> (c->(a,b)) -- Could default via swapA & funF+ funS :: (a, c->b) `ar` (c->(a,b)) -- Could default via swapA & funF -- | Extract function from result.- funR :: (a->c->b) ~> (c->a->b)+ funR :: (a->c->b) `ar` (c->a->b) -- | Curry arrow.- curryA :: ((a,b)->c) ~> (a->b->c)+ curryA :: ((a,b)->c) `ar` (a->b->c) -- | Uncurry arrow.- uncurryA :: (a->b->c) ~> ((a,b)->c)+ uncurryA :: (a->b->c) `ar` ((a,b)->c) -- | Swap elements. Has default.- swapA :: (a,b) ~> (b,a)+ swapA :: (a,b) `ar` (b,a) swapA = sndA &&& fstA -- | Left-associate. Has default.- lAssocA :: (a,(b,c)) ~> ((a,b),c)+ lAssocA :: (a,(b,c)) `ar` ((a,b),c) lAssocA = second fstA &&& (sndA . sndA) -- | Right-associate. Has default.- rAssocA :: ((a,b),c) ~> (a,(b,c))+ rAssocA :: ((a,b),c) `ar` (a,(b,c)) rAssocA = (fstA . fstA) &&& first sndA -- I don't think this one is used.- -- composeA :: Arrow (~~>) => (a ~~> b, b ~~> c) ~> (a ~~>c)+ -- composeA :: Arrow (~`ar`) => (a ~`ar` b, b ~`ar` c) `ar` (a ~`ar`c) -- composeA = arr (uncurry (>>>)) @@ -126,15 +126,15 @@ -- | Promote a function extractor into one that reaches into the first -- element of a pair.-funFirst :: DeepArrow (~>) => (a ~> (d->a')) -> ((a,b) ~> (d->(a',b)))+funFirst :: DeepArrow ar => (a `ar` (d->a')) -> ((a,b) `ar` (d->(a',b))) -- | Promote a function extractor into one that reaches into the second -- element of a pair.-funSecond :: DeepArrow (~>) => (b ~> (d->b')) -> ((a,b) ~> (d->(a,b')))+funSecond :: DeepArrow ar => (b `ar` (d->b')) -> ((a,b) `ar` (d->(a,b'))) -- | Promote a function extractor into one that reaches into the result -- element of a function.-funResult :: DeepArrow (~>) => (b ~> (d->b')) -> ((a->b) ~> (d->(a->b')))+funResult :: DeepArrow ar => (b `ar` (d->b')) -> ((a->b) `ar` (d->(a->b'))) funFirst h = funF . first h funSecond h = funS . second h@@ -146,25 +146,25 @@ ----------------------------------------------------------} -- | Extract the first component of a pair input.-inpF :: DeepArrow (~>) => ((a,b) -> c) ~> (a -> (b->c))+inpF :: DeepArrow ar => ((a,b) -> c) `ar` (a -> (b->c)) inpF = curryA -- | Extract the second component of a pair input.-inpS :: DeepArrow (~>) => ((a,b) -> c) ~> (b -> (a->c))+inpS :: DeepArrow ar => ((a,b) -> c) `ar` (b -> (a->c)) inpS = flipA . curryA -- | Given a way to extract a @d@ input from an @a@ input, leaving an @a'@ -- residual input, 'inpFirst' yields a way to extract a @d@ input from an -- @(a,b)@ input, leaving an @(a',b)@ residual input.-inpFirst :: DeepArrow (~>) =>- (( a ->c) ~> (d -> ( a' ->c)))- -> (((a,b)->c) ~> (d -> ((a',b)->c)))+inpFirst :: DeepArrow ar =>+ (( a ->c) `ar` (d -> ( a' ->c)))+ -> (((a,b)->c) `ar` (d -> ((a',b)->c))) -- | Analogous to 'inpFirst'.-inpSecond :: DeepArrow (~>) =>- (( b ->c) ~> (d -> ( b' ->c)))- -> (((a,b)->c) ~> (d -> ((a,b')->c)))+inpSecond :: DeepArrow ar =>+ (( b ->c) `ar` (d -> ( b' ->c)))+ -> (((a,b)->c) `ar` (d -> ((a,b')->c))) -- See ICFP 07 paper for the derivation of inpFirst and inpSecond@@ -179,11 +179,11 @@ ----------------------------------------------------------} -- | Flip argument order-flipA :: DeepArrow (~>) => (a->c->b) ~> (c->a->b)+flipA :: DeepArrow ar => (a->c->b) `ar` (c->a->b) flipA = funR -- | Like 'unzip' but for 'DeepArrow' arrows instead of lists.-unzipA :: DeepArrow (~>) => (a ~> (b,c)) -> (a ~> b, a ~> c)+unzipA :: DeepArrow ar => (a `ar` (b,c)) -> (a `ar` b, a `ar` c) unzipA f = (fstA . f, sndA . f) @@ -276,10 +276,10 @@ ----------------------------------------------------------} -- | Compose wrapped functions-(->|) :: (DeepArrow (~>), FunArr (~>) w)+(->|) :: (DeepArrow ar, FunArr ar w) => w (a->b) -> w (b->c) -> w (a->c) (->|) f g = result (toArr g) $$ f -- -- | Pre- and post-processing--- (~>) :: DeepArrow (-->) => (a' --> a) -> (b --> b') -> ((a -> b) --> (a' -> b'))--- f ~> h = result h . argument f+-- ar :: DeepArrow (-->) => (a' --> a) -> (b --> b') -> ((a -> b) --> (a' -> b'))+-- f `ar` h = result h . argument f
src/Control/Arrow/DeepArrow/Examples.hs view
@@ -5,7 +5,7 @@ ---------------------------------------------------------------------- -- | -- Module : Control.Arrow.DeepArrow.Examples--- Copyright : (c) Conal Elliott 2007+-- Copyright : (c) Conal Elliott 2007-2013 -- License : BSD3 -- -- Maintainer : conal@conal.net@@ -43,9 +43,9 @@ -- just the @c@ part and leave the rest intact. -- -- @deep = 'first' . 'result' . 'second' . 'result' . 'first' @-deep :: DeepArrow (~>) => (c ~> c') ->- (a -> (f,b -> (c ,g)),e)- ~> (a -> (f,b -> (c',g)),e)+deep :: DeepArrow ar => (c `ar` c') ->+ (a -> (f,b -> (c ,g)),e)+ `ar` (a -> (f,b -> (c',g)),e) deep = first.result.second.result.first @@ -59,18 +59,18 @@ -- -- @extF = 'funFirst' . 'funResult' . 'funSecond'@ -extF :: DeepArrow (~>) => (d ~> (c -> b)) ->- (e -> (a,d), f)- ~> (c -> (e -> (a,b), f))+extF :: DeepArrow ar => (d `ar` (c -> b)) ->+ (e -> (a,d), f)+ `ar` (c -> (e -> (a,b), f)) extF = funFirst.funResult.funSecond -- | To make an extractor, simply apply the extractor-transformer 'extF' -- to the identity arrow. -- -- @'extFF' = 'extF' 'idA'@-extFF :: DeepArrow (~>) =>- (e -> (a,(c-> b)),f)- ~> (c -> (e -> (a, b),f))+extFF :: DeepArrow ar =>+ (e -> (a,(c-> b)),f)+ `ar` (c -> (e -> (a, b),f)) extFF = extF id @@ -81,9 +81,9 @@ -- | Extract a @b@ input from a @((a,(b,e)),c)@ argument. -- -- @extI = ('inpFirst' . 'inpSecond') 'inpF'@-extI :: DeepArrow (~>) =>- ( ((a,(b,e)),c) -> d)- ~> (b -> ((a, e ),c) -> d)+extI :: DeepArrow ar =>+ ( ((a,(b,e)),c) -> d)+ `ar` (b -> ((a, e ),c) -> d) extI = (inpFirst.inpSecond) inpF @@ -91,7 +91,7 @@ -- For instance, combine 'extF' and 'extI'. -- -- @extFI = 'extF' 'extI'@-extFI :: DeepArrow (~>) =>- (e -> (g,(((a,(b,e)),c) -> d)), f)- ~> (b -> (e -> (g,(((a, e) ,c) -> d)), f))+extFI :: DeepArrow ar =>+ (e -> (g,(((a,(b,e)),c) -> d)), f)+ `ar` (b -> (e -> (g,(((a, e) ,c) -> d)), f)) extFI = extF extI
src/Data/FunArr.hs view
@@ -7,7 +7,7 @@ ---------------------------------------------------------------------- -- | -- Module : Data.FunArr--- Copyright : (c) Conal Elliott 2007+-- Copyright : (c) Conal Elliott 2007-2013 -- License : BSD3 -- -- Maintainer : conal@conal.net@@ -31,14 +31,14 @@ -- | Convert between an arrow value and a \"wrapped function\". The \"arrow\" -- doesn't really have to be an arrow. I'd appreciate ideas for names & -- uses.-class FunArr (~>) w | (~>)->w , w->(~>) where+class FunArr ar w | ar->w , w->ar where -- | Convert a @w@-wrapped function to an arrow value- toArr :: w (a->b) -> (a ~> b)+ toArr :: w (a->b) -> (a `ar` b) -- | Apply an arrow to a @w@-wrapped value- ($$) :: (a ~> b) -> w a -> w b+ ($$) :: (a `ar` b) -> w a -> w b -- -- | Apply a wrapped function to a wrapped value--- wapl :: FunArr (~>) w => w (a->b) -> w a -> w b+-- wapl :: FunArr ar w => w (a->b) -> w a -> w b -- wapl f a = toArr f $$ a -- The type of wapl matches <*> from Control.Applicative. What about