diagnose 1.7.1 → 1.7.2

raw patch · 4 files changed

+62/−6 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• diagnose.cabal +2/−1
• src/Error/Diagnose/Compat/Parsec.hs +3/−3
• test/parsec/Repro2.hs +50/−0
• test/parsec/Spec.hs +7/−2

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           diagnose-version:        1.7.1+version:        1.7.2 synopsis:       Beautiful error reporting done easily description:    This package provides a simple way of getting beautiful compiler/interpreter errors                 using a very simple interface for the programmer.@@ -132,6 +132,7 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      Repro2       Paths_diagnose   hs-source-dirs:       test/parsec

@@ -20,7 +20,7 @@ where  import Data.Bifunctor (second)-import Data.List (intercalate)+import Data.List (intercalate, nub) import Data.Maybe (fromMaybe) import Data.String (IsString (..)) import Data.Void (Void)@@ -65,12 +65,12 @@           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+          (nub -> sysUnexpectedList, nub -> unexpectedList, nub -> expectedList, nub -> 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)]+            <> [(source, Where $ fromString $ "expecting any of " <> intercalate ", " (filter (not . null) expectedList))]  -- | Generates an error diagnostic from a 'PE.ParseError'. errorDiagnosticFromParseError ::

@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Repro2 where++import Data.Void+import Error.Diagnose+import Error.Diagnose.Compat.Parsec+import Text.Parsec+import Text.Parsec.Token++instance HasHints Void String where hints _ = mempty++type Parser = Parsec String ()++diagParse :: Parser a -> SourceName -> String -> Either (Diagnostic String) a+diagParse p filename content =+  either (Left . diag) Right (parse p filename content)+  where+    diag e = addFile (errorDiagnosticFromParseError Nothing "Parse error on input" Nothing e) filename content++parser1 :: Parser Char+parser1 = op "\\" *> letter++parser2 :: Parser Char+parser2 = op' "\\" *> letter++main :: IO ()+main = do+  either (printDiagnostic stderr True True) print $ diagParse parser1 "issues/2.txt" "\\1"+  either (printDiagnostic stderr True True) print $ diagParse parser2 "issues/2.txt" "\\1"++-- smaller example+op' :: String -> Parser String+op' name = string name <* spaces++op :: String -> Parser ()+op =+  reservedOp $+    makeTokenParser+      LanguageDef+        { commentStart = "{-",+          commentEnd = "-}",+          commentLine = "--",+          reservedOpNames = ["\\"],+          opStart = oneOf "\\",+          opLetter = oneOf "\\"+        }

@@ -13,10 +13,12 @@ import Data.Void (Void) import Error.Diagnose import Error.Diagnose.Compat.Parsec+--+import qualified Repro2 as Issue2+-- import qualified Text.Parsec as P -instance HasHints Void msg where-  hints _ = mempty+instance HasHints Void Text where hints _ = mempty  main :: IO () main = do@@ -33,3 +35,6 @@   case res2 of     Left diag -> printDiagnostic stdout True True (addFile diag filename (Text.unpack content2) :: Diagnostic String)     Right res -> print res++  -- all issue reproduction+  Issue2.main