Arrow tutorial: Difference between revisions
(Adapted to GHC 6.10.1) |
(Added empty lins, so that the wiki source is really literate Haskell; added type signatures to solve warnings) |
||
Line 2: | Line 2: | ||
[[Category:Arrow]] | [[Category:Arrow]] | ||
<haskell> | <haskell> | ||
> {-# LANGUAGE Arrows #-} | > {-# LANGUAGE Arrows #-} | ||
> module ArrowFun where | > module ArrowFun where | ||
Line 7: | Line 8: | ||
> import Control.Category | > import Control.Category | ||
> import Prelude hiding (id,(.)) | > import Prelude hiding (id,(.)) | ||
</haskell> | </haskell> | ||
Line 17: | Line 19: | ||
<haskell> | <haskell> | ||
arr :: (Arrow a) => (b -> c) -> a b c | arr :: (Arrow a) => (b -> c) -> a b c | ||
</haskell> | </haskell> | ||
Line 25: | Line 29: | ||
<haskell> | <haskell> | ||
(>>>) :: (Arrow a) => a b c -> a c d -> a b d | (>>>) :: (Arrow a) => a b c -> a c d -> a b d | ||
</haskell> | </haskell> | ||
Line 34: | Line 40: | ||
<haskell> | <haskell> | ||
first :: (Arrow a) => a b c -> a (b, d) (c, d) | first :: (Arrow a) => a b c -> a (b, d) (c, d) | ||
second :: (Arrow a) => a b c -> a (d, b) (d, c) | second :: (Arrow a) => a b c -> a (d, b) (d, c) | ||
</haskell> | </haskell> | ||
Line 50: | Line 58: | ||
<haskell> | <haskell> | ||
> newtype SimpleFunc a b = SimpleFunc { | > newtype SimpleFunc a b = SimpleFunc { | ||
> runF :: (a -> b) | > runF :: (a -> b) | ||
Line 63: | Line 72: | ||
> instance Category SimpleFunc where | > instance Category SimpleFunc where | ||
> (SimpleFunc g) . (SimpleFunc f) = SimpleFunc (g . f) | > (SimpleFunc g) . (SimpleFunc f) = SimpleFunc (g . f) | ||
</haskell> | </haskell> | ||
Line 72: | Line 82: | ||
<haskell> | <haskell> | ||
> split :: (Arrow a) => a b (b, b) | > split :: (Arrow a) => a b (b, b) | ||
> split = arr (\x -> (x,x)) | > split = arr (\x -> (x,x)) | ||
</haskell> | </haskell> | ||
Line 80: | Line 92: | ||
<haskell> | <haskell> | ||
> unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d | > unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d | ||
> unsplit = arr . uncurry | > unsplit = arr . uncurry | ||
> -- arr (\op (x,y) -> x `op` y) | > -- arr (\op (x,y) -> x `op` y) | ||
</haskell> | </haskell> | ||
Line 90: | Line 104: | ||
<haskell> | <haskell> | ||
f *** g = first f >>> second g | f *** g = first f >>> second g | ||
</haskell> | </haskell> | ||
Line 97: | Line 113: | ||
<haskell> | <haskell> | ||
f &&& g = split >>> first f >>> second g | f &&& g = split >>> first f >>> second g | ||
-- = split >>> f *** g | -- = split >>> f *** g | ||
</haskell> | </haskell> | ||
Line 106: | Line 124: | ||
<haskell> | <haskell> | ||
> liftA2 :: (Arrow a) => (b -> c -> d) -> a e b -> a e c -> a e d | > liftA2 :: (Arrow a) => (b -> c -> d) -> a e b -> a e c -> a e d | ||
> liftA2 op f g = split >>> first f >>> second g >>> unsplit op | > liftA2 op f g = split >>> first f >>> second g >>> unsplit op | ||
> -- = f &&& g >>> unsplit op | > -- = f &&& g >>> unsplit op | ||
</haskell> | </haskell> | ||
Line 119: | Line 139: | ||
<haskell> | <haskell> | ||
> f, g :: SimpleFunc Int Int | > f, g :: SimpleFunc Int Int | ||
> f = arr (`div` 2) | > f = arr (`div` 2) | ||
> g = arr (\x -> x*3 + 1) | > g = arr (\x -> x*3 + 1) | ||
</haskell> | </haskell> | ||
Line 127: | Line 149: | ||
<haskell> | <haskell> | ||
> h :: SimpleFunc Int Int | |||
> h = liftA2 (+) f g | > h = liftA2 (+) f g | ||
> | |||
> hOutput :: Int | |||
> hOutput = runF h 8 | > hOutput = runF h 8 | ||
</haskell> | </haskell> | ||
Line 155: | Line 182: | ||
<haskell> | <haskell> | ||
> h' :: SimpleFunc Int Int | |||
> h' = proc x -> do | > h' = proc x -> do | ||
> fx <- f -< x | > fx <- f -< x | ||
> gx <- g -< x | > gx <- g -< x | ||
> returnA -< (fx + gx) | > returnA -< (fx + gx) | ||
> | |||
> hOutput' :: Int | |||
> hOutput' = runF h' 8 | > hOutput' = runF h' 8 | ||
</haskell> | </haskell> | ||
Line 169: | Line 201: | ||
<haskell> | <haskell> | ||
newtype Kleisli m a b = Kleisli { | newtype Kleisli m a b = Kleisli { | ||
runKleisli :: (a -> m b) | runKleisli :: (a -> m b) | ||
} | } | ||
</haskell> | </haskell> | ||
Line 181: | Line 215: | ||
<haskell> | <haskell> | ||
> plusminus, double, h2 :: Kleisli [] Int Int | > plusminus, double, h2 :: Kleisli [] Int Int | ||
> plusminus = Kleisli (\x -> [x, -x]) | > plusminus = Kleisli (\x -> [x, -x]) | ||
> double = arr (* 2) | > double = arr (* 2) | ||
> h2 = liftA2 (+) plusminus double | > h2 = liftA2 (+) plusminus double | ||
> | |||
> h2Output :: [Int] | |||
> h2Output = runKleisli h2 8 | > h2Output = runKleisli h2 8 | ||
</haskell> | </haskell> | ||
Line 198: | Line 236: | ||
<haskell> | <haskell> | ||
> main :: IO () | |||
> main = do | > main = do | ||
> let | > let | ||
> prepend x = arr (x ++) | > prepend x = arr (x ++) | ||
> append x = arr (++ x) | > append x = arr (++ x) | ||
> withId t = returnA <+> t | > withId t = returnA <+> t | ||
> xform = (withId $ prepend "<") >>> | > xform = (withId $ prepend "<") >>> | ||
> (withId $ append ">") >>> | > (withId $ append ">") >>> | ||
Line 208: | Line 248: | ||
> xs = ["test", "foobar"] >>= (runKleisli xform) | > xs = ["test", "foobar"] >>= (runKleisli xform) | ||
> mapM_ putStrLn xs | > mapM_ putStrLn xs | ||
</haskell> | </haskell> | ||
Line 225: | Line 266: | ||
== Tutorial Meta == | == Tutorial Meta == | ||
The wiki file source is | The wiki file source is literate Haskell. Save the source in a file called ArrowFun.lhs to compile it (or run in GHCi). | ||
The code is adapted to GHC 6.10.1; use [http://www.haskell.org/haskellwiki/?title=Arrow_tutorial&oldid=15443] for older versions of GHC | The code is adapted to GHC 6.10.1; use [http://www.haskell.org/haskellwiki/?title=Arrow_tutorial&oldid=15443] for older versions of GHC and other Haskell implementations. | ||
* Original version - Nov 19, 2006, Tim Newsham. | * Original version - Nov 19, 2006, Tim Newsham. |
Revision as of 22:10, 1 February 2009
> {-# LANGUAGE Arrows #-}
> module ArrowFun where
> import Control.Arrow
> import Control.Category
> import Prelude hiding (id,(.))
The Arrow
Arrow a b c represents a process that takes as input something of type b and outputs something of type c.
Arr builds an arrow out of a function. This function is arrow-specific. Its signature is
arr :: (Arrow a) => (b -> c) -> a b c
Arrow composition is achieved with (>>>). This takes two arrows and chains them together, one after another. It is also arrow- specific. Its signature is:
(>>>) :: (Arrow a) => a b c -> a c d -> a b d
First and second make a new arrow out of an existing arrow. They perform a transformation (given by their argument) on either the first or the second item of a pair. These definitions are arrow-specific. Their signatures are:
first :: (Arrow a) => a b c -> a (b, d) (c, d)
second :: (Arrow a) => a b c -> a (d, b) (d, c)
First and second may seem pretty strange at first, but they'll make sense in a few minutes.
That's it for the arrow-specific definitions.
A Simple Arrow
Let's define a really simple arrow as an example. Our simple arrow is just a function mapping an input to an output. We don't really need arrows for something this simple, but we could use something this simple to explain arrows.
> newtype SimpleFunc a b = SimpleFunc {
> runF :: (a -> b)
> }
>
> instance Arrow SimpleFunc where
> arr f = SimpleFunc f
> first (SimpleFunc f) = SimpleFunc (mapFst f)
> where mapFst g (a,b) = (g a, b)
> second (SimpleFunc f) = SimpleFunc (mapSnd f)
> where mapSnd g (a,b) = (a, g b)
>
> instance Category SimpleFunc where
> (SimpleFunc g) . (SimpleFunc f) = SimpleFunc (g . f)
Some Arrow Operations
Now lets define some operations that are generic to all arrows.
Split is an arrow that splits a single value into a pair of duplicate values:
> split :: (Arrow a) => a b (b, b)
> split = arr (\x -> (x,x))
Unsplit is an arrow that takes a pair of values and combines them to return a single value:
> unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d
> unsplit = arr . uncurry
> -- arr (\op (x,y) -> x `op` y)
(***) combines two arrows into a new arrow by running the two arrows on a pair of values (one arrow on the first item of the pair and one arrow on the second item of the pair).
f *** g = first f >>> second g
(&&&) combines two arrows into a new arrow by running the two arrows on the same value:
f &&& g = split >>> first f >>> second g
-- = split >>> f *** g
LiftA2 makes a new arrow that combines the output from two arrows using a binary operation. It works by splitting a value and operating on both halfs and then combining the result:
> liftA2 :: (Arrow a) => (b -> c -> d) -> a e b -> a e c -> a e d
> liftA2 op f g = split >>> first f >>> second g >>> unsplit op
> -- = f &&& g >>> unsplit op
An Example
Now let's build something using our simple arrow definition and some of the tools we just created. We start with two simple arrows, f and g. F halves its input and g triples its input and adds one:
> f, g :: SimpleFunc Int Int
> f = arr (`div` 2)
> g = arr (\x -> x*3 + 1)
We can combine these together using liftA2:
> h :: SimpleFunc Int Int
> h = liftA2 (+) f g
>
> hOutput :: Int
> hOutput = runF h 8
What is h? How does it work? The process defined by h is (split >>> first f >>> second g >>> unsplit (+)). Lets work through an application of h to some value, 8:
8 -> (8, 8) split (8, 8) -> (4, 8) first f (x `div` 2 of the first element) (4, 8) -> (4, 25) second g (3*x + 1 of the second element) (4, 25) -> 29 applies (+) to tuple elements.
+------> f --------------+ | v 8 ---> (split) ---> g -----> (unsplit (+)) ----> 29
so we see that h is a new arrow that when applied to 8, applies 8 to f and applies 8 to g and adds the results.
A lot of juggling occurred to get the plumbing right since h wasn't defined as a linear combination of arrows. GHC has a do-notation that simplifies this in a similar way to how do-notation simplifies monadic computation. To use this notation you must specify the -farrows flag. The h function can be defined as:
> h' :: SimpleFunc Int Int
> h' = proc x -> do
> fx <- f -< x
> gx <- g -< x
> returnA -< (fx + gx)
>
> hOutput' :: Int
> hOutput' = runF h' 8
Kleisli Arrows
Let's move on to something a little fancier now: Kleisli arrows. A Kleisli arrow (Kleisli m a b) is the arrow (a -> m b) for all monads. It's defined in Control.Arrows similarly to our SimpleFunc:
newtype Kleisli m a b = Kleisli {
runKleisli :: (a -> m b)
}
It comes complete with its own definitions for arr, first, second and (>>>). This means that all multi-value functions (a -> [b]) are already defined as Kleisli arrows (because [] is a monad)! (>>>) performs composition, keeping track of all the multiple results. Split, (&&&) and (***) are all defined as before. So for example:
> plusminus, double, h2 :: Kleisli [] Int Int
> plusminus = Kleisli (\x -> [x, -x])
> double = arr (* 2)
> h2 = liftA2 (+) plusminus double
>
> h2Output :: [Int]
> h2Output = runKleisli h2 8
Finally, here's a little teaser. There's an arrow function called returnA which returns an identity arrow. There's a ArrowPlus class that includes a zeroArrow (which for the list monad is an arrow that always returns the empty list) and a <+> operator (which takes the results from two arrows and concatenates them). We can build up some pretty interesting string transformations (the multi-valued function String -> [String]) using Kleisli arrows:
> main :: IO ()
> main = do
> let
> prepend x = arr (x ++)
> append x = arr (++ x)
> withId t = returnA <+> t
> xform = (withId $ prepend "<") >>>
> (withId $ append ">") >>>
> (withId $ ((prepend "!") >>> (append "!")))
> xs = ["test", "foobar"] >>= (runKleisli xform)
> mapM_ putStrLn xs
An important observation here is that
f >>> g
is multi-valued composition (g . f), and
(withId f) >>> (withId g) = (returnA <+> f) >>> (returnA <+> g) = ((arr id) <+> f) >>> ((arr id) <+> g)
which, when applied to an input x, returns all values:
((id . id) x) ++ ((id . f) x) ++ ((id . g) x) ++ ((g . f) x) = x ++ (f x) ++ (g x) ++ ((g . f) x)
which are all permutations of using arrows f and g.
Tutorial Meta
The wiki file source is literate Haskell. Save the source in a file called ArrowFun.lhs to compile it (or run in GHCi).
The code is adapted to GHC 6.10.1; use [1] for older versions of GHC and other Haskell implementations.
- Original version - Nov 19, 2006, Tim Newsham.