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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to