diff --git a/diagnose.cabal b/diagnose.cabal index 7d62f0e..cd1077d 100644 --- a/diagnose.cabal +++ b/diagnose.cabal @@ -72,7 +72,6 @@ library , hashable >=1.3 && <2 , prettyprinter >=1.7.0 && <2 , prettyprinter-ansi-terminal >=1.1.2 && <2 - , unordered-containers >=0.2.11 && <0.3 , wcwidth >=0.0.1 && <1 default-language: Haskell2010 if flag(json) @@ -118,7 +117,6 @@ test-suite diagnose-megaparsec-tests , prettyprinter >=1.7.0 && <2 , prettyprinter-ansi-terminal >=1.1.2 && <2 , text >=1.2 && <3 - , unordered-containers >=0.2.11 && <0.3 , wcwidth >=0.0.1 && <1 default-language: Haskell2010 if flag(json) @@ -159,7 +157,6 @@ test-suite diagnose-parsec-tests , prettyprinter >=1.7.0 && <2 , prettyprinter-ansi-terminal >=1.1.2 && <2 , text >=1.2 && <3 - , unordered-containers >=0.2.11 && <0.3 , wcwidth >=0.0.1 && <1 default-language: Haskell2010 if flag(json) @@ -198,7 +195,6 @@ test-suite diagnose-rendering-tests , hashable >=1.3 && <2 , prettyprinter >=1.7.0 && <2 , prettyprinter-ansi-terminal >=1.1.2 && <2 - , unordered-containers >=0.2.11 && <0.3 , wcwidth >=0.0.1 && <1 default-language: Haskell2010 if flag(json) diff --git a/package.yaml b/package.yaml index af3de41..32d7beb 100644 --- a/package.yaml +++ b/package.yaml @@ -14,7 +14,6 @@ dependencies: - hashable >= 1.3 && < 2 - prettyprinter >= 1.7.0 && < 2 - prettyprinter-ansi-terminal >= 1.1.2 && < 2 -- unordered-containers >= 0.2.11 && < 0.3 - wcwidth >= 0.0.1 && <1 default-extensions: diff --git a/src/Error/Diagnose/Diagnostic/Internal.hs b/src/Error/Diagnose/Diagnostic/Internal.hs index fdb4b2b..40207b1 100644 --- a/src/Error/Diagnose/Diagnostic/Internal.hs +++ b/src/Error/Diagnose/Diagnostic/Internal.hs @@ -26,7 +26,6 @@ import Data.Array (listArray) import Data.DList (DList) import qualified Data.DList as DL import Data.Foldable (fold, toList) -import qualified Data.HashMap.Lazy as HashMap import Data.List (intersperse) import Error.Diagnose.Report (Report) import Error.Diagnose.Report.Internal (FileMap, errorToWarning, prettyReport, warningToError, WithUnicode(..), TabSize(..)) @@ -58,7 +57,7 @@ instance Semigroup (Diagnostic msg) where #ifdef USE_AESON instance ToJSON msg => ToJSON (Diagnostic msg) where toJSON (Diagnostic reports files) = - object [ "files" .= fmap toJSONFile (fmap toList <$> (HashMap.toList files)) + object [ "files" .= fmap toJSONFile (fmap toList <$> files) , "reports" .= reports ] where @@ -175,7 +174,7 @@ addFile (Diagnostic reports files) path content = let fileLines = lines content lineCount = length fileLines lineArray = listArray (0, lineCount - 1) fileLines - in Diagnostic reports (HashMap.insert path lineArray files) + in Diagnostic reports ((path, lineArray) : files) {-# INLINE addFile #-} -- | Inserts a new report into a diagnostic. diff --git a/src/Error/Diagnose/Report/Internal.hs b/src/Error/Diagnose/Report/Internal.hs index 5b20b9e..abc5e4f 100644 --- a/src/Error/Diagnose/Report/Internal.hs +++ b/src/Error/Diagnose/Report/Internal.hs @@ -38,10 +38,10 @@ import Data.Bifunctor (bimap, first, second) import Data.Char.WCWidth (wcwidth) import Data.Default (def) import Data.Foldable (fold) -import Data.Function (on) +import Data.Function (on, (&)) import Data.Functor ((<&>), void) -import Data.HashMap.Lazy (HashMap) -import qualified Data.HashMap.Lazy as HashMap +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Data.List.NonEmpty as NE import qualified Data.List as List import qualified Data.List.Safe as List import Data.Maybe @@ -51,8 +51,10 @@ import Error.Diagnose.Style (Annotation (..)) import Prettyprinter (Doc, Pretty (..), align, annotate, colon, hardline, lbracket, rbracket, space, width, (<+>), reAnnotate, SimpleDocStream (..), layoutCompact) import Prettyprinter.Internal (Doc (..), textSpaces) import Data.Bool (bool) +import Data.Ord (comparing) +import Control.Arrow (Arrow((&&&))) -type FileMap = HashMap FilePath (Array Int String) +type FileMap = [(FilePath, Array Int String)] type WidthTable = UArray Int Int @@ -316,16 +318,23 @@ ellipsisPrefix :: Doc (Annotation ann) ellipsisPrefix leftLen withUnicode = pad leftLen ' ' mempty <> annotate RuleColor (unicode "..." (space <> "⋮") withUnicode) -groupMarkersPerFile :: +groupMarkersPerFile :: forall msg. [(Position, Marker msg)] -> [(Bool, [(Position, Marker msg)])] groupMarkersPerFile [] = [] -groupMarkersPerFile markers = - let markersPerFile = List.foldl' (HashMap.unionWith (<>)) mempty $ markers <&> \tup@(p, _) -> HashMap.singleton (file p) [tup] +groupMarkersPerFile (marker : rest) = + let + markersNE = marker :| rest + markersByFile :: NonEmpty (FilePath, (Position, Marker msg)) = (file . fst &&& id) <$> markersNE + markersPerFile :: [(FilePath, NonEmpty (Position, Marker msg))] + = markersByFile + & NE.sortBy (comparing fst) + & NE.groupBy (equating fst) + <&> (fst . NE.head &&& fmap snd) in -- put all markers on the same file together -- NOTE: it's a shame that `HashMap.unionsWith f = foldl' (HashMap.unionWith f) mempty` does not exist - onlyFirstToTrue $ putThisMarkersAtTop $ HashMap.elems markersPerFile + onlyFirstToTrue $ putThisMarkersAtTop $ NE.toList . snd <$> markersPerFile where onlyFirstToTrue = go True [] @@ -338,8 +347,15 @@ groupMarkersPerFile markers = | any isThisMarker (snd <$> ms2) -> GT | otherwise -> EQ +groupOn :: (Eq k, Ord k) => (v -> k) -> [v] -> [(k, NonEmpty v)] +groupOn f + = fmap (fst . NE.head &&& fmap snd) + . NE.groupBy (equating fst) + . List.sortOn fst + . fmap (f &&& id) + -- | Prettyprint a sub-report, which is a part of the report spanning across a single file -prettySubReport :: +prettySubReport :: forall ann. -- | The content of files in the diagnostics FileMap -> -- | Is the output done with Unicode characters? @@ -359,7 +375,8 @@ prettySubReport fileContent withUnicode isError tabSize maxLineNumberLength isFi let (markersPerLine, multilineMarkers) = splitMarkersPerLine markers -- split the list on whether markers are multiline or not - sortedMarkersPerLine = {- second (List.sortOn (first $ snd . begin)) <$> -} List.sortOn fst (HashMap.toList markersPerLine) + sortedMarkersPerLine :: [(Int, NonEmpty (Position, Marker (Doc ann)))] = {- second (List.sortOn (first $ snd . begin)) <$> -} + groupOn (fst . begin . fst) markersPerLine 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) @@ -387,13 +404,16 @@ isThisMarker (This _) = True isThisMarker _ = False -- | -splitMarkersPerLine :: [(Position, Marker msg)] -> (HashMap Int [(Position, Marker msg)], [(Position, Marker msg)]) +splitMarkersPerLine :: [(Position, Marker msg)] -> ([(Position, Marker msg)], [(Position, Marker msg)]) splitMarkersPerLine [] = (mempty, mempty) splitMarkersPerLine (m@(Position {..}, _) : ms) = let (bl, _) = begin (el, _) = end - in (if bl == el then first (HashMap.insertWith (<>) bl [m]) else second (m :)) - (splitMarkersPerLine ms) + in (if bl == el then first else second) (m:) (splitMarkersPerLine ms) + +-- Like `comparing` +equating :: Eq a => (b -> a) -> b -> b -> Bool +equating f a b = f a == f b -- | prettyAllLines :: @@ -403,11 +423,11 @@ prettyAllLines :: -- | The number of spaces each TAB character will span TabSize -> Int -> - [(Int, [(Position, Marker (Doc ann))])] -> + [(Int, NonEmpty (Position, Marker (Doc ann)))] -> [(Position, Marker (Doc ann))] -> [Int] -> Doc (Annotation ann) -prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNumbers = +prettyAllLines filesParam withUnicode isError tabSize leftLen inline multiline lineNumbers = case lineNumbers of [] -> showMultiline True multiline @@ -421,6 +441,8 @@ prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNu <> (if l2 /= l1 + 1 then hardline <+> dotPrefix leftLen withUnicode else mempty) <> prettyAllLines files withUnicode isError tabSize leftLen inline ms (l2 : ls) where + files = List.nubBy (equating fst) filesParam + showForLine isLastLine line = {- A line of code is composed of: @@ -430,7 +452,7 @@ prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNu Multline markers may also take additional space (2 characters) on the right of the bar -} - let allInlineMarkersInLine = snd =<< filter ((==) line . fst) inline + let allInlineMarkersInLine = NE.toList . snd =<< filter ((==) line . fst) inline allMultilineMarkersInLine = flip filter multiline \(Position (bl, _) (el, _) _, _) -> bl == line || el == line @@ -505,7 +527,7 @@ getLine_ :: Bool -> (WidthTable, Doc (Annotation ann)) getLine_ files markers line (TabSize tabSize) isError = - case safeArrayIndex (line - 1) =<< (HashMap.!?) files . file . fst =<< List.safeHead markers of + case safeArrayIndex (line - 1) =<< flip lookup files . file . fst =<< List.safeHead markers of Nothing -> ( mkWidthTable "", annotate NoLineColor "" diff --git a/test/rendering/Spec.hs b/test/rendering/Spec.hs index c540742..586e29f 100644 --- a/test/rendering/Spec.hs +++ b/test/rendering/Spec.hs @@ -7,8 +7,6 @@ import qualified Data.ByteString.Lazy as BS import Error.Diagnose(diagnosticToJson) #endif -import Data.HashMap.Lazy (HashMap) -import qualified Data.HashMap.Lazy as HashMap import Error.Diagnose ( Marker (..), Note (..), @@ -29,11 +27,11 @@ import Prettyprinter.Util (reflow) import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), color, bold, italicized, underlined) import Data.Traversable (mapAccumL) import Data.Functor.Compose (Compose(..)) +import Data.Foldable (Foldable(..)) main :: IO () main = do - let files :: HashMap FilePath String = - HashMap.fromList + let files :: [(FilePath, String)] = [ ("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 }"), @@ -89,8 +87,8 @@ main = do nestingReport ] - let diag = HashMap.foldlWithKey' addFile (foldl addReport mempty reports) files - customDiag = HashMap.foldlWithKey' addFile (foldl addReport mempty customAnnReports) files + let diag = foldl' (fmap uncurry addFile) (foldl addReport mempty reports) files + customDiag = foldl' (fmap uncurry addFile) (foldl addReport mempty customAnnReports) files hPutStrLn stdout "\n\nWith unicode: ─────────────────────────\n" printDiagnostic stdout WithUnicode (TabSize 4) defaultStyle diag