using interact with state, was Re: [Haskell-cafe] applicative challenge

5 views
Skip to first unread message

Thomas Hartman

unread,
May 5, 2009, 3:30:47 PM5/5/09
to Ketil Malde, Haskell Cafe
Aha!

There is in fact a way to fit this specification into the applicative paradigm.

I'm a bit muzzy as to what it all means, but I must say, aesthetically
I'm rather pleased with the result:

module Main where

import Control.Monad.State
import Control.Applicative
import Control.Applicative.State -- applicative-extras on hackage

-- works
t18 = interact $ evalState f18
where f18 = return paint `ap` grabTillBlank `ap` grabTillBlank
paint first second = "first\n" ++ first ++ "second\n" ++ second

grabTillBlank = State $ \s ->
let (beg,end) = break null . lines $ s
in (unlines beg, (unlines . drop 2 $ end))

-- And, with applicative extras:
t19 = interact $ evalState f19
where f19 = paint <$> grabTillBlank <*> grabTillBlank
paint first second = "first\n" ++ first ++ "second\n" ++ second


2009/5/5 Thomas Hartman <tphy...@gmail.com>:
>> 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 <ke...@malde.org>:
>> Thomas Hartman <tphy...@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@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
>>
>
_______________________________________________
Haskell-Cafe mailing list
Haskel...@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply all
Reply to author
Forward
0 new messages