Who is afraid of arrows, was Re: [Haskell-cafe] ANNOUNCE: Haskell
XML Toolbox Version 9.0.0
Gregory Crosswhite
gcross at phys.washington.edu
Tue Oct 12 16:21:30 EDT 2010
On 10/12/10 12:39 PM, Gene A wrote:
>
> splitMiddle :: forall a. [a] -> ([a], [a])
> splitMiddle =
> (id &&& (length >>> flip div 2)) >>>
> (\(xs,a) -> splitAt a xs)
>
But is that really easier to understand at a glance then
splitMiddle xs = splitAt (length xs `div` 2) xs
? It seems to me that while point-free style is nice and I personally
us it extensively, sticking to it religiously can sometimes lead to code
that is *less* clear.
Also, I don't see why one would prefer >>> over the standard function
composition operator, ".". Using this and uncurry you could actually
make your point-free style definition much more succinct and arguably
easier to read:
splitMiddle = uncurry splitAt . ((`div` 2) . length &&& id)
>
> OKAY here is where the thoughts can come in to play and are a direct
> result of the pointfree style that is adopted as a direct result of
> using arrow
> notation. [...]
I completely agree with you that point-free style is nice; I am
certainly not arguing against it. However, it can be over-kill, and
there is no reason that I can see why using the arrow notation ">>>" in
place of the standard function notation "." helps one write function in
a point-free style.
> The other nice use of arrow is INSIDE of a monadic structure:
>
>
> "Now is the time to come to the aid of our country" >>= (return >>>
> words >>> concat)
> "Nowisthetimetocometotheaidofourcountry" [...]
Your use of a monad here both redundant and obfuscatory; a much simpler
version of this code is
(concat . words) "Now is the time to come to the aid of our country"
>
> squeezeSentenceF
> :: forall (f :: * -> *). (Functor f) => f [Char] -> f [Char]
> squeezeSentenceF css = (squeeze <$>) css
> squeezeSentenceF ["This is how to do a list of sentences",
> "It makes use of applicatives too"]
> ["Thisishowtodoalistofsentences","Itmakesuseofapplicativestoo"]
> [...]
You aren't really using applicative style here, you are just defining a
shorthand for calling "fmap squeeze". Also, your function could be
expressed in point-free style as follows:
squeezeSentenceF = fmap squeeze
> I think that the more you mix and match ALL of the tools and
> do a little experimentation with them, that it then begins to be a
> situation where
> your thoughts of how to compose things are not locked down to one way
> and it
> opens up your mind to many possibilities. I am a proponent of having
> and using
> ALL the available tools in a mix and match way if need be.
I agree, but what I oppose is the choice of fancy tools because they are
fancy rather than because they get the job done better than simple
tools, because the fancy tools often carry a price with them over the
simpler tools.
Cheers,
Greg
More information about the Haskell-Cafe
mailing list