git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1419 from epost/master

Format parse errors uniformly (#1098)

commita1cbf8dd3c6b925a383e594c4a2e1a1cd6da8238 authorPhil Freeman <paf31@cantab.net> dateMon 24 Aug 2015, 20:37 (11 years ago) parent54cd8d996f5b98
3 files changed+71−14
src/Language/PureScript.hs+1−1 src/Language/PureScript/Errors.hs+59−8 src/Language/PureScript/Parser/Declarations.hs+11−5
src/Language/PureScript.hs+1−1
@@ -28,7 +28,7 @@ import Data.Version (Version)
2828import Language.PureScript.AST as P
2929import Language.PureScript.Comments as P
3030import Language.PureScript.Environment as P
31−import Language.PureScript.Errors as P
31+import Language.PureScript.Errors as P hiding (indent)
3232import Language.PureScript.Kinds as P
3333import Language.PureScript.Linter as P
3434import Language.PureScript.Make as P
src/Language/PureScript/Errors.hs+59−8
@@ -50,6 +50,9 @@ import Language.PureScript.Kinds
5050import qualified Text.PrettyPrint.Boxes as Box
5151
5252import qualified Text.Parsec as P
53+import qualified Text.Parsec.Error as PE
54+import Text.Parsec.Error (Message(..))
55+import Data.List (nub)
5356
5457-- |
5558-- A type of error messages
@@ -412,7 +415,7 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
412415 ]
413416 goSimple (ErrorParsingExterns err) =
414417 paras [ lineWithLevel "parsing externs files: "
415− , indent . line . show $ err
418+ , indent . prettyPrintParseError $ err
416419 ]
417420 goSimple (ErrorParsingFFIModule path) =
418421 paras [ line "Unable to parse module from FFI file: "
@@ -420,7 +423,7 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
420423 ]
421424 goSimple (ErrorParsingModule err) =
422425 paras [ line "Unable to parse module: "
423− , indent . line . show $ err
426+ , indent . prettyPrintParseError $ err
424427 ]
425428 goSimple (MissingFFIModule mn) =
426429 line $ "Missing FFI implementations for module " ++ show mn
@@ -722,9 +725,6 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
722725 ]
723726 go (SimpleErrorWrapper sem) = goSimple sem
724727
725− line :: String -> Box.Box
726− line = Box.text
727−
728728 lineWithLevel :: String -> Box.Box
729729 lineWithLevel text = line $ show level ++ " " ++ text
730730
@@ -742,9 +742,6 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
742742 paras :: [Box.Box] -> Box.Box
743743 paras = Box.vcat Box.left
744744
745− indent :: Box.Box -> Box.Box
746− indent = Box.moveRight 2
747−
748745 -- |
749746 -- Pretty print and export declaration
750747 --
@@ -822,6 +819,60 @@ prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) = do
822819 , Box.vsep 1 Box.left result
823820 ]
824821
822+-- | Pretty print a Parsec ParseError as a Box
823+prettyPrintParseError :: P.ParseError -> Box.Box
824+prettyPrintParseError = (prettyPrintParseErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input") . PE.errorMessages
825+
826+-- |
827+-- Pretty print ParseError detail messages.
828+--
829+-- Adapted from 'Text.Parsec.Error.showErrorMessages', see <https://github.com/aslatter/parsec/blob/v3.1.9/Text/Parsec/Error.hs#L173>.
830+--
831+prettyPrintParseErrorMessages :: String -> String -> String -> String -> String -> [Message] -> Box.Box
832+prettyPrintParseErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs
833+ | null msgs = Box.text msgUnknown
834+ | otherwise = Box.vcat Box.left $ map Box.text $ clean [showSysUnExpect,showUnExpect,showExpect,showMessages]
835+
836+ where
837+ (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs
838+ (unExpect,msgs2) = span ((UnExpect "") ==) msgs1
839+ (expect,messages) = span ((Expect "") ==) msgs2
840+
841+ showExpect = showMany msgExpecting expect
842+ showUnExpect = showMany msgUnExpected unExpect
843+ showSysUnExpect | not (null unExpect) ||
844+ null sysUnExpect = ""
845+ | null firstMsg = msgUnExpected ++ " " ++ msgEndOfInput
846+ | otherwise = msgUnExpected ++ " " ++ firstMsg
847+ where
848+ firstMsg = PE.messageString (head sysUnExpect)
849+
850+ showMessages = showMany "" messages
851+
852+ -- helpers
853+ showMany pre msgs' = case clean (map PE.messageString msgs') of
854+ [] -> ""
855+ ms | null pre -> commasOr ms
856+ | otherwise -> pre ++ " " ++ commasOr ms
857+
858+ commasOr [] = ""
859+ commasOr [m] = m
860+ commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms
861+
862+ commaSep = separate ", " . clean
863+
864+ separate _ [] = ""
865+ separate _ [m] = m
866+ separate sep (m:ms) = m ++ sep ++ separate sep ms
867+
868+ clean = nub . filter (not . null)
869+
870+indent :: Box.Box -> Box.Box
871+indent = Box.moveRight 2
872+
873+line :: String -> Box.Box
874+line = Box.text
875+
825876renderBox :: Box.Box -> String
826877renderBox = unlines . map trimEnd . lines . Box.render
827878 where
src/Language/PureScript/Parser/Declarations.hs+11−5
@@ -64,8 +64,6 @@ withSourceSpan f p = do
6464 end <- P.getPosition
6565 let sp = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)
6666 return $ f sp comments x
67− where
68− toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)
6967
7068kindedIdent :: TokenParser (String, Maybe Kind)
7169kindedIdent = (, Nothing) <$> identifier
@@ -287,8 +285,6 @@ parseModule = do
287285 end <- P.getPosition
288286 let ss = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)
289287 return $ Module ss comments name decls exports
290− where
291− toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)
292288
293289-- |
294290-- Parse a collection of modules
@@ -304,10 +300,20 @@ parseModulesFromFiles toFilePath input = do
304300 return $ collect modules
305301 where
306302 wrapError :: Either P.ParseError a -> m a
307− wrapError = either (throwError . errorMessage . ErrorParsingModule) return
303+ wrapError = either (throwError . MultipleErrors . pure . toPositionedError) return
308304 collect :: [(k, [v])] -> [(k, v)]
309305 collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
310306
307+toPositionedError :: P.ParseError -> ErrorMessage
308+toPositionedError perr = PositionedError (SourceSpan name start end) (SimpleErrorWrapper (ErrorParsingModule perr))
309+ where
310+ name = (P.sourceName . P.errorPos) perr
311+ start = (toSourcePos . P.errorPos) perr
312+ end = start
313+
314+toSourcePos :: P.SourcePos -> SourcePos
315+toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)
316+
311317-- |
312318-- Parse a collection of modules
313319--