[Haskell-cafe] Why were unfailable patterns removed and "fail" added to Monad?
Dan Doel
dan.doel at gmail.com
Fri Jan 20 08:14:10 CET 2012
On Thu, Jan 19, 2012 at 11:11 PM, Dan Doel <dan.doel at gmail.com> wrote:
> No, this is not correct. Unfailable patterns were specified in Haskell
> 1.4 (or, they were called "failure-free" there; they likely existed
> earlier, too, but I'll leave the research to people who are
> interested). They were "new" in the sense that they were introduced
> only for the purposes of desugaring do/comprehensions, whereas
> refutable vs. irrefutable patterns need to be talked about for other
> purposes.
I should also note: GHC already implements certain unfailable patterns
the 1.4 way when using RebindableSyntax (possibly by accident):
{-# LANGUAGE RebindableSyntax, MonadComprehensions #-}
module Test where
import qualified Prelude
import Prelude (String, Maybe(..))
import Control.Applicative
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
return :: Applicative f => a -> f a
return = pure
class Monad m => MonadZero m where
mzero :: m a
fail :: String -> m a
mzero = fail "mzero"
fail _ = mzero
foo :: MonadZero m => m (Maybe a) -> m a
foo m = do Just x <- m
pure x
bar :: Monad m => m (a, b) -> m a
bar m = do (x, y) <- m
pure x
baz :: MonadZero m => m (Maybe a) -> m a
baz m = [ x | Just x <- m ]
quux :: Monad m => m (a, b) -> m a
quux m = [ x | (x, y) <- m ]
It doesn't work for types defined with data, but it works for built-in tuples.
More information about the Haskell-Cafe
mailing list