Bringing back Monad Comprehensions (in style)

Bringing back Monad Comprehensions (in style). Dear GHC users, My colleagues and I are working on Haskell embedded DSL for data-intensive and data-parallel applications [1]. The idea is to provide the Haskell list prelude combinators to manipulate database-resident data. The combinators are not executed in Haskell runtime, instead they are compiled down to SQL, executed on relational database systems and the results are marshalled back to Haskell for further in-heap processing or generation of new database-able embedded programs. Although programming with the standard list processing combinators is feasible, the embedded programs are much more concisely formulated using the list comprehension notation, especially, when extended with 'order by' and 'group by' constructs [2]. Unfortunately, in Haskell, the list comprehension notation is only available for processing lists. In order to support the list comprehension notation, we have built a quasiquter that desugars the list comprehension notation, but, instead of generating code using the Haskell list prelude combinators the quasiquter generates code that uses list processing combinators from our embedded language. Although the quasiquoting approach worked for us, it has a number of drawbacks: * Introduces extra syntactic noise * Error messages are hard to understand as they refer to generated code * Needs to be re-implemented for every list-based embedded language One way to address the aforementioned drawbacks is to define our queries as a monad (similar to list monad) and use the monad comprehension notation. The do notation can be used but it is less suited for query languages. Unfortunately monad comprehensions were removed from Haskell, prior to Haskell 98. However, I think that the notation is extremely useful not only for lists, but for other list like data structures, list-based query languages (see above), maybe even for wider range of EDSLs and monads. I think the feature deserves to be supported at least as a GHC language extension. Thus, I would like to propose to design and implement the monad comprehension notation as a GHC language extension. I am willing to invest some time and contribute to this effort. One can also look at how recently introduced 'order by' and 'group by' constructs generalise to monad comprehensions. If that works, one could implement even more "stylish" monad comprehension notation. Feedback from GHC users and developers would be very much appreciated. * Do you think that this is a good idea? * Would you use monad comprehensions (if available) for your library/EDSL/application? * Do you think that it would be hard to integrate this extension into current GHC codebase? * Have you already thought about how to generalise 'order by' and 'group by' to monad comprehensions? * Have you already thought about how to address the original objections to the monad comprehension notation? Cheers, George [1] http://www-db.informatik.uni-tuebingen.de/files/weijers/IFL2010complete.pdf [2] http://research.microsoft.com/en-us/um/people/simonpj/papers/list-comp/

On 5 October 2010 15:41, George Giorgidze
One can also look at how recently introduced 'order by' and 'group by' constructs generalise to monad comprehensions. If that works, one could implement even more "stylish" monad comprehension notation.
They do: see the comments by MichaelAdams at http://haskell.org/haskellwiki/Simonpj/Talk:ListComp. Last I checked, the code there was slightly buggy but correct in spirit. What *doesn't* generalise is the zip comprehensions extension: [(x, y) | x <- xs | y <- ys] == zip xs ys The required operator :: m a -> m b -> m (a, b) is that of the ZipList applicative functor, not that of the standard applicative functor for lists. Probably to generalise this you need a new typeclass like this one (copied from my own library): class Functor z => Zippable z where -- Naturality: -- fmap (first f) (zip_ as bs) == zip_ (fmap f as) bs -- fmap (second f) (zip_ as bs) == zip_ as (fmap f bs) -- -- Information preservation: -- fmap fst (zip_ as bs) == as -- fmap snd (zip_ as bs) == bs zip_ :: z a -> z b -> z (a, b) zip_ = zipWith_ (,) zipWith_ :: (a -> b -> c) -> z a -> z b -> z c zipWith_ f as bs = fmap (uncurry f) (zip_ as bs) It probably needs some extra laws to say how it interacts with the Monad operators.
* Do you think that it would be hard to integrate this extension into current GHC codebase?
Pretty easy IMHO. The list comprehensions are already half-set up for this job, and you should be able to reuse lots of the code that handles the monad notation desugaring.
* Have you already thought about how to generalise 'order by' and 'group by' to monad comprehensions?
See above.
* Have you already thought about how to address the original objections to the monad comprehension notation?
I thought it was rejected because it caused newbies to get confusing type error messages: they expected *list* error messages but got errors mentioning a scary *Monad* thing. Personally I'm not sure how to solve that, but if it's only available as an extension this won't cause a problem. Cheers, Max

On 06/10/2010 00:26, Max Bolingbroke wrote:
On 5 October 2010 15:41, George Giorgidze
wrote: One can also look at how recently introduced 'order by' and 'group by' constructs generalise to monad comprehensions. If that works, one could implement even more "stylish" monad comprehension notation.
They do: see the comments by MichaelAdams at http://haskell.org/haskellwiki/Simonpj/Talk:ListComp. Last I checked, the code there was slightly buggy but correct in spirit.
What *doesn't* generalise is the zip comprehensions extension:
[(x, y) | x<- xs | y<- ys] == zip xs ys
I wonder how much that extension is actually used, e.g. in all of Hackage? Could we deprecate it? Cheers, Simon

Simon Marlow
On 06/10/2010 00:26, Max Bolingbroke wrote:
On 5 October 2010 15:41, George Giorgidze
wrote: One can also look at how recently introduced 'order by' and 'group by' constructs generalise to monad comprehensions. If that works, one could implement even more "stylish" monad comprehension notation.
They do: see the comments by MichaelAdams at http://haskell.org/haskellwiki/Simonpj/Talk:ListComp. Last I checked, the code there was slightly buggy but correct in spirit.
What *doesn't* generalise is the zip comprehensions extension:
[(x, y) | x<- xs | y<- ys] == zip xs ys
I wonder how much that extension is actually used, e.g. in all of Hackage? Could we deprecate it?
Cheers, Simon
I personally, do not have strong feelings about the zip comprehension notation. Unfortunately, I do not now how widely is this feature used by the Haskell community. I have just checked that in GHC 6.12 -XTransformListComp does not imply -XParallelListComp. The zip comprehension notation is supported as a separate language extension. As a start, one could implement -XMonadComp that supports standard list comprehensions (i.e., generators, filters and let binding) and subsequently extended it with 'order by' and 'group by'. This should only require GHC extension and does not need addition of new type classes/subclasses to the standard library. Monad and MonadPlus (for filtering) should be enough. Afterwards, if -XParallelListComp remains as a supported extension of GHC, one can identify a suitable (sub) type class for that and ensure that -XParallelListComp plays nicely with -XMonadComp. Cheers, George

Good idea. I've made a new Trac ticket and responded there. I suggest that others do the same, so the conversation is captured in the ticket. http://hackage.haskell.org/trac/ghc/ticket/4370 You can add yourself to the cc list of the ticket to stay in the loop. Of course, do use the mailing list too for clarifying discussion, and then dump the conclusion in the ticket. Simon | -----Original Message----- | From: glasgow-haskell-users-bounces@haskell.org [mailto:glasgow-haskell- | users-bounces@haskell.org] On Behalf Of George Giorgidze | Sent: 05 October 2010 15:42 | To: glasgow-haskell-users@haskell.org | Subject: Bringing back Monad Comprehensions (in style) | | Bringing back Monad Comprehensions (in style). | | Dear GHC users, | | My colleagues and I are working on Haskell embedded DSL for data-intensive | and | data-parallel applications [1]. The idea is to provide the Haskell list | prelude combinators to manipulate database-resident data. The combinators are | not executed in Haskell runtime, instead they are compiled down to SQL, | executed on relational database systems and the results are marshalled back | to | Haskell for further in-heap processing or generation of new database-able | embedded programs. | | Although programming with the standard list processing combinators is | feasible, the embedded programs are much more concisely formulated using the | list comprehension notation, especially, when extended with 'order by' and | 'group by' constructs [2]. | | Unfortunately, in Haskell, the list comprehension notation is only available | for processing lists. | | In order to support the list comprehension notation, we have built a | quasiquter that desugars the list comprehension notation, but, instead of | generating code using the Haskell list prelude combinators the quasiquter | generates code that uses list processing combinators from our embedded | language. | | Although the quasiquoting approach worked for us, it has a number of | drawbacks: | | * Introduces extra syntactic noise | | * Error messages are hard to understand as they refer to generated code | | * Needs to be re-implemented for every list-based embedded language | | One way to address the aforementioned drawbacks is to define our queries as a | monad (similar to list monad) and use the monad comprehension notation. The | do | notation can be used but it is less suited for query languages. | | Unfortunately monad comprehensions were removed from Haskell, prior to | Haskell | 98. However, I think that the notation is extremely useful not only for | lists, | but for other list like data structures, list-based query languages (see | above), maybe even for wider range of EDSLs and monads. I think the feature | deserves to be supported at least as a GHC language extension. | | Thus, I would like to propose to design and implement the monad comprehension | notation as a GHC language extension. I am willing to invest some time and | contribute to this effort. | | One can also look at how recently introduced 'order by' and 'group by' | constructs generalise to monad comprehensions. If that works, one could | implement even more "stylish" monad comprehension notation. | | Feedback from GHC users and developers would be very much appreciated. | | * Do you think that this is a good idea? | | * Would you use monad comprehensions (if available) for your | library/EDSL/application? | | * Do you think that it would be hard to integrate this extension into | current GHC codebase? | | * Have you already thought about how to generalise 'order by' and 'group | by' to monad comprehensions? | | * Have you already thought about how to address the original objections to | the monad comprehension notation? | | Cheers, George | | [1] http://www-db.informatik.uni- | tuebingen.de/files/weijers/IFL2010complete.pdf | | [2] http://research.microsoft.com/en-us/um/people/simonpj/papers/list-comp/ | | | _______________________________________________ | Glasgow-haskell-users mailing list | Glasgow-haskell-users@haskell.org | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

You can also buy the tshirt for this ticket :-) http://haskell.spreadshirt.com/bring-back-monad-comprehensions-A6499530 simonpj:
Good idea. I've made a new Trac ticket and responded there. I suggest that others do the same, so the conversation is captured in the ticket. http://hackage.haskell.org/trac/ghc/ticket/4370 You can add yourself to the cc list of the ticket to stay in the loop.
Of course, do use the mailing list too for clarifying discussion, and then dump the conclusion in the ticket.
Simon
| -----Original Message----- | From: glasgow-haskell-users-bounces@haskell.org [mailto:glasgow-haskell- | users-bounces@haskell.org] On Behalf Of George Giorgidze | Sent: 05 October 2010 15:42 | To: glasgow-haskell-users@haskell.org | Subject: Bringing back Monad Comprehensions (in style) | | Bringing back Monad Comprehensions (in style). | | Dear GHC users, | | My colleagues and I are working on Haskell embedded DSL for data-intensive | and | data-parallel applications [1]. The idea is to provide the Haskell list | prelude combinators to manipulate database-resident data. The combinators are | not executed in Haskell runtime, instead they are compiled down to SQL, | executed on relational database systems and the results are marshalled back | to | Haskell for further in-heap processing or generation of new database-able | embedded programs. | | Although programming with the standard list processing combinators is | feasible, the embedded programs are much more concisely formulated using the | list comprehension notation, especially, when extended with 'order by' and | 'group by' constructs [2]. | | Unfortunately, in Haskell, the list comprehension notation is only available | for processing lists. | | In order to support the list comprehension notation, we have built a | quasiquter that desugars the list comprehension notation, but, instead of | generating code using the Haskell list prelude combinators the quasiquter | generates code that uses list processing combinators from our embedded | language. | | Although the quasiquoting approach worked for us, it has a number of | drawbacks: | | * Introduces extra syntactic noise | | * Error messages are hard to understand as they refer to generated code | | * Needs to be re-implemented for every list-based embedded language | | One way to address the aforementioned drawbacks is to define our queries as a | monad (similar to list monad) and use the monad comprehension notation. The | do | notation can be used but it is less suited for query languages. | | Unfortunately monad comprehensions were removed from Haskell, prior to | Haskell | 98. However, I think that the notation is extremely useful not only for | lists, | but for other list like data structures, list-based query languages (see | above), maybe even for wider range of EDSLs and monads. I think the feature | deserves to be supported at least as a GHC language extension. | | Thus, I would like to propose to design and implement the monad comprehension | notation as a GHC language extension. I am willing to invest some time and | contribute to this effort. | | One can also look at how recently introduced 'order by' and 'group by' | constructs generalise to monad comprehensions. If that works, one could | implement even more "stylish" monad comprehension notation. | | Feedback from GHC users and developers would be very much appreciated. | | * Do you think that this is a good idea? | | * Would you use monad comprehensions (if available) for your | library/EDSL/application? | | * Do you think that it would be hard to integrate this extension into | current GHC codebase? | | * Have you already thought about how to generalise 'order by' and 'group | by' to monad comprehensions? | | * Have you already thought about how to address the original objections to | the monad comprehension notation? | | Cheers, George | | [1] http://www-db.informatik.uni- | tuebingen.de/files/weijers/IFL2010complete.pdf | | [2] http://research.microsoft.com/en-us/um/people/simonpj/papers/list-comp/ | | | _______________________________________________ | Glasgow-haskell-users mailing list | Glasgow-haskell-users@haskell.org | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
_______________________________________________ Glasgow-haskell-users mailing list Glasgow-haskell-users@haskell.org http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

What exactly are the benefits of Monad comprehensions over, for example, the do-notation or idioms? I'm not fully aware of what Monad comprehensions would offer in general, but aren't most comprehensions directly translatable to applicative style? For example: [(x, y) | x <- xs | y <- ys] -- Comprehension. versus (,) <$> xs <*> ys -- Applicative style. or (| (,) xs ys |) -- Idiom brackets in She. Or am I missing some subtle points here? Cheers, Sebastiaan On Oct 5, 2010, at 4:41 PM, George Giorgidze wrote:
Bringing back Monad Comprehensions (in style).
Dear GHC users,
My colleagues and I are working on Haskell embedded DSL for data-intensive and data-parallel applications [1]. The idea is to provide the Haskell list prelude combinators to manipulate database-resident data. The combinators are not executed in Haskell runtime, instead they are compiled down to SQL, executed on relational database systems and the results are marshalled back to Haskell for further in-heap processing or generation of new database-able embedded programs.
Although programming with the standard list processing combinators is feasible, the embedded programs are much more concisely formulated using the list comprehension notation, especially, when extended with 'order by' and 'group by' constructs [2].
Unfortunately, in Haskell, the list comprehension notation is only available for processing lists.
In order to support the list comprehension notation, we have built a quasiquter that desugars the list comprehension notation, but, instead of generating code using the Haskell list prelude combinators the quasiquter generates code that uses list processing combinators from our embedded language.
Although the quasiquoting approach worked for us, it has a number of drawbacks:
* Introduces extra syntactic noise
* Error messages are hard to understand as they refer to generated code
* Needs to be re-implemented for every list-based embedded language
One way to address the aforementioned drawbacks is to define our queries as a monad (similar to list monad) and use the monad comprehension notation. The do notation can be used but it is less suited for query languages.
Unfortunately monad comprehensions were removed from Haskell, prior to Haskell 98. However, I think that the notation is extremely useful not only for lists, but for other list like data structures, list-based query languages (see above), maybe even for wider range of EDSLs and monads. I think the feature deserves to be supported at least as a GHC language extension.
Thus, I would like to propose to design and implement the monad comprehension notation as a GHC language extension. I am willing to invest some time and contribute to this effort.
One can also look at how recently introduced 'order by' and 'group by' constructs generalise to monad comprehensions. If that works, one could implement even more "stylish" monad comprehension notation.
Feedback from GHC users and developers would be very much appreciated.
* Do you think that this is a good idea?
* Would you use monad comprehensions (if available) for your library/EDSL/application?
* Do you think that it would be hard to integrate this extension into current GHC codebase?
* Have you already thought about how to generalise 'order by' and 'group by' to monad comprehensions?
* Have you already thought about how to address the original objections to the monad comprehension notation?
Cheers, George
[1] http://www-db.informatik.uni-tuebingen.de/files/weijers/IFL2010complete.pdf
[2] http://research.microsoft.com/en-us/um/people/simonpj/papers/list-comp/

On 7 October 2010 12:04, Sebastiaan Visser
What exactly are the benefits of Monad comprehensions over, for example, the do-notation or idioms?
List comprehensions are just a specialisation of the do-notation for lists. Monad comprehensions are a generalisation for arbitrary monads of this specialisation :-) I don't think there are major benefits to this. The major change is that they "look like" lists (which might be important if you are writing a SQL library) and the final "return" is hoisted into the head of the comprehension [HERE | with, the, usual, do, notation, sequence, here].
I'm not fully aware of what Monad comprehensions would offer in general, but aren't most comprehensions directly translatable to applicative style?
Monadic style, not applicative style.
For example:
[(x, y) | x <- xs | y <- ys] -- Comprehension.
This computes a zip of xs and ys.
(,) <$> xs <*> ys -- Applicative style.
This actually computes a cartesian product instead. You are right in spirit because: [e | qs] ==> do { qs; return e } For example: [(x, y) | x <- xs, y <- ys] ==> do { x <- xs; y <- ys; return (x, y) } Cheers, Max

Hi Sebastian,
For example:
[(x, y) | x <- xs | y <- ys] -- Comprehension.
versus
(,) <$> xs <*> ys -- Applicative style.
or
(| (,) xs ys |) -- Idiom brackets in She.
Or am I missing some subtle points here?
Perhaps, you meant [(x, y) | x <- xs , y <- ys] which translates to the following code in the do notation: do x <- xs y <- ys return (x,y) The comprehension notation also features filters. [(x, y) | x <- xs , y <- ys, x == y] which for instances of MonadPlus (i.e., not for all monads) translates to: do x <- xs y <- ys guard (x == y) return (x,y) See Michael Adams' (link is in Max's reply) suggestion on how to translate 'order by' and 'group by' to monadic combinators. There, monadic code gets really unwieldy. The point of the comprehension notation is that (just like of any other notation, including do) it makes certain kinds of programs easier to write and read. As I have already mentioned, the comprehension notation is extremely well suited for writing programs that process collections of values. Maybe this is because the set comprehension notation was hardwired in our brains during high school math. Haskell is widely used for EDSL development. Some EDSLs are about processing collections of values. Monad comprehensions would allow EDSLs to utilise the expressive list comprehension notation that is currently only allowed for lists. Having said that, since the comprehension notation (to some extent) is used in high school math curricula, even a bit mathematically inclined non-computer scientist users of list-based EDSLs may feel at home when offered to program using the comprehension notation. To summarise, IMO programming list-processing applications is more natural in the comprehension notation than in do notation and programming with 'group by' and 'order by' is infeasible in monadic combinators. Of course one could extend do notation further, but I think it is better for the reasons outlined above to generalise the list comprehension notation instead. Of course, I still welcome alternative suggestions. Cheers, George
participants (6)
-
Don Stewart
-
George Giorgidze
-
Max Bolingbroke
-
Sebastiaan Visser
-
Simon Marlow
-
Simon Peyton-Jones