Converting IO [XmlTree] to [XmlTree]

On Tue, Apr 14, 2009 at 8:54 AM, rodrigo.bonifacio < rodrigo.bonifacio@uol.com.br> wrote:
Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
This is very important: you cannot. But you can still get your hands on one inside a do block. As in, if you have tree :: IO [XmlTree], then you can say, eg. printTree = do t <- tree print t Inside this block, t is an [XmlTree], and it is passed to print. Intutively, when you see x <- y inside a do block, if y :: IO a, for some type a, then x :: a. But there is no function that will get you from IO [XmlTree] -> [XmlTree], you have to use binding like this. Luke

On Tue, Apr 14, 2009 at 4:54 PM, rodrigo.bonifacio
Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
Quick and dirty answer: unsafePerformIO. That's an easy finding on Hoogle: http://www.haskell.org/hoogle/?hoogle=IO+a+-%3E+a Anyhow, as the name suggest, the function is "unsafe", so you better know what you're doing. Bye, Cristiano

On Tue, Apr 14, 2009 at 9:01 AM, Cristiano Paris
On Tue, Apr 14, 2009 at 4:54 PM, rodrigo.bonifacio
wrote: Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
Quick and dirty answer: unsafePerformIO.
Please don't say that. He's a beginner. You realize that the path of least resistance will be to use it, right? You see why that's not a good thing? Even experts don't use this function. (To the O.P.: don't use it) Luke
That's an easy finding on Hoogle:
http://www.haskell.org/hoogle/?hoogle=IO+a+-%3E+a
Anyhow, as the name suggest, the function is "unsafe", so you better know what you're doing.
Bye,
Cristiano _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Tue, Apr 14, 2009 at 5:09 PM, Luke Palmer
... Please don't say that. He's a beginner. You realize that the path of least resistance will be to use it, right? You see why that's not a good thing? Even experts don't use this function. (To the O.P.: don't use it)
Mmmh, sorry Luke but I don't understand this ostracism. unsafePerformIO is not "evil" by itself, it's there for a purpose and, as for anything else in the language, it's better to understand when to use it and when not rather than just knowing that is something that MUST not be used, without any further explanation. More, from my personal experience, knowing unsafePerformIO helped me understand better what Monads are and how they should be used. I wounder what so-called "experts" have to say about this. Cristiano

On Tue, Apr 14, 2009 at 9:24 AM, Cristiano Paris
On Tue, Apr 14, 2009 at 5:09 PM, Luke Palmer
wrote: ... Please don't say that. He's a beginner. You realize that the path of least resistance will be to use it, right? You see why that's not a good thing? Even experts don't use this function. (To the O.P.: don't use it)
Mmmh, sorry Luke but I don't understand this ostracism.
unsafePerformIO is not "evil" by itself, it's there for a purpose and, as for anything else in the language, it's better to understand when to use it and when not rather than just knowing that is something that MUST not be used, without any further explanation.
You have a point. I would like to avoid introducing unfounded authoritarian stigmas whenever possible. However, the way I see it is that unsafePerformIO *is* evil by itself, and it is only by the addition of Holy Water that it is benign to use. Ryan Ingram described it as a way to achieve "RTS extensions", which I think is a fine way to put it I consider Debug.Trace to be an instance of this: we are extending the RTS to provide execution traces. I guess it's a teaching style thing. Mostly, if someone sees "I have an IO [XmlTree] and I need an [XmlTree]", I want the "I'm asking the wrong question" synapse path to fire, rather than the "just use unsafePerformIO" one. Luke
More, from my personal experience, knowing unsafePerformIO helped me understand better what Monads are and how they should be used.
I wounder what so-called "experts" have to say about this.
Cristiano

On Tue, Apr 14, 2009 at 5:42 PM, Luke Palmer
... However, the way I see it is that unsafePerformIO *is* evil by itself, and it is only by the addition of Holy Water that it is benign to use.
That's what I meant but your words are indeed more effective :)
Ryan Ingram described it as a way to achieve "RTS extensions", which I think is a fine way to put it I consider Debug.Trace to be an instance of this: we are extending the RTS to provide execution traces. I guess it's a teaching style thing. Mostly, if someone sees "I have an IO [XmlTree] and I need an [XmlTree]", I want the "I'm asking the wrong question" synapse path to fire, rather than the "just use unsafePerformIO" one.
Yes, I think your analysis is correct. Perhaps I was a bit too dry in my original answer. Cristiano

Hello Cristiano, Tuesday, April 14, 2009, 7:24:40 PM, you wrote:
unsafePerformIO is not "evil" by itself, it's there for a purpose and, as for anything else in the language, it's better to understand when to use it
we just think that author of original question don't yet have good knowledge of IO monad baiscs and it's what he actually want to know. if the question was how to perform IO action in pure code, unsafePerformIO may be a good answer -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Cristiano Paris wrote:
On Tue, Apr 14, 2009 at 5:09 PM, Luke Palmer
wrote: ... Please don't say that. He's a beginner. You realize that the path of least resistance will be to use it, right? You see why that's not a good thing? Even experts don't use this function. (To the O.P.: don't use it)
Mmmh, sorry Luke but I don't understand this ostracism.
unsafePerformIO is not "evil" by itself, it's there for a purpose and, as for anything else in the language, it's better to understand when to use it and when not rather than just knowing that is something that MUST not be used, without any further explanation.
Sure, the explanation is there if people are interested in it. However, in context, your answer was wrong. It is like someone asking: "How do I get hold of a new phone" and the answer "Pull a gun on someone walking down the street and demand they give you their phone" ...that is, the answer was solving the wrong problem, or solving it in the wrong context. If you have IO [XmlTree], then you don't have an [XmlTree] at all - rather you have a description of an (IO-involving) action which you need to run to get one. You can run it many times, or once, or never. It will (in general) give different results depending exactly when you run it. Therefore you need to carefully decide when to run it - i.e. attach it indirectly or directly into your main action, as the various other answers have shown. unsafePerformIO is not part of the haskell language - it does not respect the type system. It is an extension mechanism which allows us to add hooks into the RTS; effectively a way to extend the language. This is a useful and powerful thing, but nothing in the questioner's question suggested that language extension was what they wanted. Jules

On Tue, Apr 14, 2009 at 5:54 PM, Jules Bean
...
I'm convinced about what you say and perhaps I answered the way I did just because I'm convinced that, for a newbie, knowing about the existence of unsafePerformIO can't cause any harm. I was a bit surprised by the strong reaction about my citation of unsafePerformIO. Maybe it'd useful, for the future, to write a document explaining how to help newbies properly, maybe putting it in the mailing list charter. Cristiano

Cristiano Paris
I was a bit surprised by the strong reaction about my citation of unsafePerformIO. Maybe it'd useful, for the future, to write a document explaining how to help newbies properly, maybe putting it in the mailing list charter.
1) Tell them about interact. 2) If they're not satisfied, or already spoiled by the functions they want to use, explain bind wrt. IO, then do-notation. You don't want them to get puzzled by missing returns, or think that it's a keyword. 3) Let them catch up on monads by themselves, there's no need to confuse people with explanations of things they already understand. In other words: 1) Explain Pointed 2) Explain Functor 3) Explain Applicative 4) Explain Monad -- (c) this sig last receiving data processing entity. Inspect headers for copyright history. All rights reserved. Copying, hiring, renting, performance and/or quoting of this signature prohibited.

Tillmann Rendel wrote:
Achim Schneider wrote:
In other words:
1) Explain Pointed 2) Explain Functor 3) Explain Applicative 4) Explain Monad
Why Pointed first? Functor seems more useful and more basic.
They are in order of power: every monad is an applicative; every applicative is a functor; every functor is pointed. Though I can't think of any non-functor pointiness at the moment. Martijn.

On 22:19 Mon 27 Apr , Martijn van Steenbergen wrote:
Tillmann Rendel wrote:
Achim Schneider wrote:
In other words:
1) Explain Pointed 2) Explain Functor 3) Explain Applicative 4) Explain Monad Why Pointed first? Functor seems more useful and more basic.
They are in order of power: every monad is an applicative; every applicative is a functor; every functor is pointed.
Uhm, isn't it: class (Functor f) => Pointed f where pure :: a -> f a -- singleton, return, unit etc. Got it from: The Typeclassopedia by Brent Yorgey (forgot the URL, sorry) Steffen

Steffen Schuldenzucker wrote:
Uhm, isn't it:
class (Functor f) => Pointed f where pure :: a -> f a -- singleton, return, unit etc.
Got it from: The Typeclassopedia by Brent Yorgey (forgot the URL, sorry)
Yes, but also: http://thread.gmane.org/gmane.comp.lang.haskell.cafe/54685 So maybe functor is not strictly more powerful than pointed and vice versa. I don't know. Martijn.

On Mon, Apr 27, 2009 at 4:19 PM, Martijn van Steenbergen < martijn@van.steenbergen.nl> wrote:
They are in order of power: every monad is an applicative; every applicative is a functor; every functor is pointed.
Though I can't think of any non-functor pointiness at the moment.
Martijn.
On the other hand, here's an un-pure-able and un-point-able functor: instance Functor ((,) m) where --fmap :: (n -> n') -> (m, n) -> (m, n') fmap f (m, n) = (m, f n) n -> (m, n) is not a function you can write in general without bottom values (unless you specify that m is a monoid, using mempty). Nor is Pointed in the f () sense, since forall a. (a, ()) isn't something for which a value can be pulled out of thin non-bottom air. But... getting a bit off-topic >_> —Gracenotes

On 04:33 Tue 28 Apr , Matthew Gruen wrote:
On the other hand, here's an un-pure-able and un-point-able functor:
instance Functor ((,) m) where --fmap :: (n -> n') -> (m, n) -> (m, n') fmap f (m, n) = (m, f n) n -> (m, n) is not a function you can write in general without bottom values (unless you specify that m is a monoid, using mempty). Nor is Pointed in the f () sense, since forall a. (a, ()) isn't something for which a value can be pulled out of thin non-bottom air. But... getting a bit off-topic >_>
Yeah, a good example! Especially, this [1] can't be implemented without pointed: point x = fmap (const x) shape Where does shape come from? It's a "singleton element" of the functor, right? So we'll need Pointed. Especially: How (const x) is applied greatly depends on the functor and on shape. Consider the list functor and shape = repeat () against shape = [()] against shape = [] Steffen [1] http://thread.gmane.org/gmane.comp.lang.haskell.cafe/54685

Quoth Cristiano Paris
I was a bit surprised by the strong reaction about my citation of unsafePerformIO.
Well, there might be a couple of things going on here. Part of it is how to guess the unstated context of a question - I'm fairly sure that given a more thorough presentation of the question, there would have been no controversy about the answer. The general problem is that people who are comfortable with extremely esoteric parts of Haskell and used to discussing such things here, fail to recognize when they're dealing with people who are at a point where their needs are much more basic. (And who knows, which one was the present case? Not really enough information to know absolutely for sure.) But as you have found, unsafePerformIO is not just an esoteric topic, it's an uncomfortable one. We read that it isn't even part of the language, one should never really have any use for it in computation, only as a sort of meta-programming RTS thing. Yet, you might never guess this from reading the GHC documentation, which only urges you to be careful. Or from encountering it in fairly widespread use as a way to implement top level program state with IORefs. This sort of unresolved tension between practice and theory rightly makes people uneasy, and in my opinion you shouldn't take it personally. It's a good thing to occasionally probe those sore spots, and maybe if it bothers us enough it will lead to improvements. Donn

Quick and dirty answer: unsafePerformIO.
You can do a lot of cool things with a table saw if you take the blade guard
off.
On Tue, Apr 14, 2009 at 11:01 AM, Cristiano Paris
On Tue, Apr 14, 2009 at 4:54 PM, rodrigo.bonifacio
wrote: Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
Quick and dirty answer: unsafePerformIO.
That's an easy finding on Hoogle:
http://www.haskell.org/hoogle/?hoogle=IO+a+-%3E+a
Anyhow, as the name suggest, the function is "unsafe", so you better know what you're doing.
Bye,
Cristiano _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- /jve

Never answer such newbie questions with unsafePerformIO.
That's the wrong answer 99.99% of the time, but giving it to a newbie
they might follow your advice.
On Tue, Apr 14, 2009 at 5:01 PM, Cristiano Paris
On Tue, Apr 14, 2009 at 4:54 PM, rodrigo.bonifacio
wrote: Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
Quick and dirty answer: unsafePerformIO.
That's an easy finding on Hoogle:
http://www.haskell.org/hoogle/?hoogle=IO+a+-%3E+a
Anyhow, as the name suggest, the function is "unsafe", so you better know what you're doing.
Bye,
Cristiano _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hallo,
On 4/14/09, rodrigo.bonifacio
Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
The short answer is: You cannot. The longer answer is: Only put things in the IO monad when you need to interact with the "outside", i. e., reading, displaying etc. Cheers, -- -alex http://www.ventonegro.org/

Here's another way of looking at what others have already said. The only way you can do that is within the scope of another IO action. For example: outputXmlTrees :: IO () outputXmlTrees = do trees <- inputXmlTrees; let newTrees = transform trees; print . show $ newTrees Notice a few things: - First, the line "trees <- inputXmlTrees" effectively takes an IO [XmlTree] and turns it into a [XmlTrees]. That is, it runs the IO action inputXmlTrees, and gives you the resulting list of XmlTrees to work with. - You can then pass these off to a pure function which will monkey around with them in a pure (non-IO) context - You must do this in an IO action, however, and any monadic action gets its type from the last line. Thus, the last line must be of type IO something. In this case, it is simply the action that would print out the trees. - Thus, this gives you a way to glue together different IO actions and pure actions and combine them into larger IO actions Hope this clarifies On Tue, Apr 14, 2009 at 10:54 AM, rodrigo.bonifacio < rodrigo.bonifacio@uol.com.br> wrote:
Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
Regards,
Rodrigo.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hello rodrigo.bonifacio, Tuesday, April 14, 2009, 6:54:07 PM, you wrote:
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
IO [XmlTree] is an action returning [XmlTree]. so to "convert" it to [XmlTree] you just need to execute it in IO monad: value <- action i suggest you to read http://haskell.org/haskellwiki/IO_inside in order to manage IO monad -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

On Tue, Apr 14, 2009 at 10:54 AM, rodrigo.bonifacio
Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
Regards,
Rodrigo.
One good link on this topic is http://haskell.org/haskellwiki/Avoiding_IO Maybe there's no need for it be be IO [XmlTree], if you can write functions that instead produce/consume just [XmlTree]. They can always be turned later with liftM and whatnot into a IO [XmlTree] (but not the reverse). Doing as much as possible in pure code, and wrapping around it/calling it from a few short IO functions is the Haskell Way. Sometimes it looks hard to see, but XMonad is probably the best example here of how it can both be done where it looks infeasible ('What's a window manager but a bunch of IO?") and is rewarding (testability, etc. as exemplified by http://cgi.cse.unsw.edu.au/~dons/blog/2007/05/17) The best writeup on this seems to be http://www.cse.unsw.edu.au/~dons/talks/xmonad-hw07.pdf -- gwern

rodrigo.bonifacio wrote:
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
You can't, unless you use `unsafePeformIO`, as others have already pointed out. Yet others have, more "correctly," suggested that you use do notation to bind a variable with the type you expect. I want to go into a little more detail .I have a spontaneous Monad tutorial to throw out, I guess. How you can convert a value of type `IO [XmlTree]` is probably the wrong question. The right question is how you can convert a function of type `[XmlTree] -> A` into a function of type `IO [XmlTree] -> IO A`. The correct answer has many names: fmap, liftA, liftM, (<$>) :: Monad m => (a -> b) -> (m a -> m b) I will use `fmap` to mean any of the above names. In your case, applying fmap to a function foo: foo :: [XmlTree] -> A fmap foo :: IO [XmlTree] -> IO A So any time you need to pass an IO value to a pure function, this is one way to do it. Suppose that the function actually returns an IO value, though. Here, we will call the function `bar`: bar :: [XmlTree] -> IO A fmap bar :: IO [XmlTree] -> IO (IO A) Now we seem to be in a similar situation as before. We have an extra IO that we don't want. There is a function for this: join :: Monad m => m (m a) -> m a So, we can use `join` to transform an expression of type `IO (IO a)` to an expression of type `IO a`. Putting it all together: bar :: [XmlTree] -> IO A fmap bar :: IO [XmlTree] -> IO (IO A) join . fmap bar :: IO [XmlTree] -> IO A And we now have a sensible function again. Of course, this is a common pattern, using `join` and `fmap` together, so we have yet another function: (=<<) :: Monad m => (a -> m b) -> (m a -> m b) (Note that this has a different argument order than (>>=). I prefer this form since it emphasizes that it actually transforms a function.) So, now we have bar :: [XmlTree] -> IO A (bar =<<) :: IO [XmlTree] -> IO A Putting it all together, with a function that gives us the `IO [XmlTree]`: xmlTree :: IO [XmlTree] bar :: [XmlTree] -> IO A bar =<< XmlTree :: IO A And that last line is equivalent to this in do notation: do tree <- xmlTree bar tree If you have any questions, please do ask. I understand that it can appear quite dense to a beginner. I'm thinking about using this approach in a blog article, which would have more detail and examples, but I would like to be aware of potential stumbling blocks. - Jake

"rodrigo.bonifacio"
Dear Sirs,
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
unsafeCoerce. Seriously, you just don't, you weld stuff together using >>=. It takes an 'IO a' and a function 'a -> IO b' and returns you an 'IO b', thus preventing you from launching nuclear missiles while you're standing in front of the exhaust jets. You don't want to be able to. do-notation is a convenient short-hand: foo >>= (\bar -> return $ baz bar) do bar <- foo return $ baz bar
= doesn't only work with IO, but with any monad, that's why it's type,
(>>=) :: Monad m => m a -> (a -> m b) -> m b might look intimidating, but actually isn't. For more info, have a look at Real World Haskell[1], and, after that, the Typeclassopedia[2]. As a final notice, don't listen to the others: Those are just desperate people, vainly trying to convince themselves they'd understand monads. If you see monads being compared to space suits, nuclear waste processing plants, or burritos, run far, run fast, but run. If you see them compared to applicative functors, get curious. [1]http://book.realworldhaskell.org/read/ [2]http://byorgey.wordpress.com/2009/02/16/the-typeclassopedia-request-for-feed... -- (c) this sig last receiving data processing entity. Inspect headers for copyright history. All rights reserved. Copying, hiring, renting, performance and/or quoting of this signature prohibited.

On Tue, 14 Apr 2009, rodrigo.bonifacio wrote:
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
The old Wiki had: http://www.haskell.org/wikisnapshot/ThatAnnoyingIoType.html Should be ported to the new Wiki since it is a FAQ ...

Henning Thielemann ha scritto:
On Tue, 14 Apr 2009, rodrigo.bonifacio wrote:
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
The old Wiki had: http://www.haskell.org/wikisnapshot/ThatAnnoyingIoType.html
Should be ported to the new Wiki since it is a FAQ ...
Note that it is not always possible to separate IO from pure code. As an example, consider an HTTP 1.1 server that read a request body containing a number for each line, and return a response body containing the sum of the numbers. Here, you can not really separate IO from pure computation. And you can not use lazy IO, if you want your server to support HTTP 1.1 pipelining. Regards Manlio Perillo

On Sun, Apr 19, 2009 at 9:48 AM, Manlio Perillo
Henning Thielemann ha scritto:
On Tue, 14 Apr 2009, rodrigo.bonifacio wrote:
I guess this is a very simple question. How can I convert IO [XmlTree] to just a list of XmlTree?
The old Wiki had: http://www.haskell.org/wikisnapshot/ThatAnnoyingIoType.html
Should be ported to the new Wiki since it is a FAQ ...
Note that it is not always possible to separate IO from pure code. As an example, consider an HTTP 1.1 server that read a request body containing a number for each line, and return a response body containing the sum of the numbers.
What? sumRequest :: String -> String -- strips header, sums numbers, returns response sumServer :: IO () -- reads from socket, writes sumRequest to socket And many other permutations, with differing degrees of laziness and parametericity. Luke

Luke Palmer ha scritto:
[...] Note that it is not always possible to separate IO from pure code. As an example, consider an HTTP 1.1 server that read a request body containing a number for each line, and return a response body containing the sum of the numbers.
What?
sumRequest :: String -> String -- strips header, sums numbers, returns response
sumServer :: IO () -- reads from socket, writes sumRequest to socket
And many other permutations, with differing degrees of laziness and parametericity.
As long as you stricly read a string from the socket, this is ok. But you can not read a string lazily. Regards Manlio

2009/04/21 Manlio Perillo
Luke Palmer ha scritto:
And many other permutations, with differing degrees of laziness and parametericity.
As long as you stricly read a string from the socket, this is ok. But you can not read a string lazily.
Why not? It changes the way in which the program fails (if it does) but it does not change the result. -- Jason Dusek

Jason Dusek
2009/04/21 Manlio Perillo
: Luke Palmer ha scritto:
And many other permutations, with differing degrees of laziness and parametericity.
As long as you stricly read a string from the socket, this is ok. But you can not read a string lazily.
Why not? It changes the way in which the program fails (if it does) but it does not change the result.
Reading a socket lazily has exactly the same result as strictly reading a socket that isn't sent any data. In network programming, you continuously have to drain your input. -- (c) this sig last receiving data processing entity. Inspect headers for copyright history. All rights reserved. Copying, hiring, renting, performance and/or quoting of this signature prohibited.

On Sun, 19 Apr 2009, Manlio Perillo wrote:
Note that it is not always possible to separate IO from pure code. As an example, consider an HTTP 1.1 server that read a request body containing a number for each line, and return a response body containing the sum of the numbers.
Here, you can not really separate IO from pure computation. And you can not use lazy IO, if you want your server to support HTTP 1.1 pipelining.
I have done exactly this, but I needed to define the LazyIO type: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/http-monad http://hackage.haskell.org/cgi-bin/hackage-scripts/package/lazyio
participants (20)
-
Achim Schneider
-
Alex Queiroz
-
Andrew Wagner
-
Bulat Ziganshin
-
Cristiano Paris
-
Donn Cave
-
Gwern Branwen
-
Henning Thielemann
-
Jake McArthur
-
Jason Dusek
-
John Van Enk
-
Jules Bean
-
Lennart Augustsson
-
Luke Palmer
-
Manlio Perillo
-
Martijn van Steenbergen
-
Matthew Gruen
-
rodrigo.bonifacio
-
Steffen Schuldenzucker
-
Tillmann Rendel