diff --git a/Text/ParserCombinators/Parsec/Combinator.hs b/Text/ParserCombinators/Parsec/Combinator.hs --- a/Text/ParserCombinators/Parsec/Combinator.hs +++ b/Text/ParserCombinators/Parsec/Combinator.hs @@ -3,13 +3,13 @@ -- Module : Text.ParserCombinators.Parsec.Combinator -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) --- +-- -- Maintainer : Antoine Latter -- Stability : provisional -- Portability : portable -- -- Commonly used generic combinators --- +-- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Combinator @@ -25,7 +25,7 @@ , chainl, chainl1 , chainr, chainr1 , eof, notFollowedBy - + -- tricky combinators , manyTill, lookAhead, anyToken ) where @@ -66,12 +66,12 @@ -- Returns the value returned by @p@. -- -- > braces = between (symbol "{") (symbol "}") -between :: GenParser tok st open -> GenParser tok st close +between :: GenParser tok st open -> GenParser tok st close -> GenParser tok st a -> GenParser tok st a between open close p = do{ open; x <- p; close; return x } - - + + -- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping -- its result. skipMany1 :: GenParser tok st a -> GenParser tok st () @@ -123,7 +123,7 @@ } <|> return [x] } - + -- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@, -- separated and optionally ended by @sep@, ie. haskell style -- statements. Returns a list of values returned by @p@. @@ -192,7 +192,7 @@ ; rest (f x y) } <|> return x - + -- | @chainr1 p op x@ parser /one/ or more occurrences of |p|, -- separated by @op@ Returns a value obtained by a /right/ associative -- application of all functions returned by @op@ to the values returned @@ -201,7 +201,7 @@ chainr1 p op = scan where scan = do{ x <- p; rest x } - + rest x = do{ f <- op ; y <- scan ; return (f x y) @@ -222,7 +222,7 @@ -- -- > eof = notFollowedBy anyToken "end of input" eof :: Show tok => GenParser tok st () -eof = notFollowedBy anyToken "end of input" +eof = notFollowedBy anyToken "end of input" -- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser -- does not consume any input. This parser can be used to implement the @@ -235,8 +235,8 @@ -- > keywordLet = try (do{ string "let" -- > ; notFollowedBy alphaNum -- > }) -notFollowedBy :: Show tok => GenParser tok st tok -> GenParser tok st () -notFollowedBy p = try (do{ c <- p; unexpected (show [c]) } +notFollowedBy :: Show a => GenParser tok st a -> GenParser tok st () +notFollowedBy p = try (do{ c <- p; unexpected (show c) } <|> return () ) @@ -256,12 +256,3 @@ scan = do{ end; return [] } <|> do{ x <- p; xs <- scan; return (x:xs) } - - --- | @lookAhead p@ parses @p@ without consuming any input. -lookAhead :: GenParser tok st a -> GenParser tok st a -lookAhead p = do{ state <- getParserState - ; x <- p - ; setParserState state - ; return x - } diff --git a/Text/ParserCombinators/Parsec/Error.hs b/Text/ParserCombinators/Parsec/Error.hs --- a/Text/ParserCombinators/Parsec/Error.hs +++ b/Text/ParserCombinators/Parsec/Error.hs @@ -3,22 +3,22 @@ -- Module : Text.ParserCombinators.Parsec.Error -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) --- +-- -- Maintainer : Antoine Latter -- Stability : provisional -- Portability : portable -- -- Parse errors --- +-- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Error ( Message(SysUnExpect,UnExpect,Expect,Message) , messageString, messageCompare, messageEq - + , ParseError, errorPos, errorMessages, errorIsUnknown , showErrorMessages - + , newErrorMessage, newErrorUnknown , addErrorMessage, setErrorPos, setErrorMessage , mergeError @@ -28,8 +28,8 @@ import Prelude import Data.List (nub,sortBy) -import Text.ParserCombinators.Parsec.Pos - +import Text.ParserCombinators.Parsec.Pos + -- | This abstract data type represents parse error messages. There are -- four kinds of messages: -- @@ -37,7 +37,7 @@ -- > | UnExpect String -- > | Expect String -- > | Message String --- +-- -- The fine distinction between different kinds of parse errors allows -- the system to generate quite good error messages for the user. It -- also allows error messages that are formatted in different @@ -56,34 +56,34 @@ -- -- * A 'Message' message is generated by the 'fail' -- combinator. The argument is some general parser message. -data Message = SysUnExpect !String --library generated unexpect - | UnExpect !String --unexpected something +data Message = SysUnExpect !String --library generated unexpect + | UnExpect !String --unexpected something | Expect !String --expecting something | Message !String --raw message - + messageToEnum msg = case msg of SysUnExpect _ -> 0 UnExpect _ -> 1 Expect _ -> 2 - Message _ -> 3 - + Message _ -> 3 + messageCompare :: Message -> Message -> Ordering messageCompare msg1 msg2 = compare (messageToEnum msg1) (messageToEnum msg2) - + -- | Extract the message string from an error message messageString :: Message -> String messageString msg = case msg of SysUnExpect s -> s UnExpect s -> s Expect s -> s - Message s -> s + Message s -> s messageEq :: Message -> Message -> Bool messageEq msg1 msg2 = (messageCompare msg1 msg2 == EQ) - - + + -- | The abstract data type @ParseError@ represents parse errors. It -- provides the source position ('SourcePos') of the error -- and a list of error messages ('Message'). A @ParseError@ @@ -95,54 +95,60 @@ errorPos :: ParseError -> SourcePos errorPos (ParseError pos msgs) = pos - + -- | Extracts the list of error messages from the parse error errorMessages :: ParseError -> [Message] errorMessages (ParseError pos msgs) - = sortBy messageCompare msgs - + = sortBy messageCompare msgs + errorIsUnknown :: ParseError -> Bool errorIsUnknown (ParseError pos msgs) = null msgs - - + + ----------------------------------------------------------- -- Create parse errors ------------------------------------------------------------ +----------------------------------------------------------- newErrorUnknown :: SourcePos -> ParseError newErrorUnknown pos = ParseError pos [] - + newErrorMessage :: Message -> SourcePos -> ParseError -newErrorMessage msg pos +newErrorMessage msg pos = ParseError pos [msg] addErrorMessage :: Message -> ParseError -> ParseError addErrorMessage msg (ParseError pos msgs) = ParseError pos (msg:msgs) - + setErrorPos :: SourcePos -> ParseError -> ParseError setErrorPos pos (ParseError _ msgs) = ParseError pos msgs - + setErrorMessage :: Message -> ParseError -> ParseError setErrorMessage msg (ParseError pos msgs) = ParseError pos (msg:filter (not . messageEq msg) msgs) - - -mergeError :: ParseError -> ParseError -> ParseError -mergeError (ParseError pos msgs1) (ParseError _ msgs2) - = ParseError pos (msgs1 ++ msgs2) - +mergeError :: ParseError -> ParseError -> ParseError +mergeError e1@(ParseError pos1 msgs1) e2@(ParseError pos2 msgs2) + -- prefer meaningful errors + | null msgs2 && not (null msgs1) = e1 + | null msgs1 && not (null msgs2) = e2 + | otherwise + = case pos1 `compare` pos2 of + -- select the longest match + EQ -> ParseError pos1 (msgs1 ++ msgs2) + GT -> e1 + LT -> e2 + ----------------------------------------------------------- -- Show Parse Errors ------------------------------------------------------------ +----------------------------------------------------------- instance Show ParseError where show err - = show (errorPos err) ++ ":" ++ - showErrorMessages "or" "unknown parse error" + = show (errorPos err) ++ ":" ++ + showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages err) @@ -158,7 +164,7 @@ (sysUnExpect,msgs1) = span (messageEq (SysUnExpect "")) msgs (unExpect,msgs2) = span (messageEq (UnExpect "")) msgs1 (expect,messages) = span (messageEq (Expect "")) msgs2 - + showExpect = showMany msgExpecting expect showUnExpect = showMany msgUnExpected unExpect showSysUnExpect | not (null unExpect) || @@ -167,26 +173,26 @@ | otherwise = msgUnExpected ++ " " ++ firstMsg where firstMsg = messageString (head sysUnExpect) - + showMessages = showMany "" messages - - --helpers + + --helpers showMany pre msgs = case (clean (map messageString msgs)) of [] -> "" ms | null pre -> commasOr ms | otherwise -> pre ++ " " ++ commasOr ms - - commasOr [] = "" - commasOr [m] = m + + commasOr [] = "" + commasOr [m] = m commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms - + commaSep = seperate ", " . clean - semiSep = seperate "; " . clean - + semiSep = seperate "; " . clean + seperate sep [] = "" seperate sep [m] = m - seperate sep (m:ms) = m ++ sep ++ seperate sep ms - - clean = nub . filter (not.null) - + seperate sep (m:ms) = m ++ sep ++ seperate sep ms + + clean = nub . filter (not.null) + diff --git a/Text/ParserCombinators/Parsec/Prim.hs b/Text/ParserCombinators/Parsec/Prim.hs --- a/Text/ParserCombinators/Parsec/Prim.hs +++ b/Text/ParserCombinators/Parsec/Prim.hs @@ -25,7 +25,7 @@ -- instance Monad Parser : return, >>=, fail -- instance MonadPlus Parser : mzero (pzero), mplus (<|>) , token, tokens, tokenPrim, tokenPrimEx - , try, label, labels, unexpected, pzero + , try, label, labels, lookAhead, unexpected, pzero -- primitive because of space behaviour , many, skipMany @@ -368,13 +368,24 @@ -- > identifier = many1 letter try :: GenParser tok st a -> GenParser tok st a try (Parser p) - = Parser (\state@(State input pos user) -> + = Parser (\state -> case (p state) of - Consumed (Error err) -> Empty (Error (setErrorPos pos err)) + Consumed (Error err) -> Empty (Error err) Consumed ok -> Consumed ok -- was: Empty ok empty -> empty ) +-- | @lookAhead p@ parses @p@ without consuming any input. +lookAhead :: GenParser tok st a -> GenParser tok st a +lookAhead p = do{ state <- getParserState + ; x <- p' + ; setParserState state + ; return x + } + where p' = Parser $ \ state -> case runP p state of + Consumed ok@Ok{} -> Empty ok + reply -> reply + -- | The parser @token showTok posFromTok testTok@ accepts a token @t@ -- with result @x@ when the function @testTok t@ returns @'Just' x@. The -- source position of the @t@ should be returned by @posFromTok t@ and @@ -571,18 +582,18 @@ errEof = Error (setErrorMessage (Expect (shows s)) (newErrorMessage (SysUnExpect "") pos)) - errExpect c = Error (setErrorMessage (Expect (shows s)) - (newErrorMessage (SysUnExpect (shows [c])) pos)) + errExpect r = Error $ setErrorMessage (Expect (shows s)) + $ newErrorMessage (SysUnExpect $ shows $ reverse r) pos - walk [] cs = ok cs - walk xs [] = errEof - walk (x:xs) (c:cs)| x == c = walk xs cs - | otherwise = errExpect c + walk _ [] cs = ok cs + walk r xs [] = errExpect r + walk r (x:xs) (c:cs)| x == c = walk (x : r) xs cs + | otherwise = errExpect $ c : r walk1 [] cs = Empty (ok cs) walk1 xs [] = Empty (errEof) - walk1 (x:xs) (c:cs)| x == c = Consumed (walk xs cs) - | otherwise = Empty (errExpect c) + walk1 (x:xs) (c:cs)| x == c = Consumed (walk [x] xs cs) + | otherwise = Empty (errExpect [c] ) in walk1 s input) diff --git a/parsec1.cabal b/parsec1.cabal --- a/parsec1.cabal +++ b/parsec1.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.2 name: parsec1 -version: 1.0.0.4 +version: 1.0.0.5 license: BSD3 license-file: LICENSE author: Daan Leijen @@ -26,8 +26,16 @@ in order to avoid module ambiguities for users just installing your package. Your own module ambiguities are best avoided by hiding packages. . - This version only differs from pervious ones by a changed description. - (In version 1.0.0.4 only the inline pragmas have been removed #4849.) + + This version only differs from the pervious one by improved error messages + for try (positions are not reset), tokens and thus string (longer + unexpected strings are now reported to match the error position). + The notFollowedBy-parser was generalized (as in parsec-3) so + characters in messages are now shown in single instead of double + quotes. + Also (as since parsec-3.1.2) lookAhead no longer consumes tokens on success + (so that the many-parser can detect this). + build-type: Simple cabal-version: >= 1.6 library {