Replace Default instance for Diagnostic with Monoid

This commit is contained in:
Ellie Hermaszewska 2023-05-22 13:01:09 +08:00
parent e5145b67c5
commit 9ced23674f
No known key found for this signature in database
4 changed files with 11 additions and 13 deletions

View File

@ -39,7 +39,8 @@ You don't even need to `import Prettyprinter`, as it is already provided to you
A diagnostic can be viewed as a collection of reports, spanning on files. A diagnostic can be viewed as a collection of reports, spanning on files.
This is what the `Diagnostic` type embodies. This is what the `Diagnostic` type embodies.
It has a `Default` instance, which can be used to construct an empty diagnostic (contains no reports, and has no files). It is an instance of `Monoid`, which can be used to construct an empty
diagnostic (contains no reports, and has no files).
The second step is to add some reports. The second step is to add some reports.
There are two kinds of reports: There are two kinds of reports:
@ -99,7 +100,7 @@ let beautifulExample =
-- ^^^^ This is a 'Note' not a 'Hint', as specified by its 'IsString' instance -- ^^^^ This is a 'Note' not a 'Hint', as specified by its 'IsString' instance
-- Create the diagnostic -- Create the diagnostic
let diagnostic = addFile def "somefile.zc" "let id<a>(x : a) : a := x\n + 1" let diagnostic = addFile mempty "somefile.zc" "let id<a>(x : a) : a := x\n + 1"
let diagnostic' = addReport diagnostic beautifulExample let diagnostic' = addReport diagnostic beautifulExample
-- Print with unicode characters, and the default (colorful) style -- Print with unicode characters, and the default (colorful) style

View File

@ -20,7 +20,6 @@ import Error.Diagnose.Diagnostic.Internal as Export
#endif #endif
addFile, addFile,
addReport, addReport,
def,
errorsToWarnings, errorsToWarnings,
hasReports, hasReports,
reportsOf, reportsOf,

View File

@ -14,7 +14,7 @@
-- It is also highly undocumented. -- It is also highly undocumented.
-- --
-- Please limit yourself to the "Error.Diagnose.Diagnostic" module, which exports some of the useful functions defined here. -- 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, WithUnicode(..), TabSize(..)) where module Error.Diagnose.Diagnostic.Internal (module Error.Diagnose.Diagnostic.Internal, WithUnicode(..), TabSize(..)) where
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
#ifdef USE_AESON #ifdef USE_AESON
@ -25,7 +25,6 @@ import Data.ByteString.Lazy (ByteString)
import Data.Array (listArray) import Data.Array (listArray)
import Data.DList (DList) import Data.DList (DList)
import qualified Data.DList as DL import qualified Data.DList as DL
import Data.Default (Default, def)
import Data.Foldable (fold, toList) import Data.Foldable (fold, toList)
import qualified Data.HashMap.Lazy as HashMap import qualified Data.HashMap.Lazy as HashMap
import Data.List (intersperse) import Data.List (intersperse)
@ -38,8 +37,8 @@ import System.IO (Handle)
-- | The data type for diagnostic containing messages of an abstract type. -- | The data type for diagnostic containing messages of an abstract type.
-- --
-- The constructors are private, but users can use 'def' from the 'Default' typeclass -- Users can use 'mempty' to create a new empty diagnostic, and 'addFile' and
-- to create a new empty diagnostic, and 'addFile' and 'addReport' to alter its internal state. -- 'addReport' to alter its internal state.
data Diagnostic msg data Diagnostic msg
= Diagnostic = Diagnostic
(DList (Report msg)) (DList (Report msg))
@ -50,11 +49,11 @@ data Diagnostic msg
-- ^ A map associating files with their content as lists of lines. -- ^ A map associating files with their content as lists of lines.
deriving (Functor, Foldable, Traversable) deriving (Functor, Foldable, Traversable)
instance Default (Diagnostic msg) where instance Monoid (Diagnostic msg) where
def = Diagnostic mempty mempty mempty = Diagnostic mempty mempty
instance Semigroup (Diagnostic msg) where instance Semigroup (Diagnostic msg) where
Diagnostic rs1 file <> Diagnostic rs2 _ = Diagnostic (rs1 <> rs2) file Diagnostic rs1 files1 <> Diagnostic rs2 files2 = Diagnostic (rs1 <> rs2) (files1 <> files2)
#ifdef USE_AESON #ifdef USE_AESON
instance ToJSON msg => ToJSON (Diagnostic msg) where instance ToJSON msg => ToJSON (Diagnostic msg) where

View File

@ -16,7 +16,6 @@ import Error.Diagnose
Report(..), Report(..),
addFile, addFile,
addReport, addReport,
def,
defaultStyle, defaultStyle,
printDiagnostic, printDiagnostic,
printDiagnostic', printDiagnostic',
@ -90,8 +89,8 @@ main = do
nestingReport nestingReport
] ]
let diag = HashMap.foldlWithKey' addFile (foldl addReport def reports) files let diag = HashMap.foldlWithKey' addFile (foldl addReport mempty reports) files
customDiag = HashMap.foldlWithKey' addFile (foldl addReport def customAnnReports) files customDiag = HashMap.foldlWithKey' addFile (foldl addReport mempty customAnnReports) files
hPutStrLn stdout "\n\nWith unicode: ─────────────────────────\n" hPutStrLn stdout "\n\nWith unicode: ─────────────────────────\n"
printDiagnostic stdout WithUnicode (TabSize 4) defaultStyle diag printDiagnostic stdout WithUnicode (TabSize 4) defaultStyle diag