Removing MonadFail from Monad
adam vogt
vogt.adam at gmail.com
Tue Dec 17 00:50:33 UTC 2013
On Mon, Dec 16, 2013 at 5:26 PM, David Luposchainsky
<dluposchainsky at googlemail.com> wrote:
> Desugaring is then changed to the following:
>
> ```haskell
> -- Explicitly irrefutable pattern: do not add MonadFail constraint
> do ~pat <- computation >>> let f pat = more
> more >>> in computation >>= f
>
> -- Only one data constructor: do not add MonadFail constraint
> do (Only x) <- computation >>> let f (Only x) = more
> more >>> in computation >>= f
>
> -- Otherwise: add MonadFail constraint
> do pat <- computation >>> let f pat = more
> more >>> f _ = fail "..."
> >>> in computation >>= f
> ```
Hello David,
GHC can already do this for you. Only `f' below has no MonadFail in
the inferred type:
{-# LANGUAGE RebindableSyntax #-}
import Prelude hiding (fail)
class MonadFail m where fail :: String -> m a
f x = do x <- x; x
g x = do Just y <- return Nothing; x
h x = do (a, Just b) <- x; a
A specification for "pattern can fail given input that is fully
defined" outside of ghc might be
<http://hackage.haskell.org/package/applicative-quoters-0.1.0.8/docs/src/Control-Applicative-QQ-ADo.html#failingPattern>.
Otherwise I suppose section "3.17.2" of the 2010 report covers this
case.
Regards,
Adam
More information about the Libraries
mailing list