diagnose 1.6.4 → 1.7.0

raw patch · 10 files changed

+359/−291 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +13/−9
• diagnose.cabal +1/−1
• src/Error/Diagnose.hs +241/−247
• src/Error/Diagnose/Compat/Megaparsec.hs +8/−3
• src/Error/Diagnose/Compat/Parsec.hs +8/−3
• src/Error/Diagnose/Diagnostic/Internal.hs +6/−3
• src/Error/Diagnose/Report/Internal.hs +23/−7
• test/megaparsec/Spec.hs +4/−6
• test/parsec/Spec.hs +4/−7
• test/rendering/Spec.hs +51/−5

@@ -24,6 +24,7 @@ - Generic over the type of message which can be displayed, meaning that you can output custom data types as well as they can be pretty-printed - Diagnostics can be exported to JSON, if you don't quite like the rendering as it is, or if you need to transmit them to e.g. a website - Plug and play (mega)parsec integration and it magically works with your parsers!+- Support for optional custom error codes, if you want to go the Rust way  ## Usage @@ -44,14 +45,16 @@  Both of these fonctions have the following type: ```haskell-  -- | The main message, which is output at the top right after `[error]` or `[warning]`-  msg ->-  -- | A list of markers, along with the positions they span on-  [(Position, Marker msg)] ->-  -- | Some hints to be output at the bottom of the report-  [msg] ->-  -- | The created report-  Report msg+-- | An optional error code, shown right after @error@ or @warning@ in the square brackets+Maybe msg ->+-- | The main message, which is output at the top right after @[error]@ or @[warning]@+msg ->+-- | A list of markers, along with the positions they span on+[(Position, Marker msg)] ->+-- | Some hints to be output at the bottom of the report+[msg] ->+-- | The created report+Report msg ```  Each report contains markers, which are what underlines the code in the screenshots above.@@ -81,6 +84,7 @@ ```haskell let beautifulExample =       err+        Nothing         "Could not deduce constraint 'Num(a)' from the current context"         [ (Position (1, 25) (2, 6) "somefile.zc", This "While applying function '+'"),           (Position (1, 11) (1, 16) "somefile.zc", Where "'x' is supposed to have type 'a'"),@@ -100,7 +104,7 @@  ## TODO list -- Handle variable-width characters such as tabs or some unicode characters+- Handle variable-width characters such as tabs or some unicode characters.    For tabs, we may just resort to having the user fix a given number of   spaces in the `printDiagnostic` function.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           diagnose-version:        1.6.4+version:        1.7.0 synopsis:       Beautiful error reporting done easily description:    This package provides a simple way of getting beautiful compiler/interpreter errors                 using a very simple interface for the programmer.

@@ -21,269 +21,263 @@      -- *** megaparsec >= 9.0.0 ("Error.Diagnose.Compat.Megaparsec")     -- $compatibility_megaparsec-     +     -- *** parsec >= 3.1.14.0 ("Error.Diagnose.Compat.Parsec")     -- $compatibility_parsec-    +     -- *** Common errors     -- $compatibility_errors      -- * Re-exports-    module Export ) where+    module Export,+  )+where -import Error.Diagnose.Pretty as Export+import Error.Diagnose.Diagnostic as Export import Error.Diagnose.Position as Export+import Error.Diagnose.Pretty as Export import Error.Diagnose.Report as Export-import Error.Diagnose.Diagnostic as Export -{- $header--   This module exports all the needed data types to use this library.-   It should be sufficient to only @import "Error.Diagnose"@.--}--{- $usage--   This library is intended to provide a very simple way of creating beautiful errors, by exposing-   a small yet simple API to the user.--   The basic idea is that a diagnostic is a collection of reports (which embody errors or warnings) along-   with the files which can be referenced in those reports.--}--{- $generate_report--   A report contains:--   - A message, to be shown at the top--   - A list of located markers, used to underline parts of the source code and to emphasize it with a message--   - A list of hints, shown at the very bottom--   __Note__: The message type contained in a report is abstracted by a type variable.-             In order to render the report, the message must also be able to be rendered in some way-             (that we'll see later).--   This library allows defining two kinds of reports:--   - Errors, using 'err'--   - Warnings, using 'warn'--   Both take a message, a list of located markers and a list of hints.--   A very simple example is:--   > exampleReport :: Report String-   > exampleReport =-   >   err-   >     -- vv  ERROR MESSAGE-   >     "This is my first error report"-   >     -- vv  MARKERS-   >     [ (Position (1, 3) (1, 8) "some_test.txt", This "Some text under the marker") ]-   >     -- vv  HINTS-   >     []--   In general, 'Position's are returned by either a lexer or a parser, so that you never have to construct them-   directly in the code.--   __Note__: If using any parser library, you will have to convert from the internal positioning system to a 'Position'-             to be able to use this library.--   Markers put in the report can be one of (the colors specified are used only when pretty-printing):--   - A 'This' marker, which is the primary marker of the report.-     While it is allowed to have multiple of these inside one report, it is encouraged not to, because the position at the top of-     the report will only be the one of the /first/ 'This' marker, and because the resulting report may be harder to understand.--         This marker is output in red in an error report, and yellow in a warning report.--   - A 'Where' marker contains additional information/provides context to the error/warning report.-     For example, it may underline where a given variable @x@ is bound to emphasize it.--         This marker is output in blue.--   - A 'Error.Diagnose.Report.Maybe' marker may contain possible fixes (if the text is short, else hints are recommended for this use).--         This marker is output in magenta.--}--{- $create_diagnostic--   To create a new diagnostic, you need to use its 'Data.Default.Default' instance (which exposes a 'def' function, returning a new empty 'Diagnostic').-   Once the 'Diagnostic' is created, you can use either 'addReport' (which takes a 'Diagnostic' and a 'Report', abstract by the same message type,-   and returns a 'Diagnostic') to insert a new report inside the diagnostic, or 'addFile' (which takes a 'Diagnostic', a 'FilePath' and a @['String']@,-   and returns a 'Diagnostic') to insert a new file reference in the diagnostic.--   You can then either pretty-print the diagnostic obtained (which requires all messages to be instances of the 'Text.PrettyPrint.ANSI.Leijen.Pretty')-   or export it to a lazy JSON 'Data.Bytestring.Lazy.ByteString' (e.g. in a LSP context).--}--{- $diagnostic_pretty--   'Diagnostic's can be output to any 'System.IO.Handle' using the 'printDiagnostic' function.-   This function takes several parameters:--   - The 'System.IO.Handle' onto which to output the 'Diagnostic'.-     It __must__ be a 'System.IO.Handle' capable of outputting data.--   - A 'Bool' used to indicate whether you want to output the 'Diagnostic' with unicode characters, or simple ASCII characters.--         Here are two examples of the same diagnostic, the first output with unicode characters, and the second output with ASCII characters:--         > [error]: Error with one marker in bounds-         >      ╭─▶ test.zc@1:25-1:30-         >      │-         >    1 │ let id<a>(x : a) : a := x + 1-         >      •                         ┬────-         >      •                         ╰╸ Required here-         > ─────╯--         > [error]: Error with one marker in bounds-         >      +-> test.zc@1:25-1:30-         >      |-         >    1 | let id<a>(x : a) : a := x + 1-         >      :                         ^-----         >      :                         `- Required here-         > -----+--   - A 'Bool' set to 'False' if you don't want colors in the end result.--   - And finally the 'Diagnostic' to output.--}--{- $diagnostic_json--   'Diagnostic's can be exported to a JSON record of the following type, using the 'diagnosticToJson' function:--   > { files:-   >     { name: string-   >     , content: string[]-   >     }[]-   > , reports:-   >     { kind: 'error' | 'warning'-   >     , message: string-   >     , markers:-   >         { kind: 'this' | 'where' | 'maybe'-   >         , position:-   >             { beginning: { line: int, column: int }-   >             , end: { line: int, column: int }-   >             , file: string-   >             }-   >         , message: string-   >         }[]-   >     , hints: string[]-   >     }[]-   > }--   This is particularly useful in the context of a LSP server, where outputting or parsing a raw error yields strange results or is unnecessarily complicated.--   Please note that this requires the flag @diagnose:json@ to be enabled (it is disabled by default in order not to include @aeson@, which is a heavy library).--}--{- $compatibility_layers --   There are many parsing libraries available in the Haskell ecosystem, each coming with its own way of handling errors.-   Eventually, one needs to be able to map errors from these libraries to 'Diagnostic's, without having to include additional code for doing so.-   This is where compatibility layers come in handy.--   As of now, there are compatibility layers for these libraries:--}--{- $compatibility_megaparsec--   This needs the flag @diagnose:megaparsec-compat@ to be enabled.--   Using the compatibility layer is very easy, as it is designed to be as simple as possible.-   One simply needs to convert the 'Text.Megaparsec.ParseErrorBundle' which is returned by running a parser into a 'Diagnostic' by using 'Error.Diagnose.Compat.Megaparsec.diagnosticFromBundle'.-   Several wrappers are included for easy creation of kinds (error, warning) of diagnostics.--   __Note:__ the returned diagnostic does not include file contents, which needs to be added manually afterwards.--   As a quick example:--   > import qualified Text.Megaparsec as MP-   > import qualified Text.Megaparsec.Char as MP-   > import qualified Text.Megaparsec.Char.Lexer as MP-   >-   > let filename = "<interactive>"-   >     content  = "00000a2223266"-   >-   > let myParser = MP.some MP.decimal <* MP.eof-   >-   > let res      = MP.runParser myParser filename content-   >-   > case res of-   >   Left bundle ->-   >     let diag  = errorDiagnosticFromBundle "Parse error on input" Nothing bundle-   >            --   Creates a new diagnostic with no default hints from the bundle returned by megaparsec-   >         diag' = addFile diag filename content-   >            --   Add the file used when parsing with the same filename given to 'MP.runParser'-   >     in printDiagnostic stderr True True diag'-   >   Right res   -> print res--   This example will return the following error message (assuming default instances for @'Error.Diagnose.Compat.Megaparsec.HasHints' 'Data.Void.Void' msg@):--   > [error]: Parse error on input-   >      ╭─▶ <interactive>@1:6-1:7-   >      │-   >    1 │ 00000a2223266-   >      •      ┬ -   >      •      ├╸ unexpected 'a'-   >      •      ╰╸ expecting digit, end of input, or integer-   > ─────╯--}--{- $compatibility_parsec--   This needs the flag @diagnose:parsec-compat@ to be enabled.--   This compatibility layer allows easily converting 'Text.Parsec.Error.ParseError's into a single-report diagnostic containing all available information such-   as unexpected/expected tokens or error messages.-   The function 'Error.Diagnose.Compat.Parsec.diagnosticFromParseError' is used to perform the conversion between a 'Text.Parsec.Error.ParseError' and a 'Diagnostic'.--   __Note:__ the returned diagnostic does not include file contents, which needs to be added manually afterwards.+-- $header+--+--   This module exports all the needed data types to use this library.+--   It should be sufficient to only @import "Error.Diagnose"@. -   Quick example:+-- $usage+--+--   This library is intended to provide a very simple way of creating beautiful errors, by exposing+--   a small yet simple API to the user.+--+--   The basic idea is that a diagnostic is a collection of reports (which embody errors or warnings) along+--   with the files which can be referenced in those reports. -   > import qualified Text.Parsec as P-   >-   > let filename = "<interactive>"-   >     content  = "00000a2223266"-   >-   > let myParser = P.many1 P.digit <* P.eof-   >-   > let res      = P.parse myParser filename content-   >-   > case res of-   >   Left error ->-   >     let diag  = errorDiagnosticFromParseError "Parse error on input" Nothing error-   >            --   Creates a new diagnostic with no default hints from the bundle returned by megaparsec-   >         diag' = addFile diag filename content-   >            --   Add the file used when parsing with the same filename given to 'MP.runParser'-   >     in printDiagnostic stderr True True diag'-   >   Right res  -> print res+-- $generate_report+--+--   A report contains:+--+--   - A message, to be shown at the top+--+--   - A list of located markers, used to underline parts of the source code and to emphasize it with a message+--+--   - A list of hints, shown at the very bottom+--+--   __Note__: The message type contained in a report is abstracted by a type variable.+--             In order to render the report, the message must also be able to be rendered in some way+--             (that we'll see later).+--+--   This library allows defining two kinds of reports:+--+--   - Errors, using 'err'+--+--   - Warnings, using 'warn'+--+--   Both take an optional error code, a message, a list of located markers and a list of hints.+--+--   A very simple example is:+--+--   > exampleReport :: Report String+--   > exampleReport =+--   >   err+--   >     -- vv  OPTIONAL ERROR CODE+--   >     Nothing+--   >     -- vv  ERROR MESSAGE+--   >     "This is my first error report"+--   >     -- vv  MARKERS+--   >     [ (Position (1, 3) (1, 8) "some_test.txt", This "Some text under the marker") ]+--   >     -- vv  HINTS+--   >     []+--+--   In general, 'Position's are returned by either a lexer or a parser, so that you never have to construct them+--   directly in the code.+--+--   __Note__: If using any parser library, you will have to convert from the internal positioning system to a 'Position'+--             to be able to use this library.+--+--   Markers put in the report can be one of (the colors specified are used only when pretty-printing):+--+--   - A 'This' marker, which is the primary marker of the report.+--     While it is allowed to have multiple of these inside one report, it is encouraged not to, because the position at the top of+--     the report will only be the one of the /first/ 'This' marker, and because the resulting report may be harder to understand.+--+--         This marker is output in red in an error report, and yellow in a warning report.+--+--   - A 'Where' marker contains additional information/provides context to the error/warning report.+--     For example, it may underline where a given variable @x@ is bound to emphasize it.+--+--         This marker is output in blue.+--+--   - A 'Error.Diagnose.Report.Maybe' marker may contain possible fixes (if the text is short, else hints are recommended for this use).+--+--         This marker is output in magenta. -   This will output the following errr on @stderr@:+-- $create_diagnostic+--+--   To create a new diagnostic, you need to use its 'Data.Default.Default' instance (which exposes a 'def' function, returning a new empty 'Diagnostic').+--   Once the 'Diagnostic' is created, you can use either 'addReport' (which takes a 'Diagnostic' and a 'Report', abstract by the same message type,+--   and returns a 'Diagnostic') to insert a new report inside the diagnostic, or 'addFile' (which takes a 'Diagnostic', a 'FilePath' and a @['String']@,+--   and returns a 'Diagnostic') to insert a new file reference in the diagnostic.+--+--   You can then either pretty-print the diagnostic obtained (which requires all messages to be instances of the 'Text.PrettyPrint.ANSI.Leijen.Pretty')+--   or export it to a lazy JSON 'Data.Bytestring.Lazy.ByteString' (e.g. in a LSP context). -   > [error]: Parse error on input-   >      ╭─▶ <interactive>@1:6-1:7-   >      │-   >    1 │ 00000a2223266-   >      •      ┬ -   >      •      ├╸ unexpected 'a'-   >      •      ╰╸ expecting any of digit, end of input-   > ─────╯--}+-- $diagnostic_pretty+--+--   'Diagnostic's can be output to any 'System.IO.Handle' using the 'printDiagnostic' function.+--   This function takes several parameters:+--+--   - The 'System.IO.Handle' onto which to output the 'Diagnostic'.+--     It __must__ be a 'System.IO.Handle' capable of outputting data.+--+--   - A 'Bool' used to indicate whether you want to output the 'Diagnostic' with unicode characters, or simple ASCII characters.+--+--         Here are two examples of the same diagnostic, the first output with unicode characters, and the second output with ASCII characters:+--+--         > [error]: Error with one marker in bounds+--         >      ╭─▶ test.zc@1:25-1:30+--         >      │+--         >    1 │ let id<a>(x : a) : a := x + 1+--         >      •                         ┬────+--         >      •                         ╰╸ Required here+--         > ─────╯+--+--         > [error]: Error with one marker in bounds+--         >      +-> test.zc@1:25-1:30+--         >      |+--         >    1 | let id<a>(x : a) : a := x + 1+--         >      :                         ^----+--         >      :                         `- Required here+--         > -----++--+--   - A 'Bool' set to 'False' if you don't want colors in the end result.+--+--   - And finally the 'Diagnostic' to output. -{- $compatibility_errors+-- $diagnostic_json+--+--   'Diagnostic's can be exported to a JSON record of the following type, using the 'diagnosticToJson' function:+--+--   > { files:+--   >     { name: string+--   >     , content: string[]+--   >     }[]+--   > , reports:+--   >     { kind: 'error' | 'warning'+--   >     , code: string?+--   >     , message: string+--   >     , markers:+--   >         { kind: 'this' | 'where' | 'maybe'+--   >         , position:+--   >             { beginning: { line: int, column: int }+--   >             , end: { line: int, column: int }+--   >             , file: string+--   >             }+--   >         , message: string+--   >         }[]+--   >     , hints: string[]+--   >     }[]+--   > }+--+--   This is particularly useful in the context of a LSP server, where outputting or parsing a raw error yields strange results or is unnecessarily complicated.+--+--   Please note that this requires the flag @diagnose:json@ to be enabled (it is disabled by default in order not to include @aeson@, which is a heavy library). -   - @No instance for (HasHints ??? msg) arising from a use of ‘errorDiagnosticFromBundle’@ (@???@ is any type, depending on your parser's custom error type):+-- $compatibility_layers+--+--   There are many parsing libraries available in the Haskell ecosystem, each coming with its own way of handling errors.+--   Eventually, one needs to be able to map errors from these libraries to 'Diagnostic's, without having to include additional code for doing so.+--   This is where compatibility layers come in handy.+--+--   As of now, there are compatibility layers for these libraries: -       The typeclass 'Error.Diagnose.Compat.Megaparsec.HasHints' does not have any default instances, because treatments of custom errors is highly dependent on who is using the library.-       As such, you will need to create orphan instances for your parser's error type.+-- $compatibility_megaparsec+--+--   This needs the flag @diagnose:megaparsec-compat@ to be enabled.+--+--   Using the compatibility layer is very easy, as it is designed to be as simple as possible.+--   One simply needs to convert the 'Text.Megaparsec.ParseErrorBundle' which is returned by running a parser into a 'Diagnostic' by using 'Error.Diagnose.Compat.Megaparsec.diagnosticFromBundle'.+--   Several wrappers are included for easy creation of kinds (error, warning) of diagnostics.+--+--   __Note:__ the returned diagnostic does not include file contents, which needs to be added manually afterwards.+--+--   As a quick example:+--+--   > import qualified Text.Megaparsec as MP+--   > import qualified Text.Megaparsec.Char as MP+--   > import qualified Text.Megaparsec.Char.Lexer as MP+--   >+--   > let filename = "<interactive>"+--   >     content  = "00000a2223266"+--   >+--   > let myParser = MP.some MP.decimal <* MP.eof+--   >+--   > let res      = MP.runParser myParser filename content+--   >+--   > case res of+--   >   Left bundle ->+--   >     let diag  = errorDiagnosticFromBundle "Parse error on input" Nothing bundle+--   >            --   Creates a new diagnostic with no default hints from the bundle returned by megaparsec+--   >         diag' = addFile diag filename content+--   >            --   Add the file used when parsing with the same filename given to 'MP.runParser'+--   >     in printDiagnostic stderr True True diag'+--   >   Right res   -> print res+--+--   This example will return the following error message (assuming default instances for @'Error.Diagnose.Compat.Megaparsec.HasHints' 'Data.Void.Void' msg@):+--+--   > [error]: Parse error on input+--   >      ╭─▶ <interactive>@1:6-1:7+--   >      │+--   >    1 │ 00000a2223266+--   >      •      ┬+--   >      •      ├╸ unexpected 'a'+--   >      •      ╰╸ expecting digit, end of input, or integer+--   > ─────╯ -       Note that the message type @msg@ can be left abstract if the implements of 'Error.Diagnose.Compat.Hints.hints' is @hints _ = mempty@.+-- $compatibility_parsec+--+--   This needs the flag @diagnose:parsec-compat@ to be enabled.+--+--   This compatibility layer allows easily converting 'Text.Parsec.Error.ParseError's into a single-report diagnostic containing all available information such+--   as unexpected/expected tokens or error messages.+--   The function 'Error.Diagnose.Compat.Parsec.diagnosticFromParseError' is used to perform the conversion between a 'Text.Parsec.Error.ParseError' and a 'Diagnostic'.+--+--   __Note:__ the returned diagnostic does not include file contents, which needs to be added manually afterwards.+--+--   Quick example:+--+--   > import qualified Text.Parsec as P+--   >+--   > let filename = "<interactive>"+--   >     content  = "00000a2223266"+--   >+--   > let myParser = P.many1 P.digit <* P.eof+--   >+--   > let res      = P.parse myParser filename content+--   >+--   > case res of+--   >   Left error ->+--   >     let diag  = errorDiagnosticFromParseError "Parse error on input" Nothing error+--   >            --   Creates a new diagnostic with no default hints from the bundle returned by megaparsec+--   >         diag' = addFile diag filename content+--   >            --   Add the file used when parsing with the same filename given to 'MP.runParser'+--   >     in printDiagnostic stderr True True diag'+--   >   Right res  -> print res+--+--   This will output the following errr on @stderr@:+--+--   > [error]: Parse error on input+--   >      ╭─▶ <interactive>@1:6-1:7+--   >      │+--   >    1 │ 00000a2223266+--   >      •      ┬+--   >      •      ├╸ unexpected 'a'+--   >      •      ╰╸ expecting any of digit, end of input+--   > ─────╯ --}+-- $compatibility_errors+--+--   - @No instance for (HasHints ??? msg) arising from a use of ‘errorDiagnosticFromBundle’@ (@???@ is any type, depending on your parser's custom error type):+--+--       The typeclass 'Error.Diagnose.Compat.Megaparsec.HasHints' does not have any default instances, because treatments of custom errors is highly dependent on who is using the library.+--       As such, you will need to create orphan instances for your parser's error type.+--+--       Note that the message type @msg@ can be left abstract if the implements of 'Error.Diagnose.Compat.Hints.hints' is @hints _ = mempty@.

@@ -24,7 +24,6 @@ where  import Data.Bifunctor (second)-import Data.Function ((&)) import Data.Maybe (fromMaybe) import qualified Data.Set as Set (toList) import Data.String (IsString (..))@@ -38,6 +37,8 @@   (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>   -- | How to decide whether this is an error or a warning diagnostic   (MP.ParseError s e -> Bool) ->+  -- | An optional error code+  Maybe msg ->   -- | The error message of the diagnostic   msg ->   -- | Default hints when trivial errors are reported@@ -45,7 +46,7 @@   -- | The bundle to create a diagnostic from   MP.ParseErrorBundle s e ->   Diagnostic msg-diagnosticFromBundle isError msg (fromMaybe [] -> trivialHints) MP.ParseErrorBundle {..} =+diagnosticFromBundle isError code msg (fromMaybe [] -> trivialHints) MP.ParseErrorBundle {..} =   foldl addReport def (toLabeledPosition <$> bundleErrors)   where     toLabeledPosition :: MP.ParseError s e -> Report msg@@ -54,7 +55,7 @@           source = fromSourcePos (MP.pstateSourcePos pos)           msgs = fromString @msg <$> lines (MP.parseErrorTextPretty error)        in flip-            (msg & if isError error then err else warn)+            (if isError error then err code msg else warn code msg)             (errorHints error)             if                 | [m] <- msgs -> [(source, This m)]@@ -78,6 +79,8 @@ errorDiagnosticFromBundle ::   forall msg s e.   (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>+  -- | An optional error code+  Maybe msg ->   -- | The error message of the diagnostic   msg ->   -- | Default hints when trivial errors are reported@@ -91,6 +94,8 @@ warningDiagnosticFromBundle ::   forall msg s e.   (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>+  -- | An optional error code+  Maybe msg ->   -- | The error message of the diagnostic   msg ->   -- | Default hints when trivial errors are reported

@@ -20,7 +20,6 @@ where  import Data.Bifunctor (second)-import Data.Function ((&)) import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.String (IsString (..))@@ -36,6 +35,8 @@   (IsString msg, HasHints Void msg) =>   -- | Determine whether the diagnostic is an error or a warning   (PE.ParseError -> Bool) ->+  -- | An optional error code+  Maybe msg ->   -- | The main error of the diagnostic   msg ->   -- | Default hints@@ -43,10 +44,10 @@   -- | The 'PE.ParseError' to transform into a 'Diagnostic'   PE.ParseError ->   Diagnostic msg-diagnosticFromParseError isError msg (fromMaybe [] -> defaultHints) error =+diagnosticFromParseError isError code msg (fromMaybe [] -> defaultHints) error =   let pos = fromSourcePos $ PE.errorPos error       markers = toMarkers pos $ PE.errorMessages error-      report = (msg & if isError error then err else warn) markers (defaultHints <> hints (undefined :: Void))+      report = (if isError error then err code msg else warn code msg) markers (defaultHints <> hints (undefined :: Void))    in addReport def report   where     fromSourcePos :: PP.SourcePos -> Position@@ -75,6 +76,8 @@ errorDiagnosticFromParseError ::   forall msg.   (IsString msg, HasHints Void msg) =>+  -- | An optional error code+  Maybe msg ->   -- | The main error message of the diagnostic   msg ->   -- | Default hints@@ -88,6 +91,8 @@ warningDiagnosticFromParseError ::   forall msg.   (IsString msg, HasHints Void msg) =>+  -- | An optional error code+  Maybe msg ->   -- | The main error message of the diagnostic   msg ->   -- | Default hints

@@ -126,7 +126,8 @@ --   >     }[] --   > , reports: --   >     { kind: 'error' | 'warning'---   >     , message: string+--   >     , code: T?+--   >     , message: T --   >     , markers: --   >         { kind: 'this' | 'where' | 'maybe' --   >         , position:@@ -134,11 +135,13 @@ --   >             , end: { line: int, column: int } --   >             , file: string --   >             }---   >         , message: string+--   >         , message: T --   >         }[]---   >     , hints: string[]+--   >     , hints: T[] --   >     }[] --   > }+--+--   where @T@ is the type of the JSON representation for the @msg@ type variable. diagnosticToJson :: ToJSON msg => Diagnostic msg -> ByteString diagnosticToJson = encode #endif

@@ -25,6 +25,7 @@ #ifdef USE_AESON import Data.Aeson (ToJSON(..), object, (.=)) #endif+import Control.Applicative ((<|>)) import Data.Bifunctor (bimap, first, second) import Data.Default (def) import Data.Foldable (fold)@@ -36,7 +37,7 @@ import qualified Data.List.Safe as List import Data.Ord (Down (..)) import Error.Diagnose.Position-import Prettyprinter (Doc, Pretty (..), align, annotate, colon, hardline, space, width, (<+>))+import Prettyprinter (Doc, Pretty (..), align, annotate, colon, hardline, lbracket, rbracket, space, width, (<+>)) import Prettyprinter.Internal (Doc (..)) import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bold, color, colorDull) @@ -45,6 +46,8 @@   = Report       Bool       -- ^ Is the report a warning or an error?+      (Maybe msg)+      -- ^ An optional error code to print at the top.       msg       -- ^ The message associated with the error.       [(Position, Marker msg)]@@ -53,16 +56,17 @@       -- ^ A list of hints to add at the end of the report.  instance Semigroup msg => Semigroup (Report msg) where-  Report isError1 msg1 pos1 hints1 <> Report isError2 msg2 pos2 hints2 =-    Report (isError1 || isError2) (msg1 <> msg2) (pos1 <> pos2) (hints1 <> hints2)+  Report isError1 code1 msg1 pos1 hints1 <> Report isError2 code2 msg2 pos2 hints2 =+    Report (isError1 || isError2) (code1 <|> code2) (msg1 <> msg2) (pos1 <> pos2) (hints1 <> hints2)  instance Monoid msg => Monoid (Report msg) where-  mempty = Report False mempty mempty mempty+  mempty = Report False Nothing mempty mempty mempty  #ifdef USE_AESON instance ToJSON msg => ToJSON (Report msg) where-  toJSON (Report isError msg markers hints) =+  toJSON (Report isError code msg markers hints) =     object [ "kind" .= (if isError then "error" else "warning" :: String)+           , "code" .= code            , "message" .= msg            , "markers" .= fmap showMarker markers            , "hints" .= hints@@ -111,6 +115,8 @@ -- | Constructs a warning or an error report. warn,   err ::+    -- | An optional error code to be shown right next to "error" or "warning".+    Maybe msg ->     -- | The report message, shown at the very top.     msg ->     -- | A list associating positions with markers.@@ -133,7 +139,7 @@   -- | The whole report to output   Report msg ->   Doc AnsiStyle-prettyReport fileContent withUnicode (Report isError message markers hints) =+prettyReport fileContent withUnicode (Report isError code message markers hints) =   let sortedMarkers = List.sortOn (fst . begin . fst) markers       -- sort the markers so that the first lines of the reports are the first lines of the file @@ -143,7 +149,17 @@       maxLineNumberLength = maybe 3 (max 3 . length . show . fst . end . fst) $ List.safeLast markers       -- if there are no markers, then default to 3, else get the maximum between 3 and the length of the last marker -      header = annotate bold if isError then annotate (color Red) "[error]" else annotate (color Yellow) "[warning]"+      header =+        annotate (bold <> color if isError then Red else Yellow) $+          ( lbracket+              <> ( if isError+                     then "error"+                     else "warning"+                 )+              <> case code of+                Nothing -> rbracket+                Just code -> space <> pretty code <> rbracket+          )    in {-               A report is of the form:               (1)    [error|warning]: <message>

@@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}  {-# OPTIONS -Wno-orphans #-} @@ -11,10 +11,8 @@ import Data.Text (Text) import qualified Data.Text as Text (unpack) import Data.Void (Void)- import Error.Diagnose import Error.Diagnose.Compat.Megaparsec- import qualified Text.Megaparsec as MP import qualified Text.Megaparsec.Char as MP import qualified Text.Megaparsec.Char.Lexer as MP@@ -28,8 +26,8 @@       content1 :: Text = "0000000123456"       content2 :: Text = "00000a2223266" -  let res1 = first (errorDiagnosticFromBundle "Parse error on input" Nothing) $ MP.runParser @Void (MP.some MP.decimal <* MP.eof) filename content1-      res2 = first (errorDiagnosticFromBundle "Parse error on input" Nothing) $ MP.runParser @Void (MP.some MP.decimal <* MP.eof) filename content2+  let res1 = first (errorDiagnosticFromBundle Nothing "Parse error on input" Nothing) $ MP.runParser @Void (MP.some MP.decimal <* MP.eof) filename content1+      res2 = first (errorDiagnosticFromBundle Nothing "Parse error on input" Nothing) $ MP.runParser @Void (MP.some MP.decimal <* MP.eof) filename content2    case res1 of     Left diag -> printDiagnostic stdout True True (addFile diag filename (Text.unpack content1) :: Diagnostic String)

@@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}  {-# OPTIONS -Wno-orphans #-} @@ -11,10 +11,8 @@ import Data.Text (Text) import qualified Data.Text as Text (unpack) import Data.Void (Void)- import Error.Diagnose import Error.Diagnose.Compat.Parsec- import qualified Text.Parsec as P  instance HasHints Void msg where@@ -26,8 +24,8 @@       content1 :: Text = "0000000123456"       content2 :: Text = "00000a2223266" -  let res1 = first (errorDiagnosticFromParseError "Parse error on input" Nothing) $ P.parse (P.many1 P.digit <* P.eof) filename content1-      res2 = first (errorDiagnosticFromParseError "Parse error on input" Nothing) $ P.parse (P.many1 P.digit <* P.eof) filename content2+  let res1 = first (errorDiagnosticFromParseError Nothing "Parse error on input" Nothing) $ P.parse (P.many1 P.digit <* P.eof) filename content1+      res2 = first (errorDiagnosticFromParseError Nothing "Parse error on input" Nothing) $ P.parse (P.many1 P.digit <* P.eof) filename content2    case res1 of     Left diag -> printDiagnostic stdout True True (addFile diag filename (Text.unpack content1) :: Diagnostic String)@@ -35,4 +33,3 @@   case res2 of     Left diag -> printDiagnostic stdout True True (addFile diag filename (Text.unpack content2) :: Diagnostic String)     Right res -> print res-

@@ -2,10 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-}  #ifdef USE_AESON-      diagnosticToJson,-#endif--#ifdef USE_AESON import qualified Data.ByteString.Lazy as BS #endif import Data.HashMap.Lazy (HashMap)@@ -17,6 +13,9 @@     addFile,     addReport,     def,+#ifdef USE_AESON+    diagnosticToJson,+#endif     err,     printDiagnostic,     stdout,@@ -31,7 +30,8 @@           [ ("test.zc", "let id<a>(x : a) : a := x + 1\nrec fix(f) := f(fix(f))\nlet const<a, b>(x : a, y : b) : a := x"),             ("somefile.zc", "let id<a>(x : a) : a := x\n  + 1"),             ("err.nst", "\n\n\n\n    = jmp g\n\n    g: forall(s: Ts, e: Tc).{ %r0: *s64 | s -> e }"),-            ("unsized.nst", "main: forall(a: Ta, s: Ts, e: Tc).{ %r5: forall().{| s -> e } | s -> %r5 }\n    = salloc a\n    ; sfree\n")+            ("unsized.nst", "main: forall(a: Ta, s: Ts, e: Tc).{ %r5: forall().{| s -> e } | s -> %r5 }\n    = salloc a\n    ; sfree\n"),+            ("unicode.txt", "±⅀\t★♲♥🎉⑳⓴ჳᏁℳ爪")           ]    let reports =@@ -62,6 +62,8 @@           errorMultilineAfterSingleLine,           errorOnEmptyLine,           errorMultipleFiles,+          errorWithCode,+          errorWithStrangeUnicodeInput,           beautifulExample         ] @@ -80,6 +82,7 @@ errorNoMarkersNoHints :: Report String errorNoMarkersNoHints =   err+    Nothing     "Error with no marker"     []     []@@ -87,6 +90,7 @@ errorSingleMarkerNoHints :: Report String errorSingleMarkerNoHints =   err+    Nothing     "Error with one marker in bounds"     [(Position (1, 25) (1, 30) "test.zc", This "Required here")]     []@@ -94,6 +98,7 @@ warningSingleMarkerNoHints :: Report String warningSingleMarkerNoHints =   warn+    Nothing     "Warning with one marker in bounds"     [(Position (1, 25) (1, 30) "test.zc", This "Required here")]     []@@ -101,6 +106,7 @@ errorTwoMarkersSameLineNoOverlapNoHints :: Report String errorTwoMarkersSameLineNoOverlapNoHints =   err+    Nothing     "Error with two markers in bounds (no overlap) on the same line"     [ (Position (1, 5) (1, 10) "test.zc", This "First"),       (Position (1, 15) (1, 22) "test.zc", Where "Second")@@ -110,6 +116,7 @@ errorSingleMarkerOutOfBoundsNoHints :: Report String errorSingleMarkerOutOfBoundsNoHints =   err+    Nothing     "Error with one marker out of bounds"     [(Position (10, 5) (10, 15) "test2.zc", This "Out of bounds")]     []@@ -117,6 +124,7 @@ errorTwoMarkersSameLineOverlapNoHints :: Report String errorTwoMarkersSameLineOverlapNoHints =   err+    Nothing     "Error with two overlapping markers in bounds"     [ (Position (1, 6) (1, 13) "test.zc", This "First"),       (Position (1, 10) (1, 15) "test.zc", Where "Second")@@ -126,6 +134,7 @@ errorTwoMarkersSameLinePartialOverlapNoHints :: Report String errorTwoMarkersSameLinePartialOverlapNoHints =   err+    Nothing     "Error with two partially overlapping markers in bounds"     [ (Position (1, 5) (1, 25) "test.zc", This "First"),       (Position (1, 12) (1, 20) "test.zc", Where "Second")@@ -135,6 +144,7 @@ errorTwoMarkersTwoLinesNoHints :: Report String errorTwoMarkersTwoLinesNoHints =   err+    Nothing     "Error with two markers on two lines in bounds"     [ (Position (1, 5) (1, 12) "test.zc", This "First"),       (Position (2, 3) (2, 4) "test.zc", Where "Second")@@ -144,6 +154,7 @@ realWorldExample :: Report String realWorldExample =   err+    Nothing     "Could not deduce constraint 'Num(a)' from the current context"     [ (Position (1, 25) (1, 30) "test.zc", This "While applying function '+'"),       (Position (1, 11) (1, 16) "test.zc", Where "'x' is supposed to have type 'a'"),@@ -154,6 +165,7 @@ errorTwoMarkersSamePositionNoHints :: Report String errorTwoMarkersSamePositionNoHints =   err+    Nothing     "Error with two markers on the same exact position in bounds"     [ (Position (1, 6) (1, 10) "test.zc", This "First"),       (Position (1, 6) (1, 10) "test.zc", Maybe "Second")@@ -163,6 +175,7 @@ errorThreeMarkersWithOverlapNoHints :: Report String errorThreeMarkersWithOverlapNoHints =   err+    Nothing     "Error with three markers with overlapping in bounds"     [ (Position (1, 9) (1, 15) "test.zc", This "First"),       (Position (1, 9) (1, 18) "test.zc", Maybe "Second"),@@ -173,6 +186,7 @@ errorWithMultilineErrorNoMarkerNoHints :: Report String errorWithMultilineErrorNoMarkerNoHints =   err+    Nothing     "Error with multi\nline message and no markers"     []     []@@ -180,6 +194,7 @@ errorSingleMultilineMarkerMessageNoHints :: Report String errorSingleMultilineMarkerMessageNoHints =   err+    Nothing     "Error with single marker with multiline message"     [(Position (1, 9) (1, 15) "test.zc", This "First\nmultiline")]     []@@ -187,6 +202,7 @@ errorTwoMarkersSameOriginOverlapNoHints :: Report String errorTwoMarkersSameOriginOverlapNoHints =   err+    Nothing     "Error with two markers with same origin but partial overlap in bounds"     [ (Position (1, 9) (1, 15) "test.zc", This "First"),       (Position (1, 9) (1, 20) "test.zc", Maybe "Second")@@ -196,6 +212,7 @@ errorNoMarkersSingleHint :: Report String errorNoMarkersSingleHint =   err+    Nothing     "Error with no marker and one hint"     []     ["First hint"]@@ -203,6 +220,7 @@ errorNoMarkersSingleMultilineHint :: Report String errorNoMarkersSingleMultilineHint =   err+    Nothing     "Error with no marker and one multiline hint"     []     ["First multi\nline hint"]@@ -210,6 +228,7 @@ errorNoMarkersTwoHints :: Report String errorNoMarkersTwoHints =   err+    Nothing     "Error with no markers and two hints"     []     [ "First hint",@@ -219,6 +238,7 @@ errorSingleMultilineMarkerNoHints :: Report String errorSingleMultilineMarkerNoHints =   err+    Nothing     "Error with single marker spanning across multiple lines"     [(Position (1, 15) (2, 6) "test.zc", This "First")]     []@@ -226,6 +246,7 @@ errorTwoMarkersWithMultilineNoHints :: Report String errorTwoMarkersWithMultilineNoHints =   err+    Nothing     "Error with two markers, one single line and one multiline, in bounds"     [ (Position (1, 9) (1, 13) "test.zc", This "First"),       (Position (1, 14) (2, 6) "test.zc", Where "Second")@@ -235,6 +256,7 @@ errorTwoMultilineMarkersNoHints :: Report String errorTwoMultilineMarkersNoHints =   err+    Nothing     "Error with two multiline markers in bounds"     [ (Position (1, 9) (2, 5) "test.zc", This "First"),       (Position (2, 1) (3, 10) "test.zc", Where "Second")@@ -244,6 +266,7 @@ errorSingleMultilineMarkerMultilineMessageNoHints :: Report String errorSingleMultilineMarkerMultilineMessageNoHints =   err+    Nothing     "Error with one multiline marker with a multiline message in bounds"     [(Position (1, 9) (2, 5) "test.zc", This "Multi\nline message")]     []@@ -251,6 +274,7 @@ errorTwoMultilineMarkersFirstMultilineMessageNoHints :: Report String errorTwoMultilineMarkersFirstMultilineMessageNoHints =   err+    Nothing     "Error with two multiline markers with one multiline message in bounds"     [ (Position (1, 9) (2, 5) "test.zc", This "First"),       (Position (1, 9) (2, 6) "test.zc", Where "Multi\nline message")@@ -260,6 +284,7 @@ errorThreeMultilineMarkersTwoMultilineMessageNoHints :: Report String errorThreeMultilineMarkersTwoMultilineMessageNoHints =   err+    Nothing     "Error with three multiline markers with two multiline messages in bounds"     [ (Position (1, 9) (2, 5) "test.zc", This "First"),       (Position (1, 9) (2, 6) "test.zc", Where "Multi\nline message"),@@ -270,6 +295,7 @@ errorOrderSensitive :: Report String errorOrderSensitive =   err+    Nothing     "Order-sensitive labels with crossing"     [ (Position (1, 1) (1, 7) "somefile.zc", This "Leftmost label"),       (Position (1, 9) (1, 16) "somefile.zc", Where "Rightmost label")@@ -279,6 +305,7 @@ beautifulExample :: Report String beautifulExample =   err+    Nothing     "Could not deduce constraint 'Num(a)' from the current context"     [ (Position (1, 25) (2, 6) "somefile.zc", This "While applying function '+'"),       (Position (1, 11) (1, 16) "somefile.zc", Where "'x' is supposed to have type 'a'"),@@ -289,6 +316,7 @@ errorMultilineAfterSingleLine :: Report String errorMultilineAfterSingleLine =   err+    Nothing     "Multiline after single line"     [ (Position (1, 17) (1, 18) "unsized.nst", Where "Kind is infered from here"),       (Position (2, 14) (3, 0) "unsized.nst", This "is an error")@@ -298,6 +326,7 @@ errorOnEmptyLine :: Report String errorOnEmptyLine =   err+    Nothing     "Error on empty line"     [(Position (1, 5) (3, 8) "err.nst", This "error on empty line")]     []@@ -305,8 +334,25 @@ errorMultipleFiles :: Report String errorMultipleFiles =   err+    Nothing     "Error on multiple files"     [ (Position (1, 5) (1, 7) "test.zc", Where "Function already declared here"),       (Position (1, 5) (1, 7) "somefile.zc", This "Function `id` is already declared in another module")     ]+    []++errorWithCode :: Report String+errorWithCode =+  err+    (Just "E0123")+    "Error with code and markers"+    [(Position (1, 5) (1, 7) "test.zc", This "is an error")]+    []++errorWithStrangeUnicodeInput :: Report String+errorWithStrangeUnicodeInput =+  err+    (Just "❎")+    "ⓈⓉⓇⒶⓃⒼⒺ ⓊⓃⒾⒸⓄⒹⒺ"+    [(Position (1, 1) (1, 7) "unicode.txt", This "should work fine 🎉")]     []