{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
module Text.Parsec.Error
( Message ( SysUnExpect, UnExpect, Expect, Message )
, messageString
, ParseError, errorPos, errorMessages, errorIsUnknown
, showErrorMessages
, newErrorMessage, newErrorUnknown
, addErrorMessage, setErrorPos, setErrorMessage
, mergeError
) where
import Data.List ( nub, sort )
import Data.Typeable ( Typeable )
import Text.Parsec.Pos
data Message = SysUnExpect !String
| UnExpect !String
| Expect !String
| Message !String
deriving ( Typeable )
instance Enum Message where
fromEnum :: Message -> Int
fromEnum (SysUnExpect _) = 0
fromEnum (UnExpect _) = 1
fromEnum (Expect _) = 2
fromEnum (Message _) = 3
toEnum :: Int -> Message
toEnum _ = [Char] -> Message
forall a. HasCallStack => [Char] -> a
error "toEnum is undefined for Message"
instance Eq Message where
m1 :: Message
m1 == :: Message -> Message -> Bool
== m2 :: Message
m2 = Message -> Int
forall a. Enum a => a -> Int
fromEnum Message
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Message -> Int
forall a. Enum a => a -> Int
fromEnum Message
m2
instance Ord Message where
compare :: Message -> Message -> Ordering
compare msg1 :: Message
msg1 msg2 :: Message
msg2 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Message -> Int
forall a. Enum a => a -> Int
fromEnum Message
msg1) (Message -> Int
forall a. Enum a => a -> Int
fromEnum Message
msg2)
messageString :: Message -> String
messageString :: Message -> [Char]
messageString (SysUnExpect s :: [Char]
s) = [Char]
s
messageString (UnExpect s :: [Char]
s) = [Char]
s
messageString (Expect s :: [Char]
s) = [Char]
s
messageString (Message s :: [Char]
s) = [Char]
s
data ParseError = ParseError !SourcePos [Message]
deriving ( Typeable )
errorPos :: ParseError -> SourcePos
errorPos :: ParseError -> SourcePos
errorPos (ParseError pos :: SourcePos
pos _msgs :: [Message]
_msgs)
= SourcePos
pos
errorMessages :: ParseError -> [Message]
errorMessages :: ParseError -> [Message]
errorMessages (ParseError _pos :: SourcePos
_pos msgs :: [Message]
msgs)
= [Message] -> [Message]
forall a. Ord a => [a] -> [a]
sort [Message]
msgs
errorIsUnknown :: ParseError -> Bool
errorIsUnknown :: ParseError -> Bool
errorIsUnknown (ParseError _pos :: SourcePos
_pos msgs :: [Message]
msgs)
= [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs
newErrorUnknown :: SourcePos -> ParseError
newErrorUnknown :: SourcePos -> ParseError
newErrorUnknown pos :: SourcePos
pos
= SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos []
newErrorMessage :: Message -> SourcePos -> ParseError
newErrorMessage :: Message -> SourcePos -> ParseError
newErrorMessage msg :: Message
msg pos :: SourcePos
pos
= SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos [Message
msg]
addErrorMessage :: Message -> ParseError -> ParseError
addErrorMessage :: Message -> ParseError -> ParseError
addErrorMessage msg :: Message
msg (ParseError pos :: SourcePos
pos msgs :: [Message]
msgs)
= SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos (Message
msgMessage -> [Message] -> [Message]
forall a. a -> [a] -> [a]
:[Message]
msgs)
setErrorPos :: SourcePos -> ParseError -> ParseError
setErrorPos :: SourcePos -> ParseError -> ParseError
setErrorPos pos :: SourcePos
pos (ParseError _ msgs :: [Message]
msgs)
= SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos [Message]
msgs
setErrorMessage :: Message -> ParseError -> ParseError
setErrorMessage :: Message -> ParseError -> ParseError
setErrorMessage msg :: Message
msg (ParseError pos :: SourcePos
pos msgs :: [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 (Message
msg Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
/=) [Message]
msgs)
mergeError :: ParseError -> ParseError -> ParseError
mergeError :: ParseError -> ParseError -> ParseError
mergeError e1 :: ParseError
e1@(ParseError pos1 :: SourcePos
pos1 msgs1 :: [Message]
msgs1) e2 :: ParseError
e2@(ParseError pos2 :: SourcePos
pos2 msgs2 :: [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
EQ -> SourcePos -> [Message] -> ParseError
ParseError SourcePos
pos1 ([Message]
msgs1 [Message] -> [Message] -> [Message]
forall a. [a] -> [a] -> [a]
++ [Message]
msgs2)
GT -> ParseError
e1
LT -> ParseError
e2
instance Show ParseError where
show :: ParseError -> [Char]
show err :: ParseError
err
= SourcePos -> [Char]
forall a. Show a => a -> [Char]
show (ParseError -> SourcePos
errorPos ParseError
err) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
-> [Char] -> [Char] -> [Char] -> [Char] -> [Message] -> [Char]
showErrorMessages "or" "unknown parse error"
"expecting" "unexpected" "end of input"
(ParseError -> [Message]
errorMessages ParseError
err)
instance Eq ParseError where
l :: ParseError
l == :: ParseError -> ParseError -> Bool
== r :: ParseError
r
= ParseError -> SourcePos
errorPos ParseError
l SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== ParseError -> SourcePos
errorPos ParseError
r Bool -> Bool -> Bool
&& ParseError -> [[Char]]
messageStrs ParseError
l [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== ParseError -> [[Char]]
messageStrs ParseError
r
where
messageStrs :: ParseError -> [[Char]]
messageStrs = (Message -> [Char]) -> [Message] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Message -> [Char]
messageString ([Message] -> [[Char]])
-> (ParseError -> [Message]) -> ParseError -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Message]
errorMessages
showErrorMessages ::
String -> String -> String -> String -> String -> [Message] -> String
showErrorMessages :: [Char]
-> [Char] -> [Char] -> [Char] -> [Char] -> [Message] -> [Char]
showErrorMessages msgOr :: [Char]
msgOr msgUnknown :: [Char]
msgUnknown msgExpecting :: [Char]
msgExpecting msgUnExpected :: [Char]
msgUnExpected msgEndOfInput :: [Char]
msgEndOfInput msgs :: [Message]
msgs
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = [Char]
msgUnknown
| Bool
otherwise = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ("\n"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
clean ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
[[Char]
showSysUnExpect,[Char]
showUnExpect,[Char]
showExpect,[Char]
showMessages]
where
(sysUnExpect :: [Message]
sysUnExpect,msgs1 :: [Message]
msgs1) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (([Char] -> Message
SysUnExpect "") Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
==) [Message]
msgs
(unExpect :: [Message]
unExpect,msgs2 :: [Message]
msgs2) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (([Char] -> Message
UnExpect "") Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
==) [Message]
msgs1
(expect :: [Message]
expect,messages :: [Message]
messages) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (([Char] -> Message
Expect "") Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
==) [Message]
msgs2
showExpect :: [Char]
showExpect = [Char] -> [Message] -> [Char]
showMany [Char]
msgExpecting [Message]
expect
showUnExpect :: [Char]
showUnExpect = [Char] -> [Message] -> [Char]
showMany [Char]
msgUnExpected [Message]
unExpect
showSysUnExpect :: [Char]
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 = ""
| [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
firstMsg = [Char]
msgUnExpected [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msgEndOfInput
| Bool
otherwise = [Char]
msgUnExpected [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
firstMsg
where
firstMsg :: [Char]
firstMsg = Message -> [Char]
messageString ([Message] -> Message
forall a. [a] -> a
head [Message]
sysUnExpect)
showMessages :: [Char]
showMessages = [Char] -> [Message] -> [Char]
showMany "" [Message]
messages
showMany :: [Char] -> [Message] -> [Char]
showMany pre :: [Char]
pre msgs3 :: [Message]
msgs3 = case [[Char]] -> [[Char]]
clean ((Message -> [Char]) -> [Message] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Message -> [Char]
messageString [Message]
msgs3) of
[] -> ""
ms :: [[Char]]
ms | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
pre -> [[Char]] -> [Char]
commasOr [[Char]]
ms
| Bool
otherwise -> [Char]
pre [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
commasOr [[Char]]
ms
commasOr :: [[Char]] -> [Char]
commasOr [] = ""
commasOr [m :: [Char]
m] = [Char]
m
commasOr ms :: [[Char]]
ms = [[Char]] -> [Char]
commaSep ([[Char]] -> [[Char]]
forall a. [a] -> [a]
init [[Char]]
ms) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msgOr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
ms
commaSep :: [[Char]] -> [Char]
commaSep = [Char] -> [[Char]] -> [Char]
separate ", " ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
clean
separate :: [Char] -> [[Char]] -> [Char]
separate _ [] = ""
separate _ [m :: [Char]
m] = [Char]
m
separate sep :: [Char]
sep (m :: [Char]
m:ms :: [[Char]]
ms) = [Char]
m [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
sep [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
separate [Char]
sep [[Char]]
ms
clean :: [[Char]] -> [[Char]]
clean = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)