module Text.Megaparsec.Error
( Message (..)
, messageString
, badMessage
, ParseError
, errorPos
, errorMessages
, errorIsUnknown
, newErrorMessage
, newErrorUnknown
, addErrorMessage
, setErrorMessage
, setErrorPos
, mergeError
, showMessages )
where
#if MIN_VERSION_base(4,7,0)
import Data.Bool (bool)
#endif
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Text.Megaparsec.Pos
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
import Data.Foldable (foldMap)
#endif
#if !MIN_VERSION_base(4,7,0)
bool :: a -> a -> Bool -> a
bool f _ False = f
bool _ t True = t
#endif
data Message
= Unexpected !String
| Expected !String
| Message !String
deriving (Show, Eq)
instance Enum Message where
fromEnum (Unexpected _) = 0
fromEnum (Expected _) = 1
fromEnum (Message _) = 2
toEnum _ = error "Text.Megaparsec.Error: toEnum is undefined for Message"
instance Ord Message where
compare m1 m2 =
case compare (fromEnum m1) (fromEnum m2) of
LT -> LT
EQ -> compare (messageString m1) (messageString m2)
GT -> GT
messageString :: Message -> String
messageString (Unexpected s) = s
messageString (Expected s) = s
messageString (Message s) = s
badMessage :: Message -> Bool
badMessage = null . messageString
data ParseError = ParseError
{
errorPos :: !SourcePos
, errorMessages :: [Message] }
deriving Eq
instance Show ParseError where
show e = show (errorPos e) ++ ":\n" ++ showMessages (errorMessages e)
errorIsUnknown :: ParseError -> Bool
errorIsUnknown (ParseError _ ms) = null ms
newErrorUnknown :: SourcePos -> ParseError
newErrorUnknown pos = ParseError pos []
newErrorMessage :: Message -> SourcePos -> ParseError
newErrorMessage m pos = ParseError pos $ bool [m] [] (badMessage m)
addErrorMessage :: Message -> ParseError -> ParseError
addErrorMessage m (ParseError pos ms) =
ParseError pos $ bool (pre ++ [m] ++ post) ms (badMessage m)
where pre = filter (< m) ms
post = filter (> m) ms
setErrorMessage :: Message -> ParseError -> ParseError
setErrorMessage m (ParseError pos ms) =
bool (addErrorMessage m pe) pe (badMessage m)
where pe = ParseError pos xs
xs = filter ((/= fromEnum m) . fromEnum) ms
setErrorPos :: SourcePos -> ParseError -> ParseError
setErrorPos pos (ParseError _ ms) = ParseError pos ms
mergeError :: ParseError -> ParseError -> ParseError
mergeError e1@(ParseError pos1 _) e2@(ParseError pos2 ms2) =
case pos1 `compare` pos2 of
LT -> e2
EQ -> foldr addErrorMessage e1 ms2
GT -> e1
showMessages :: [Message] -> String
showMessages [] = "unknown parse error"
showMessages ms = tail $ foldMap (fromMaybe "") (zipWith f ns rs)
where (unexpected, ms') = span ((== 0) . fromEnum) ms
(expected, messages) = span ((== 1) . fromEnum) ms'
f prefix m = (prefix ++) <$> m
ns = ["\nunexpected ","\nexpecting ","\n"]
rs = renderMsgs <$> [unexpected, expected, messages]
renderMsgs :: [Message] -> Maybe String
renderMsgs [] = Nothing
renderMsgs ms = Just . orList $ messageString <$> ms
orList :: [String] -> String
orList [] = ""
orList [x] = x
orList [x,y] = x ++ " or " ++ y
orList xs = intercalate ", " (init xs) ++ ", or " ++ last xs