Mesabloo/diagnose
1
1
Fork 0
mirror of https://github.com/Mesabloo/diagnose.git synced 2024-11-22 01:32:56 +03:00
Code Issues Projects Releases Wiki Activity

show 'end of line' token when converting from parsec error

Browse Source
This commit is contained in:
Mesabloo 2022-07-15 09:24:37 +02:00
parent 5414562720
commit c8f855325c
2 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Error/Diagnose/Compat/Parsec.hs
View File

@ -66,11 +66,12 @@ diagnosticFromParseError isError code msg (fromMaybe [] -> defaultHints) error =
putTogether (PE.Message thing : ms) = let (a, b, c, d) = putTogether ms in (a, b, c, thing : d)
(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 ", " (filter (not . null) expectedList))]
firstSysUnexpectedMessage = head sysUnexpectedList
unexpectedMessage = "unexpected " <> if null unexpectedList then if null firstSysUnexpectedMessage then "end of line" else firstSysUnexpectedMessage else intercalate ", " (filter (not . null) unexpectedList)
in [ (source, This $ fromString unexpectedMessage) ]
<> [ (source, This $ fromString msg) | msg <- messages ]
<> [ (source, Where $ fromString $ "expecting any of " <> intercalate ", " (filter (not . null) expectedList)) ]
-- | Generates an error diagnostic from a 'PE.ParseError'.
errorDiagnosticFromParseError ::

7
test/parsec/Spec.hs
View File

@ -25,9 +25,11 @@ main = do
let filename :: FilePath = "<interactive>"
content1 :: Text = "0000000123456"
content2 :: Text = "00000a2223266"
content3 :: Text = "aab"
let res1 = first (errorDiagnosticFromParseError Nothing "Parse error on input" Nothing) $ P.parse (P.many1 P.digit <* P.eof) filename content1
res2 = first (errorDiagnosticFromParseError Nothing "Parse error on input" Nothing) $ P.parse (P.many1 P.digit <* P.eof) filename content2
res3 = first (errorDiagnosticFromParseError Nothing "Parse error on input" Nothing) $ P.parse (test1 <* P.eof) filename content3
case res1 of
Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content1) :: Diagnostic String)
@ -35,6 +37,11 @@ main = do
case res2 of
Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content2) :: Diagnostic String)
Right res -> print res
case res3 of
Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content3) :: Diagnostic String)
Right res -> print res
-- all issue reproduction
Issue2.main
test1 = P.many (P.string "a") *> P.string "b" *> P.many1 (P.string "c")