module Text.ParserCombinators.Parsec.Error
( Message (SysUnExpect, UnExpect, Expect, Message)
, ParseError
, addErrorMessage
, errorIsUnknown
, errorMessages
, errorPos
, mergeError
, messageCompare
, messageEq
, messageString
, newErrorMessage
, newErrorUnknown
, setErrorMessage
, setErrorPos
, showErrorMessages
) where
import Data.List (nub, sortBy)
import Text.ParserCombinators.Parsec.Pos
data Message
= SysUnExpect !String
| UnExpect !String
| Expect !String
| Message !String
deriving Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq
messageToEnum :: Message -> Int
messageToEnum :: Message -> Int
messageToEnum Message
msg = case Message
msg of
SysUnExpect String
_ -> Int
0
UnExpect String
_ -> Int
1
Expect String
_ -> Int
2
Message String
_ -> Int
3
messageCompare :: Message -> Message -> Ordering
messageCompare :: Message -> Message -> Ordering
messageCompare Message
msg1 Message
msg2
= Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Message -> Int
messageToEnum Message
msg1) (Message -> Int
messageToEnum Message
msg2)
messageString :: Message -> String
messageString :: Message -> String
messageString Message
msg = case Message
msg of
SysUnExpect String
s -> String
s
UnExpect String
s -> String
s
Expect String
s -> String
s
Message String
s -> String
s
messageEq :: Message -> Message -> Bool
messageEq :: Message -> Message -> Bool
messageEq Message
msg1 Message
msg2
= Message -> Message -> Ordering
messageCompare Message
msg1 Message
msg2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
data ParseError = ParseError !SourcePos [Message] deriving ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq
errorPos :: ParseError -> SourcePos
errorPos :: ParseError -> SourcePos
errorPos (ParseError SourcePos
pos [Message]
_msgs) = SourcePos
pos
errorMessages :: ParseError -> [Message]
errorMessages :: ParseError -> [Message]
errorMessages (ParseError SourcePos
_pos [Message]
msgs) = (Message -> Message -> Ordering) -> [Message] -> [Message]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Message -> Message -> Ordering
messageCompare [Message]
msgs
errorIsUnknown :: ParseError -> Bool
errorIsUnknown :: ParseError -> Bool
errorIsUnknown (ParseError SourcePos
_pos [Message]
msgs) = [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs
newErrorUnknown :: SourcePos -> ParseError
newErrorUnknown :: SourcePos -> ParseError
newErrorUnknown SourcePos
pos = SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos []
newErrorMessage :: Message -> SourcePos -> ParseError
newErrorMessage :: Message -> SourcePos -> ParseError
newErrorMessage Message
msg SourcePos
pos = SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos [Message
msg]
addErrorMessage :: Message -> ParseError -> ParseError
addErrorMessage :: Message -> ParseError -> ParseError
addErrorMessage Message
msg (ParseError SourcePos
pos [Message]
msgs) = SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos (Message
msg Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: [Message]
msgs)
setErrorPos :: SourcePos -> ParseError -> ParseError
setErrorPos :: SourcePos -> ParseError -> ParseError
setErrorPos SourcePos
pos (ParseError SourcePos
_ [Message]
msgs) = SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos [Message]
msgs
setErrorMessage :: Message -> ParseError -> ParseError
setErrorMessage :: Message -> ParseError -> ParseError
setErrorMessage Message
msg (ParseError SourcePos
pos [Message]
msgs)
= SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos (Message
msg Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: (Message -> Bool) -> [Message] -> [Message]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Message -> Bool) -> Message -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Message -> Bool
messageEq Message
msg) [Message]
msgs)
mergeError :: ParseError -> ParseError -> ParseError
mergeError :: ParseError -> ParseError -> ParseError
mergeError e1 :: ParseError
e1@(ParseError SourcePos
pos1 [Message]
msgs1) e2 :: ParseError
e2@(ParseError SourcePos
pos2 [Message]
msgs2)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs2 Bool -> Bool -> Bool
&& Bool -> Bool
not ([Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs1) = ParseError
e1
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs2) = ParseError
e2
| Bool
otherwise
= case SourcePos
pos1 SourcePos -> SourcePos -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` SourcePos
pos2 of
Ordering
EQ -> SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos1 ([Message]
msgs1 [Message] -> [Message] -> [Message]
forall a. [a] -> [a] -> [a]
++ [Message]
msgs2)
Ordering
GT -> ParseError
e1
Ordering
LT -> ParseError
e2
instance Show ParseError where
show :: ParseError -> String
show ParseError
err = SourcePos -> String
forall a. Show a => a -> String
show (ParseError -> SourcePos
errorPos ParseError
err) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages String
"or" String
"unknown parse error"
String
"expecting" String
"unexpected" String
"end of input"
(ParseError -> [Message]
errorMessages ParseError
err)
showErrorMessages ::
String -> String -> String -> String -> String -> [Message] -> String
showErrorMessages :: String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages String
msgOr String
msgUnknown String
msgExpecting String
msgUnExpected String
msgEndOfInput [Message]
msgs
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = String
msgUnknown
| Bool
otherwise = ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
clean
[String
showSysUnExpect, String
showUnExpect, String
showExpect, String
showMessages]
where
([Message]
sysUnExpect, [Message]
msgs1) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Message -> Message -> Bool
messageEq (String -> Message
SysUnExpect String
"")) [Message]
msgs
([Message]
unExpect, [Message]
msgs2) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Message -> Message -> Bool
messageEq (String -> Message
UnExpect String
"")) [Message]
msgs1
([Message]
expect, [Message]
messages) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Message -> Message -> Bool
messageEq (String -> Message
Expect String
"")) [Message]
msgs2
showExpect :: String
showExpect = String -> [Message] -> String
showMany String
msgExpecting [Message]
expect
showUnExpect :: String
showUnExpect = String -> [Message] -> String
showMany String
msgUnExpected [Message]
unExpect
showSysUnExpect :: String
showSysUnExpect
| Bool -> Bool
not ([Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
unExpect) Bool -> Bool -> Bool
|| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
sysUnExpect = String
""
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
firstMsg = String
msgUnExpected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msgEndOfInput
| Bool
otherwise = String
msgUnExpected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
firstMsg
where
firstMsg :: String
firstMsg = Message -> String
messageString ([Message] -> Message
forall a. [a] -> a
head [Message]
sysUnExpect)
showMessages :: String
showMessages = String -> [Message] -> String
showMany String
"" [Message]
messages
showMany :: String -> [Message] -> String
showMany String
pre [Message]
es = case [String] -> [String]
clean ((Message -> String) -> [Message] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Message -> String
messageString [Message]
es) of
[] -> String
""
[String]
ms | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pre -> [String] -> String
commasOr [String]
ms
| Bool
otherwise -> String
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commasOr [String]
ms
commasOr :: [String] -> String
commasOr [String]
ms = case [String]
ms of
[] -> String
""
[String
m] -> String
m
[String]
_ -> [String] -> String
commaSep ([String] -> [String]
forall a. [a] -> [a]
init [String]
ms) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msgOr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
last [String]
ms
commaSep :: [String] -> String
commaSep = String -> [String] -> String
seperate String
", " ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
clean
seperate :: String -> [String] -> String
seperate String
sep [String]
ms = case [String]
ms of
[] -> String
""
[String
m] -> String
m
String
m : [String]
rs -> String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
seperate String
sep [String]
rs
clean :: [String] -> [String]
clean = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)