
This :
pv a = [t | Just t <- pvc a]
is strange, can we really do pattern matching inside list comprehension?
If I try to make your code work its lead me to this:
import Data.Maybe
data V = A | B | C
pv l = catMaybes [pvc e | e <- l]
where
pvc A = Just 'A'
pvc B = Just 'B'
pvc _ = Nothing
main = print $ pv [A,B,C,C,A]
As you can see, [pvc e | e <- l] is just "map (plv) l" and I think the
where is more clear with a lambdaCase.
{-# LANGUAGE LambdaCase #-}
import Data.Maybe
data V = A | B | C
pv l = catMaybes $ flip map l $ \case
A -> Just 'A'
B -> Just 'B'
_ -> Nothing
main = print $ pv [A,B,C,C,A]
No, this solution does not use list comprehension, but your problem need
some form of pattern matching and as Mateusz said, inlining it inside the
function would be ugly. Since all the real work of your problem is in the
case with the Maybe and the _ I think list comprehension can't offer much.
I think its interesting how the case is doing the job of the earlier
discussed filter AND the mapping to a char. And as a bonus it support
adding D, E, F ... to the V data without much trouble.
2014-11-09 22:47 GMT-05:00 Donn Cave
quoth Mateusz Kowalczyk
[... re someone else's example ] {-# 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.
Indeed, I'd rigged up something with Maybe for this, like
pv a = [t | Just t <- pvc a] where pvc A = Just 'A' pvc B = Just 'B' _ = Nothing
... when it occurred to me that I might be wasting the power of the list comprehensions that I so rarely use. Guess not! Thanks,
Donn _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Viva Cila