[Haskell-cafe] list comprehension with multiple generator|targets

Mateusz Kowalczyk fuuzetsu at fuuzetsu.co.uk
Mon Nov 10 03:37:53 UTC 2014


On 11/10/2014 03:32 AM, Raphaël Mongeau wrote:
> Wow, didn't know about the LambdaCase.
> 
> Here is the code with LambdaCase, filter and Eq
> 
> {-# LANGUAGE LambdaCase #-}
> 
> data V = A | B | C deriving (Eq)
> 
> f :: [V] -> String
> f l = flip map (filter (/= C) l) $ \case
>     A -> 'A'
>     B -> 'B'
> 
> main = print $ f [A,B,C,C,A]

The problem with this solution is that your pattern match is partial.
Add a D constructor and you get a pattern match failure. You could
extend to ‘\case { A -> Just 'A'; …; _ -> Nothing }’ and use mapMaybe
instead of map but it doesn't answer the question of using list
comprehensions.

> 
> 2014-11-09 22:28 GMT-05:00 Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>:
> 
>> On 11/10/2014 02:58 AM, Donn Cave wrote:
>>> I'm guessing this isn't supported, but might be worth asking -
>>> can I extend a list comprehension like  ['A' | A <- s] to multiple
>> values?
>>> Like,
>>>
>>> data V = A | B | C
>>>
>>> pv :: [V] -> [Char]
>>> pv [] = []
>>> pv (A:x) = 'A':(pv x)
>>> pv (B:x) = 'B':(pv x)
>>> pv (_:x) = pv x
>>>
>>> -- can that be a list comprehension, like
>>>
>>> pv s = [
>>>           'A' | A <- s
>>>           -- ??
>>>           ]
>>>
>>> thanks,
>>>       Donn
>>
>> You basically want map and filter. Moreover, you are also inlining a
>> toChar function which complicates matters.
>>
>> If you have ‘Eq V’ instance and ‘toChar’ function then you could write it
>> as
>>
>> [ toChar y | y <- [ x | x <- s, x /= C ] ]
>>
>> Where inner comprehension is just filter and outer is just map. It
>> doesn't make much sense to do it this way and it imposes an extra
>> constraint, Eq. Alternative (with LambdaCase):
>>
>> map toChar $ filter (\case { C -> False; _ -> True }) s
>>
>> But that's ugly and we still need toChar. Further, although not really
>> applicable here, there might not be a reasonable toChar :: V -> Char for
>> every constructor of V.
>>
>> So in conclusion, the way you have now is pretty good: it avoids Eq
>> constraint and it doesn't force us to write (possibly partial) toChar.
>>
>> So to answer your question, no, you can't extend this very easily to
>> multiple without effectively inlining your existing ‘pv’ function into
>> the comprehension.
>>
>> --
>> Mateusz K.
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
> 
> 
> 


-- 
Mateusz K.


More information about the Haskell-Cafe mailing list