[Haskell-cafe] about Haskell code written to be "too smart"

Thomas Hartman tphyahoo at gmail.com
Wed Mar 25 15:55:32 EDT 2009


Oh, and incidentally, if you change to Control.Monad.State.Strict

*Main> testP partitionsTooFrickinClever
testP partitionsTooFrickinClever^J*** Exception: stack overflow

Don't get me wrong -- I have learned a lot from this thread, and I
think it would be really cool if there was a way to do this that is
clever, that is *right*.

But since the original point was about style, I think this underscores
the point that good style should be newbie friendly *if possible*.
Especially since being a newbie in haskell isn't like in other
languages -- might mean you have been using it for years as a hobby,
but just don't have comfort in certain monads and idioms.


2009/3/25 Thomas Hartman <tphyahoo at gmail.com>:
>> Are you saying there's a problem with this implementation? It's the
>
> Yes, there is actually a problem with this implementation.
>
> import Data.List
> import Control.Monad.State
> import Debug.Trace.Helpers
>
>
> partitions [] xs = []
> partitions (n:parts) xs =
>  let (beg,end) = splitAt n xs
>  in beg : ( case end of
>               [] -> []
>               xs -> partitions parts xs)
>
> partitionsSimpleStupidGood = partitions
>
> partitionsTooFrickinClever = evalState . mapM (State . splitAt)
>
> testP pf = mapM_ putStrLn  [
>          show . pf [3,7..] $ [1..10]
>          , show . pf [3,7,11,15] $ [1..]
>          , show . head . last $ pf [3,3..] [1..10^6]
>        ]
>
> *Main> testP partitionsSimpleStupidGood
> testP partitionsSimpleStupidGood^J[[1,2,3],[4,5,6,7,8,9,10]]
> [[1,2,3],[4,5,6,7,8,9,10],[11,12,13,14,15,16,17,18,19,20,21],[22,23,24,25,26,27,28,29,30,31,32,33,34,35,36]]
> 1000000
>
> Now try testP partitionsTooFrickinClever
>
> Now, I am sure there is a fix for whatever is ailing the State monad
> version, and we would all learn a lesson from it about strictness,
> laziness, and the State monad.
>
> However, there is something to be said for code that just looks like a
> duck and quacks like a duck. It's less likely to surprise you.
>
> So... I insist... Easy for a beginner to read == better!
>
>
> 2009/3/24 Dan Piponi <dpiponi at gmail.com>:
>>> Miguel Mitrofanov wrote:
>>>> takeList = evalState . mapM (State . splitAt)
>>
>>> However, ironically, I stopped using them for pretty
>>> much the same reason that Manlio is saying.
>>
>> Are you saying there's a problem with this implementation? It's the
>> only one I could just read immediately. The trick is to see that
>> evalState and State are just noise for the type inferencer so we just
>> need to think about mapM splitAt. This turns a sequence of integers
>> into a sequence of splitAts, each one chewing on the leftovers of the
>> previous one. *Way* easier than both the zipWith one-liner and the
>> explicit version. It says exactly what it means, almost in English.
>> --
>> Dan
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>


More information about the Haskell-Cafe mailing list