diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/diagnose.cabal b/diagnose.cabal --- a/diagnose.cabal +++ b/diagnose.cabal @@ -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. diff --git a/src/Error/Diagnose.hs b/src/Error/Diagnose.hs --- a/src/Error/Diagnose.hs +++ b/src/Error/Diagnose.hs @@ -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(x : a) : a := x + 1 - > • ┬──── - > • ╰╸ Required here - > ─────╯ - - > [error]: Error with one marker in bounds - > +-> test.zc@1:25-1:30 - > | - > 1 | let id(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 = "" - > 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 - > ╭─▶ @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 = "" - > 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 - > ╭─▶ @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(x : a) : a := x + 1 +-- > • ┬──── +-- > • ╰╸ Required here +-- > ─────╯ +-- +-- > [error]: Error with one marker in bounds +-- > +-> test.zc@1:25-1:30 +-- > | +-- > 1 | let id(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 = "" +-- > 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 +-- > ╭─▶ @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 = "" +-- > 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 +-- > ╭─▶ @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@. diff --git a/src/Error/Diagnose/Compat/Megaparsec.hs b/src/Error/Diagnose/Compat/Megaparsec.hs --- a/src/Error/Diagnose/Compat/Megaparsec.hs +++ b/src/Error/Diagnose/Compat/Megaparsec.hs @@ -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 diff --git a/src/Error/Diagnose/Compat/Parsec.hs b/src/Error/Diagnose/Compat/Parsec.hs --- a/src/Error/Diagnose/Compat/Parsec.hs +++ b/src/Error/Diagnose/Compat/Parsec.hs @@ -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 diff --git a/src/Error/Diagnose/Diagnostic/Internal.hs b/src/Error/Diagnose/Diagnostic/Internal.hs --- a/src/Error/Diagnose/Diagnostic/Internal.hs +++ b/src/Error/Diagnose/Diagnostic/Internal.hs @@ -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 diff --git a/src/Error/Diagnose/Report/Internal.hs b/src/Error/Diagnose/Report/Internal.hs --- a/src/Error/Diagnose/Report/Internal.hs +++ b/src/Error/Diagnose/Report/Internal.hs @@ -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]: diff --git a/test/megaparsec/Spec.hs b/test/megaparsec/Spec.hs --- a/test/megaparsec/Spec.hs +++ b/test/megaparsec/Spec.hs @@ -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) diff --git a/test/parsec/Spec.hs b/test/parsec/Spec.hs --- a/test/parsec/Spec.hs +++ b/test/parsec/Spec.hs @@ -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 - diff --git a/test/rendering/Spec.hs b/test/rendering/Spec.hs --- a/test/rendering/Spec.hs +++ b/test/rendering/Spec.hs @@ -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(x : a) : a := x + 1\nrec fix(f) := f(fix(f))\nlet const(x : a, y : b) : a := x"), ("somefile.zc", "let id(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 🎉")] []