[Git][ghc/ghc][wip/structured-ghci-errors] WIP
Jade (@Jade)
gitlab at gitlab.haskell.org
Thu Aug 1 14:03:06 UTC 2024
Jade pushed to branch wip/structured-ghci-errors at Glasgow Haskell Compiler / GHC
Commits:
c914af12 by Jade at 2024-08-01T16:02:31+02:00
WIP
- - - - -
20 changed files:
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Ppr.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/Error/Codes.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Info.hs
- ghc/GHCi/UI/Monad.hs
- + ghc/GHCi/UI/Print.hs
- ghc/ghc-bin.cabal.in
- testsuite/tests/ghci/scripts/T10508.stderr
Changes:
=====================================
compiler/GHC/Driver/Errors.hs
=====================================
@@ -13,7 +13,7 @@ import GHC.Utils.Error
import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext )
import GHC.Utils.Logger
-printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO ()
+printMessages :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO ()
printMessages logger msg_opts opts msgs
= sequence_ [ let style = mkErrStyle name_ppr_ctx
ctx = (diag_ppr_ctx opts) { sdocStyle = style }
@@ -28,7 +28,7 @@ printMessages logger msg_opts opts msgs
errMsgContext = name_ppr_ctx }
<- sortMsgBag (Just opts) (getMessages msgs) ]
where
- messageWithHints :: Diagnostic a => a -> SDoc
+ messageWithHints :: a -> SDoc
messageWithHints e =
let main_msg = formatBulleted $ diagnosticMessage msg_opts e
in case diagnosticHints e of
=====================================
compiler/GHC/Driver/Errors/Ppr.hs
=====================================
@@ -62,7 +62,7 @@ instance Diagnostic GhcMessage where
-> diagnosticMessage (dsMessageOpts opts) m
GhcDriverMessage m
-> diagnosticMessage (driverMessageOpts opts) m
- GhcUnknownMessage (UnknownDiagnostic f m)
+ GhcUnknownMessage (UnknownDiagnostic f _ m)
-> diagnosticMessage (f opts) m
diagnosticReason = \case
@@ -97,7 +97,7 @@ instance HasDefaultDiagnosticOpts DriverMessageOpts where
instance Diagnostic DriverMessage where
type DiagnosticOpts DriverMessage = DriverMessageOpts
diagnosticMessage opts = \case
- DriverUnknownMessage (UnknownDiagnostic f m)
+ DriverUnknownMessage (UnknownDiagnostic f _ m)
-> diagnosticMessage (f opts) m
DriverPsHeaderMessage m
-> diagnosticMessage (psDiagnosticOpts opts) m
=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -94,7 +94,7 @@ data GhcMessage where
-- 'Diagnostic' constraint ensures that worst case scenario we can still
-- render this into something which can be eventually converted into a
-- 'DecoratedSDoc'.
- GhcUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts GhcMessage)) -> GhcMessage
+ GhcUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts GhcMessage) GhcHint) -> GhcMessage
deriving Generic
@@ -111,7 +111,7 @@ data GhcMessageOpts = GhcMessageOpts { psMessageOpts :: DiagnosticOpts PsMessage
-- conversion can happen gradually. This function should not be needed within
-- GHC, as it would typically be used by plugin or library authors (see
-- comment for the 'GhcUnknownMessage' type constructor)
-ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) => a -> GhcMessage
+ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ GhcHint, Diagnostic a, Typeable a) => a -> GhcMessage
ghcUnknownMessage = GhcUnknownMessage . mkSimpleUnknownDiagnostic
-- | Abstracts away the frequent pattern where we are calling 'ioMsgMaybe' on
@@ -130,7 +130,7 @@ type DriverMessages = Messages DriverMessage
-- | A message from the driver.
data DriverMessage where
-- | Simply wraps a generic 'Diagnostic' message @a at .
- DriverUnknownMessage :: UnknownDiagnostic (DiagnosticOpts DriverMessage) -> DriverMessage
+ DriverUnknownMessage :: UnknownDiagnostic (DiagnosticOpts DriverMessage) GhcHint -> DriverMessage
-- | A parse error in parsing a Haskell file header during dependency
-- analysis
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -484,7 +484,7 @@ mkBatchMsg hsc_env =
then batchMultiMsg
else batchMsg
-type AnyGhcDiagnostic = UnknownDiagnostic (DiagnosticOpts GhcMessage)
+type AnyGhcDiagnostic = UnknownDiagnostic (DiagnosticOpts GhcMessage) GhcHint
loadWithCache :: GhcMonad m => Maybe ModIfaceCache -- ^ Instructions about how to cache interfaces as we create them.
-> (GhcMessage -> AnyGhcDiagnostic) -- ^ How to wrap error messages before they are displayed to a user.
=====================================
compiler/GHC/Driver/Ppr.hs
=====================================
@@ -6,6 +6,7 @@ module GHC.Driver.Ppr
, showPpr
, showPprUnsafe
, printForUser
+ , printForUserColoured
)
where
@@ -34,6 +35,13 @@ showSDocForUser dflags unit_state name_ppr_ctx doc = renderWithContext (initSDoc
doc' = pprWithUnitState unit_state doc
printForUser :: DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
-printForUser dflags handle name_ppr_ctx depth doc
+printForUser = printForUser' False
+
+printForUserColoured :: DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
+printForUserColoured = printForUser' True
+
+printForUser' :: Bool -> DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
+printForUser' colour dflags handle name_ppr_ctx depth doc
= printSDocLn ctx (PageMode False) handle doc
- where ctx = initSDocContext dflags (mkUserStyle name_ppr_ctx depth)
+ where ctx = initSDocContext dflags (setStyleColoured colour $ mkUserStyle name_ppr_ctx depth)
+
=====================================
compiler/GHC/HsToCore/Errors/Ppr.hs
=====================================
@@ -27,7 +27,7 @@ import GHC.HsToCore.Pmc.Ppr
instance Diagnostic DsMessage where
type DiagnosticOpts DsMessage = NoDiagnosticOpts
diagnosticMessage opts = \case
- DsUnknownMessage (UnknownDiagnostic f m)
+ DsUnknownMessage (UnknownDiagnostic f _ m)
-> diagnosticMessage (f opts) m
DsEmptyEnumeration
-> mkSimpleDecorated $ text "Enumeration is empty"
=====================================
compiler/GHC/HsToCore/Errors/Types.hs
=====================================
@@ -31,7 +31,7 @@ type MaxPmCheckModels = Int
-- | Diagnostics messages emitted during desugaring.
data DsMessage
-- | Simply wraps a generic 'Diagnostic' message.
- = DsUnknownMessage (UnknownDiagnostic (DiagnosticOpts DsMessage))
+ = DsUnknownMessage (UnknownDiagnostic (DiagnosticOpts DsMessage) GhcHint)
{-| DsEmptyEnumeration is a warning (controlled by the -Wempty-enumerations flag) that is
emitted if an enumeration is empty.
=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -41,7 +41,7 @@ import Data.List.NonEmpty (NonEmpty((:|)))
instance Diagnostic PsMessage where
type DiagnosticOpts PsMessage = NoDiagnosticOpts
diagnosticMessage opts = \case
- PsUnknownMessage (UnknownDiagnostic f m)
+ PsUnknownMessage (UnknownDiagnostic f _ m)
-> diagnosticMessage (f opts) m
PsHeaderMessage m
=====================================
compiler/GHC/Parser/Errors/Types.hs
=====================================
@@ -68,7 +68,7 @@ data PsMessage
arbitrary messages to be embedded. The typical use case would be GHC plugins
willing to emit custom diagnostics.
-}
- PsUnknownMessage (UnknownDiagnostic (DiagnosticOpts PsMessage))
+ PsUnknownMessage (UnknownDiagnostic (DiagnosticOpts PsMessage) GhcHint)
{-| A group of parser messages emitted in 'GHC.Parser.Header'.
See Note [Messages from GHC.Parser.Header].
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -141,7 +141,7 @@ instance HasDefaultDiagnosticOpts TcRnMessageOpts where
instance Diagnostic TcRnMessage where
type DiagnosticOpts TcRnMessage = TcRnMessageOpts
diagnosticMessage opts = \case
- TcRnUnknownMessage (UnknownDiagnostic f m)
+ TcRnUnknownMessage (UnknownDiagnostic f _ m)
-> diagnosticMessage (f opts) m
TcRnMessageWithInfo unit_state msg_with_info
-> case msg_with_info of
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -285,7 +285,7 @@ data TcRnMessageDetailed
!TcRnMessage
deriving Generic
-mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts)
+mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ GhcHint)
=> a -> TcRnMessage
mkTcRnUnknownMessage diag = TcRnUnknownMessage (mkSimpleUnknownDiagnostic diag)
-- Please don't use this function inside the GHC codebase;
@@ -299,7 +299,7 @@ data TcRnMessage where
{-| Simply wraps an unknown 'Diagnostic' message @a at . It can be used by plugins
to provide custom diagnostic messages originated during typechecking/renaming.
-}
- TcRnUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts TcRnMessage)) -> TcRnMessage
+ TcRnUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts TcRnMessage) GhcHint) -> TcRnMessage
{-| Wrap an 'IfaceMessage' to a 'TcRnMessage' for when we attempt to load interface
files during typechecking but encounter an error. -}
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -9,6 +9,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE UndecidableInstances #-}
module GHC.Types.Error
( -- * Messages
@@ -36,7 +37,6 @@ module GHC.Types.Error
, DiagnosticMessage (..)
, DiagnosticReason (WarningWithFlag, ..)
, ResolvedDiagnosticReason(..)
- , DiagnosticHint (..)
, mkPlainDiagnostic
, mkPlainError
, mkDecoratedDiagnostic
@@ -167,7 +167,7 @@ instance Diagnostic e => Outputable (Messages e) where
pprDiagnostic (errMsgDiagnostic envelope)
]
-instance Diagnostic e => ToJson (Messages e) where
+instance (Diagnostic e) => ToJson (Messages e) where
json msgs = JSArray . toList $ json <$> getMessages msgs
{- Note [Discarding Messages]
@@ -247,11 +247,16 @@ defaultDiagnosticOpts = defaultOpts @(DiagnosticOpts opts)
-- A 'Diagnostic' carries the /actual/ description of the message (which, in
-- GHC's case, it can be an error or a warning) and the /reason/ why such
-- message was generated in the first place.
-class (HasDefaultDiagnosticOpts (DiagnosticOpts a)) => Diagnostic a where
+class (Outputable (DiagnosticHint a), HasDefaultDiagnosticOpts (DiagnosticOpts a)) => Diagnostic a where
-- | Type of configuration options for the diagnostic.
type DiagnosticOpts a
+ -- | Type of hint this diagnostic can provide.
+ -- by default this is 'GhcHint'
+ type DiagnosticHint a
+ type DiagnosticHint a = GhcHint
+
-- | Extract the error message text from a 'Diagnostic'.
diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc
@@ -261,7 +266,7 @@ class (HasDefaultDiagnosticOpts (DiagnosticOpts a)) => Diagnostic a where
-- | Extract any hints a user might use to repair their
-- code to avoid this diagnostic.
- diagnosticHints :: a -> [GhcHint]
+ diagnosticHints :: a -> [DiagnosticHint a]
-- | Get the 'DiagnosticCode' associated with this 'Diagnostic'.
-- This can return 'Nothing' for at least two reasons:
@@ -278,19 +283,21 @@ class (HasDefaultDiagnosticOpts (DiagnosticOpts a)) => Diagnostic a where
diagnosticCode :: a -> Maybe DiagnosticCode
-- | An existential wrapper around an unknown diagnostic.
-data UnknownDiagnostic opts where
+data UnknownDiagnostic opts hint where
UnknownDiagnostic :: (Diagnostic a, Typeable a)
=> (opts -> DiagnosticOpts a) -- Inject the options of the outer context
-- into the options for the wrapped diagnostic.
+ -> (DiagnosticHint a -> hint)
-> a
- -> UnknownDiagnostic opts
+ -> UnknownDiagnostic opts hint
-instance HasDefaultDiagnosticOpts opts => Diagnostic (UnknownDiagnostic opts) where
- type DiagnosticOpts (UnknownDiagnostic opts) = opts
- diagnosticMessage opts (UnknownDiagnostic f diag) = diagnosticMessage (f opts) diag
- diagnosticReason (UnknownDiagnostic _ diag) = diagnosticReason diag
- diagnosticHints (UnknownDiagnostic _ diag) = diagnosticHints diag
- diagnosticCode (UnknownDiagnostic _ diag) = diagnosticCode diag
+instance (HasDefaultDiagnosticOpts opts, Outputable hint) => Diagnostic (UnknownDiagnostic opts hint) where
+ type DiagnosticOpts (UnknownDiagnostic opts _) = opts
+ type DiagnosticHint (UnknownDiagnostic _ hint) = hint
+ diagnosticMessage opts (UnknownDiagnostic f _ diag) = diagnosticMessage (f opts) diag
+ diagnosticReason (UnknownDiagnostic _ _ diag) = diagnosticReason diag
+ diagnosticHints (UnknownDiagnostic _ f diag) = map f (diagnosticHints diag)
+ diagnosticCode (UnknownDiagnostic _ _ diag) = diagnosticCode diag
-- A fallback 'DiagnosticOpts' which can be used when there are no options
-- for a particular diagnostic.
@@ -299,16 +306,18 @@ instance HasDefaultDiagnosticOpts NoDiagnosticOpts where
defaultOpts = NoDiagnosticOpts
-- | Make a "simple" unknown diagnostic which doesn't have any configuration options.
-mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) => a -> UnknownDiagnostic b
-mkSimpleUnknownDiagnostic = UnknownDiagnostic (const NoDiagnosticOpts)
+mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ GhcHint) =>
+ a -> UnknownDiagnostic b GhcHint
+mkSimpleUnknownDiagnostic = UnknownDiagnostic (const NoDiagnosticOpts) id
-- | Make an unknown diagnostic which uses the same options as the context it will be embedded into.
-mkUnknownDiagnostic :: (Typeable a, Diagnostic a) => a -> UnknownDiagnostic (DiagnosticOpts a)
-mkUnknownDiagnostic = UnknownDiagnostic id
+mkUnknownDiagnostic :: (Typeable a, Diagnostic a, DiagnosticHint a ~ GhcHint) =>
+ a -> UnknownDiagnostic (DiagnosticOpts a) GhcHint
+mkUnknownDiagnostic = UnknownDiagnostic id id
-- | Embed a more complicated diagnostic which requires a potentially different options type.
-embedUnknownDiagnostic :: (Diagnostic a, Typeable a) => (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts
-embedUnknownDiagnostic = UnknownDiagnostic
+embedUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticHint a ~ GhcHint) => (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts GhcHint
+embedUnknownDiagnostic f = UnknownDiagnostic f id
--------------------------------------------------------------------------------
@@ -317,11 +326,6 @@ pprDiagnostic e = vcat [ ppr (diagnosticReason e)
, nest 2 (vcat (unDecorated (diagnosticMessage opts e))) ]
where opts = defaultDiagnosticOpts @e
--- | A generic 'Hint' message, to be used with 'DiagnosticMessage'.
-data DiagnosticHint = DiagnosticHint !SDoc
-
-instance Outputable DiagnosticHint where
- ppr (DiagnosticHint msg) = msg
-- | A generic 'Diagnostic' message, without any further classification or
-- provenance: By looking at a 'DiagnosticMessage' we don't know neither
@@ -578,7 +582,7 @@ https://json-schema.org
schemaVersion :: String
schemaVersion = "1.0"
-- See Note [Diagnostic Message JSON Schema] before editing!
-instance Diagnostic e => ToJson (MsgEnvelope e) where
+instance (Diagnostic e) => ToJson (MsgEnvelope e) where
json m = JSObject [
("version", JSString schemaVersion),
("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -30,7 +30,7 @@ import GHC.Prelude
import GHC.Core.InstEnv ( LookupInstanceErrReason )
import GHC.Hs.Extension ( GhcRn )
import GHC.Types.Error ( DiagnosticCode(..), UnknownDiagnostic (..), NoDiagnosticOpts
- , diagnosticCode )
+ , diagnosticCode, GhcHint )
import GHC.Unit.Module.Warnings ( WarningTxt )
import GHC.Utils.Panic.Plain
@@ -1015,12 +1015,12 @@ type family ConRecursInto con where
ConRecursInto "GhcPsMessage" = 'Just PsMessage
ConRecursInto "GhcTcRnMessage" = 'Just TcRnMessage
ConRecursInto "GhcDsMessage" = 'Just DsMessage
- ConRecursInto "GhcUnknownMessage" = 'Just (UnknownDiagnostic GhcMessageOpts)
+ ConRecursInto "GhcUnknownMessage" = 'Just (UnknownDiagnostic GhcMessageOpts GhcHint)
----------------------------------
-- Constructors of DriverMessage
- ConRecursInto "DriverUnknownMessage" = 'Just (UnknownDiagnostic DriverMessageOpts)
+ ConRecursInto "DriverUnknownMessage" = 'Just (UnknownDiagnostic DriverMessageOpts GhcHint)
ConRecursInto "DriverPsHeaderMessage" = 'Just PsMessage
ConRecursInto "DriverInterfaceError" = 'Just IfaceMessage
@@ -1035,13 +1035,13 @@ type family ConRecursInto con where
----------------------------------
-- Constructors of PsMessage
- ConRecursInto "PsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts)
+ ConRecursInto "PsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts GhcHint)
ConRecursInto "PsHeaderMessage" = 'Just PsHeaderMessage
----------------------------------
-- Constructors of TcRnMessage
- ConRecursInto "TcRnUnknownMessage" = 'Just (UnknownDiagnostic TcRnMessageOpts)
+ ConRecursInto "TcRnUnknownMessage" = 'Just (UnknownDiagnostic TcRnMessageOpts GhcHint)
-- Recur into TcRnMessageWithInfo to get the underlying TcRnMessage
ConRecursInto "TcRnMessageWithInfo" = 'Just TcRnMessageDetailed
@@ -1136,7 +1136,7 @@ type family ConRecursInto con where
----------------------------------
-- Constructors of DsMessage
- ConRecursInto "DsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts)
+ ConRecursInto "DsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts GhcHint)
----------------------------------
-- Constructors of ImportLookupBad
@@ -1232,14 +1232,14 @@ class ConstructorCodes namespace con f seen recur where
-- If we recur into the 'UnknownDiagnostic' existential datatype,
-- unwrap the existential and obtain the error code.
instance {-# OVERLAPPING #-}
- ( ConRecursIntoFor namespace con ~ 'Just (UnknownDiagnostic opts)
- , HasType namespace (UnknownDiagnostic opts) con f )
- => ConstructorCode namespace con f ('Just (UnknownDiagnostic opts)) where
- gconstructorCode diag = case getType @namespace @(UnknownDiagnostic opts) @con @f diag of
- UnknownDiagnostic _ diag -> diagnosticCode diag
+ ( ConRecursIntoFor namespace con ~ 'Just (UnknownDiagnostic opts hint)
+ , HasType namespace (UnknownDiagnostic opts hint) con f )
+ => ConstructorCode namespace con f ('Just (UnknownDiagnostic opts hint)) where
+ gconstructorCode diag = case getType @namespace @(UnknownDiagnostic opts hint) @con @f diag of
+ UnknownDiagnostic _ _ diag -> diagnosticCode diag
instance {-# OVERLAPPING #-}
- ( ConRecursIntoFor namespace con ~ 'Just (UnknownDiagnostic opts) )
- => ConstructorCodes namespace con f seen ('Just (UnknownDiagnostic opts)) where
+ ( ConRecursIntoFor namespace con ~ 'Just (UnknownDiagnostic opts hint) )
+ => ConstructorCodes namespace con f seen ('Just (UnknownDiagnostic opts hint)) where
gconstructorCodes = Map.empty
-- | (*) Base instance: use the diagnostic code for this constructor in this namespace.
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -10,6 +10,7 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
{-# OPTIONS -fno-warn-name-shadowing #-}
-- This module does a lot of it
@@ -34,7 +35,10 @@ module GHCi.UI (
import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' )
import GHCi.UI.Monad hiding ( args, runStmt )
import GHCi.UI.Info
-import GHCi.UI.Exception
+import GHCi.UI.Exception hiding (GHCi)
+import GHCi.Leak
+import GHCi.UI.Print
+
import GHC.Runtime.Debugger
import GHC.Runtime.Eval (mkTopLevEnv)
@@ -170,14 +174,12 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
import GHC.IO.Handle ( hFlushAll )
import GHC.TopHandler ( topHandler )
-import GHCi.Leak
import qualified GHC.Unit.Module.Graph as GHC
-----------------------------------------------------------------------------
data GhciSettings = GhciSettings {
availableCommands :: [Command],
- shortHelpText :: String,
fullHelpText :: String,
defPrompt :: PromptFunction,
defPromptCont :: PromptFunction
@@ -187,7 +189,6 @@ defaultGhciSettings :: GhciSettings
defaultGhciSettings =
GhciSettings {
availableCommands = ghciCommands,
- shortHelpText = defShortHelpText,
defPrompt = default_prompt,
defPromptCont = default_prompt_cont,
fullHelpText = defFullHelpText
@@ -321,10 +322,8 @@ keepGoing' :: GhciMonad m => (a -> m ()) -> a -> m CmdExecOutcome
keepGoing' a str = do
in_multi <- inMultiMode
if in_multi
- then
- liftIO $ hPutStrLn stderr "Command is not supported (yet) in multi-mode"
- else
- a str
+ then reportError GhciCommandNotSupportedInMultiMode
+ else a str
return CmdSuccess
-- For commands which are actually support in multi-mode, initially just :reload
@@ -337,12 +336,9 @@ inMultiMode = multiMode <$> getGHCiState
keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
keepGoingPaths a str
= do case toArgsNoLoc str of
- Left err -> liftIO $ hPutStrLn stderr err >> return CmdSuccess
+ Left err -> reportError (GhciInvalidArgumentString err) >> return CmdSuccess
Right args -> keepGoing' a args
-defShortHelpText :: String
-defShortHelpText = "use :? for help.\n"
-
defFullHelpText :: String
defFullHelpText =
" Commands available from the prompt:\n" ++
@@ -588,7 +584,6 @@ interactiveUI config srcs maybe_exprs = do
extra_imports = [],
prelude_imports = [prelude_import],
ghc_e = isJust maybe_exprs,
- short_help = shortHelpText config,
long_help = fullHelpText config,
lastErrorLocations = lastErrLocationsRef,
mod_infos = M.empty,
@@ -599,6 +594,11 @@ interactiveUI config srcs maybe_exprs = do
return ()
+reportError :: GhciMonad m => GhciCommandMessage -> m ()
+reportError err = do
+ printError err
+ failIfExprEvalMode
+
{-
Note [Changing language extensions for interactive evaluation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1015,15 +1015,14 @@ generatePromptFunctionFromString promptS modules_names line =
processString ('%':'c':'a':'l':'l':xs) = do
-- Input has just been validated by parseCallEscape
let (cmd NE.:| args, afterClosed) = fromJust $ parseCallEscape xs
- respond <- liftIO $ do
+ respond <- do
(code, out, err) <-
- readProcessWithExitCode
- cmd args ""
+ liftIO $ readProcessWithExitCode cmd args ""
`catchIO` \e -> return (ExitFailure 1, "", show e)
case code of
ExitSuccess -> return out
_ -> do
- hPutStrLn stderr err
+ reportError (GhciPromptCallError err)
return ""
liftM ((text respond) <>) (processString afterClosed)
processString ('%':'%':xs) =
@@ -1143,6 +1142,7 @@ runOneCommand eh gCmd = do
where normSpace '\r' = ' '
normSpace x = x
-- SDM (2007-11-07): is userError the one to use here?
+ -- no
collectError = userError "unterminated multiline command :{ .. :}"
cmdOutcome :: CmdExecOutcome -> Maybe Bool
@@ -1448,16 +1448,13 @@ specialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)
specialCommand str = do
let (cmd,rest) = break isSpace str
maybe_cmd <- lookupCommand cmd
- htxt <- short_help <$> getGHCiState
case maybe_cmd of
GotCommand cmd -> (cmdAction cmd) (dropWhile isSpace rest)
BadCommand ->
- do liftIO $ hPutStr stderr ("unknown command ':" ++ cmd ++ "'\n"
- ++ htxt)
+ do reportError (GhciUnknownCommand cmd)
return CmdFailure
NoLastCommand ->
- do liftIO $ hPutStr stderr ("there is no last command to perform\n"
- ++ htxt)
+ do reportError GhciNoLastCommandAvailable
return CmdFailure
shellEscape :: MonadIO m => String -> m CmdExecOutcome
@@ -1577,8 +1574,8 @@ help _ = do
-----------------------------------------------------------------------------
-- :info
-info :: GHC.GhcMonad m => Bool -> String -> m ()
-info _ "" = throwGhcException (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
+info :: GhciMonad m => Bool -> String -> m ()
+info _ "" = reportError (GhciCommandSyntaxError "info <thing-you-want-info-about>")
info allInfo s = handleSourceError printGhciException $ do
forM_ (words s) $ \thing -> do
sdoc <- infoThing allInfo thing
@@ -1617,9 +1614,7 @@ pprInfo (thing, fixity, cls_insts, fam_insts, docs)
-- :main
runMain :: GhciMonad m => String -> m ()
-runMain s = case toArgsNoLoc s of
- Left err -> liftIO (hPutStrLn stderr err)
- Right args -> doWithMain (doWithArgs args)
+runMain s = toArgsNoLocWithErrorHandler s (doWithMain . doWithArgs)
where
doWithMain fun = do
dflags <- getDynFlags
@@ -1676,6 +1671,11 @@ toArgsNoLoc str = map unLoc <$> toArgs fake_loc str
fake_loc = mkRealSrcLoc (fsLit "<interactive>") 1 1
-- this should never be seen, because it's discarded with the `map unLoc`
+toArgsNoLocWithErrorHandler :: GhciMonad m => String -> ([String] -> m ()) -> m ()
+toArgsNoLocWithErrorHandler str f = case toArgsNoLoc str of
+ Left err -> reportError $ GhciInvalidArgumentString err
+ Right ok -> f ok
+
-----------------------------------------------------------------------------
-- :cd
@@ -1776,59 +1776,53 @@ chooseEditFile =
-- :def
defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m ()
-defineMacro _ (':':_) = (liftIO $ hPutStrLn stderr
- "macro name cannot start with a colon")
- >> failIfExprEvalMode
-defineMacro _ ('!':_) = (liftIO $ hPutStrLn stderr
- "macro name cannot start with an exclamation mark")
- >> failIfExprEvalMode
- -- little code duplication allows to grep error msg
+defineMacro _ (':':_) = reportError (GhciMacroInvalidStart "a colon")
+defineMacro _ ('!':_) = reportError (GhciMacroInvalidStart "an exclamation mark")
defineMacro overwrite s = do
let (macro_name, definition) = break isSpace s
macros <- ghci_macros <$> getGHCiState
let defined = map cmdName macros
if null macro_name
- then if null defined
- then liftIO $ putStrLn "no macros defined"
- else liftIO $ putStr ("the following macros are defined:\n" ++
- unlines defined)
+ then printForUser $ if null defined
+ then "no macros defined"
+ else "the following macros are defined" <> colon $$
+ nest 2 (vcat (map ((bullet <+>) . text) defined))
else do
isCommand <- isJust <$> lookupCommand' macro_name
+
let check_newname
- | macro_name `elem` defined = throwGhcException (CmdLineError
- ("macro '" ++ macro_name ++ "' is already defined. " ++ hint))
- | isCommand = throwGhcException (CmdLineError
- ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint))
- | otherwise = return ()
- hint = " Use ':def!' to overwrite."
-
- unless overwrite check_newname
- -- compile the expression
- handleSourceError printErrAndMaybeExit $ do
- step <- getGhciStepIO
- expr <- GHC.parseExpr definition
- -- > ghciStepIO . definition :: String -> IO String
- let stringTy :: LHsType GhcPs
- stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
- ioM :: LHsType GhcPs -- AZ
- ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
- body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
- `mkHsApp` (nlHsPar expr)
- tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
- nlHsFunTy stringTy ioM
- new_expr = L (getLoc expr) $ ExprWithTySig noAnn body tySig
- hv <- GHC.compileParsedExprRemote new_expr
-
- let newCmd = Command { cmdName = macro_name
- , cmdAction = lift . runMacro hv
- , cmdHidden = False
- , cmdCompletionFunc = noCompletion
- }
-
- -- later defined macros have precedence
- modifyGHCiState $ \s ->
- let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
- in s { ghci_macros = newCmd : filtered }
+ | macro_name `elem` defined = Just (GhciMacroAlreadyDefined macro_name)
+ | isCommand = Just (GhciMacroOverwritesBuiltin macro_name)
+ | otherwise = Nothing
+
+ if | not overwrite, Just err <- check_newname -> reportError err
+ | otherwise -> do
+ -- compile the expression
+ handleSourceError printErrAndMaybeExit $ do
+ step <- getGhciStepIO
+ expr <- GHC.parseExpr definition
+ -- > ghciStepIO . definition :: String -> IO String
+ let stringTy :: LHsType GhcPs
+ stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
+ ioM :: LHsType GhcPs -- AZ
+ ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
+ body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
+ `mkHsApp` (nlHsPar expr)
+ tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
+ nlHsFunTy stringTy ioM
+ new_expr = L (getLoc expr) $ ExprWithTySig noAnn body tySig
+ hv <- GHC.compileParsedExprRemote new_expr
+
+ let newCmd = Command { cmdName = macro_name
+ , cmdAction = lift . runMacro hv
+ , cmdHidden = False
+ , cmdCompletionFunc = noCompletion
+ }
+
+ -- later defined macros have precedence
+ modifyGHCiState $ \s ->
+ let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
+ in s { ghci_macros = newCmd : filtered }
runMacro
:: GhciMonad m
@@ -1850,8 +1844,7 @@ undefineMacro str = mapM_ undef (words str)
where undef macro_name = do
cmds <- ghci_macros <$> getGHCiState
if (macro_name `notElem` map cmdName cmds)
- then throwGhcException (CmdLineError
- ("macro '" ++ macro_name ++ "' is not defined"))
+ then reportError (GhciMacroNotDefined macro_name)
else do
-- This is a tad racy but really, it's a shell
modifyGHCiState $ \s ->
@@ -1890,9 +1883,8 @@ getGhciStepIO = do
-----------------------------------------------------------------------------
-- :doc
-docCmd :: GHC.GhcMonad m => String -> m ()
-docCmd "" =
- throwGhcException (CmdLineError "syntax: ':doc <thing-you-want-docs-for>'")
+docCmd :: GhciMonad m => String -> m ()
+docCmd "" = reportError (GhciCommandSyntaxError "doc <thing-you-want-docs-for>")
docCmd s = do
-- TODO: Maybe also get module headers for module names
names <- GHC.parseName s
@@ -1978,8 +1970,7 @@ handleGetDocsFailure no_docs = do
-- :instances
instancesCmd :: String -> InputT GHCi ()
-instancesCmd "" =
- throwGhcException (CmdLineError "syntax: ':instances <type-you-want-instances-for>'")
+instancesCmd "" = reportError (GhciCommandSyntaxError "instances <type-you-want-instances-for>")
instancesCmd s = do
handleSourceError printGhciException $ do
ty <- GHC.parseInstanceHead s
@@ -2082,16 +2073,13 @@ addModule files = do
Finder.findImportedModule hsc_env m (ThisPkg (homeUnitId home_unit))
case result of
Found _ _ -> return True
- _ -> do liftIO $ hPutStrLn stderr ("Module " ++ moduleNameString m ++ " not found")
- failIfExprEvalMode
+ _ -> do reportError (GhciModuleNotFound (moduleNameString m))
return False
checkTargetFile :: GhciMonad m => String -> m Bool
checkTargetFile f = do
exists <- liftIO (doesFileExist f)
- unless exists $ do
- liftIO $ hPutStrLn stderr $ "File " ++ f ++ " not found"
- failIfExprEvalMode
+ unless exists $ reportError (GhciFileNotFound f)
return exists
-- | @:unadd@ command
@@ -2164,7 +2152,7 @@ doLoad load_type howmuch = do
hmis <- ifaceCache <$> getGHCiState
-- If GHCi message gets its own configuration at some stage then this will need to be
-- modified to 'embedUnknownDiagnostic'.
- ok <- trySuccess $ GHC.loadWithCache (Just hmis) (mkUnknownDiagnostic . GHCiMessage) howmuch
+ ok <- trySuccess $ GHC.loadWithCache (Just hmis) mkUnknownDiagnostic howmuch
afterLoad ok load_type
pure ok
@@ -2335,15 +2323,10 @@ modulesLoadedMsg ok mods load_type = do
-- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
-- and printing 'throwE' strings to 'stderr'. If in expression
-- evaluation mode - throw GhcException and exit.
-runExceptGhciMonad :: GhciMonad m => ExceptT SDoc m () -> m ()
+runExceptGhciMonad :: GhciMonad m => ExceptT GhciCommandMessage m () -> m ()
runExceptGhciMonad act = handleSourceError printGhciException $
- either handleErr pure =<<
+ either reportError pure =<<
runExceptT act
- where
- handleErr sdoc = do
- rendered <- showSDocForUserQualify sdoc
- liftIO $ hPutStrLn stderr rendered
- failIfExprEvalMode
-- | Inverse of 'runExceptT' for \"pure\" computations
-- (c.f. 'except' for 'Except')
@@ -2419,7 +2402,7 @@ allTypesCmd _ = runExceptGhciMonad $ do
-- Helpers for locAtCmd/typeAtCmd/usesCmd
-- | Parse a span: <module-name/filepath> <sl> <sc> <el> <ec> <string>
-parseSpanArg :: String -> Either SDoc (RealSrcSpan,String)
+parseSpanArg :: String -> Either GhciCommandMessage (RealSrcSpan,String)
parseSpanArg s = do
(fp,s0) <- readAsString (skipWs s)
s0' <- skipWs1 s0
@@ -2443,13 +2426,13 @@ parseSpanArg s = do
return (span',trailer)
where
- readAsInt :: String -> Either SDoc (Int,String)
- readAsInt "" = Left "Premature end of string while expecting Int"
+ readAsInt :: String -> Either GhciCommandMessage (Int,String)
+ readAsInt "" = failParse "Premature end of string while expecting Int"
readAsInt s0 = case reads s0 of
[s_rest] -> Right s_rest
- _ -> Left ("Couldn't read" <+> text (show s0) <+> "as Int")
+ _ -> failParse $ "Couldn't read" <+> text (show s0) <+> "as Int"
- readAsString :: String -> Either SDoc (String,String)
+ readAsString :: String -> Either GhciCommandMessage (String,String)
readAsString s0
| '"':_ <- s0 = case reads s0 of
[s_rest] -> Right s_rest
@@ -2457,15 +2440,16 @@ parseSpanArg s = do
| s_rest@(_:_,_) <- breakWs s0 = Right s_rest
| otherwise = leftRes
where
- leftRes = Left ("Couldn't read" <+> text (show s0) <+> "as String")
+ leftRes = failParse $ "Couldn't read" <+> text (show s0) <+> "as String"
- skipWs1 :: String -> Either SDoc String
+ skipWs1 :: String -> Either GhciCommandMessage String
skipWs1 (c:cs) | isWs c = Right (skipWs cs)
- skipWs1 s0 = Left ("Expected whitespace in" <+> text (show s0))
+ skipWs1 s0 = failParse $ "Expected whitespace in" <+> text (show s0)
isWs = (`elem` [' ','\t'])
skipWs = dropWhile isWs
breakWs = break isWs
+ failParse = Left . GhciArgumentParseError
-- | Pretty-print \"real\" 'SrcSpan's as
@@ -2514,7 +2498,7 @@ scriptCmd :: String -> InputT GHCi ()
scriptCmd ws = do
case words' ws of
[s] -> runScript s
- _ -> throwGhcException (CmdLineError "syntax: :script <filename>")
+ _ -> reportError (GhciCommandSyntaxError "script <filename>")
-- | A version of 'words' that treats sequences enclosed in double quotes as
-- single words and that does not break on backslash-escaped spaces.
@@ -2562,7 +2546,7 @@ runScript filename = do
-- Displaying Safe Haskell properties of a module
-isSafeCmd :: GHC.GhcMonad m => String -> m ()
+isSafeCmd :: GhciMonad m => String -> m ()
isSafeCmd m =
case words m of
[s] | looksLikeModuleName s -> do
@@ -2570,7 +2554,7 @@ isSafeCmd m =
isSafeModule md
[] -> do md <- guessCurrentModule "issafe"
isSafeModule md
- _ -> throwGhcException (CmdLineError "syntax: :issafe <module>")
+ _ -> reportError (GhciCommandSyntaxError "issafe <module>")
isSafeModule :: GHC.GhcMonad m => Module -> m ()
isSafeModule m = do
@@ -2741,7 +2725,7 @@ browseModule bang modl exports_only = do
moduleCmd :: GhciMonad m => String -> m ()
moduleCmd str
| all sensible strs = cmd
- | otherwise = throwGhcException (CmdLineError "syntax: :module [+/-] [*]M1 ... [*]Mn")
+ | otherwise = reportError (GhciCommandSyntaxError "module [+/-] [*]M1 ... [*]Mn")
where
(cmd, strs) =
case str of
@@ -2989,41 +2973,30 @@ setCmd "" = showOptions False
setCmd "-a" = showOptions True
setCmd str
= case getCmd str of
- Right ("args", rest) ->
- case toArgsNoLoc rest of
- Left err -> liftIO (hPutStrLn stderr err)
- Right args -> setArgs args
- Right ("prog", rest) ->
- case toArgsNoLoc rest of
- Right [prog] -> setProg prog
- _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>")
-
+ Right ("args", rest) -> toArgsNoLocWithErrorHandler rest setArgs
+ Right ("prog", rest) -> toArgsNoLocWithErrorHandler rest $ \case
+ [prog] -> setProg prog
+ _ -> reportError $ GhciCommandSyntaxError "set prog <progname>"
Right ("prompt", rest) ->
setPromptString setPrompt (dropWhile isSpace rest)
- "syntax: set prompt <string>"
+ (GhciCommandSyntaxError "set promp <string>")
Right ("prompt-function", rest) ->
setPromptFunc setPrompt $ dropWhile isSpace rest
Right ("prompt-cont", rest) ->
setPromptString setPromptCont (dropWhile isSpace rest)
- "syntax: :set prompt-cont <string>"
+ (GhciCommandSyntaxError "set prompt-cont <string>")
Right ("prompt-cont-function", rest) ->
setPromptFunc setPromptCont $ dropWhile isSpace rest
-
Right ("editor", rest) -> setEditor $ dropWhile isSpace rest
Right ("stop", rest) -> setStop $ dropWhile isSpace rest
Right ("local-config", rest) ->
setLocalConfigBehaviour $ dropWhile isSpace rest
- _ -> case toArgsNoLoc str of
- Left err -> liftIO (hPutStrLn stderr err)
- Right wds -> () <$ keepGoing' setOptions wds
+ _ -> toArgsNoLocWithErrorHandler str $ \wds -> () <$ keepGoing' setOptions wds
setiCmd :: GhciMonad m => String -> m ()
setiCmd "" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False
setiCmd "-a" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True
-setiCmd str =
- case toArgsNoLoc str of
- Left err -> liftIO (hPutStrLn stderr err)
- Right wds -> newDynFlags True wds
+setiCmd str = toArgsNoLocWithErrorHandler str (newDynFlags True)
showOptions :: GhciMonad m => Bool -> m ()
showOptions show_all
@@ -3096,8 +3069,7 @@ setLocalConfigBehaviour s
modifyGHCiState (\st -> st { localConfig = SourceLocalConfig })
| s == "ignore" =
modifyGHCiState (\st -> st { localConfig = IgnoreLocalConfig })
- | otherwise = throwGhcException
- (CmdLineError "syntax: :set local-config { source | ignore }")
+ | otherwise = reportError (GhciCommandSyntaxError "set local-config { source | ignore }")
setStop str@(c:_) | isDigit c
= do let (nm_str,rest) = break (not.isDigit) str
@@ -3134,18 +3106,17 @@ setPromptFunc fSetPrompt s = do
convertToPromptFunction func = (\mods line -> liftIO $
liftM text (func mods line))
-setPromptString :: MonadIO m
- => (PromptFunction -> m ()) -> String -> String -> m ()
+setPromptString :: GhciMonad m
+ => (PromptFunction -> m ()) -> String -> GhciCommandMessage -> m ()
setPromptString fSetPrompt value err = do
if null value
- then liftIO $ hPutStrLn stderr $ err
+ then reportError err
else case value of
('\"':_) ->
case reads value of
[(value', xs)] | all isSpace xs ->
setParsedPromptString fSetPrompt value'
- _ -> liftIO $ hPutStrLn stderr
- "Can't parse prompt string. Use Haskell syntax."
+ _ -> reportError GhciInvalidPromptString
_ ->
setParsedPromptString fSetPrompt value
@@ -3228,15 +3199,11 @@ newDynFlags interactive_only minus_opts = do
return ()
-unknownFlagsErr :: [String] -> a
-unknownFlagsErr fs = throwGhcException $ CmdLineError $ concatMap oneError fs
+
+unknownFlagsErr :: GhciMonad m => [String] -> m ()
+unknownFlagsErr fs = mapM_ (\f -> reportError (GhciUnknownFlag f (suggestions f))) fs
where
- oneError f =
- "unrecognised flag: " ++ f ++ "\n" ++
- (case flagSuggestions ghciFlags f of
- [] -> ""
- suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs))
- ghciFlags = nubSort $ flagsForCompletion True
+ suggestions f = flagSuggestions (nubSort $ flagsForCompletion True) f
unsetOptions :: GhciMonad m => String -> m ()
unsetOptions str
@@ -3357,13 +3324,13 @@ showCmd str = do
$ hang (text ":show") 6
$ brackets (fsep $ punctuate (text " |") helpCmds)
-showiCmd :: GHC.GhcMonad m => String -> m ()
+showiCmd :: GhciMonad m => String -> m ()
showiCmd str = do
case words str of
["languages"] -> showiLanguages -- backwards compat
["language"] -> showiLanguages
["lang"] -> showiLanguages -- useful abbreviation
- _ -> throwGhcException (CmdLineError ("syntax: :showi language"))
+ _ -> reportError (GhciCommandSyntaxError "showi language")
showImports :: GhciMonad m => m ()
showImports = do
@@ -3550,7 +3517,7 @@ completeCmd argLine0 = case parseLine argLine0 of
liftIO . putStrLn $ unwords [ show (length compls'), show (length compls), show (reverse unusedLine) ]
forM_ (takeRange resultRange compls) $ \(Completion r _ _) -> do
liftIO $ print r
- _ -> throwGhcException (CmdLineError "Syntax: :complete repl [<range>] <quoted-string-to-complete>")
+ _ -> reportError (GhciCommandSyntaxError "complete repl [<range>] <quoted-string-to-complete>")
where
parseLine [] = Nothing
parseLine argLine = case breakSpace argLine of
@@ -4587,7 +4554,7 @@ failIfExprEvalMode = do
-- | When in expression evaluation mode (ghc -e), we want to exit immediately.
-- Otherwis, just print out the message.
printErrAndMaybeExit :: (GhciMonad m, MonadIO m, HasLogger m) => SourceError -> m ()
-printErrAndMaybeExit = (>> failIfExprEvalMode) . printGhciException
+printErrAndMaybeExit err = printGhciException err >> failIfExprEvalMode
-----------------------------------------------------------------------------
-- recursive exception handlers
=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -1,15 +1,19 @@
{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
-module GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where
+module GHCi.UI.Exception
+ ( GhciMessage(..)
+ , GhciMessageOpts(..)
+ , GhciCommandMessage(..)
+ , GHCi
+ ) where
import GHC.Prelude
-import GHC.Driver.Config.Diagnostic
-import GHC.Driver.Errors
import GHC.Driver.Errors.Types
-import GHC.Driver.Session
import GHC.Iface.Errors.Ppr
import GHC.Iface.Errors.Types
@@ -19,40 +23,60 @@ import qualified GHC.LanguageExtensions as LangExt
import GHC.Tc.Errors.Ppr
import GHC.Tc.Errors.Types
-import GHC.Types.Error
-import GHC.Types.SourceError
+import GHC.Types.Error.Codes
+import GHC.TypeLits
import GHC.Unit.State
-import GHC.Utils.Logger
import GHC.Utils.Outputable
-import Control.Monad.IO.Class
+import GHC.Generics
+import GHC.Types.Error
+import qualified GHC
+
+
+data GhciMessageOpts = GhciMessageOpts
+ { ghcMessageOpts :: DiagnosticOpts GhcMessage
+ , ghciCommandMessageOpts :: DiagnosticOpts GhciCommandMessage
+ }
+data GhciMessage where
+ GhciCommandMessage :: GhciCommandMessage -> GhciMessage
+ GhciGhcMessage :: GhcMessage -> GhciMessage
--- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting
--- for some error messages.
-printGhciException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m ()
-printGhciException err = do
- dflags <- getDynFlags
- logger <- getLogger
- let !diag_opts = initDiagOpts dflags
- !print_config = initPrintConfig dflags
- liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err))
+data GhciHint where
+ GhciCommandHint :: GhciCommandHint -> GhciHint
+ GhciGhcHint :: GhcHint -> GhciHint
+instance Outputable GhciHint where
+ ppr = \case
+ GhciCommandHint hint -> ppr hint
+ GhciGhcHint hint -> ppr hint
-newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage }
+instance HasDefaultDiagnosticOpts GhciMessageOpts where
+ defaultOpts = GhciMessageOpts
+ (defaultDiagnosticOpts @GhcMessage)
+ (defaultDiagnosticOpts @GhciCommandMessage)
-instance Diagnostic GHCiMessage where
- type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage
+instance Diagnostic GhciMessage where
+ type DiagnosticOpts GhciMessage = GhciMessageOpts
+ type DiagnosticHint GhciMessage = GhciHint
- diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg
+ diagnosticMessage opts = \case
+ GhciGhcMessage m -> ghciDiagnosticMessage (ghcMessageOpts opts) m
+ GhciCommandMessage m -> diagnosticMessage (ghciCommandMessageOpts opts) m
- diagnosticReason (GHCiMessage msg) = diagnosticReason msg
+ diagnosticReason = \case
+ GhciGhcMessage m -> diagnosticReason m
+ GhciCommandMessage m -> diagnosticReason m
- diagnosticHints (GHCiMessage msg) = ghciDiagnosticHints msg
+ diagnosticHints = \case
+ GhciGhcMessage m -> map GhciGhcHint (ghciDiagnosticHints m)
+ GhciCommandMessage m -> map GhciCommandHint (diagnosticHints m)
- diagnosticCode (GHCiMessage msg) = diagnosticCode msg
+ diagnosticCode = \case
+ GhciGhcMessage m -> diagnosticCode m
+ GhciCommandMessage m -> diagnosticCode m
-- | Modifications to hint messages which we want to display in GHCi.
@@ -139,3 +163,159 @@ ghciDiagnosticMessage ghc_opts msg =
quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
text "to expose it." $$
text "(Note: this unloads all the modules in the current scope.)"
+
+data GhciCommandMessage
+ -- macro errors
+ = GhciMacroAlreadyDefined String
+ | GhciMacroInvalidStart String
+ | GhciMacroNotDefined String
+ | GhciMacroOverwritesBuiltin String
+ -- module name errors
+ | GhciModuleNotFound String
+ | GhciNoModuleNameGuess
+ | GhciNoModuleInfoForCurrentFile
+ | GhciNoLocationInfoForModule GHC.ModuleName
+ | GhciNoResolvedModules
+ | GhciNoModuleForName GHC.Name
+ | GhciNoMatchingModuleExport
+ -- argument parse error
+ | GhciArgumentParseError SDoc
+ -- other errors
+ | GhciCommandNotSupportedInMultiMode
+ | GhciInvalidArgumentString String
+ | GhciFileNotFound String
+ | GhciCommandSyntaxError String
+ | GhciInvalidPromptString
+ | GhciPromptCallError String
+ | GhciUnknownCommand String
+ | GhciNoLastCommandAvailable
+ | GhciUnknownFlag String [String]
+ | GhciNoSetEditor
+ | Foo GHC.Module
+ deriving Generic
+
+data GhciCommandHint
+ = HelpCommand
+ | SetEditor
+ | Overwrite
+ | MeantOther [String]
+
+instance Outputable GhciCommandHint where
+ ppr = \case
+ HelpCommand
+ -> use "?" <+> "for help"
+ MeantOther suggs
+ -> "did you mean one of" <> colon <+> nest 2 (hsep (map text suggs))
+ SetEditor
+ -> use "set editor"
+ Overwrite
+ -> use "def!" <+> "to overwrite"
+ where use cmd = "Use" <+> quotes (colon <> cmd)
+
+instance Diagnostic GhciCommandMessage where
+ type DiagnosticOpts GhciCommandMessage = NoDiagnosticOpts
+ type DiagnosticHint GhciCommandMessage = GhciCommandHint
+
+ diagnosticMessage NoDiagnosticOpts = mkSimpleDecorated . \case
+ GhciMacroAlreadyDefined name
+ -> "Macro" <+> quotes (text name) <+> "is already defined"
+ GhciMacroOverwritesBuiltin name
+ -> "Macro" <+> quotes (text name) <+> "overwrites builtin command"
+ GhciMacroInvalidStart str
+ -> "Macro name cannot start with" <+> text str
+ GhciMacroNotDefined name
+ -> "Macro" <+> quotes (text name) <+> "is not defined"
+ GhciModuleNotFound modN
+ -> "Module" <+> text modN <+> "not found"
+ GhciNoModuleNameGuess
+ -> "Couldn't guess that module name. Does it exist?"
+ GhciNoModuleInfoForCurrentFile
+ -> "No module info for current file! Try loading it?"
+ GhciNoLocationInfoForModule name
+ -> "Found a name, but no location information" <> dot <+> "The module is" <> colon <+> ppr name
+ GhciNoResolvedModules
+ -> "Couldn't resolve to any modules."
+ GhciNoModuleForName name
+ -> "No module for" <+> ppr name
+ GhciNoMatchingModuleExport
+ -> "No matching export in any local modules."
+ GhciArgumentParseError ape -> ape
+ GhciCommandNotSupportedInMultiMode
+ -> "Command is not supported (yet) in multi-mode"
+ GhciInvalidArgumentString str
+ -> text str -- JADE_TODO
+ GhciCommandSyntaxError cmd
+ -> "Syntax" <> colon $+$ nest 2 (colon <> text cmd)
+ GhciInvalidPromptString
+ -> "Can't parse prompt string. Use Haskell syntax"
+ GhciUnknownCommand cmd
+ -> "Unknown command" <+> quotes (colon <> text cmd)
+ GhciNoLastCommandAvailable
+ -> "There is no last command to perform"
+ GhciFileNotFound f
+ -> "File" <+> text f <+> "not found"
+ GhciUnknownFlag flag _
+ -> "Unrecognised flag" <> colon <+> text flag
+ GhciPromptCallError err
+ -> "Error while calling prompt function" <> colon $$ nest 2 (quotes (text err))
+ GhciNoSetEditor
+ -> "Editor not set"
+ Foo modL
+ -> ppr (GHC.moduleUnit modL) <> colon <> ppr modL -- JADE_TODO
+
+ -- this might change in the future when we add more GHCi diagnostics
+ diagnosticReason _ = ErrorWithoutFlag
+
+ diagnosticHints = \case
+ GhciUnknownCommand{}
+ -> [HelpCommand]
+ GhciNoLastCommandAvailable{}
+ -> [HelpCommand]
+ GhciUnknownFlag _ suggs@(_:_)
+ -> [MeantOther suggs]
+ GhciNoSetEditor{}
+ -> [SetEditor]
+ GhciMacroAlreadyDefined{}
+ -> [Overwrite]
+ GhciMacroOverwritesBuiltin{}
+ -> [Overwrite]
+ _ -> []
+
+ diagnosticCode = constructorCode @GHCi
+
+-- | type index for the ghci diagnostic code namespace
+data GHCi
+
+instance DiagnosticCodeNameSpace GHCi where
+ type instance NameSpaceTag GHCi = "GHCi"
+ type instance DiagnosticCodeFor GHCi con = GhciDiagnosticCode con
+ -- For now we don't recur into any error
+ -- once we do, this should use a type family analogous to
+ -- GHCs 'ConRecursInto'
+ type instance ConRecursIntoFor GHCi con = 'Nothing
+
+type GhciDiagnosticCode :: Symbol -> Nat
+type family GhciDiagnosticCode c = n | n -> c where
+ GhciDiagnosticCode "GhciCommandNotSupportedInMultiMode" = 83514
+ GhciDiagnosticCode "GhciInvalidArgumentString" = 68894
+ GhciDiagnosticCode "GhciCommandSyntaxError" = 72682
+ GhciDiagnosticCode "GhciInvalidPromptString" = 50882
+ GhciDiagnosticCode "GhciPromptCallError" = 22747
+ GhciDiagnosticCode "GhciUnknownCommand" = 54713
+ GhciDiagnosticCode "GhciNoLastCommandAvailable" = 29130
+ GhciDiagnosticCode "GhciUnknownFlag" = 15670
+ GhciDiagnosticCode "GhciNoSetEditor" = 34086
+ GhciDiagnosticCode "GhciMacroInvalidStart" = 64996
+ GhciDiagnosticCode "GhciMacroAlreadyDefined" = 93909
+ GhciDiagnosticCode "GhciMacroNotDefined" = 40561
+ GhciDiagnosticCode "GhciMacroOverwritesBuiltin" = 86201
+ GhciDiagnosticCode "GhciFileNotFound" = 31901
+ GhciDiagnosticCode "GhciModuleNotFound" = 23305
+ GhciDiagnosticCode "GhciNoModuleNameGuess" = 21939
+ GhciDiagnosticCode "GhciNoModuleInfoForCurrentFile" = 96587
+ GhciDiagnosticCode "GhciNoLocationInfoForModule" = 12769
+ GhciDiagnosticCode "GhciNoResolvedModules" = 54909
+ GhciDiagnosticCode "GhciNoModuleForName" = 21847
+ GhciDiagnosticCode "GhciNoMatchingModuleExport" = 59723
+ GhciDiagnosticCode "GhciArgumentParseError" = 35671
+ GhciDiagnosticCode "Foo" = 00001
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -50,6 +50,8 @@ import GHC.Types.SrcLoc
import GHC.Types.Var
import qualified GHC.Data.Strict as Strict
+import GHCi.UI.Exception
+
-- | Info about a module. This information is generated every time a
-- module is loaded.
data ModInfo = ModInfo
@@ -114,23 +116,19 @@ findLoc :: GhcMonad m
=> Map ModuleName ModInfo
-> RealSrcSpan
-> String
- -> ExceptT SDoc m (ModInfo,Name,SrcSpan)
+ -> ExceptT GhciCommandMessage m (ModInfo,Name,SrcSpan)
findLoc infos span0 string = do
- name <- maybeToExceptT "Couldn't guess that module name. Does it exist?" $
+ name <- maybeToExceptT GhciNoModuleNameGuess $
guessModule infos (srcSpanFilePath span0)
- info <- maybeToExceptT "No module info for current file! Try loading it?" $
+ info <- maybeToExceptT GhciNoModuleInfoForCurrentFile $
MaybeT $ pure $ M.lookup name infos
name' <- findName infos span0 info string
case getSrcSpan name' of
- UnhelpfulSpan{} -> do
- throwE ("Found a name, but no location information." <+>
- "The module is:" <+>
- maybe "<unknown>" (ppr . moduleName)
- (nameModule_maybe name'))
-
+ UnhelpfulSpan{} -> throwE $ GhciNoLocationInfoForModule
+ (maybe (ModuleName "<unknown>") moduleName (nameModule_maybe name'))
span' -> return (info,name',span')
-- | Find any uses of the given identifier in the codebase.
@@ -138,7 +136,7 @@ findNameUses :: (GhcMonad m)
=> Map ModuleName ModInfo
-> RealSrcSpan
-> String
- -> ExceptT SDoc m [SrcSpan]
+ -> ExceptT GhciCommandMessage m [SrcSpan]
findNameUses infos span0 string =
locToSpans <$> findLoc infos span0 string
where
@@ -166,7 +164,7 @@ findName :: GhcMonad m
-> RealSrcSpan
-> ModInfo
-> String
- -> ExceptT SDoc m Name
+ -> ExceptT GhciCommandMessage m Name
findName infos span0 mi string =
case resolveName (modinfoSpans mi) (spanInfoFromRealSrcSpan' span0) of
Nothing -> tryExternalModuleResolution
@@ -178,7 +176,7 @@ findName infos span0 mi string =
rdrs = modInfo_rdrs mi
tryExternalModuleResolution =
case find (matchName $ mkFastString string) rdrs of
- Nothing -> throwE "Couldn't resolve to any modules."
+ Nothing -> throwE GhciNoResolvedModules
Just imported -> resolveNameFromModule infos imported
matchName :: FastString -> Name -> Bool
@@ -190,18 +188,20 @@ findName infos span0 mi string =
resolveNameFromModule :: GhcMonad m
=> Map ModuleName ModInfo
-> Name
- -> ExceptT SDoc m Name
+ -> ExceptT GhciCommandMessage m Name
resolveNameFromModule infos name = do
- modL <- maybe (throwE $ "No module for" <+> ppr name) return $
+ modL <- maybe (throwE $ GhciNoModuleForName name) return $
nameModule_maybe name
- info <- maybe (throwE (ppr (moduleUnit modL) <> ":" <>
- ppr modL)) return $
- M.lookup (moduleName modL) infos
+ -- JADE_TODO
+ -- info <- maybe (throwE () return $
+ -- M.lookup (moduleName modL) infos
+ info <- maybe (throwE Foo) return $
+ M.lookup (moduleName modL) infos
let all_names = modInfo_rdrs info
- maybe (throwE "No matching export in any local modules.") return $
+ maybe (throwE GhciNoMatchingModuleExport) return $
find (matchName name) all_names
where
matchName :: Name -> Name -> Bool
@@ -218,12 +218,12 @@ findType :: GhcMonad m
=> Map ModuleName ModInfo
-> RealSrcSpan
-> String
- -> ExceptT SDoc m (ModInfo, Type)
+ -> ExceptT GhciCommandMessage m (ModInfo, Type)
findType infos span0 string = do
- name <- maybeToExceptT "Couldn't guess that module name. Does it exist?" $
+ name <- maybeToExceptT GhciNoModuleNameGuess $
guessModule infos (srcSpanFilePath span0)
- info <- maybeToExceptT "No module info for current file! Try loading it?" $
+ info <- maybeToExceptT GhciNoModuleInfoForCurrentFile $
MaybeT $ pure $ M.lookup name infos
case resolveType (modinfoSpans info) (spanInfoFromRealSrcSpan' span0) of
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -24,9 +24,7 @@ module GHCi.UI.Monad (
runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,
ActionStats(..), runAndPrintStats, runWithStats, printStats,
- printForUserNeverQualify,
- printForUserGlobalRdrEnv,
- printForUser, printForUserPartWay, prettyLocations,
+ prettyLocations,
compileGHCiExpr,
initInterpBuffering,
@@ -42,7 +40,6 @@ import GHC.Driver.Monad hiding (liftIO)
import GHC.Utils.Outputable
import qualified GHC.Driver.Ppr as Ppr
import GHC.Types.Name.Occurrence
-import GHC.Types.Name.Reader
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Driver.Env
@@ -51,12 +48,10 @@ import GHC.Types.SafeHaskell
import GHC.Driver.Make (ModIfaceCache(..))
import GHC.Unit
import GHC.Types.Name.Reader as RdrName (mkOrig)
-import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx)
import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS)
import GHC.Runtime.Interpreter
import GHC.Runtime.Context
import GHCi.RemoteTypes
-import GHCi.UI.Exception (printGhciException)
import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
import GHC.Hs.Utils
import GHC.Utils.Misc
@@ -82,6 +77,8 @@ import qualified Data.IntMap.Strict as IntMap
import qualified GHC.Data.EnumSet as EnumSet
import qualified GHC.LanguageExtensions as LangExt
+import GHCi.UI.Print
+
-----------------------------------------------------------------------------
-- GHCi monad
@@ -155,9 +152,6 @@ data GHCiState = GHCiState
-- "import Prelude hiding (map)"
ghc_e :: Bool, -- ^ True if this is 'ghc -e' (or runghc)
-
- short_help :: String,
- -- ^ help text to display to a user
long_help :: String,
lastErrorLocations :: IORef [(FastString, Int)],
@@ -360,36 +354,6 @@ unsetOption opt
= do st <- getGHCiState
setGHCiState (st{ options = filter (/= opt) (options st) })
-printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
-printForUserNeverQualify doc = do
- dflags <- GHC.getInteractiveDynFlags
- liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc
-
-printForUserGlobalRdrEnv :: (GhcMonad m, Outputable info)
- => Maybe (GlobalRdrEnvX info) -> SDoc -> m ()
-printForUserGlobalRdrEnv mb_rdr_env doc = do
- dflags <- GHC.getInteractiveDynFlags
- name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env
- liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
- where
- mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx
- mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) =
- withSession $ \ hsc_env ->
- let unit_env = hsc_unit_env hsc_env
- ptc = initPromotionTickContext dflags
- in return $ Ppr.mkNamePprCtx ptc unit_env rdr_env
-
-printForUser :: GhcMonad m => SDoc -> m ()
-printForUser doc = do
- name_ppr_ctx <- GHC.getNamePprCtx
- dflags <- GHC.getInteractiveDynFlags
- liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
-
-printForUserPartWay :: GhcMonad m => SDoc -> m ()
-printForUserPartWay doc = do
- name_ppr_ctx <- GHC.getNamePprCtx
- dflags <- GHC.getInteractiveDynFlags
- liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx DefaultDepth doc
-- | Run a single Haskell expression
runStmt
=====================================
ghc/GHCi/UI/Print.hs
=====================================
@@ -0,0 +1,85 @@
+module GHCi.UI.Print
+ ( printForUserNeverQualify
+ , printForUserGlobalRdrEnv
+ , printForUser
+ , printForUserPartWay
+ , printError -- TODO
+ , printGhciException
+ ) where
+
+import qualified GHC
+import GHC.Types.Name.Reader
+import GHC.Types.SourceError
+import GHC.Types.SrcLoc
+import GHC.Types.Error
+import GHC.Driver.Monad
+import GHC.Driver.Env
+import GHC.Driver.Session
+import GHC.Driver.Errors
+import GHC.Driver.Config.Diagnostic
+
+import GHC.Utils.Logger
+import GHC.Utils.Error
+import GHC.Utils.Outputable
+import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx)
+import qualified GHC.Driver.Ppr as Ppr
+
+import Prelude hiding ((<>))
+import System.IO
+
+import GHCi.UI.Exception
+
+
+printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
+printForUserNeverQualify doc = do
+ dflags <- GHC.getInteractiveDynFlags
+ liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc
+
+printForUserGlobalRdrEnv :: (GhcMonad m, Outputable info)
+ => Maybe (GlobalRdrEnvX info) -> SDoc -> m ()
+printForUserGlobalRdrEnv mb_rdr_env doc = do
+ dflags <- GHC.getInteractiveDynFlags
+ name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env
+ liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
+ where
+ mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx
+ mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) =
+ withSession $ \ hsc_env ->
+ let unit_env = hsc_unit_env hsc_env
+ ptc = initPromotionTickContext dflags
+ in return $ Ppr.mkNamePprCtx ptc unit_env rdr_env
+
+printForUser :: GhcMonad m => SDoc -> m ()
+printForUser doc = do
+ name_ppr_ctx <- GHC.getNamePprCtx
+ dflags <- GHC.getInteractiveDynFlags
+ liftIO $ Ppr.printForUserColoured dflags stdout name_ppr_ctx AllTheWay doc
+
+printForUserPartWay :: GhcMonad m => SDoc -> m ()
+printForUserPartWay doc = do
+ name_ppr_ctx <- GHC.getNamePprCtx
+ dflags <- GHC.getInteractiveDynFlags
+ liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx DefaultDepth doc
+
+printError :: GhcMonad m => GhciCommandMessage -> m ()
+printError err = printError' (const NoDiagnosticOpts) $ singleMessage (mkPlainErrorMsgEnvelope (UnhelpfulSpan UnhelpfulInteractive) err)
+
+-- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting
+-- for some error messages.
+printGhciException :: GhcMonad m => SourceError -> m ()
+printGhciException err = printError' initGhciPrintConfig (GhciGhcMessage <$> (srcErrorMessages err))
+
+printError' :: (GhcMonad m, Diagnostic a) => (DynFlags -> DiagnosticOpts a) -> Messages a -> m ()
+printError' get_config err = do
+ dflags <- getDynFlags
+ logger <- getLogger
+ let !diag_opts = initDiagOpts dflags
+ !print_config = get_config dflags
+ liftIO $ printMessages logger print_config diag_opts err
+
+
+initGhciPrintConfig :: DynFlags -> GhciMessageOpts
+initGhciPrintConfig dflags = GhciMessageOpts
+ { ghcMessageOpts = initPrintConfig dflags
+ , ghciCommandMessageOpts = NoDiagnosticOpts
+ }
=====================================
ghc/ghc-bin.cabal.in
=====================================
@@ -68,6 +68,7 @@ Executable ghc
GHCi.UI
GHCi.UI.Info
GHCi.UI.Monad
+ GHCi.UI.Print
GHCi.UI.Exception
GHCi.Util
Other-Extensions:
=====================================
testsuite/tests/ghci/scripts/T10508.stderr
=====================================
@@ -1,4 +1,3 @@
-
<interactive>:1:15: error: [GHC-83865]
• Couldn't match type: a0 -> a0
with: [Char]
@@ -8,5 +7,8 @@
In the first argument of ‘return’, namely ‘id’
In the expression: return id
In the second argument of ‘(.)’, namely ‘(\ _ -> return id)’
-unknown command ':macro'
-use :? for help.
+
+<interactive>: error: [GHCi-54713]
+ Unknown command ‘:macro’
+ use :? for help
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c914af12f4f8c7f40c9450223e492df9a02b5217
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c914af12f4f8c7f40c9450223e492df9a02b5217
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240801/7ffed131/attachment-0001.html>
More information about the ghc-commits
mailing list