Arrow tutorial
> {-# LANGUAGE Arrows #-}
> module ArrowFun where
> import Control.Arrow
> import Control.Category
> import Prelude hiding (id,(.))
|
The Arrow
class
A value of type (Arrow a) => a b c
(commonly referred to as just an arrow) represents a process that takes as input a value of type b
and outputs a value of type c
.
The class includes the following methods:
arr
builds an arrow value out of a function:
arr :: (Arrow a) => (b -> c) -> a b c
(>>>)
composes two arrow values to form a new one by "chaining" them them together, one after another:
(>>>) :: (Arrow a) => a b c -> a c d -> a b d
first
andsecond
make a new arrow value out of an existing one. They perform a transformation (given by their argument) on either the first or the second item of a pair:
first :: (Arrow a) => a b c -> a (b, d) (c, d) second :: (Arrow a) => a b c -> a (d, b) (d, c)
first
andsecond
may seem pretty strange at first, but they'll make sense in a few minutes.
A simple arrow type
Let's define a really simple arrow type as an example, based on a function mapping an input to an output:
> 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) > id = arr id
Some other arrow operations
Now let's define some operations that are generic to all arrow types:
split
is an arrow value 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 value 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 > -- = \op -> arr (\(x,y) -> x `op` y)
(***)
combines two arrow values by running them on a pair (the first arrow value on the first component of the pair; the second arrow value on the second component of the pair):
f *** g = first f >>> second g
(&&&)
combines two arrow values by running them with the same input:
f &&& g = split >>> first f >>> second g -- = split >>> f *** g
liftA2
makes a new arrow value that combines the output from two other arrow values using a binary operation. It works by splitting a value and operating on both halves 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've just created. We start with two simple arrow values, f
and g
:
f
halves its input:
> f :: SimpleFunc Int Int > f = arr (`div` 2)
- and
g
triples its input and adds one:
> g :: SimpleFunc Int Int > 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 (+)
. Let's work through an application of h
to the value 8
:
8
→ (8, 8)
split
(8, 8)
→ (4, 8)
first f
⇔x `div` 2
, wherex
is the first component of the pair(4, 8)
→ (4, 25)
second g
⇔3*y + 1
, wherey
is the second component of the pair(4, 25)
→ 29
apply (+)
to the components of the pair
f ↗ ↘ 8 → (split) (unsplit (+)) → 29 ↘ ↗ g
We can see that h
is a new arrow value that, when applied to 8
, will apply both f
and g
to 8
, then adds their results.
A lot of juggling occurred to get the plumbing right since h
wasn't defined as a linear combination of arrow values. GHC has a syntactic notation that simplifies this in a similar way to how
do
-notation simplifies monadic computations. The h
function can then 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
arrow values
Let's move on to something a little fancier now: Kleisli arrows.
A Kleisli arrow type (Kleisli m a b
) corresponds to the type (a -> m b)
, where m
is a monadic type. 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
, and second
. This means that all multi-value functions (i.e of type a -> [b]
) are already defined as Kleisli arrows (because the list type []
is monadic)! (>>>)
performs composition, keeping track of all the multiple results. split
, (&&&)
and (***)
are all defined as before. 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 is a little teaser. There is an arrow function called returnA
which returns an identity arrow. There is an ArrowPlus
class that includes a zeroArrow
(which for the list type is an arrow value that always returns the empty list) and a (<+>)
operator (which takes the results from two arrow values and concatenates them). We can build up some pretty interesting string transformations (multi-valued functions of type String -> [String]
) using Kleisli arrow values:
> 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 a 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 the arrow values 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.