[Haskell-cafe] applicative challenge

Thomas Hartman tphyahoo at gmail.com
Tue May 5 14:17:19 EDT 2009


> interact (\s -> let (first,second) = span (not . null) (lines s)
               in unlines ("first":first++"second":takeWhile (not.null) second))

So, that didn't quite do the right thing, and it seemed like using
span/break wouldn't scale well for more than two iterations. Here's
another attempt, which is a little closer I think, except that it
seems to be using some sort of half-assed state without being explicit
about it:

module Main where

t17 = interact f17
f17 s = let (first,rest) = grabby s
            (second,_) = grabby rest
        in "first\n" ++ first ++ "second\n" ++ second

grabby :: String -> (String,String)
grabby s =
  let (beg,end) = break null . lines $ s
  in (unlines beg, (unlines . drop 2 $ end))


2009/5/5 Ketil Malde <ketil at malde.org>:
> Thomas Hartman <tphyahoo at gmail.com> writes:
>
>> That's slick, but is there some way to use interact twice in the same program?
>
> No :-)
>
>> t10 =
>>   let f = unlines . takeWhile (not . blank) . lines
>>   in  do putStrLn "first time"
>>          interact f
>>          putStrLn "second time"
>>          interact f
>>
>> this results in *** Exception: <stdin>: hGetContents: illegal
>> operation (handle is closed) -}
>
> Yes. Interacting uses hGetContents, and hGetContents semi-closes (or
> fully-closes) the handle.  If you do it from GHCi, you only get to run
> your program once.
>
>> I also tried
>>
>> t15 =
>>   let grabby = unlines . takeWhile (not . blank) . lines
>>       top = ("first time: " ++) . grabby . ("second time: " ++) . grabby
>>   in  interact top
>
>> but that didn't work either:
>> thartman at ubuntu:~/haskell-learning/lazy-n-strict>runghc sequencing.hs
>> a
>> first time: second time: a
>> b
>> b
>
> Well - the input to the leftmost grabby is "second time" prepended to
> the input from the first, and then you prepend "first time" - so this
> makes sense.
>
> Something like this, perhaps:
>
> interact (\s -> let (first,second) = span (not . null) (lines s)
>                in unlines ("first":first++"second":takeWhile (not.null) second))
>
>> If someone can explain the subtleties of using interact when you run
>> out of stdio here, it would be nice to incorporate this into
>
> hGetContents - there can only be one.
>
> -k
> --
> If I haven't seen further, it is by standing in the footprints of giants
>


More information about the Haskell-Cafe mailing list