diff --git a/src/Error/Diagnose/Compat/Megaparsec.hs b/src/Error/Diagnose/Compat/Megaparsec.hs index 5788fe4..d33e21d 100644 --- a/src/Error/Diagnose/Compat/Megaparsec.hs +++ b/src/Error/Diagnose/Compat/Megaparsec.hs @@ -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 "<>") ] + 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 "<>")] 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 -------------- ------------------------------------ diff --git a/src/Error/Diagnose/Compat/Parsec.hs b/src/Error/Diagnose/Compat/Parsec.hs index 2bfc7b2..31fdab8 100644 --- a/src/Error/Diagnose/Compat/Parsec.hs +++ b/src/Error/Diagnose/Compat/Parsec.hs @@ -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 "<>") ] + toMarkers source [] = [(source, This $ fromString "<>")] 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) - diff --git a/src/Error/Diagnose/Diagnostic.hs b/src/Error/Diagnose/Diagnostic.hs index bd52ad3..9e0aeb0 100644 --- a/src/Error/Diagnose/Diagnostic.hs +++ b/src/Error/Diagnose/Diagnostic.hs @@ -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) diff --git a/src/Error/Diagnose/Diagnostic/Internal.hs b/src/Error/Diagnose/Diagnostic/Internal.hs index 4e0cf7d..08862a2 100644 --- a/src/Error/Diagnose/Diagnostic/Internal.hs +++ b/src/Error/Diagnose/Diagnostic/Internal.hs @@ -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 #-} diff --git a/src/Error/Diagnose/Position.hs b/src/Error/Diagnose/Position.hs index 2c93d57..19d2a8f 100644 --- a/src/Error/Diagnose/Position.hs +++ b/src/Error/Diagnose/Position.hs @@ -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) "" diff --git a/src/Error/Diagnose/Report.hs b/src/Error/Diagnose/Report.hs index a80214e..c1efb2f 100644 --- a/src/Error/Diagnose/Report.hs +++ b/src/Error/Diagnose/Report.hs @@ -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)