Commit ab51bee4 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺 Committed by Ben Gamari

base: Remove `Monad(fail)` method and reexport `MonadFail(fail)` instead

As per https://prime.haskell.org/wiki/Libraries/Proposals/MonadFailCoauthored-by: Ben Gamari's avatarBen Gamari <ben@well-typed.com>
parent cd07086a
......@@ -87,7 +87,6 @@ Library
GHC-Options: -Wall
-Wno-name-shadowing
-Wnoncanonical-monad-instances
-Wnoncanonical-monadfail-instances
-Wnoncanonical-monoid-instances
if flag(ghci)
......
......@@ -823,7 +823,7 @@ data WarningFlag =
| Opt_WarnDeferredTypeErrors
| Opt_WarnDeferredOutOfScopeVariables
| Opt_WarnNonCanonicalMonadInstances -- since 8.0
| Opt_WarnNonCanonicalMonadFailInstances -- since 8.0
| Opt_WarnNonCanonicalMonadFailInstances -- since 8.0, removed 8.8
| Opt_WarnNonCanonicalMonoidInstances -- since 8.0
| Opt_WarnMissingPatternSynonymSignatures -- since 8.0
| Opt_WarnUnrecognisedWarningFlags -- since 8.0
......@@ -2245,7 +2245,6 @@ languageExtensions (Just Haskell98)
= [LangExt.ImplicitPrelude,
-- See Note [When is StarIsType enabled]
LangExt.StarIsType,
LangExt.MonadFailDesugaring,
LangExt.MonomorphismRestriction,
LangExt.NPlusKPatterns,
LangExt.DatatypeContexts,
......@@ -2262,7 +2261,6 @@ languageExtensions (Just Haskell2010)
= [LangExt.ImplicitPrelude,
-- See Note [When is StarIsType enabled]
LangExt.StarIsType,
LangExt.MonadFailDesugaring,
LangExt.MonomorphismRestriction,
LangExt.DatatypeContexts,
LangExt.TraditionalRecordSyntax,
......@@ -4007,8 +4005,9 @@ wWarningFlagsDeps = [
flagSpec "name-shadowing" Opt_WarnNameShadowing,
flagSpec "noncanonical-monad-instances"
Opt_WarnNonCanonicalMonadInstances,
flagSpec "noncanonical-monadfail-instances"
Opt_WarnNonCanonicalMonadFailInstances,
depFlagSpec "noncanonical-monadfail-instances"
Opt_WarnNonCanonicalMonadInstances
"fail is no longer a method of Monad",
flagSpec "noncanonical-monoid-instances"
Opt_WarnNonCanonicalMonoidInstances,
flagSpec "orphans" Opt_WarnOrphans,
......@@ -4392,7 +4391,8 @@ xFlagsDeps = [
flagSpec "LiberalTypeSynonyms" LangExt.LiberalTypeSynonyms,
flagSpec "MagicHash" LangExt.MagicHash,
flagSpec "MonadComprehensions" LangExt.MonadComprehensions,
flagSpec "MonadFailDesugaring" LangExt.MonadFailDesugaring,
depFlagSpec "MonadFailDesugaring" LangExt.MonadFailDesugaring
"MonadFailDesugaring is now the default behavior",
flagSpec "MonoLocalBinds" LangExt.MonoLocalBinds,
depFlagSpecCond "MonoPatBinds" LangExt.MonoPatBinds
id
......
......@@ -314,7 +314,7 @@ basicKnownKeyNames
returnMName, joinMName,
-- MonadFail
monadFailClassName, failMName, failMName_preMFP,
monadFailClassName, failMName,
-- MonadFix
monadFixClassName, mfixName,
......@@ -669,13 +669,12 @@ map_RDR, append_RDR :: RdrName
map_RDR = nameRdrName mapName
append_RDR = nameRdrName appendName
foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR_preMFP,
failM_RDR :: RdrName
foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR
:: RdrName
foldr_RDR = nameRdrName foldrName
build_RDR = nameRdrName buildName
returnM_RDR = nameRdrName returnMName
bindM_RDR = nameRdrName bindMName
failM_RDR_preMFP = nameRdrName failMName_preMFP
failM_RDR = nameRdrName failMName
left_RDR, right_RDR :: RdrName
......@@ -1018,12 +1017,11 @@ functorClassName = clsQual gHC_BASE (fsLit "Functor") functorClassKey
fmapName = varQual gHC_BASE (fsLit "fmap") fmapClassOpKey
-- Class Monad
monadClassName, thenMName, bindMName, returnMName, failMName_preMFP :: Name
monadClassName, thenMName, bindMName, returnMName :: Name
monadClassName = clsQual gHC_BASE (fsLit "Monad") monadClassKey
thenMName = varQual gHC_BASE (fsLit ">>") thenMClassOpKey
bindMName = varQual gHC_BASE (fsLit ">>=") bindMClassOpKey
returnMName = varQual gHC_BASE (fsLit "return") returnMClassOpKey
failMName_preMFP = varQual gHC_BASE (fsLit "fail") failMClassOpKey_preMFP
-- Class MonadFail
monadFailClassName, failMName :: Name
......@@ -2253,8 +2251,7 @@ unboundKey = mkPreludeMiscIdUnique 158
fromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey,
enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey,
enumFromThenToClassOpKey, eqClassOpKey, geClassOpKey, negateClassOpKey,
failMClassOpKey_preMFP, bindMClassOpKey, thenMClassOpKey, returnMClassOpKey,
fmapClassOpKey
bindMClassOpKey, thenMClassOpKey, returnMClassOpKey, fmapClassOpKey
:: Unique
fromIntegerClassOpKey = mkPreludeMiscIdUnique 160
minusClassOpKey = mkPreludeMiscIdUnique 161
......@@ -2266,7 +2263,6 @@ enumFromThenToClassOpKey = mkPreludeMiscIdUnique 166
eqClassOpKey = mkPreludeMiscIdUnique 167
geClassOpKey = mkPreludeMiscIdUnique 168
negateClassOpKey = mkPreludeMiscIdUnique 169
failMClassOpKey_preMFP = mkPreludeMiscIdUnique 170
bindMClassOpKey = mkPreludeMiscIdUnique 171 -- (>>=)
thenMClassOpKey = mkPreludeMiscIdUnique 172 -- (>>)
fmapClassOpKey = mkPreludeMiscIdUnique 173
......
......@@ -2100,11 +2100,6 @@ badIpBinds what binds
---------
lookupSyntaxMonadFailOpName :: Bool -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxMonadFailOpName monadFailEnabled
| monadFailEnabled = lookupSyntaxName failMName
| otherwise = lookupSyntaxName failMName_preMFP
monadFailOp :: LPat GhcPs
-> HsStmtContext Name
-> RnM (SyntaxExpr GhcRn, FreeVars)
......@@ -2146,14 +2141,14 @@ So, in this case, we synthesize the function
-}
getMonadFailOp :: RnM (SyntaxExpr GhcRn, FreeVars) -- Syntax expr fail op
getMonadFailOp
= do { xMonadFailEnabled <- fmap (xopt LangExt.MonadFailDesugaring) getDynFlags
; xOverloadedStrings <- fmap (xopt LangExt.OverloadedStrings) getDynFlags
= do { xOverloadedStrings <- fmap (xopt LangExt.OverloadedStrings) getDynFlags
; xRebindableSyntax <- fmap (xopt LangExt.RebindableSyntax) getDynFlags
; reallyGetMonadFailOp xRebindableSyntax xOverloadedStrings xMonadFailEnabled }
; reallyGetMonadFailOp xRebindableSyntax xOverloadedStrings
}
where
reallyGetMonadFailOp rebindableSyntax overloadedStrings monadFailEnabled
reallyGetMonadFailOp rebindableSyntax overloadedStrings
| rebindableSyntax && overloadedStrings = do
(failExpr, failFvs) <- lookupSyntaxMonadFailOpName monadFailEnabled
(failExpr, failFvs) <- lookupSyntaxName failMName
(fromStringExpr, fromStringFvs) <- lookupSyntaxName fromStringName
let arg_lit = fsLit "arg"
arg_name = mkSystemVarName (mkVarOccUnique arg_lit) arg_lit
......@@ -2167,4 +2162,4 @@ getMonadFailOp
let failAfterFromStringSynExpr :: SyntaxExpr GhcRn =
mkSyntaxExpr failAfterFromStringExpr
return (failAfterFromStringSynExpr, failFvs `plusFV` fromStringFvs)
| otherwise = lookupSyntaxMonadFailOpName monadFailEnabled
| otherwise = lookupSyntaxName failMName
......@@ -43,7 +43,6 @@ import Module
import HscTypes ( Warnings(..), plusWarns )
import PrelNames ( applicativeClassName, pureAName, thenAName
, monadClassName, returnMName, thenMName
, monadFailClassName, failMName, failMName_preMFP
, semigroupClassName, sappendName
, monoidClassName, mappendName
)
......@@ -457,9 +456,6 @@ checkCanonicalInstances cls poly_ty mbinds = do
whenWOptM Opt_WarnNonCanonicalMonadInstances
checkCanonicalMonadInstances
whenWOptM Opt_WarnNonCanonicalMonadFailInstances
checkCanonicalMonadFailInstances
whenWOptM Opt_WarnNonCanonicalMonoidInstances
checkCanonicalMonoidInstances
......@@ -510,45 +506,6 @@ checkCanonicalInstances cls poly_ty mbinds = do
| otherwise = return ()
-- | Warn about unsound/non-canonical 'Monad'/'MonadFail' instance
-- declarations. Specifically, the following conditions are verified:
--
-- In 'Monad' instances declarations:
--
-- * If 'fail' is overridden it must be canonical
-- (i.e. @fail = Control.Monad.Fail.fail@)
--
-- In 'MonadFail' instance declarations:
--
-- * Warn if 'fail' is defined backwards
-- (i.e. @fail = Control.Monad.fail@).
--
checkCanonicalMonadFailInstances
| cls == monadFailClassName = do
forM_ (bagToList mbinds) $ \(dL->L loc mbind) -> setSrcSpan loc $ do
case mbind of
FunBind { fun_id = (dL->L _ name)
, fun_matches = mg }
| name == failMName, isAliasMG mg == Just failMName_preMFP
-> addWarnNonCanonicalMethod1
Opt_WarnNonCanonicalMonadFailInstances "fail"
"Control.Monad.fail"
_ -> return ()
| cls == monadClassName = do
forM_ (bagToList mbinds) $ \(dL->L loc mbind) -> setSrcSpan loc $ do
case mbind of
FunBind { fun_id = (dL->L _ name)
, fun_matches = mg }
| name == failMName_preMFP, isAliasMG mg /= Just failMName
-> addWarnNonCanonicalMethod2
Opt_WarnNonCanonicalMonadFailInstances "fail"
"Control.Monad.Fail.fail"
_ -> return ()
| otherwise = return ()
-- | Check whether Monoid(mappend) is defined in terms of
-- Semigroup((<>)) (and not the other way round). Specifically,
-- the following conditions are verified:
......
......@@ -943,18 +943,18 @@ shortOutIndirections binds
makeIndEnv :: [CoreBind] -> IndEnv
makeIndEnv binds
= foldr add_bind emptyVarEnv binds
= foldl' add_bind emptyVarEnv binds
where
add_bind :: CoreBind -> IndEnv -> IndEnv
add_bind (NonRec exported_id rhs) env = add_pair (exported_id, rhs) env
add_bind (Rec pairs) env = foldr add_pair env pairs
add_bind :: IndEnv -> CoreBind -> IndEnv
add_bind env (NonRec exported_id rhs) = add_pair env (exported_id, rhs)
add_bind env (Rec pairs) = foldl' add_pair env pairs
add_pair :: (Id,CoreExpr) -> IndEnv -> IndEnv
add_pair (exported_id, exported) env
add_pair :: IndEnv -> (Id,CoreExpr) -> IndEnv
add_pair env (exported_id, exported)
| (ticks, Var local_id) <- stripTicksTop tickishFloatable exported
, shortMeOut env exported_id local_id
= extendVarEnv env local_id (exported_id, ticks)
add_pair _ env = env
add_pair env _ = env
-----------------
shortMeOut :: IndEnv -> Id -> Id -> Bool
......
......@@ -42,9 +42,6 @@ import TcEvidence
import Outputable
import Util
import SrcLoc
import DynFlags
import PrelNames (monadFailClassName)
import qualified GHC.LanguageExtensions as LangExt
-- Create chunkified tuple tybes for monad comprehensions
import MkCore
......@@ -940,43 +937,8 @@ tcMonadFailOp orig pat fail_op res_ty
= return noSyntaxExpr
| otherwise
= do { -- Issue MonadFail warnings
rebindableSyntax <- xoptM LangExt.RebindableSyntax
; desugarFlag <- xoptM LangExt.MonadFailDesugaring
; missingWarning <- woptM Opt_WarnMissingMonadFailInstances
; if | rebindableSyntax && desugarFlag && missingWarning
-> warnRebindableClash pat
| not desugarFlag && missingWarning
-> emitMonadFailConstraint pat res_ty
| otherwise
-> return ()
-- Get the fail op itself
; snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy]
(mkCheckExpType res_ty) $ \_ -> return ()) }
emitMonadFailConstraint :: LPat GhcTcId -> TcType -> TcRn ()
emitMonadFailConstraint pat res_ty
= do { -- We expect res_ty to be of form (monad_ty arg_ty)
(_co, (monad_ty, _arg_ty)) <- matchExpectedAppTy res_ty
-- Emit (MonadFail m), but ignore the evidence; it's
-- just there to generate a warning
; monadFailClass <- tcLookupClass monadFailClassName
; _ <- emitWanted (FailablePattern pat)
(mkClassPred monadFailClass [monad_ty])
; return () }
warnRebindableClash :: LPat GhcTcId -> TcRn ()
warnRebindableClash pattern = addWarnAt
(Reason Opt_WarnMissingMonadFailInstances)
(getLoc pattern)
(text "The failable pattern" <+> quotes (ppr pattern)
$$
nest 2 (text "is used together with -XRebindableSyntax."
<+> text "If this is intentional,"
$$
text "compile with -Wno-missing-monadfail-instances."))
= snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy]
(mkCheckExpType res_ty) $ \_ -> return ())
{-
Note [Treat rebindable syntax first]
......
......@@ -51,7 +51,6 @@ Executable ghc
GHC-Options: -Wall
-Wnoncanonical-monad-instances
-Wnoncanonical-monadfail-instances
-Wnoncanonical-monoid-instances
if flag(ghci)
......
......@@ -19,7 +19,8 @@ module Control.Monad
-- * Functor and monad classes
Functor(fmap)
, Monad((>>=), (>>), return, fail)
, Monad((>>=), (>>), return)
, MonadFail(fail)
, MonadPlus(mzero, mplus)
-- * Functions
......@@ -75,6 +76,7 @@ module Control.Monad
, (<$!>)
) where
import Control.Monad.Fail ( MonadFail(fail) )
import Data.Foldable ( Foldable, sequence_, sequenceA_, msum, mapM_, foldlM, forM_ )
import Data.Functor ( void, (<$>) )
import Data.Traversable ( forM, mapM, traverse, sequence, sequenceA )
......
......@@ -180,9 +180,6 @@ instance Applicative (ST s) where
-- | @since 2.01
instance Monad (ST s) where
fail s = errorWithoutStackTrace s
(>>) = (*>)
m >>= k = ST $ \ s ->
......
......@@ -664,17 +664,6 @@ class Applicative m => Monad m where
return :: a -> m a
return = pure
-- | Fail with a message. This operation is not part of the
-- mathematical definition of a monad, but is invoked on pattern-match
-- failure in a @do@ expression.
--
-- As part of the MonadFail proposal (MFP), this function is moved
-- to its own class 'Control.Monad.MonadFail' (see "Control.Monad.Fail" for
-- more details). The definition here will be removed in a future
-- release.
fail :: String -> m a
fail s = errorWithoutStackTrace s
{- Note [Recursive bindings for Applicative/Monad]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -855,8 +844,6 @@ instance Monad Maybe where
(>>) = (*>)
fail _ = Nothing
-- -----------------------------------------------------------------------------
-- The Alternative class definition
......@@ -984,8 +971,6 @@ instance Monad [] where
xs >>= f = [y | x <- xs, y <- f x]
{-# INLINE (>>) #-}
(>>) = (*>)
{-# INLINE fail #-}
fail _ = []
-- | @since 2.01
instance Alternative [] where
......@@ -1365,7 +1350,6 @@ instance Monad IO where
{-# INLINE (>>=) #-}
(>>) = (*>)
(>>=) = bindIO
fail s = failIO s
-- | @since 4.9.0.0
instance Alternative IO where
......
......@@ -367,7 +367,7 @@ to avoid contention with other processes in the machine.
-}
setNumCapabilities :: Int -> IO ()
setNumCapabilities i
| i <= 0 = fail $ "setNumCapabilities: Capability count ("++show i++") must be positive"
| i <= 0 = failIO $ "setNumCapabilities: Capability count ("++show i++") must be positive"
| otherwise = c_setNumCapabilities (fromIntegral i)
foreign import ccall safe "setNumCapabilities"
......
......@@ -241,7 +241,7 @@ safeExit = exitHelper useSafeExit
fastExit = exitHelper useFastExit
unreachable :: IO a
unreachable = fail "If you can read this, shutdownHaskellAndExit did not exit."
unreachable = failIO "If you can read this, shutdownHaskellAndExit did not exit."
exitHelper :: CInt -> Int -> IO a
#if defined(mingw32_HOST_OS)
......
......@@ -73,7 +73,8 @@ module Prelude (
-- ** Monads and functors
Functor(fmap, (<$)), (<$>),
Applicative(pure, (<*>), (*>), (<*)),
Monad((>>=), (>>), return, fail),
Monad((>>=), (>>), return),
MonadFail(fail),
mapM_, sequence_, (=<<),
-- ** Folds and traversals
......
......@@ -236,7 +236,7 @@ import System.Posix.Types
import GHC.Base
import GHC.List
#ifndef mingw32_HOST_OS
#if !defined(mingw32_HOST_OS)
import GHC.IORef
#endif
import GHC.Num
......@@ -485,7 +485,7 @@ openTempFile' :: String -> FilePath -> String -> Bool -> CMode
-> IO (FilePath, Handle)
openTempFile' loc tmp_dir template binary mode
| pathSeparator template
= fail $ "openTempFile': Template string must not contain path separator characters: "++template
= failIO $ "openTempFile': Template string must not contain path separator characters: "++template
| otherwise = findTempName
where
-- We split off the last extension, so we can use .foo.ext files
......
......@@ -120,8 +120,6 @@ instance Monad P where
(Result x p) >>= k = k x <|> (p >>= k)
(Final (r:|rs)) >>= k = final [ys' | (x,s) <- (r:rs), ys' <- run (k x) s]
fail _ = Fail
-- | @since 4.9.0.0
instance MonadFail P where
fail _ = Fail
......@@ -177,7 +175,6 @@ instance Applicative ReadP where
-- | @since 2.01
instance Monad ReadP where
fail _ = R (\_ -> Fail)
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
-- | @since 4.9.0.0
......
......@@ -85,7 +85,6 @@ instance Applicative ReadPrec where
-- | @since 2.01
instance Monad ReadPrec where
fail s = P (\_ -> fail s)
P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n)
-- | @since 4.9.0.0
......
cabal-version: 2.1
cabal-version: 2.2
name: base
version: 4.12.0.0
version: 4.13.0.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD-3-Clause
......
Subproject commit 75f898badf40cddba7b3bcf149648e49095a52f9
Subproject commit 7673420558e2a54affe530911d555cc78577ad87
......@@ -42,5 +42,5 @@ TYPE SIGNATURES
(Monad m, Num (m a)) =>
(m a -> m (m a)) -> p -> m a
Dependent modules: []
Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
Dependent packages: [base-4.13.0.0, ghc-prim-0.5.3,
integer-gmp-1.0.2.0]
......@@ -18,19 +18,19 @@ cabal-version: >=2
library library-a
signatures: A.Sig
exposed-modules: B
build-depends: base >=4.12 && <4.13
build-depends: base == 4.13.*
hs-source-dirs: library-a
default-language: Haskell2010
library library-a-impl
exposed-modules: A
build-depends: base >=4.12 && <4.13
build-depends: base == 4.13.*
hs-source-dirs: library-a-impl
default-language: Haskell2010
library library-b
exposed-modules: C
build-depends: base >=4.12 && <4.13
build-depends: base == 4.13.*
, library-a
hs-source-dirs: library-b
default-language: Haskell2010
......@@ -40,7 +40,7 @@ library
mixins: library-a requires (A.Sig as A)
, library-b requires (A.Sig as A)
reexported-modules: A, B, C
build-depends: base >=4.12 && <4.13
build-depends: base == 4.13.*
, library-a
, library-a-impl
, library-b
......
......@@ -2,7 +2,7 @@
[1 of 1] Compiling Int[sig] ( p/Int.hsig, nothing )
[2 of 2] Processing q
Instantiating q
[1 of 1] Including p[Int=base-4.12.0.0:GHC.Exts]
Instantiating p[Int=base-4.12.0.0:GHC.Exts]
[1 of 1] Including p[Int=base-4.13.0.0:GHC.Exts]
Instantiating p[Int=base-4.13.0.0:GHC.Exts]
[1 of 1] Including ghc-prim-0.5.3
[1 of 1] Compiling Int[sig] ( p/Int.hsig, bkp16.out/p/p-97PZnzqiJmd2hTwUNGdjod/Int.o )
......@@ -2,8 +2,8 @@
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing )
[2 of 2] Processing q
Instantiating q
[1 of 1] Including p[ShouldFail=base-4.12.0.0:Data.Bool]
Instantiating p[ShouldFail=base-4.12.0.0:Data.Bool]
[1 of 1] Including p[ShouldFail=base-4.13.0.0:Data.Bool]
Instantiating p[ShouldFail=base-4.13.0.0:Data.Bool]
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/ShouldFail.o )
bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error:
......
......@@ -2,8 +2,8 @@
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing )
[2 of 2] Processing q
Instantiating q
[1 of 1] Including p[ShouldFail=base-4.12.0.0:Prelude]
Instantiating p[ShouldFail=base-4.12.0.0:Prelude]
[1 of 1] Including p[ShouldFail=base-4.13.0.0:Prelude]
Instantiating p[ShouldFail=base-4.13.0.0:Prelude]
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail17.out/p/p-2W6J7O3LvroH97zGxbPEGF/ShouldFail.o )
<no location info>: error:
......
......@@ -2,8 +2,8 @@
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing )
[2 of 2] Processing q
Instantiating q
[1 of 1] Including p[ShouldFail=base-4.12.0.0:Data.STRef]
Instantiating p[ShouldFail=base-4.12.0.0:Data.STRef]
[1 of 1] Including p[ShouldFail=base-4.13.0.0:Data.STRef]
Instantiating p[ShouldFail=base-4.13.0.0:Data.STRef]
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail19.out/p/p-CfyUIAu1JTRCDuXEyGszXN/ShouldFail.o )
<no location info>: error:
......
......@@ -2,13 +2,11 @@
-- is reflected by calling the monadic 'fail', not by a
-- runtime exception
{-# LANGUAGE NoMonadFailDesugaring #-}
{-# OPTIONS -Wno-missing-monadfail-instances #-}
import Control.Monad
import Control.Monad.Fail
import Data.Maybe
test :: (MonadPlus m) => [a] -> m Bool
test :: (MonadPlus m, MonadFail m) => [a] -> m Bool
test xs
= do
(_:_) <- return xs
......
......@@ -11,5 +11,5 @@ COERCION AXIOMS
FAMILY INSTANCES
type instance F Int = Bool -- Defined at T14729.hs:10:15
Dependent modules: []
Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
Dependent packages: [base-4.13.0.0, ghc-prim-0.5.3,
integer-gmp-1.0.2.0]
......@@ -3,5 +3,5 @@ TYPE CONSTRUCTORS
forall {k1} k2 (k3 :: k2). Proxy k3 -> k1 -> k2 -> *
roles nominal nominal nominal phantom phantom phantom
Dependent modules: []
Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
Dependent packages: [base-4.13.0.0, ghc-prim-0.5.3,
integer-gmp-1.0.2.0]
......@@ -52,5 +52,5 @@ DATA CONSTRUCTORS
(d :: Proxy k5) (e :: Proxy k7).
f c -> T k8 a b f c d e
Dependent modules: []
Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
Dependent packages: [base-4.13.0.0, ghc-prim-0.5.3,
integer-gmp-1.0.2.0]
......@@ -20,7 +20,7 @@
-- | Module "Trampoline" defines the pipe computations and their basic building blocks.
{-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses,
TypeFamilies, KindSignatures, FlexibleContexts, NoMonadFailDesugaring,
TypeFamilies, KindSignatures, FlexibleContexts,
FlexibleInstances, OverlappingInstances, UndecidableInstances
#-}
......@@ -81,6 +81,9 @@ instance Monad Identity where
return a = Identity a
m >>= k = k (runIdentity m)
instance MonadFail Identity where
fail = error "Identity(fail)"
newtype Trampoline m s r = Trampoline {bounce :: m (TrampolineState m s r)}
data TrampolineState m s r = Done r | Suspend! (s (Trampoline m s r))
......@@ -97,6 +100,9 @@ instance (Monad m, Functor s) => Monad (Trampoline m s) where
where apply f (Done x) = bounce (f x)
apply f (Suspend s) = return (Suspend (fmap (>>= f) s))
instance (MonadFail m, Functor s) => MonadFail (Trampoline m s) where
fail = error "Trampoline(fail)"
data Yield x y = Yield! x y
instance Functor (Yield x) where
fmap f (Yield x y) = trace "fmap yield" $ Yield x (f y)
......
......@@ -5,7 +5,7 @@ TYPE SIGNATURES
(Applicative f, Num t, Num b) =>
(t -> f b) -> f b
Dependent modules: []
Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
Dependent packages: [base-4.13.0.0, ghc-prim-0.5.3,
integer-gmp-1.0.2.0]
[1 of 1] Compiling A ( A.hs, A.o )
TYPE SIGNATURES
......@@ -14,5 +14,5 @@ TYPE SIGNATURES
(Applicative f, Num t, Num b) =>
(t -> f b) -> f b
Dependent modules: []
Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
Dependent packages: [base-4.13.0.0, ghc-prim-0.5.3,
integer-gmp-1.0.2.0]
{"span": null,"doc": "TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.12.0.0, ghc-prim-0.5.3,\n integer-gmp-1.0.2.0]","severity": "SevOutput","reason": null}
{"span": null,"doc": "TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.13.0.0, ghc-prim-0.5.3,\n integer-gmp-1.0.2.0]","severity": "SevOutput","reason": null}
......@@ -39,6 +39,7 @@ instance Semigroup a => Semigroup (Maybe a)
-- Defined in ‘GHC.Base’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
instance MonadFail Maybe -- Defined in ‘Control.Monad.Fail’
instance Foldable Maybe -- Defined in ‘Data.Foldable’
instance Traversable Maybe -- Defined in ‘Data.Traversable’
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:15
......
......@@ -35,5 +35,5 @@ class (RealFrac a, Floating a) => RealFloat a where
-- Defined in ‘GHC.Float’
instance RealFloat Float -- Defined in ‘GHC.Float’
instance RealFloat Double -- Defined in ‘GHC.Float’
base-4.12.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool
-- Defined in ‘base-4.12.0.0:Data.OldList’
base-4.13.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool
-- Defined in ‘base-4.13.0.0:Data.OldList’
......@@ -8,6 +8,7 @@ instance Ord a => Ord [a] -- Defined in ‘GHC.Classes’
instance Semigroup [a] -- Defined in ‘GHC.Base’
instance Show a => Show [a] -- Defined in ‘GHC.Show’
instance Read a => Read [a] -- Defined in ‘GHC.Read’
instance MonadFail [] -- Defined in ‘Control.Monad.Fail’
instance Foldable [] -- Defined in ‘Data.Foldable’