mirror of
https://github.com/Mesabloo/diagnose.git
synced 2024-11-22 09:42:01 +03:00
reformat all files
This commit is contained in:
Mesabloo
parent
ecdbed4a2d
commit
21a3c67660
@ -1,86 +1,105 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-# OPTIONS -Wno-name-shadowing #-}
|
||||
|
||||
-- |
|
||||
-- Module : Error.Diagnose.Compat.Megaparsec
|
||||
-- Description : Compatibility layer for megaparsec
|
||||
-- Copyright : (c) Mesabloo, 2021
|
||||
-- License : BSD3
|
||||
-- Stability : experimental
|
||||
-- Portability : Portable
|
||||
module Error.Diagnose.Compat.Megaparsec
|
||||
( diagnosticFromBundle
|
||||
, errorDiagnosticFromBundle
|
||||
, warningDiagnosticFromBundle
|
||||
, module Error.Diagnose.Compat.Hints
|
||||
) where
|
||||
( diagnosticFromBundle,
|
||||
errorDiagnosticFromBundle,
|
||||
warningDiagnosticFromBundle,
|
||||
module Error.Diagnose.Compat.Hints,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Bifunctor (second)
|
||||
import Data.Function ((&))
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Set as Set (toList)
|
||||
import Data.String (IsString(..))
|
||||
|
||||
import Data.String (IsString (..))
|
||||
import Error.Diagnose
|
||||
import Error.Diagnose.Compat.Hints (HasHints(..))
|
||||
|
||||
import Error.Diagnose.Compat.Hints (HasHints (..))
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
-- | Transforms a megaparsec 'MP.ParseErrorBundle' into a well-formated 'Diagnostic' ready to be shown.
|
||||
diagnosticFromBundle
|
||||
:: forall msg s e.
|
||||
(IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s)
|
||||
=> (MP.ParseError s e -> Bool) -- ^ How to decide whether this is an error or a warning diagnostic
|
||||
-> msg -- ^ The error message of the diagnostic
|
||||
-> Maybe [msg] -- ^ Default hints when trivial errors are reported
|
||||
-> MP.ParseErrorBundle s e -- ^ The bundle to create a diagnostic from
|
||||
-> Diagnostic msg
|
||||
diagnosticFromBundle isError msg (fromMaybe [] -> trivialHints) MP.ParseErrorBundle{..} =
|
||||
diagnosticFromBundle ::
|
||||
forall msg s e.
|
||||
(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) ->
|
||||
-- | The error message of the diagnostic
|
||||
msg ->
|
||||
-- | Default hints when trivial errors are reported
|
||||
Maybe [msg] ->
|
||||
-- | The bundle to create a diagnostic from
|
||||
MP.ParseErrorBundle s e ->
|
||||
Diagnostic msg
|
||||
diagnosticFromBundle isError msg (fromMaybe [] -> trivialHints) MP.ParseErrorBundle {..} =
|
||||
foldl addReport def (toLabeledPosition <$> bundleErrors)
|
||||
where
|
||||
toLabeledPosition :: MP.ParseError s e -> Report msg
|
||||
toLabeledPosition error =
|
||||
let (_, pos) = MP.reachOffset (MP.errorOffset error) bundlePosState
|
||||
source = fromSourcePos (MP.pstateSourcePos pos)
|
||||
msgs = fromString @msg <$> lines (MP.parseErrorTextPretty error)
|
||||
in flip (msg & if isError error then err else warn) (errorHints error)
|
||||
if | [m] <- msgs -> [ (source, This m) ]
|
||||
| [m1, m2] <- msgs -> [ (source, This m1), (source, Where m2) ]
|
||||
| otherwise -> [ (source, This $ fromString "<<Unknown error>>") ]
|
||||
source = fromSourcePos (MP.pstateSourcePos pos)
|
||||
msgs = fromString @msg <$> lines (MP.parseErrorTextPretty error)
|
||||
in flip
|
||||
(msg & if isError error then err else warn)
|
||||
(errorHints error)
|
||||
if
|
||||
| [m] <- msgs -> [(source, This m)]
|
||||
| [m1, m2] <- msgs -> [(source, This m1), (source, Where m2)]
|
||||
| otherwise -> [(source, This $ fromString "<<Unknown error>>")]
|
||||
|
||||
fromSourcePos :: MP.SourcePos -> Position
|
||||
fromSourcePos MP.SourcePos{..} =
|
||||
fromSourcePos MP.SourcePos {..} =
|
||||
let start = both (fromIntegral . MP.unPos) (sourceLine, sourceColumn)
|
||||
end = second (+ 1) start
|
||||
in Position start end sourceName
|
||||
end = second (+ 1) start
|
||||
in Position start end sourceName
|
||||
|
||||
errorHints :: MP.ParseError s e -> [msg]
|
||||
errorHints MP.TrivialError{} = trivialHints
|
||||
errorHints (MP.FancyError _ errs) = Set.toList errs >>= \ case
|
||||
MP.ErrorCustom e -> hints e
|
||||
_ -> mempty
|
||||
errorHints MP.TrivialError {} = trivialHints
|
||||
errorHints (MP.FancyError _ errs) =
|
||||
Set.toList errs >>= \case
|
||||
MP.ErrorCustom e -> hints e
|
||||
_ -> mempty
|
||||
|
||||
-- | Creates an error diagnostic from a megaparsec 'MP.ParseErrorBundle'.
|
||||
errorDiagnosticFromBundle
|
||||
:: forall msg s e.
|
||||
(IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s)
|
||||
=> msg -- ^ The error message of the diagnostic
|
||||
-> Maybe [msg] -- ^ Default hints when trivial errors are reported
|
||||
-> MP.ParseErrorBundle s e -- ^ The bundle to create a diagnostic from
|
||||
-> Diagnostic msg
|
||||
errorDiagnosticFromBundle ::
|
||||
forall msg s e.
|
||||
(IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>
|
||||
-- | The error message of the diagnostic
|
||||
msg ->
|
||||
-- | Default hints when trivial errors are reported
|
||||
Maybe [msg] ->
|
||||
-- | The bundle to create a diagnostic from
|
||||
MP.ParseErrorBundle s e ->
|
||||
Diagnostic msg
|
||||
errorDiagnosticFromBundle = diagnosticFromBundle (const True)
|
||||
|
||||
-- | Creates a warning diagnostic from a megaparsec 'MP.ParseErrorBundle'.
|
||||
warningDiagnosticFromBundle
|
||||
:: forall msg s e.
|
||||
(IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s)
|
||||
=> msg -- ^ The error message of the diagnostic
|
||||
-> Maybe [msg] -- ^ Default hints when trivial errors are reported
|
||||
-> MP.ParseErrorBundle s e -- ^ The bundle to create a diagnostic from
|
||||
-> Diagnostic msg
|
||||
warningDiagnosticFromBundle ::
|
||||
forall msg s e.
|
||||
(IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>
|
||||
-- | The error message of the diagnostic
|
||||
msg ->
|
||||
-- | Default hints when trivial errors are reported
|
||||
Maybe [msg] ->
|
||||
-- | The bundle to create a diagnostic from
|
||||
MP.ParseErrorBundle s e ->
|
||||
Diagnostic msg
|
||||
warningDiagnosticFromBundle = diagnosticFromBundle (const False)
|
||||
|
||||
|
||||
------------------------------------
|
||||
------------ INTERNAL --------------
|
||||
------------------------------------
|
||||
|
||||
@ -1,85 +1,102 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
||||
{-# OPTIONS -Wno-name-shadowing #-}
|
||||
|
||||
-- |
|
||||
-- Module : Error.Diagnose.Compat.Parsec
|
||||
-- Description : Compatibility layer for parsec
|
||||
-- Copyright : (c) Mesabloo, 2021
|
||||
-- License : BSD3
|
||||
-- Stability : experimental
|
||||
-- Portability : Portable
|
||||
module Error.Diagnose.Compat.Parsec
|
||||
( diagnosticFromParseError
|
||||
, errorDiagnosticFromParseError
|
||||
, warningDiagnosticFromParseError
|
||||
, module Error.Diagnose.Compat.Hints
|
||||
) where
|
||||
( diagnosticFromParseError,
|
||||
errorDiagnosticFromParseError,
|
||||
warningDiagnosticFromParseError,
|
||||
module Error.Diagnose.Compat.Hints,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Bifunctor (second)
|
||||
import Data.Function ((&))
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.List (intercalate)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String (IsString (..))
|
||||
import Data.Void (Void)
|
||||
|
||||
import Error.Diagnose
|
||||
import Error.Diagnose.Compat.Hints (HasHints(..))
|
||||
|
||||
import Error.Diagnose.Compat.Hints (HasHints (..))
|
||||
import qualified Text.Parsec.Error as PE
|
||||
import qualified Text.Parsec.Pos as PP
|
||||
|
||||
-- | Generates a diagnostic from a 'PE.ParseError'.
|
||||
diagnosticFromParseError
|
||||
:: forall msg. (IsString msg, HasHints Void msg)
|
||||
=> (PE.ParseError -> Bool) -- ^ Determine whether the diagnostic is an error or a warning
|
||||
-> msg -- ^ The main error of the diagnostic
|
||||
-> Maybe [msg] -- ^ Default hints
|
||||
-> PE.ParseError -- ^ The 'PE.ParseError' to transform into a 'Diagnostic'
|
||||
-> Diagnostic msg
|
||||
diagnosticFromParseError ::
|
||||
forall msg.
|
||||
(IsString msg, HasHints Void msg) =>
|
||||
-- | Determine whether the diagnostic is an error or a warning
|
||||
(PE.ParseError -> Bool) ->
|
||||
-- | The main error of the diagnostic
|
||||
msg ->
|
||||
-- | Default hints
|
||||
Maybe [msg] ->
|
||||
-- | The 'PE.ParseError' to transform into a 'Diagnostic'
|
||||
PE.ParseError ->
|
||||
Diagnostic msg
|
||||
diagnosticFromParseError isError msg (fromMaybe [] -> defaultHints) error =
|
||||
let pos = fromSourcePos $ PE.errorPos 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))
|
||||
in addReport def report
|
||||
in addReport def report
|
||||
where
|
||||
fromSourcePos :: PP.SourcePos -> Position
|
||||
fromSourcePos pos =
|
||||
let start = both fromIntegral (PP.sourceLine pos, PP.sourceColumn pos)
|
||||
end = second (+ 1) start
|
||||
in Position start end (PP.sourceName pos)
|
||||
end = second (+ 1) start
|
||||
in Position start end (PP.sourceName pos)
|
||||
|
||||
toMarkers :: Position -> [PE.Message] -> [(Position, Marker msg)]
|
||||
toMarkers source [] = [ (source, This $ fromString "<<unknown error>>") ]
|
||||
toMarkers source [] = [(source, This $ fromString "<<unknown error>>")]
|
||||
toMarkers source msgs =
|
||||
let putTogether [] = ([], [], [], [])
|
||||
putTogether (PE.SysUnExpect thing:ms) = let (a, b, c, d) = putTogether ms in (thing:a, b, c, d)
|
||||
putTogether (PE.UnExpect thing:ms) = let (a, b, c, d) = putTogether ms in (a, thing:b, c, d)
|
||||
putTogether (PE.Expect thing:ms) = let (a, b, c, d) = putTogether ms in (a, b, thing:c, d)
|
||||
putTogether (PE.Message thing:ms) = let (a, b, c, d) = putTogether ms in (a, b, c, thing:d)
|
||||
let putTogether [] = ([], [], [], [])
|
||||
putTogether (PE.SysUnExpect thing : ms) = let (a, b, c, d) = putTogether ms in (thing : a, b, c, d)
|
||||
putTogether (PE.UnExpect thing : ms) = let (a, b, c, d) = putTogether ms in (a, thing : b, c, d)
|
||||
putTogether (PE.Expect thing : ms) = let (a, b, c, d) = putTogether ms in (a, b, thing : c, d)
|
||||
putTogether (PE.Message thing : ms) = let (a, b, c, d) = putTogether ms in (a, b, c, thing : d)
|
||||
|
||||
(sysUnexpectedList, unexpectedList, expectedList, messages) = putTogether msgs
|
||||
in [ (source, marker) | unexpected <- if null unexpectedList then sysUnexpectedList else unexpectedList
|
||||
, let marker = This $ fromString $ "unexpected " <> unexpected ]
|
||||
<> [ (source, marker) | msg <- messages
|
||||
, let marker = This $ fromString msg ]
|
||||
<> [ (source, Where $ fromString $ "expecting any of " <> intercalate ", " expectedList) ]
|
||||
in [ (source, marker) | unexpected <- if null unexpectedList then sysUnexpectedList else unexpectedList, let marker = This $ fromString $ "unexpected " <> unexpected
|
||||
]
|
||||
<> [ (source, marker) | msg <- messages, let marker = This $ fromString msg
|
||||
]
|
||||
<> [(source, Where $ fromString $ "expecting any of " <> intercalate ", " expectedList)]
|
||||
|
||||
-- | Generates an error diagnostic from a 'PE.ParseError'.
|
||||
errorDiagnosticFromParseError
|
||||
:: forall msg. (IsString msg, HasHints Void msg)
|
||||
=> msg -- ^ The main error message of the diagnostic
|
||||
-> Maybe [msg] -- ^ Default hints
|
||||
-> PE.ParseError -- ^ The 'PE.ParseError' to convert
|
||||
-> Diagnostic msg
|
||||
errorDiagnosticFromParseError ::
|
||||
forall msg.
|
||||
(IsString msg, HasHints Void msg) =>
|
||||
-- | The main error message of the diagnostic
|
||||
msg ->
|
||||
-- | Default hints
|
||||
Maybe [msg] ->
|
||||
-- | The 'PE.ParseError' to convert
|
||||
PE.ParseError ->
|
||||
Diagnostic msg
|
||||
errorDiagnosticFromParseError = diagnosticFromParseError (const True)
|
||||
|
||||
-- | Generates a warning diagnostic from a 'PE.ParseError'.
|
||||
warningDiagnosticFromParseError
|
||||
:: forall msg. (IsString msg, HasHints Void msg)
|
||||
=> msg -- ^ The main error message of the diagnostic
|
||||
-> Maybe [msg] -- ^ Default hints
|
||||
-> PE.ParseError -- ^ The 'PE.ParseError' to convert
|
||||
-> Diagnostic msg
|
||||
warningDiagnosticFromParseError ::
|
||||
forall msg.
|
||||
(IsString msg, HasHints Void msg) =>
|
||||
-- | The main error message of the diagnostic
|
||||
msg ->
|
||||
-- | Default hints
|
||||
Maybe [msg] ->
|
||||
-- | The 'PE.ParseError' to convert
|
||||
PE.ParseError ->
|
||||
Diagnostic msg
|
||||
warningDiagnosticFromParseError = diagnosticFromParseError (const False)
|
||||
|
||||
|
||||
|
||||
------------------------------------
|
||||
------------ INTERNAL --------------
|
||||
------------------------------------
|
||||
@ -89,4 +106,3 @@ warningDiagnosticFromParseError = diagnosticFromParseError (const False)
|
||||
-- > both f = bimap @(,) f f
|
||||
both :: (a -> b) -> (a, a) -> (b, b)
|
||||
both f ~(x, y) = (f x, f y)
|
||||
|
||||
|
||||
@ -1,22 +1,26 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
{-|
|
||||
Module : Error.Diagnose.Diagnostic
|
||||
Description : Diagnostic definition and pretty printing
|
||||
Copyright : (c) Mesabloo, 2021
|
||||
License : BSD3
|
||||
Stability : experimental
|
||||
Portability : Portable
|
||||
-}
|
||||
-- |
|
||||
-- Module : Error.Diagnose.Diagnostic
|
||||
-- Description : Diagnostic definition and pretty printing
|
||||
-- Copyright : (c) Mesabloo, 2021
|
||||
-- License : BSD3
|
||||
-- Stability : experimental
|
||||
-- Portability : Portable
|
||||
module Error.Diagnose.Diagnostic
|
||||
( -- * Re-exports
|
||||
module Export ) where
|
||||
module Export,
|
||||
)
|
||||
where
|
||||
|
||||
import Error.Diagnose.Diagnostic.Internal as Export
|
||||
(Diagnostic, def, printDiagnostic,
|
||||
( Diagnostic,
|
||||
#ifdef USE_AESON
|
||||
diagnosticToJson,
|
||||
#endif
|
||||
addFile, addReport)
|
||||
|
||||
import System.IO as Export (stdout, stderr)
|
||||
#endif
|
||||
addFile,
|
||||
addReport,
|
||||
def,
|
||||
printDiagnostic,
|
||||
)
|
||||
import System.IO as Export (stderr, stdout)
|
||||
|
||||
@ -1,23 +1,21 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
{-|
|
||||
Module : Error.Diagnose.Diagnostic.Internal
|
||||
Description : Internal workings for diagnostic definitions and pretty printing.
|
||||
Copyright : (c) Mesabloo, 2021
|
||||
License : BSD3
|
||||
Stability : experimental
|
||||
Portability : Portable
|
||||
|
||||
/Warning/: The API of this module can break between two releases, therefore you should not rely on it.
|
||||
It is also highly undocumented.
|
||||
|
||||
Please limit yourself to the "Error.Diagnose.Diagnostic" module, which exports some of the useful functions defined here.
|
||||
-}
|
||||
-- |
|
||||
-- Module : Error.Diagnose.Diagnostic.Internal
|
||||
-- Description : Internal workings for diagnostic definitions and pretty printing.
|
||||
-- Copyright : (c) Mesabloo, 2021
|
||||
-- License : BSD3
|
||||
-- Stability : experimental
|
||||
-- Portability : Portable
|
||||
--
|
||||
-- /Warning/: The API of this module can break between two releases, therefore you should not rely on it.
|
||||
-- It is also highly undocumented.
|
||||
--
|
||||
-- Please limit yourself to the "Error.Diagnose.Diagnostic" module, which exports some of the useful functions defined here.
|
||||
module Error.Diagnose.Diagnostic.Internal (module Error.Diagnose.Diagnostic.Internal, def) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
|
||||
#ifdef USE_AESON
|
||||
import Data.Aeson (ToJSON(..), encode, object, (.=))
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
@ -27,26 +25,24 @@ import Data.Foldable (fold)
|
||||
import Data.HashMap.Lazy (HashMap)
|
||||
import qualified Data.HashMap.Lazy as HashMap
|
||||
import Data.List (intersperse)
|
||||
|
||||
import Error.Diagnose.Report (Report)
|
||||
import Error.Diagnose.Report.Internal (prettyReport)
|
||||
|
||||
import Prettyprinter (Doc, Pretty, hardline, unAnnotate)
|
||||
import Prettyprinter.Render.Terminal (AnsiStyle, hPutDoc)
|
||||
import System.IO (Handle)
|
||||
|
||||
import Prettyprinter (Pretty, Doc, unAnnotate, hardline)
|
||||
import Prettyprinter.Render.Terminal (hPutDoc, AnsiStyle)
|
||||
|
||||
|
||||
-- | The data type for diagnostic containing messages of an abstract type.
|
||||
--
|
||||
-- The constructors are private, but users can use 'def' from the 'Default' typeclass
|
||||
-- to create a new empty diagnostic, and 'addFile' and 'addReport' to alter its internal state.
|
||||
data Diagnostic msg
|
||||
= Diagnostic
|
||||
[Report msg] -- ^ All the reports contained in a diagnostic.
|
||||
--
|
||||
-- Reports are output one by one, without connections in between.
|
||||
(HashMap FilePath [String]) -- ^ A map associating files with their content as lists of lines.
|
||||
[Report msg]
|
||||
-- ^ All the reports contained in a diagnostic.
|
||||
--
|
||||
-- Reports are output one by one, without connections in between.
|
||||
(HashMap FilePath [String])
|
||||
-- ^ A map associating files with their content as lists of lines.
|
||||
|
||||
instance Default (Diagnostic msg) where
|
||||
def = Diagnostic mempty mempty
|
||||
@ -69,21 +65,29 @@ instance ToJSON msg => ToJSON (Diagnostic msg) where
|
||||
|
||||
-- | Pretty prints a diagnostic into a 'Doc'ument that can be output using
|
||||
-- 'Text.PrettyPrint.ANSI.Leijen.hPutDoc' or 'Text.PrettyPrint.ANSI.Leijen.displayIO'.
|
||||
prettyDiagnostic :: Pretty msg
|
||||
=> Bool -- ^ Should we use unicode when printing paths?
|
||||
-> Diagnostic msg -- ^ The diagnostic to print
|
||||
-> Doc AnsiStyle
|
||||
prettyDiagnostic ::
|
||||
Pretty msg =>
|
||||
-- | Should we use unicode when printing paths?
|
||||
Bool ->
|
||||
-- | The diagnostic to print
|
||||
Diagnostic msg ->
|
||||
Doc AnsiStyle
|
||||
prettyDiagnostic withUnicode (Diagnostic reports file) =
|
||||
fold . intersperse hardline $ prettyReport file withUnicode <$> reports
|
||||
{-# INLINE prettyDiagnostic #-}
|
||||
|
||||
-- | Prints a 'Diagnostic' onto a specific 'Handle'.
|
||||
printDiagnostic :: (MonadIO m, Pretty msg)
|
||||
=> Handle -- ^ The handle onto which to output the diagnostic.
|
||||
-> Bool -- ^ Should we print with unicode characters?
|
||||
-> Bool -- ^ 'False' to disable colors.
|
||||
-> Diagnostic msg -- ^ The diagnostic to output.
|
||||
-> m ()
|
||||
printDiagnostic ::
|
||||
(MonadIO m, Pretty msg) =>
|
||||
-- | The handle onto which to output the diagnostic.
|
||||
Handle ->
|
||||
-- | Should we print with unicode characters?
|
||||
Bool ->
|
||||
-- | 'False' to disable colors.
|
||||
Bool ->
|
||||
-- | The diagnostic to output.
|
||||
Diagnostic msg ->
|
||||
m ()
|
||||
printDiagnostic handle withUnicode withColors diag =
|
||||
liftIO $ hPutDoc handle (unlessId withColors unAnnotate $ prettyDiagnostic withUnicode diag)
|
||||
where
|
||||
@ -92,18 +96,23 @@ printDiagnostic handle withUnicode withColors diag =
|
||||
{-# INLINE printDiagnostic #-}
|
||||
|
||||
-- | Inserts a new referenceable file within the diagnostic.
|
||||
addFile :: Diagnostic msg
|
||||
-> FilePath -- ^ The path to the file.
|
||||
-> String -- ^ The content of the file as a single string, where lines are ended by @\n@.
|
||||
-> Diagnostic msg
|
||||
addFile ::
|
||||
Diagnostic msg ->
|
||||
-- | The path to the file.
|
||||
FilePath ->
|
||||
-- | The content of the file as a single string, where lines are ended by @\n@.
|
||||
String ->
|
||||
Diagnostic msg
|
||||
addFile (Diagnostic reports files) path content =
|
||||
Diagnostic reports (HashMap.insert path (lines content) files)
|
||||
{-# INLINE addFile #-}
|
||||
|
||||
-- | Inserts a new report into a diagnostic.
|
||||
addReport :: Diagnostic msg
|
||||
-> Report msg -- ^ The new report to add to the diagnostic.
|
||||
-> Diagnostic msg
|
||||
addReport ::
|
||||
Diagnostic msg ->
|
||||
-- | The new report to add to the diagnostic.
|
||||
Report msg ->
|
||||
Diagnostic msg
|
||||
addReport (Diagnostic reports files) report =
|
||||
Diagnostic (report : reports) files
|
||||
{-# INLINE addReport #-}
|
||||
|
||||
@ -1,18 +1,17 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
{-|
|
||||
Module : Error.Diagnose.Diagnostic
|
||||
Description : Defines location information as a simple record.
|
||||
Copyright : (c) Mesabloo, 2021
|
||||
License : BSD3
|
||||
Stability : experimental
|
||||
Portability : Portable
|
||||
-}
|
||||
module Error.Diagnose.Position (Position(..)) where
|
||||
-- |
|
||||
-- Module : Error.Diagnose.Diagnostic
|
||||
-- Description : Defines location information as a simple record.
|
||||
-- Copyright : (c) Mesabloo, 2021
|
||||
-- License : BSD3
|
||||
-- Stability : experimental
|
||||
-- Portability : Portable
|
||||
module Error.Diagnose.Position (Position (..)) where
|
||||
|
||||
#ifdef USE_AESON
|
||||
import Data.Aeson (ToJSON(..), object, (.=))
|
||||
@ -20,31 +19,25 @@ import Data.Aeson (ToJSON(..), object, (.=))
|
||||
import Data.Default (Default, def)
|
||||
import Data.Hashable (Hashable)
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics (Generic (..))
|
||||
import Prettyprinter (Pretty (..), colon)
|
||||
|
||||
import GHC.Generics (Generic(..))
|
||||
|
||||
import Prettyprinter (Pretty(..), colon)
|
||||
-- import Text.PrettyPrint.ANSI.Leijen (Pretty(..), text, colon, int)
|
||||
|
||||
|
||||
-- | Contains information about the location about something.
|
||||
-- | Contains information about the location of something.
|
||||
--
|
||||
-- It is best used in a datatype like:
|
||||
--
|
||||
-- > data Located a
|
||||
-- > = a :@ Position
|
||||
-- > deriving (Show, Eq, Ord, Functor, Traversable)
|
||||
data Position
|
||||
= Position
|
||||
{
|
||||
-- | The beginning line and column of the span.
|
||||
begin :: (Int, Int)
|
||||
,
|
||||
-- | The end line and column of the span.
|
||||
end :: (Int, Int)
|
||||
,
|
||||
-- | The file this position spans in.
|
||||
file :: FilePath
|
||||
data Position = Position
|
||||
{ -- | The beginning line and column of the span.
|
||||
begin :: (Int, Int),
|
||||
-- | The end line and column of the span.
|
||||
end :: (Int, Int),
|
||||
-- | The file this position spans in.
|
||||
file :: FilePath
|
||||
}
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
@ -53,10 +46,11 @@ instance Ord Position where
|
||||
|
||||
instance Pretty Position where
|
||||
pretty (Position (bl, bc) (el, ec) f) = pretty f <> at <> pretty bl <> colon <> pretty bc <> dash <> pretty el <> colon <> pretty ec
|
||||
where at = pretty @Text "@"
|
||||
dash = pretty @Text "-"
|
||||
where
|
||||
at = pretty @Text "@"
|
||||
dash = pretty @Text "-"
|
||||
|
||||
instance Hashable Position where
|
||||
instance Hashable Position
|
||||
|
||||
instance Default Position where
|
||||
def = Position (1, 1) (1, 1) "<no-file>"
|
||||
|
||||
@ -1,13 +1,14 @@
|
||||
{-|
|
||||
Module : Error.Diagnose.Report
|
||||
Description : Report definition and pretty printing
|
||||
Copyright : (c) Mesabloo, 2021
|
||||
License : BSD3
|
||||
Stability : experimental
|
||||
Portability : Portable
|
||||
-}
|
||||
-- |
|
||||
-- Module : Error.Diagnose.Report
|
||||
-- Description : Report definition and pretty printing
|
||||
-- Copyright : (c) Mesabloo, 2021
|
||||
-- License : BSD3
|
||||
-- Stability : experimental
|
||||
-- Portability : Portable
|
||||
module Error.Diagnose.Report
|
||||
( -- * Re-exports
|
||||
module Export ) where
|
||||
module Export,
|
||||
)
|
||||
where
|
||||
|
||||
import Error.Diagnose.Report.Internal as Export (Report, warn, err, Marker(..))
|
||||
import Error.Diagnose.Report.Internal as Export (Marker (..), Report, err, warn)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user