mirror of
https://github.com/Mesabloo/diagnose.git
synced 2024-08-16 23:00:47 +03:00
Merge pull request #22 from expipiplus1/instances
Remove suspicious instances + some new ones
This commit is contained in:
commit
2a16c8e74a
@ -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.
|
||||
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.
|
||||
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
|
||||
|
||||
-- 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
|
||||
|
||||
-- Print with unicode characters, and the default (colorful) style
|
||||
|
@ -20,7 +20,6 @@ import Error.Diagnose.Diagnostic.Internal as Export
|
||||
#endif
|
||||
addFile,
|
||||
addReport,
|
||||
def,
|
||||
errorsToWarnings,
|
||||
hasReports,
|
||||
reportsOf,
|
||||
|
@ -14,7 +14,7 @@
|
||||
-- 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, WithUnicode(..), TabSize(..)) where
|
||||
module Error.Diagnose.Diagnostic.Internal (module Error.Diagnose.Diagnostic.Internal, WithUnicode(..), TabSize(..)) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
#ifdef USE_AESON
|
||||
@ -25,7 +25,6 @@ import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Array (listArray)
|
||||
import Data.DList (DList)
|
||||
import qualified Data.DList as DL
|
||||
import Data.Default (Default, def)
|
||||
import Data.Foldable (fold, toList)
|
||||
import qualified Data.HashMap.Lazy as HashMap
|
||||
import Data.List (intersperse)
|
||||
@ -38,8 +37,8 @@ import System.IO (Handle)
|
||||
|
||||
-- | 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.
|
||||
-- Users can use 'mempty' to create a new empty diagnostic, and 'addFile' and
|
||||
-- 'addReport' to alter its internal state.
|
||||
data Diagnostic msg
|
||||
= Diagnostic
|
||||
(DList (Report msg))
|
||||
@ -50,11 +49,11 @@ data Diagnostic msg
|
||||
-- ^ A map associating files with their content as lists of lines.
|
||||
deriving (Functor, Foldable, Traversable)
|
||||
|
||||
instance Default (Diagnostic msg) where
|
||||
def = Diagnostic mempty mempty
|
||||
instance Monoid (Diagnostic msg) where
|
||||
mempty = Diagnostic mempty mempty
|
||||
|
||||
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
|
||||
instance ToJSON msg => ToJSON (Diagnostic msg) where
|
||||
|
@ -41,10 +41,7 @@ data Position = Position
|
||||
-- | The file this position spans in.
|
||||
file :: FilePath
|
||||
}
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
instance Ord Position where
|
||||
Position b1 e1 _ `compare` Position b2 e2 _ = (b1, e1) `compare` (b2, e2)
|
||||
deriving (Show, Eq, Ord, Generic)
|
||||
|
||||
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
|
||||
|
@ -39,15 +39,13 @@ import Data.Char.WCWidth (wcwidth)
|
||||
import Data.Default (def)
|
||||
import Data.Foldable (fold)
|
||||
import Data.Function (on)
|
||||
import Data.Functor ((<&>))
|
||||
import Data.Functor ((<&>), void)
|
||||
import Data.HashMap.Lazy (HashMap)
|
||||
import qualified Data.HashMap.Lazy as HashMap
|
||||
import qualified Data.List as List
|
||||
import qualified Data.List.Safe as List
|
||||
import Data.Maybe
|
||||
import Data.Ord (Down (Down))
|
||||
import Data.String (IsString (fromString))
|
||||
import qualified Data.Text as Text
|
||||
import Error.Diagnose.Position
|
||||
import Error.Diagnose.Style (Annotation (..))
|
||||
import Prettyprinter (Doc, Pretty (..), align, annotate, colon, hardline, lbracket, rbracket, space, width, (<+>), reAnnotate, SimpleDocStream (..), layoutCompact)
|
||||
@ -125,27 +123,12 @@ data Marker msg
|
||||
Maybe msg
|
||||
| -- | An empty marker, whose sole purpose is to include a line of code in the report without markers under.
|
||||
Blank
|
||||
deriving (Functor, Foldable, Traversable)
|
||||
deriving (Eq, Ord, Functor, Foldable, Traversable)
|
||||
|
||||
instance Eq (Marker msg) where
|
||||
This _ == This _ = True
|
||||
Where _ == Where _ = True
|
||||
Maybe _ == Maybe _ = True
|
||||
Blank == Blank = True
|
||||
_ == _ = False
|
||||
{-# INLINEABLE (==) #-}
|
||||
|
||||
instance Ord (Marker msg) where
|
||||
This _ < _ = False
|
||||
Where _ < This _ = True
|
||||
Where _ < _ = False
|
||||
Maybe _ < _ = True
|
||||
_ < Blank = True
|
||||
Blank < _ = False
|
||||
{-# INLINEABLE (<) #-}
|
||||
|
||||
m1 <= m2 = m1 < m2 || m1 == m2
|
||||
{-# INLINEABLE (<=) #-}
|
||||
isBlank :: Marker msg -> Bool
|
||||
isBlank = \case
|
||||
Blank -> True
|
||||
_ -> False
|
||||
|
||||
-- | A note is a piece of information that is found at the end of a report.
|
||||
data Note msg
|
||||
@ -378,7 +361,7 @@ prettySubReport fileContent withUnicode isError tabSize maxLineNumberLength isFi
|
||||
|
||||
sortedMarkersPerLine = {- second (List.sortOn (first $ snd . begin)) <$> -} List.sortOn fst (HashMap.toList markersPerLine)
|
||||
|
||||
reportFile = maybe (pretty @Position def) (pretty . fst) $ List.safeHead (List.sortOn (Down . snd) markers)
|
||||
reportFile = maybe (pretty @Position def) (pretty . fst) $ List.safeHead (List.sortOn (void . snd) markers)
|
||||
-- the reported file is the file of the first 'This' marker (only one must be present)
|
||||
|
||||
allLineNumbers = List.sort $ List.nub $ (fst <$> sortedMarkersPerLine) <> (multilineMarkers >>= \(Position (bl, _) (el, _) _, _) -> [bl .. el])
|
||||
@ -459,6 +442,8 @@ prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNu
|
||||
-- take the first multiline marker to color the entire line, if there is one
|
||||
|
||||
(multilineEndingOnLine, otherMultilines) = flip List.partition multiline \(Position _ (el, _) _, _) -> el == line
|
||||
shouldShowMultiLine = isLastLine
|
||||
|| ((==) `on` fmap (fmap void)) (List.safeLast multilineEndingOnLine) (List.safeLast multiline)
|
||||
|
||||
!additionalPrefix = case allMultilineMarkersInLine of
|
||||
[] ->
|
||||
@ -476,8 +461,8 @@ prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNu
|
||||
<> space
|
||||
|
||||
-- we need to remove all blank markers because they are irrelevant to the display
|
||||
allInlineMarkersInLine' = filter ((/=) Blank . snd) allInlineMarkersInLine
|
||||
allMultilineMarkersSpanningLine' = filter ((/=) Blank . snd) allMultilineMarkersSpanningLine
|
||||
allInlineMarkersInLine' = filter (not . isBlank . snd) allInlineMarkersInLine
|
||||
allMultilineMarkersSpanningLine' = filter (not . isBlank . snd) allMultilineMarkersSpanningLine
|
||||
|
||||
(widths, renderedCode) = getLine_ files (allInlineMarkersInLine <> allMultilineMarkersInLine <> allMultilineMarkersSpanningLine') line tabSize isError
|
||||
in ( otherMultilines,
|
||||
@ -485,7 +470,7 @@ prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNu
|
||||
<> {- (1) -} linePrefix leftLen line withUnicode <+> additionalPrefix
|
||||
<> renderedCode
|
||||
<> {- (2) -} showAllMarkersInLine (not $ null multiline) inSpanOfMultiline colorOfFirstMultilineMarker withUnicode isError leftLen widths allInlineMarkersInLine'
|
||||
<> showMultiline (isLastLine || List.safeLast multilineEndingOnLine == List.safeLast multiline) multilineEndingOnLine
|
||||
<> showMultiline shouldShowMultiLine multilineEndingOnLine
|
||||
)
|
||||
|
||||
showMultiline _ [] = mempty
|
||||
@ -570,7 +555,7 @@ showAllMarkersInLine hasMultilines inSpanOfMultiline colorMultilinePrefix withUn
|
||||
showMarkers n lineLen
|
||||
| n > lineLen = mempty -- reached the end of the line
|
||||
| otherwise =
|
||||
let allMarkers = flip filter ms \(Position (_, bc) (_, ec) _, mark) -> mark /= Blank && n >= bc && n < ec
|
||||
let allMarkers = flip filter ms \(Position (_, bc) (_, ec) _, mark) -> not (isBlank mark) && n >= bc && n < ec
|
||||
in -- only consider markers which span onto the current column
|
||||
case allMarkers of
|
||||
[] -> fold (replicate (widthAt n) space) <> showMarkers (n + 1) lineLen
|
||||
@ -586,7 +571,7 @@ showAllMarkersInLine hasMultilines inSpanOfMultiline colorMultilinePrefix withUn
|
||||
showMessages specialPrefix ms lineLen = case List.safeUncons ms of
|
||||
Nothing -> mempty -- no more messages to show
|
||||
Just ((Position b@(_, bc) _ _, msg), pipes) ->
|
||||
let filteredPipes = filter (uncurry (&&) . bimap ((/= b) . begin) (/= Blank)) pipes
|
||||
let filteredPipes = filter (uncurry (&&) . bimap ((/= b) . begin) (not . isBlank)) pipes
|
||||
-- record only the pipes corresponding to markers on different starting positions
|
||||
nubbedPipes = List.nubBy ((==) `on` (begin . fst)) filteredPipes
|
||||
-- and then remove all duplicates
|
||||
|
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
-- |
|
||||
-- Module : Error.Diagnose.Style
|
||||
-- Description : Custom style definitions
|
||||
@ -19,6 +19,7 @@ module Error.Diagnose.Style
|
||||
)
|
||||
where
|
||||
|
||||
import GHC.Generics
|
||||
import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bold, color, colorDull)
|
||||
|
||||
-- $defining_new_styles
|
||||
@ -71,7 +72,7 @@ data Annotation a
|
||||
CodeStyle
|
||||
| -- | Something else, could be provided by the user
|
||||
OtherStyle a
|
||||
deriving (Functor, Foldable, Traversable)
|
||||
deriving (Eq, Ord, Show, Generic, Functor, Foldable, Traversable)
|
||||
|
||||
-- | A style is a function which can be applied using 'reAnnotate'.
|
||||
--
|
||||
|
@ -16,7 +16,6 @@ import Error.Diagnose
|
||||
Report(..),
|
||||
addFile,
|
||||
addReport,
|
||||
def,
|
||||
defaultStyle,
|
||||
printDiagnostic,
|
||||
printDiagnostic',
|
||||
@ -90,8 +89,8 @@ main = do
|
||||
nestingReport
|
||||
]
|
||||
|
||||
let diag = HashMap.foldlWithKey' addFile (foldl addReport def reports) files
|
||||
customDiag = HashMap.foldlWithKey' addFile (foldl addReport def customAnnReports) files
|
||||
let diag = HashMap.foldlWithKey' addFile (foldl addReport mempty reports) files
|
||||
customDiag = HashMap.foldlWithKey' addFile (foldl addReport mempty customAnnReports) files
|
||||
|
||||
hPutStrLn stdout "\n\nWith unicode: ─────────────────────────\n"
|
||||
printDiagnostic stdout WithUnicode (TabSize 4) defaultStyle diag
|
||||
|
Loading…
Reference in New Issue
Block a user