proposal: point free case expressions

Hello all, Wouldn't it be nice if we could write point free case statements? I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
We could really use a case statement in which we skip the scrutinee and make `(case of {})' be syntactic sugar for `(\x -> case x of {})'. So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win! Cheers, -- Sebastiaan Visser

2009/11/5 Sebastiaan Visser
Hello all,
Wouldn't it be nice if we could write point free case statements?
I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
We could really use a case statement in which we skip the scrutinee and make `(case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Hi, In this particular case, myFunc = anotherFun (either print putStrLn) seems fine... So, unless there are too many variants in your scrutinee, writing a function such as 'either' would be a win too. Cheers, Thu

I seem to recall this proposal being included on the Haskell' proposals. Ah,
here it is:
http://hackage.haskell.org/trac/haskell-prime/ticket/41
-Edward Kmett
On Thu, Nov 5, 2009 at 10:09 AM, Sebastiaan Visser
Hello all,
Wouldn't it be nice if we could write point free case statements?
I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
We could really use a case statement in which we skip the scrutinee and make `(case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Cheers,
-- Sebastiaan Visser _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Neat! Thanks for this link. On Nov 5, 2009, at 4:22 PM, Edward Kmett wrote: I seem to recall this proposal being included on the Haskell' proposals. Ah, here it is:
http://hackage.haskell.org/trac/haskell-prime/ticket/41
-Edward Kmett
On Thu, Nov 5, 2009 at 10:09 AM, Sebastiaan Visser
wrote: Hello all, Wouldn't it be nice if we could write point free case statements?
I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
We could really use a case statement in which we skip the scrutinee and make `(case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Cheers,
-- Sebastiaan Visser

Let's add point free pattern matching too then:
myFunc = anotherFunc $ case of Left -> print Right -> putStrLn
Sjoerd On Nov 5, 2009, at 4:09 PM, Sebastiaan Visser wrote:
Hello all,
Wouldn't it be nice if we could write point free case statements?
I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
We could really use a case statement in which we skip the scrutinee and make `(case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Cheers,
-- Sebastiaan Visser _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Sjoerd Visscher sjoerd@w3future.com

Yeah. I wanted to propose that as well, but I don't really know how well that scales to larger patterns. On Nov 5, 2009, at 4:42 PM, Sjoerd Visscher wrote:
Let's add point free pattern matching too then:
myFunc = anotherFunc $ case of Left -> print Right -> putStrLn
Sjoerd
On Nov 5, 2009, at 4:09 PM, Sebastiaan Visser wrote:
Hello all,
Wouldn't it be nice if we could write point free case statements?
I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
We could really use a case statement in which we skip the scrutinee and make `(case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Cheers,
-- Sebastiaan Visser

Me too. Looks cool!
2009/11/5 Martijn van Steenbergen
Sebastiaan Visser wrote:
> myFunc = anotherFunc $ case of > Left err -> print err > Right msg -> putStrLn msg
A minor syntactical addition, a big win!
+1!
Martijn. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Eugene Kirpichov Web IR developer, market.yandex.ru

Excerpts from Martijn van Steenbergen's message of Thu Nov 05 16:54:36 +0100 2009:
Sebastiaan Visser wrote:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
+1!
+1 -- Nicolas Pouillard http://nicolaspouillard.fr

+1
If we're counting increments, should add in previous instances of the same proposal - Andrew Pimlott Sep 2005 on haskell-cafe, at least. I agree with Stefan Monnier, might as well allow pattern alternatives in lambda expressions - essentially the same idea and allows multiple case parameters. Donn Cave, donn@avvanta.com

We could really use a case statement in which we skip the scrutinee and make (case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Since this "case" really defines a function, it seems like it would make more sense to allow defining anonymous functions by pattern matching. I.e. instead of "case of", I think it should use "λ", "\", "fn", or ... Stefan

How about \{Left err -> print err; Right msg -> putStrLn msg} ?
2009/11/5 Stefan Monnier
We could really use a case statement in which we skip the scrutinee and make (case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Since this "case" really defines a function, it seems like it would make more sense to allow defining anonymous functions by pattern matching. I.e. instead of "case of", I think it should use "λ", "\", "fn", or ...
Stefan
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Eugene Kirpichov Web IR developer, market.yandex.ru

Addendum: This would also work nicely for matching on multiple arguments.
elem = \(_ Leaf -> False; x (Fork a l r) | a==x -> True; | a>x -> elem
x l; | otherwise -> elem x r)
2009/11/5 Eugene Kirpichov
How about \{Left err -> print err; Right msg -> putStrLn msg} ?
2009/11/5 Stefan Monnier
: We could really use a case statement in which we skip the scrutinee and make (case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Since this "case" really defines a function, it seems like it would make more sense to allow defining anonymous functions by pattern matching. I.e. instead of "case of", I think it should use "λ", "\", "fn", or ...
Stefan
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Eugene Kirpichov Web IR developer, market.yandex.ru
-- Eugene Kirpichov Web IR developer, market.yandex.ru

On Thu, Nov 5, 2009 at 10:59 AM, Stefan Monnier
We could really use a case statement in which we skip the scrutinee and make (case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Since this "case" really defines a function, it seems like it would make more sense to allow defining anonymous functions by pattern matching. I.e. instead of "case of", I think it should use "λ", "\", "fn", or ...
The problem with all of those options is that they introduce a new keyword into the language and can potentially break existing code. Eugene's \{ } avoids that by using a different hole in the grammar, but at the expense of 'un-Haskelly' braces. That and I question how easy it would be to get to parse, because a common idiom seems to be to parse patterns as expressions before converting them to patterns to avoid certain other ambiguities in the grammar, so this requires a { } expression, which may introduce a lot more ambiguity and problems to the grammar than it would seem at first glance. -Edward Kmett

Don't these things generally get added as LANGUAGE pragmas though? If it's off by default then peoples code should be okay. Also, I'd prefer something like `cases` as the keyword, rather than `case of`, mostly for aesthetics, but also so that, upon visual inspection, I wouldn't wonder where the pattern went and potentially try to 'fix" the point-free case match. /Joe On Nov 5, 2009, at 1:09 PM, Edward Kmett wrote:
On Thu, Nov 5, 2009 at 10:59 AM, Stefan Monnier
wrote: We could really use a case statement in which we skip the scrutinee and make (case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Since this "case" really defines a function, it seems like it would make more sense to allow defining anonymous functions by pattern matching. I.e. instead of "case of", I think it should use "λ", "\", "fn", or ...
The problem with all of those options is that they introduce a new keyword into the language and can potentially break existing code.
Eugene's \{ } avoids that by using a different hole in the grammar, but at the expense of 'un-Haskelly' braces. That and I question how easy it would be to get to parse, because a common idiom seems to be to parse patterns as expressions before converting them to patterns to avoid certain other ambiguities in the grammar, so this requires a { } expression, which may introduce a lot more ambiguity and problems to the grammar than it would seem at first glance.
-Edward Kmett _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

2009/11/5 Edward Kmett
On Thu, Nov 5, 2009 at 10:59 AM, Stefan Monnier
wrote: We could really use a case statement in which we skip the scrutinee and make (case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Since this "case" really defines a function, it seems like it would make more sense to allow defining anonymous functions by pattern matching. I.e. instead of "case of", I think it should use "λ", "\", "fn", or ...
The problem with all of those options is that they introduce a new keyword into the language and can potentially break existing code.
Eugene's \{ } avoids that by using a different hole in the grammar, but at the expense of 'un-Haskelly' braces. That and I question how easy it would be to get to parse, because a common idiom seems to be to parse patterns as expressions before converting them to patterns to avoid certain other ambiguities in the grammar, so this requires a { } expression, which may introduce a lot more ambiguity and problems to the grammar than it would seem at first glance.
Hey, the braces are not that un-Haskelly. After all, you already can write "case x of {Left err -> ...; Right res -> ...}" - that's exactly why I suggested this notation. So, I am just suggesting to replace "case of" with "\" and that's all.
-Edward Kmett
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Eugene Kirpichov Web IR developer, market.yandex.ru

So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
+1. While we're on the topic, what do people think of a related problem, case expressions over monadic values? I run into this often enough that it's a pain. I'd like to take result <- act1 case result of ... -> actN and drop the bind entirely to get case act1 of ... -> actN I know that there are many helper functions and constructs to make this sort of thing more readable, but sometimes a case expression is a good fit and the preceding bind just ends up being noisy. -- Jonathan Daugherty

On Nov 5, 2009, at 6:26 PM, Jonathan Daugherty wrote:
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
+1.
While we're on the topic, what do people think of a related problem, case expressions over monadic values? I run into this often enough that it's a pain. I'd like to take
result <- act1 case result of ... -> actN
and drop the bind entirely to get
case act1 of ... -> actN
I know that there are many helper functions and constructs to make this sort of thing more readable, but sometimes a case expression is a good fit and the preceding bind just ends up being noisy.
-- Jonathan Daugherty
I think your example is ambiguous in the sense that the case cannot know whether it should pattern match on the entire `m a' or just on the value `a' pulled out of the monad . Or maybe I don't entirely understand your example. With the proposed `case of' it would become something like this: act1 >>= case of ... -> actN Cheers, Sebastiaan

I think your example is ambiguous in the sense that the case cannot know whether it should pattern match on the entire `m a' or just on the value `a' pulled out of the monad . Or maybe I don't entirely understand your example.
You're right; it's ambiguous. :)
With the proposed `case of' it would become something like this:
act1 >>= case of ... -> actN
That would work perfectly. -- Jonathan Daugherty

Wouldn't it be nice if we could write point free case statements?
Yes. Haskell should automatically define destructors for each data type you define in addition to defining constructors.
I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
When you define "data Either a b = Left a | Right b" it should define "Left", "Right" and "destruct_Either" (or whatever other name you want to give it). Of course "destruct_Either" is just "either" from the prelude, and you also get "maybe", but these shouldn't be prelude functions, they should be automatically derived. Then your points free version is just: myFunc = anotherFunc $ either print putStrLn In the meantime, the Data.Derive library http://community.haskell.org/~ndm/derive/ has a function for deriving these using TH: http://hackage.haskell.org/packages/archive/derive/latest/doc/html/Data-Deri... This derives a non-recursive definition for recursive data types. Its also possible to derive a similar recursive definition for recursive data types.
Sebastiaan Visser
Tim Newsham http://www.thenewsh.com/~newsham/

2009/11/5 Sebastiaan Visser
Hello all,
Wouldn't it be nice if we could write point free case statements?
I regularly find myself writing down something like this:
myFunc = anotherFunc $ \x -> case x of Left err -> print err Right msg -> putStrLn msg
We could really use a case statement in which we skip the scrutinee and make `(case of {})' be syntactic sugar for `(\x -> case x of {})'.
So we could write:
myFunc = anotherFunc $ case of Left err -> print err Right msg -> putStrLn msg
A minor syntactical addition, a big win!
Cheers,
-- Sebastiaan Visser _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Morten Rhiger implemented "Type-safe pattern combinators" [1], which are essentially a library for pattern matching, entirely within Haskell98. As an example, he implemented "anonymous pattern-matching" with this library, which is similar to what you ask for. It would be certainly be possible to implement your proposal with his library. My library "first-class-patterns" [2] on Hackage essentially follows Morten Rhiger's approach, but makes the types more understandable. I implemented point free case expressions (the 'elim' function) and monadic pattern matches (the 'mmatch' function) in version 0.2.0, which I just uploaded. For instance, you could write
import Data.Pattern
---- anonymous matching ex6 :: Show a => Either a String -> IO () ex6 = elim $ left var ->> print <|> right var ->> putStrLn
-- monadic matching ex8 :: IO () ex8 = mmatch getLine $ cst "" ->> return () <|> var ->> putStrLn . ("You said " ++)
Cheers, Reiner [1] http://www.itu.dk/people/mir/typesafepatterns.pdf [2] http://hackage.haskell.org/package/first-class-patterns
participants (14)
-
Donn Cave
-
Edward Kmett
-
Eugene Kirpichov
-
Joe Fredette
-
Jonathan Daugherty
-
Martijn van Steenbergen
-
minh thu
-
Nicolas Pouillard
-
Reiner Pope
-
Roel van Dijk
-
Sebastiaan Visser
-
Sjoerd Visscher
-
Stefan Monnier
-
Tim Newsham