git.iko.soy/Idris-dev
on master help sign in
Get error location & message direct from parser

With Trifecta, we were parsing this information from the formatted output. With Megaparsec, we don't need to rely on the format. Closes #1575

commitb6f8bdfc0c650f5363f261429414f59e7b32e61c authorJason Felice <jason.m.felice@gmail.com> dateFri 3 Nov 2017, 15:28 (9 years ago) parent774d1b6
2 files changed+27−29
compare with master
unifiedsplit
src/Idris/Parser.hs+2−21 src/Idris/Parser/Helpers.hs+25−8
src/Idris/Parser.hs+2−21
@@ -1551,21 +1551,6 @@ parseImports fname input
15511551 shebang :: IdrisParser ()
15521552 shebang = string "#!" *> many (P.satisfy $ not . isEol) *> eol *> pure ()
15531553
1554−-- | There should be a better way of doing this...
1555−findFC :: PP.Doc -> (FC, String)
1556−findFC x = let s = show (PP.plain x) in findFC' s
1557− where findFC' s = case span (/= ':') s of
1558− -- Horrid kludge to prevent crashes on Windows
1559− (prefix, ':':'\\':rest) ->
1560− case findFC' rest of
1561− (NoFC, msg) -> (NoFC, msg)
1562− (FileFC f, msg) -> (FileFC (prefix ++ ":\\" ++ f), msg)
1563− (FC f start end, msg) -> (FC (prefix ++ ":\\" ++ f) start end, msg)
1564− (failname, ':':rest) -> case span isDigit rest of
1565− (line, ':':rest') -> case span isDigit rest' of
1566− (col, ':':msg) -> let pos = (read line, read col) in
1567− (FC failname pos pos, msg)
1568−
15691554-- | Check if the coloring matches the options and corrects if necessary
15701555fixColour :: Bool -> PP.Doc -> PP.Doc
15711556fixColour False doc = PP.plain doc
@@ -1577,15 +1562,11 @@ parseProg :: SyntaxInfo -> FilePath -> String -> Maybe ParseState -> Idris [PDec
15771562parseProg syn fname input mrk
15781563 = do i <- getIState
15791564 case runparser mainProg i fname input of
1580− Left err -> do -- FIXME: Get error location from trifecta
1581− -- this can't be the solution!
1582− -- Issue #1575 on the issue tracker.
1583− -- https://github.com/idris-lang/Idris-dev/issues/1575
1584− let (fc, msg) = findFC $ parseErrorDoc err
1565+ Left err -> do let fc = parseErrorFC err
15851566 i <- getIState
15861567 case idris_outputmode i of
15871568 RawOutput h -> iputStrLn (show . fixColour (idris_colourRepl i) . parseErrorDoc $ err)
1588− IdeMode n h -> iWarn fc (Util.Pretty.text msg)
1569+ IdeMode n h -> iWarn fc (Util.Pretty.text $ parseErrorMessage err)
15891570 putIState (i { errSpan = Just fc })
15901571 return []
15911572 Right (x, i) -> do putIState i
src/Idris/Parser/Helpers.hs+25−8
@@ -49,6 +49,15 @@ parseErrorPretty (ParseError s err) = P.parseErrorPretty' s err
4949parseErrorDoc :: ParseError -> PP.Doc
5050parseErrorDoc = PP.string . parseErrorPretty
5151
52+parseErrorFC :: ParseError -> FC
53+parseErrorFC (ParseError _ err) = sourcePositionFC pos
54+ where
55+ (pos NonEmpty.:| _) = P.errorPos err
56+
57+parseErrorMessage :: ParseError -> String
58+parseErrorMessage (ParseError _ err) = P.parseErrorTextPretty err
59+
60+
5261-- | Generalized monadic parsing constraint type
5362type MonadicParsing m = (P.MonadParsec Void String m)
5463
@@ -393,16 +402,24 @@ symbolicOperatorFC = do (FC f (l, c) _) <- getFC
393402 return (op, FC f (l, c) (l, c + length op))
394403
395404{- * Position helpers -}
405+
406+sourcePositionFC :: P.SourcePos -> FC
407+sourcePositionFC (P.SourcePos name line column) =
408+ -- TODO: Change to actual spanning
409+ -- Issue #1594 on the Issue Tracker.
410+ -- https://github.com/idris-lang/Idris-dev/issues/1594
411+ FC f (lineNumber, columnNumber) (lineNumber, columnNumber)
412+ where
413+ lineNumber = P.unPos line
414+ columnNumber = P.unPos column
415+ (dir, file) = splitFileName name
416+ f = if dir == addTrailingPathSeparator "."
417+ then file
418+ else name
419+
396420{- | Get file position as FC -}
397421getFC :: MonadicParsing m => m FC
398−getFC = do pos <- P.getPosition
399− let columnNumber = P.unPos . P.sourceColumn $ pos
400− let lineNumber = P.unPos . P.sourceLine $ pos
401− let (dir, file) = splitFileName (P.sourceName pos)
402− let f = if dir == addTrailingPathSeparator "." then file else P.sourceName pos
403− return $ FC f (lineNumber, columnNumber) (lineNumber, columnNumber) -- TODO: Change to actual spanning
404− -- Issue #1594 on the Issue Tracker.
405− -- https://github.com/idris-lang/Idris-dev/issues/1594
422+getFC = sourcePositionFC <$> P.getPosition
406423
407424{-* Syntax helpers-}
408425-- | Bind constraints to term