[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Deprecate -ddump-json and introduce -fdiagnostics-as-json
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Dec 25 18:51:33 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
dfd670a0 by Ben Bellick at 2023-12-24T10:10:31-05:00
Deprecate -ddump-json and introduce -fdiagnostics-as-json
Addresses #19278
This commit deprecates the underspecified -ddump-json flag and
introduces a newer, well-specified flag -fdiagnostics-as-json.
Also included is a JSON schema as part of the documentation.
The -ddump-json flag will be slated for removal shortly after this merge.
- - - - -
609e6225 by Ben Bellick at 2023-12-24T10:10:31-05:00
Deprecate -ddump-json and introduce -fdiagnostics-as-json
Addresses #19278
This commit deprecates the underspecified -ddump-json flag and
introduces a newer, well-specified flag -fdiagnostics-as-json.
Also included is a JSON schema as part of the documentation.
The -ddump-json flag will be slated for removal shortly after this merge.
- - - - -
865513b2 by Ömer Sinan Ağacan at 2023-12-24T10:11:13-05:00
Fix BNF in user manual 6.6.8.2: formal syntax for instance declarations
- - - - -
1de8607b by Zubin Duggal at 2023-12-25T13:51:16-05:00
docs: document permissibility of -XOverloadedLabels (#24249)
Document the permissibility introduced by
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst
- - - - -
85ca8a84 by Ömer Sinan Ağacan at 2023-12-25T13:51:19-05:00
Fix a code block syntax in user manual sec. 6.8.8.6
- - - - -
23 changed files:
- compiler/GHC/Driver/Config/Logger.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Monad.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Utils/Logger.hs
- docs/users_guide/debugging.rst
- + docs/users_guide/diagnostics-as-json-schema-1_0.json
- docs/users_guide/exts/instances.rst
- docs/users_guide/exts/overloaded_labels.rst
- docs/users_guide/using.rst
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/driver/T16167.stdout
- testsuite/tests/driver/all.T
- testsuite/tests/driver/json.hs
- testsuite/tests/driver/json.stderr
- testsuite/tests/driver/json2.stderr
- + testsuite/tests/driver/json_dump.hs
- + testsuite/tests/driver/json_dump.stderr
- + testsuite/tests/driver/json_warn.hs
- + testsuite/tests/driver/json_warn.stderr
Changes:
=====================================
compiler/GHC/Driver/Config/Logger.hs
=====================================
@@ -17,6 +17,7 @@ initLogFlags dflags = LogFlags
, log_default_dump_context = initSDocContext dflags defaultDumpStyle
, log_dump_flags = dumpFlags dflags
, log_show_caret = gopt Opt_DiagnosticsShowCaret dflags
+ , log_diagnostics_as_json = gopt Opt_DiagnosticsAsJSON dflags
, log_show_warn_groups = gopt Opt_ShowWarnGroups dflags
, log_enable_timestamps = not (gopt Opt_SuppressTimestamps dflags)
, log_dump_to_file = gopt Opt_DumpToFile dflags
=====================================
compiler/GHC/Driver/Errors.hs
=====================================
@@ -17,13 +17,15 @@ printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOp
printMessages logger msg_opts opts msgs
= sequence_ [ let style = mkErrStyle name_ppr_ctx
ctx = (diag_ppr_ctx opts) { sdocStyle = style }
- in logMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) s $
- updSDocContext (\_ -> ctx) (messageWithHints dia)
- | MsgEnvelope { errMsgSpan = s,
- errMsgDiagnostic = dia,
- errMsgSeverity = sev,
- errMsgReason = reason,
- errMsgContext = name_ppr_ctx }
+ in (if log_diags_as_json
+ then logJsonMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) msg
+ else logMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) s $
+ updSDocContext (\_ -> ctx) (messageWithHints dia))
+ | msg at MsgEnvelope { errMsgSpan = s,
+ errMsgDiagnostic = dia,
+ errMsgSeverity = sev,
+ errMsgReason = reason,
+ errMsgContext = name_ppr_ctx }
<- sortMsgBag (Just opts) (getMessages msgs) ]
where
messageWithHints :: Diagnostic a => a -> SDoc
@@ -34,6 +36,7 @@ printMessages logger msg_opts opts msgs
[h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h)
hs -> main_msg $$ hang (text "Suggested fixes:") 2
(formatBulleted $ mkDecorated . map ppr $ hs)
+ log_diags_as_json = log_diagnostics_as_json (logFlags logger)
-- | Given a bag of diagnostics, turn them into an exception if
-- any has 'SevError', or print them out otherwise.
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -412,6 +412,7 @@ data GeneralFlag
| Opt_ErrorSpans -- Include full span info in error messages,
-- instead of just the start position.
| Opt_DeferDiagnostics
+ | Opt_DiagnosticsAsJSON -- ^ Dump diagnostics as JSON
| Opt_DiagnosticsShowCaret -- Show snippets of offending code
| Opt_PprCaseAsLet
| Opt_PprShowTicks
=====================================
compiler/GHC/Driver/Monad.hs
=====================================
@@ -23,6 +23,8 @@ module GHC.Driver.Monad (
modifyLogger,
pushLogHookM,
popLogHookM,
+ pushJsonLogHookM,
+ popJsonLogHookM,
putLogMsgM,
putMsgM,
withTimingM,
@@ -121,6 +123,12 @@ pushLogHookM = modifyLogger . pushLogHook
popLogHookM :: GhcMonad m => m ()
popLogHookM = modifyLogger popLogHook
+pushJsonLogHookM :: GhcMonad m => (LogJsonAction -> LogJsonAction) -> m ()
+pushJsonLogHookM = modifyLogger . pushJsonLogHook
+
+popJsonLogHookM :: GhcMonad m => m ()
+popJsonLogHookM = modifyLogger popJsonLogHook
+
-- | Put a log message
putMsgM :: GhcMonad m => SDoc -> m ()
putMsgM doc = do
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1573,15 +1573,15 @@ dynamic_flags_deps = [
(NoArg (setGeneralFlag Opt_NoTypeableBinds))
, make_ord_flag defGhcFlag "ddump-debug"
(setDumpFlag Opt_D_dump_debug)
- , make_ord_flag defGhcFlag "ddump-json"
- (setDumpFlag Opt_D_dump_json )
+ , make_dep_flag defGhcFlag "ddump-json"
+ (setDumpFlag Opt_D_dump_json)
+ "Use `-fdiagnostics-as-json` instead"
, make_ord_flag defGhcFlag "dppr-debug"
(setDumpFlag Opt_D_ppr_debug)
, make_ord_flag defGhcFlag "ddebug-output"
(noArg (flip dopt_unset Opt_D_no_debug_output))
, make_ord_flag defGhcFlag "dno-debug-output"
(setDumpFlag Opt_D_no_debug_output)
-
, make_ord_flag defGhcFlag "ddump-faststrings"
(setDumpFlag Opt_D_dump_faststrings)
@@ -2354,6 +2354,7 @@ fFlagsDeps = [
flagSpec "defer-typed-holes" Opt_DeferTypedHoles,
flagSpec "defer-out-of-scope-variables" Opt_DeferOutOfScopeVariables,
flagSpec "diagnostics-show-caret" Opt_DiagnosticsShowCaret,
+ flagSpec "diagnostics-as-json" Opt_DiagnosticsAsJSON,
-- With-ways needs to be reversible hence why its made via flagSpec unlike
-- other debugging flags.
flagSpec "dump-with-ways" Opt_DumpWithWays,
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -103,15 +103,16 @@ import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
import GHC.Utils.Json
import GHC.Utils.Panic
import GHC.Unit.Module.Warnings (WarningCategory)
-
import Data.Bifunctor
-import Data.Foldable ( fold )
+import Data.Foldable ( fold, toList )
import Data.List.NonEmpty ( NonEmpty (..) )
import qualified Data.List.NonEmpty as NE
import Data.List ( intercalate )
import Data.Typeable ( Typeable )
import Numeric.Natural ( Natural )
import Text.Printf ( printf )
+import GHC.Version (cProjectVersion)
+import GHC.Types.Hint.Ppr () -- Outputtable instance
{- Note [Messages]
~~~~~~~~~~~~~~~~~~
@@ -166,6 +167,9 @@ instance Diagnostic e => Outputable (Messages e) where
pprDiagnostic (errMsgDiagnostic envelope)
]
+instance Diagnostic e => ToJson (Messages e) where
+ json msgs = JSArray . toList $ json <$> getMessages msgs
+
{- Note [Discarding Messages]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -540,7 +544,9 @@ instance Outputable Severity where
SevError -> text "SevError"
instance ToJson Severity where
- json s = JSString (show s)
+ json SevIgnore = JSString "Ignore"
+ json SevWarning = JSString "Warning"
+ json SevError = JSString "Error"
instance ToJson MessageClass where
json MCOutput = JSString "MCOutput"
@@ -551,6 +557,45 @@ instance ToJson MessageClass where
json (MCDiagnostic sev reason code) =
JSString $ renderWithContext defaultSDocContext (ppr $ text "MCDiagnostic" <+> ppr sev <+> ppr reason <+> ppr code)
+instance ToJson DiagnosticCode where
+ json c = JSInt (fromIntegral (diagnosticCodeNumber c))
+
+{- Note [Diagnostic Message JSON Schema]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The below instance of ToJson must conform to the JSON schema
+specified in docs/users_guide/diagnostics-as-json-schema-1_0.json.
+When the schema is altered, please bump the version.
+If the content is altered in a backwards compatible way,
+update the minor version (e.g. 1.3 ~> 1.4).
+If the content is breaking, update the major version (e.g. 1.3 ~> 2.3).
+When updating the schema, replace the above file and name it appropriately with
+the version appended, and change the documentation of the -fdiagnostics-as-json
+flag to reflect the new schema.
+To learn more about JSON schemas, check out the below link:
+https://json-schema.org
+-}
+
+schemaVersion :: String
+schemaVersion = "1.0"
+-- See Note [Diagnostic Message JSON Schema] before editing!
+instance Diagnostic e => ToJson (MsgEnvelope e) where
+ json m = JSObject [
+ ("version", JSString schemaVersion),
+ ("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),
+ ("span", json $ errMsgSpan m),
+ ("severity", json $ errMsgSeverity m),
+ ("code", maybe JSNull json (diagnosticCode diag)),
+ ("message", JSArray $ map renderToJSString diagMsg),
+ ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) )
+ ]
+ where diag = errMsgDiagnostic m
+ opts = defaultDiagnosticOpts @e
+ style = mkErrStyle (errMsgContext m)
+ ctx = defaultSDocContext {sdocStyle = style }
+ diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))
+ renderToJSString :: SDoc -> JsonDoc
+ renderToJSString = JSString . (renderWithContext ctx)
+
instance Show (MsgEnvelope DiagnosticMessage) where
show = showMsgEnvelope
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -426,12 +426,14 @@ instance ToJson SrcSpan where
json (RealSrcSpan rss _) = json rss
instance ToJson RealSrcSpan where
- json (RealSrcSpan'{..}) = JSObject [ ("file", JSString (unpackFS srcSpanFile))
- , ("startLine", JSInt srcSpanSLine)
- , ("startCol", JSInt srcSpanSCol)
- , ("endLine", JSInt srcSpanELine)
- , ("endCol", JSInt srcSpanECol)
+ json (RealSrcSpan'{..}) = JSObject [ ("file", JSString (unpackFS srcSpanFile)),
+ ("start", start),
+ ("end", end)
]
+ where start = JSObject [ ("line", JSInt srcSpanSLine),
+ ("column", JSInt srcSpanSCol) ]
+ end = JSObject [ ("line", JSInt srcSpanELine),
+ ("column", JSInt srcSpanECol) ]
instance NFData SrcSpan where
rnf x = x `seq` ()
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -24,6 +24,7 @@ module GHC.Utils.Logger
-- * Logger setup
, initLogger
, LogAction
+ , LogJsonAction
, DumpAction
, TraceAction
, DumpFormat (..)
@@ -31,6 +32,8 @@ module GHC.Utils.Logger
-- ** Hooks
, popLogHook
, pushLogHook
+ , popJsonLogHook
+ , pushJsonLogHook
, popDumpHook
, pushDumpHook
, popTraceHook
@@ -49,12 +52,13 @@ module GHC.Utils.Logger
, logVerbAtLeast
-- * Logging
- , jsonLogAction
, putLogMsg
, defaultLogAction
+ , defaultLogJsonAction
, defaultLogActionHPrintDoc
, defaultLogActionHPutStrDoc
, logMsg
+ , logJsonMsg
, logDumpMsg
-- * Dumping
@@ -87,6 +91,7 @@ import GHC.Utils.Panic
import GHC.Data.EnumSet (EnumSet)
import qualified GHC.Data.EnumSet as EnumSet
+import GHC.Data.FastString
import System.Directory
import System.FilePath ( takeDirectory, (</>) )
@@ -111,6 +116,7 @@ data LogFlags = LogFlags
, log_default_dump_context :: SDocContext
, log_dump_flags :: !(EnumSet DumpFlag) -- ^ Dump flags
, log_show_caret :: !Bool -- ^ Show caret in diagnostics
+ , log_diagnostics_as_json :: !Bool -- ^ Format diagnostics as JSON
, log_show_warn_groups :: !Bool -- ^ Show warning flag groups
, log_enable_timestamps :: !Bool -- ^ Enable timestamps
, log_dump_to_file :: !Bool -- ^ Enable dump to file
@@ -130,6 +136,7 @@ defaultLogFlags = LogFlags
, log_default_dump_context = defaultSDocContext
, log_dump_flags = EnumSet.empty
, log_show_caret = True
+ , log_diagnostics_as_json = False
, log_show_warn_groups = True
, log_enable_timestamps = True
, log_dump_to_file = False
@@ -177,6 +184,11 @@ type LogAction = LogFlags
-> SDoc
-> IO ()
+type LogJsonAction = LogFlags
+ -> MessageClass
+ -> JsonDoc
+ -> IO ()
+
type DumpAction = LogFlags
-> PprStyle
-> DumpFlag
@@ -214,6 +226,9 @@ data Logger = Logger
{ log_hook :: [LogAction -> LogAction]
-- ^ Log hooks stack
+ , json_log_hook :: [LogJsonAction -> LogJsonAction]
+ -- ^ Json log hooks stack
+
, dump_hook :: [DumpAction -> DumpAction]
-- ^ Dump hooks stack
@@ -249,6 +264,7 @@ initLogger = do
dumps <- newMVar Map.empty
return $ Logger
{ log_hook = []
+ , json_log_hook = []
, dump_hook = []
, trace_hook = []
, generated_dumps = dumps
@@ -260,6 +276,10 @@ initLogger = do
putLogMsg :: Logger -> LogAction
putLogMsg logger = foldr ($) defaultLogAction (log_hook logger)
+-- | Log a JsonDoc
+putJsonLogMsg :: Logger -> LogJsonAction
+putJsonLogMsg logger = foldr ($) defaultLogJsonAction (json_log_hook logger)
+
-- | Dump something
putDumpFile :: Logger -> DumpAction
putDumpFile logger =
@@ -284,6 +304,15 @@ popLogHook logger = case log_hook logger of
[] -> panic "popLogHook: empty hook stack"
_:hs -> logger { log_hook = hs }
+-- | Push a json log hook
+pushJsonLogHook :: (LogJsonAction -> LogJsonAction) -> Logger -> Logger
+pushJsonLogHook h logger = logger { json_log_hook = h:json_log_hook logger }
+
+popJsonLogHook :: Logger -> Logger
+popJsonLogHook logger = case json_log_hook logger of
+ [] -> panic "popJsonLogHook: empty hook stack"
+ _:hs -> logger { json_log_hook = hs}
+
-- | Push a dump hook
pushDumpHook :: (DumpAction -> DumpAction) -> Logger -> Logger
pushDumpHook h logger = logger { dump_hook = h:dump_hook logger }
@@ -328,7 +357,23 @@ makeThreadSafe logger = do
$ logger
-- See Note [JSON Error Messages]
---
+defaultLogJsonAction :: LogJsonAction
+defaultLogJsonAction logflags msg_class jsdoc =
+ case msg_class of
+ MCOutput -> printOut msg
+ MCDump -> printOut (msg $$ blankLine)
+ MCInteractive -> putStrSDoc msg
+ MCInfo -> printErrs msg
+ MCFatal -> printErrs msg
+ MCDiagnostic SevIgnore _ _ -> pure () -- suppress the message
+ MCDiagnostic _sev _rea _code -> printErrs msg
+ where
+ printOut = defaultLogActionHPrintDoc logflags False stdout
+ printErrs = defaultLogActionHPrintDoc logflags False stderr
+ putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout
+ msg = renderJSON jsdoc
+-- See Note [JSON Error Messages]
+-- this is to be removed
jsonLogAction :: LogAction
jsonLogAction _ (MCDiagnostic SevIgnore _ _) _ _ = return () -- suppress the message
jsonLogAction logflags msg_class srcSpan msg
@@ -338,10 +383,20 @@ jsonLogAction logflags msg_class srcSpan msg
where
str = renderWithContext (log_default_user_context logflags) msg
doc = renderJSON $
- JSObject [ ( "span", json srcSpan )
+ JSObject [ ( "span", spanToDumpJSON srcSpan )
, ( "doc" , JSString str )
, ( "messageClass", json msg_class )
]
+ spanToDumpJSON :: SrcSpan -> JsonDoc
+ spanToDumpJSON s = case s of
+ (RealSrcSpan rss _) -> JSObject [ ("file", json file)
+ , ("startLine", json $ srcSpanStartLine rss)
+ , ("startCol", json $ srcSpanStartCol rss)
+ , ("endLine", json $ srcSpanEndLine rss)
+ , ("endCol", json $ srcSpanEndCol rss)
+ ]
+ where file = unpackFS $ srcSpanFile rss
+ UnhelpfulSpan _ -> JSNull
defaultLogAction :: LogAction
defaultLogAction logflags msg_class srcSpan msg
@@ -403,6 +458,12 @@ defaultLogActionHPutStrDoc logflags asciiSpace h d
-- information to provide to the user but refactoring log_action is quite
-- invasive as it is called in many places. So, for now I left it alone
-- and we can refine its behaviour as users request different output.
+--
+-- The recent work here replaces the purpose of flag -ddump-json with
+-- -fdiagnostics-as-json. For temporary backwards compatibility while
+-- -ddump-json is being deprecated, `jsonLogAction` has been added in, but
+-- it should be removed along with -ddump-json. Similarly, the guard in
+-- `defaultLogAction` should be removed. This cleanup is tracked in #24113.
-- | Default action for 'dumpAction' hook
defaultDumpAction :: DumpCache -> LogAction -> DumpAction
@@ -532,6 +593,9 @@ defaultTraceAction logflags title doc x =
logMsg :: Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
logMsg logger mc loc msg = putLogMsg logger (logFlags logger) mc loc msg
+logJsonMsg :: ToJson a => Logger -> MessageClass -> a -> IO ()
+logJsonMsg logger mc d = putJsonLogMsg logger (logFlags logger) mc (json d)
+
-- | Dump something
logDumpFile :: Logger -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
logDumpFile logger = putDumpFile logger (logFlags logger)
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -56,12 +56,11 @@ Dumping out compiler intermediate structures
output of one way with the output of another.
.. ghc-flag:: -ddump-json
- :shortdesc: Dump error messages as JSON documents
+ :shortdesc: *(deprecated)* Use :ghc-flag:`-fdiagnostics-as-json` instead
:type: dynamic
- Dump error messages as JSON documents. This is intended to be consumed
- by external tooling. A good way to use it is in conjunction with
- :ghc-flag:`-ddump-to-file`.
+ This flag was previously used to generated JSON formatted GHC diagnostics,
+ but has been deprecated. Instead, use :ghc-flag:`-fdiagnostics-as-json`.
.. ghc-flag:: -dshow-passes
:shortdesc: Print out each pass name as it happens
=====================================
docs/users_guide/diagnostics-as-json-schema-1_0.json
=====================================
@@ -0,0 +1,103 @@
+{
+ "$schema": "https://json-schema.org/draft/2020-12/schema",
+ "title": "JSON Diagnostic Schema",
+ "description": "A Schema for specifying GHC diagnostics output as JSON",
+ "type": "object",
+ "properties": {
+ "version": {
+ "description": "The current JSON schema version this object conforms to",
+ "type": "string"
+ },
+ "ghcVersion": {
+ "description": "The GHC version",
+ "type": "string"
+ },
+ "span": {
+ "$ref": "#/$defs/span"
+ },
+ "severity": {
+ "description": "The diagnostic severity",
+ "type": "string",
+ "enum": [
+ "Warning",
+ "Error"
+ ]
+ },
+ "code": {
+ "description": "The diagnostic code (if it exists)",
+ "type": [
+ "integer",
+ "null"
+ ]
+ },
+ "message": {
+ "description": "The string output of the diagnostic message by GHC",
+ "type": "array",
+ "items": {
+ "type": "string"
+ }
+ },
+ "hints": {
+ "description": "The suggested fixes",
+ "type": "array",
+ "items": {
+ "type": "string"
+ }
+ }
+ },
+ "required": [
+ "version",
+ "ghcVersion",
+ "span",
+ "severity",
+ "code",
+ "message",
+ "hints"
+ ],
+ "additionalProperties": false,
+ "$defs": {
+ "span": {
+ "description": "The span of the diagnostic",
+ "type": "object",
+ "properties": {
+ "file": {
+ "description": "The file in which the diagnostic occurs",
+ "type": "string"
+ },
+ "start": {
+ "description": "The start location of the diagnostic",
+ "$ref": "#/$defs/location"
+ },
+ "end": {
+ "description": "The end location of the diagnostic",
+ "$ref": "#/$defs/location"
+ }
+ },
+ "required": [
+ "file",
+ "start",
+ "end"
+ ],
+ "additionalProperties": false
+ },
+ "location": {
+ "description": "A location in a text file",
+ "type": "object",
+ "properties": {
+ "line": {
+ "description": "The line number",
+ "type": "integer"
+ },
+ "column": {
+ "description": "The column number",
+ "type": "integer"
+ }
+ },
+ "required": [
+ "line",
+ "column"
+ ],
+ "additionalProperties": false
+ }
+ }
+}
=====================================
docs/users_guide/exts/instances.rst
=====================================
@@ -139,8 +139,8 @@ BNF-style grammar for the tops of instance declarations below.
| arg_type infix_cls_tycon arg_type
| '(' arg_type infix_cls_tycon arg_type ')' arg_types
- arg_type ::= <empty>
- | arg_type arg_types
+ arg_types ::= <empty>
+ | arg_type arg_types
opt_where ::= <empty>
| 'where'
@@ -718,7 +718,7 @@ Some details:
- The instance signature is purely local to the class instance
declaration. It only affects the typechecking of the method in
the instance; it does not affect anything outside the class
- instance. In this way, it is similar to an inline type signature:
+ instance. In this way, it is similar to an inline type signature: ::
instance Eq a => Eq (T a) where
(==) = (\ x y -> True) :: forall b. b -> b -> Bool
=====================================
docs/users_guide/exts/overloaded_labels.rst
=====================================
@@ -91,4 +91,69 @@ showing how an overloaded label can be used as a record selector:
example = #x (Point 1 2)
+Since GHC 9.6, any non-empty double quoted string can be used as a label. The
+restriction that the label must be a valid identifier has also been lifted.
+Examples of newly allowed syntax:
+
+- Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"`
+
+- Numeric characters: `#3.14` equivalent to `getLabel @"3.14"`
+
+- Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"`
+
+Here is an example of the more permissive use of this extension, available since
+GHC 9.6:
+
+::
+
+ {-# LANGUAGE DataKinds #-}
+ {-# LANGUAGE MultiParamTypeClasses #-}
+ {-# LANGUAGE OverloadedLabels #-}
+ {-# LANGUAGE MagicHash #-}
+
+ import Data.Foldable (traverse_)
+ import Data.Proxy (Proxy(..))
+ import GHC.OverloadedLabels (IsLabel(..))
+ import GHC.TypeLits (KnownSymbol, symbolVal)
+ import GHC.Prim (Addr#)
+
+ instance KnownSymbol symbol => IsLabel symbol String where
+ fromLabel = symbolVal (Proxy :: Proxy symbol)
+
+ (#) :: String -> Int -> String
+ (#) _ i = show i
+
+ f :: Addr# -> Int -> String
+ f _ i = show i
+
+ main :: IO ()
+ main = traverse_ putStrLn
+ [ #a
+ , #number17
+ , #do
+ , #type
+ , #Foo
+ , #3
+ , #199.4
+ , #17a23b
+ , #f'a'
+ , #'a'
+ , #'
+ , #''notTHSplice
+ , #...
+ , #привет
+ , #こんにちは
+ , #"3"
+ , #":"
+ , #"Foo"
+ , #"The quick brown fox"
+ , #"\""
+ , (++) #hello#world
+ , (++) #"hello"#"world"
+ , #"hello"# 1 -- equivalent to `(fromLabel @"hello") # 1`
+ , f "hello"#2 -- equivalent to `f ("hello"# :: Addr#) 2`
+ ]
+
+See `GHC Proposal #170 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst>`__
+for more details.
=====================================
docs/users_guide/using.rst
=====================================
@@ -1403,6 +1403,19 @@ messages and in GHCi:
find the relevant errors or likely to ignore the warnings when they are
mixed with many other messages.
+.. ghc-flag:: -fdiagnostics-as-json
+ :shortdesc: Output diagnostics in Json format specified by JSON schema
+ :type: dynamic
+ :category: verbosity
+
+ Causes GHC to emit diagnostic messages in a standardized JSON format,
+ and output them directly to ``stderr``. The format follows the `JSON Lines <https://jsonlines.org>`_
+ convention, where each diagnostic is its own JSON object separated by
+ a new line.
+
+ The structure of the output is described by a `JSON Schema <https://json-schema.org/>`_.
+ The schema can be downloaded :download:`here <diagnostics-as-json-schema-1_0.json>`.
+
.. ghc-flag:: -fdiagnostics-color=⟨always|auto|never⟩
:shortdesc: Use colors in error messages
:type: dynamic
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -151,6 +151,7 @@ GHC.Types.ForeignCall
GHC.Types.ForeignStubs
GHC.Types.GREInfo
GHC.Types.Hint
+GHC.Types.Hint.Ppr
GHC.Types.HpcInfo
GHC.Types.Id
GHC.Types.Id.Info
=====================================
testsuite/tests/driver/T16167.stdout
=====================================
@@ -1 +1,2 @@
+{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
{"span":{"file":"T16167.hs","startLine":1,"startCol":8,"endLine":1,"endCol":9},"doc":"parse error on input \u2018f\u2019","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-58481"}
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -273,13 +273,11 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef'])
test('T12955', normal, makefile_test, [])
test('T12971', [when(opsys('mingw32'), fragile(17945)), ignore_stdout], makefile_test, [])
-test('json', normal, compile_fail, ['-ddump-json'])
-
-# json2 test is sensitive to the LLVM not supported ouput from GHC. ANd the error
-# won't tell. It looks unrelated and is annoying to debug. Hence we disable the
-# warning to prevent spurious errors.
+test('json_dump', normal, compile_fail, ['-ddump-json'])
+test('json', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json'])
+test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches'])
test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json -Wno-unsupported-llvm-version'])
-test('T16167', [req_interp,exit_code(1)], run_command,
+test('T16167', [normalise_version('ghc'),req_interp,exit_code(1)], run_command,
['{compiler} -x hs -e ":set prog T16167.hs" -ddump-json T16167.hs'])
test('T13604', [], makefile_test, [])
test('T13604a',
=====================================
testsuite/tests/driver/json.hs
=====================================
@@ -1,6 +1,9 @@
+{-# LANGUAGE NoEmptyCase #-}
module Foo where
import Data.List
-id1 :: a -> a
-id1 = 5
+f1 :: a -> a
+f1 x = 5
+
+f2 x = do case () of
=====================================
testsuite/tests/driver/json.stderr
=====================================
@@ -1 +1 @@
-{"span":{"file":"json.hs","startLine":6,"startCol":7,"endLine":6,"endCol":8},"doc":"\u2022 No instance for \u2018Num (a -> a)\u2019 arising from the literal \u20185\u2019\n (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n In an equation for \u2018id1\u2019: id1 = 5","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-39999"}
+{"version":"1.0","ghcVersion":"ghc-9.9.20230817","span":{"file":"json.hs","start":{"line":9,"column":11},"end":{"line":9,"column":21}},"severity":"Error","code":48010,"message":["Empty list of alternatives in case expression"],"hints":["Perhaps you intended to use EmptyCase"]}
=====================================
testsuite/tests/driver/json2.stderr
=====================================
@@ -1 +1,2 @@
-{"span":null,"doc":"TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.16.0.0]","messageClass":"MCOutput"}
+{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
+{"span":null,"doc":"TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.19.0.0]","messageClass":"MCOutput"}
=====================================
testsuite/tests/driver/json_dump.hs
=====================================
@@ -0,0 +1,6 @@
+module Foo where
+
+import Data.List
+
+id1 :: a -> a
+id1 = 5
=====================================
testsuite/tests/driver/json_dump.stderr
=====================================
@@ -0,0 +1,2 @@
+{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
+{"span":{"file":"json_dump.hs","startLine":6,"startCol":7,"endLine":6,"endCol":8},"doc":"\u2022 No instance for \u2018Num (a -> a)\u2019 arising from the literal \u20185\u2019\n (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n In an equation for \u2018id1\u2019: id1 = 5","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-39999"}
=====================================
testsuite/tests/driver/json_warn.hs
=====================================
@@ -0,0 +1,4 @@
+module Foo where
+
+f :: Int -> Int
+f x = 5
=====================================
testsuite/tests/driver/json_warn.stderr
=====================================
@@ -0,0 +1 @@
+{"version":"1.0","ghcVersion":"ghc-9.9.20230817","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"message":["Defined but not used: `x'"],"hints":[]}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b54559436f0e18760b9d47c6d959b24208897f2...85ca8a84190aa7427d6157d94c49409b91b11261
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b54559436f0e18760b9d47c6d959b24208897f2...85ca8a84190aa7427d6157d94c49409b91b11261
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/20231225/f786e602/attachment-0001.html>
More information about the ghc-commits
mailing list