Remove dependency on unordered-containers

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)

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:

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.

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 "<no line>"

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<a>(x : a) : a := x + 1\nrec fix(f) := f(fix(f))\nlet const<a, b>(x : a, y : b) : a := x"),
             ("somefile.zc", "let id<a>(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