{-# LANGUAGE DeriveDataTypeable, TypeFamilies #-}
module Text.Boomerang.Error where
import Control.Monad.Error (Error(..))
import Data.Data (Data, Typeable)
import Data.List (intercalate, sort, nub)
import Text.Boomerang.Prim
import Text.Boomerang.Pos
data ErrorMsg
= SysUnExpect String
| EOI String
| UnExpect String
| Expect String
| Message String
deriving (ErrorMsg -> ErrorMsg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorMsg -> ErrorMsg -> Bool
$c/= :: ErrorMsg -> ErrorMsg -> Bool
== :: ErrorMsg -> ErrorMsg -> Bool
$c== :: ErrorMsg -> ErrorMsg -> Bool
Eq, Eq ErrorMsg
ErrorMsg -> ErrorMsg -> Bool
ErrorMsg -> ErrorMsg -> Ordering
ErrorMsg -> ErrorMsg -> ErrorMsg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorMsg -> ErrorMsg -> ErrorMsg
$cmin :: ErrorMsg -> ErrorMsg -> ErrorMsg
max :: ErrorMsg -> ErrorMsg -> ErrorMsg
$cmax :: ErrorMsg -> ErrorMsg -> ErrorMsg
>= :: ErrorMsg -> ErrorMsg -> Bool
$c>= :: ErrorMsg -> ErrorMsg -> Bool
> :: ErrorMsg -> ErrorMsg -> Bool
$c> :: ErrorMsg -> ErrorMsg -> Bool
<= :: ErrorMsg -> ErrorMsg -> Bool
$c<= :: ErrorMsg -> ErrorMsg -> Bool
< :: ErrorMsg -> ErrorMsg -> Bool
$c< :: ErrorMsg -> ErrorMsg -> Bool
compare :: ErrorMsg -> ErrorMsg -> Ordering
$ccompare :: ErrorMsg -> ErrorMsg -> Ordering
Ord, ReadPrec [ErrorMsg]
ReadPrec ErrorMsg
Int -> ReadS ErrorMsg
ReadS [ErrorMsg]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorMsg]
$creadListPrec :: ReadPrec [ErrorMsg]
readPrec :: ReadPrec ErrorMsg
$creadPrec :: ReadPrec ErrorMsg
readList :: ReadS [ErrorMsg]
$creadList :: ReadS [ErrorMsg]
readsPrec :: Int -> ReadS ErrorMsg
$creadsPrec :: Int -> ReadS ErrorMsg
Read, Int -> ErrorMsg -> ShowS
[ErrorMsg] -> ShowS
ErrorMsg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMsg] -> ShowS
$cshowList :: [ErrorMsg] -> ShowS
show :: ErrorMsg -> String
$cshow :: ErrorMsg -> String
showsPrec :: Int -> ErrorMsg -> ShowS
$cshowsPrec :: Int -> ErrorMsg -> ShowS
Show, Typeable, Typeable ErrorMsg
ErrorMsg -> DataType
ErrorMsg -> Constr
(forall b. Data b => b -> b) -> ErrorMsg -> ErrorMsg
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u
forall u. (forall d. Data d => d -> u) -> ErrorMsg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorMsg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorMsg -> c ErrorMsg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorMsg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorMsg)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorMsg -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorMsg -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
gmapT :: (forall b. Data b => b -> b) -> ErrorMsg -> ErrorMsg
$cgmapT :: (forall b. Data b => b -> b) -> ErrorMsg -> ErrorMsg
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorMsg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorMsg)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorMsg)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorMsg)
dataTypeOf :: ErrorMsg -> DataType
$cdataTypeOf :: ErrorMsg -> DataType
toConstr :: ErrorMsg -> Constr
$ctoConstr :: ErrorMsg -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorMsg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorMsg
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorMsg -> c ErrorMsg
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorMsg -> c ErrorMsg
Data)
messageString :: ErrorMsg -> String
messageString :: ErrorMsg -> String
messageString (Expect String
s) = String
s
messageString (UnExpect String
s) = String
s
messageString (SysUnExpect String
s) = String
s
messageString (EOI String
s) = String
s
messageString (Message String
s) = String
s
data ParserError pos = ParserError (Maybe pos) [ErrorMsg]
deriving (ParserError pos -> ParserError pos -> Bool
forall pos. Eq pos => ParserError pos -> ParserError pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserError pos -> ParserError pos -> Bool
$c/= :: forall pos. Eq pos => ParserError pos -> ParserError pos -> Bool
== :: ParserError pos -> ParserError pos -> Bool
$c== :: forall pos. Eq pos => ParserError pos -> ParserError pos -> Bool
Eq, ParserError pos -> ParserError pos -> Bool
ParserError pos -> ParserError pos -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {pos}. Ord pos => Eq (ParserError pos)
forall pos. Ord pos => ParserError pos -> ParserError pos -> Bool
forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> Ordering
forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> ParserError pos
min :: ParserError pos -> ParserError pos -> ParserError pos
$cmin :: forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> ParserError pos
max :: ParserError pos -> ParserError pos -> ParserError pos
$cmax :: forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> ParserError pos
>= :: ParserError pos -> ParserError pos -> Bool
$c>= :: forall pos. Ord pos => ParserError pos -> ParserError pos -> Bool
> :: ParserError pos -> ParserError pos -> Bool
$c> :: forall pos. Ord pos => ParserError pos -> ParserError pos -> Bool
<= :: ParserError pos -> ParserError pos -> Bool
$c<= :: forall pos. Ord pos => ParserError pos -> ParserError pos -> Bool
< :: ParserError pos -> ParserError pos -> Bool
$c< :: forall pos. Ord pos => ParserError pos -> ParserError pos -> Bool
compare :: ParserError pos -> ParserError pos -> Ordering
$ccompare :: forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> Ordering
Ord, Typeable, ParserError pos -> DataType
ParserError pos -> Constr
forall {pos}. Data pos => Typeable (ParserError pos)
forall pos. Data pos => ParserError pos -> DataType
forall pos. Data pos => ParserError pos -> Constr
forall pos.
Data pos =>
(forall b. Data b => b -> b) -> ParserError pos -> ParserError pos
forall pos u.
Data pos =>
Int -> (forall d. Data d => d -> u) -> ParserError pos -> u
forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> ParserError pos -> [u]
forall pos r r'.
Data pos =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
forall pos r r'.
Data pos =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
forall pos (m :: * -> *).
(Data pos, Monad m) =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
forall pos (c :: * -> *).
Data pos =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParserError pos)
forall pos (c :: * -> *).
Data pos =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParserError pos -> c (ParserError pos)
forall pos (t :: * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ParserError pos))
forall pos (t :: * -> * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParserError pos))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParserError pos)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParserError pos -> c (ParserError pos)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ParserError pos))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
$cgmapMo :: forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
$cgmapMp :: forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
$cgmapM :: forall pos (m :: * -> *).
(Data pos, Monad m) =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParserError pos -> u
$cgmapQi :: forall pos u.
Data pos =>
Int -> (forall d. Data d => d -> u) -> ParserError pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParserError pos -> [u]
$cgmapQ :: forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> ParserError pos -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
$cgmapQr :: forall pos r r'.
Data pos =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
$cgmapQl :: forall pos r r'.
Data pos =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
gmapT :: (forall b. Data b => b -> b) -> ParserError pos -> ParserError pos
$cgmapT :: forall pos.
Data pos =>
(forall b. Data b => b -> b) -> ParserError pos -> ParserError pos
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParserError pos))
$cdataCast2 :: forall pos (t :: * -> * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParserError pos))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ParserError pos))
$cdataCast1 :: forall pos (t :: * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ParserError pos))
dataTypeOf :: ParserError pos -> DataType
$cdataTypeOf :: forall pos. Data pos => ParserError pos -> DataType
toConstr :: ParserError pos -> Constr
$ctoConstr :: forall pos. Data pos => ParserError pos -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParserError pos)
$cgunfold :: forall pos (c :: * -> *).
Data pos =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParserError pos)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParserError pos -> c (ParserError pos)
$cgfoldl :: forall pos (c :: * -> *).
Data pos =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParserError pos -> c (ParserError pos)
Data)
type instance Pos (ParserError p) = p
instance ErrorPosition (ParserError p) where
getPosition :: ParserError p -> Maybe (Pos (ParserError p))
getPosition (ParserError Maybe p
mPos [ErrorMsg]
_) = Maybe p
mPos
instance Error (ParserError p) where
strMsg :: String -> ParserError p
strMsg String
s = forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError forall a. Maybe a
Nothing [String -> ErrorMsg
Message String
s]
mkParserError :: pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError :: forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError pos
pos [ErrorMsg]
e = [forall a b. a -> Either a b
Left (forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError (forall a. a -> Maybe a
Just pos
pos) [ErrorMsg]
e)]
infix 0 <?>
(<?>) :: Boomerang (ParserError p) tok a b -> String -> Boomerang (ParserError p) tok a b
Boomerang (ParserError p) tok a b
router <?> :: forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String
msg =
Boomerang (ParserError p) tok a b
router { prs :: Parser (ParserError p) tok (a -> b)
prs = forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser forall a b. (a -> b) -> a -> b
$ \tok
tok Pos (ParserError p)
pos ->
forall a b. (a -> b) -> [a] -> [b]
map (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(ParserError Maybe p
mPos [ErrorMsg]
errs) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError Maybe p
mPos ((String -> ErrorMsg
Expect String
msg) forall a. a -> [a] -> [a]
: [ErrorMsg]
errs)) forall a b. b -> Either a b
Right) (forall e tok a.
Parser e tok a -> tok -> Pos e -> [Either e ((a, tok), Pos e)]
runParser (forall e tok a b. Boomerang e tok a b -> Parser e tok (a -> b)
prs Boomerang (ParserError p) tok a b
router) tok
tok Pos (ParserError p)
pos) }
condenseErrors :: (Ord pos) => [ParserError pos] -> ParserError pos
condenseErrors :: forall pos. Ord pos => [ParserError pos] -> ParserError pos
condenseErrors [ParserError pos]
errs =
case forall e. (ErrorPosition e, Ord (Pos e)) => [e] -> [e]
bestErrors [ParserError pos]
errs of
[] -> forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError forall a. Maybe a
Nothing []
errs' :: [ParserError pos]
errs'@(ParserError Maybe pos
pos [ErrorMsg]
_ : [ParserError pos]
_) ->
forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError Maybe pos
pos (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ParserError Maybe pos
_ [ErrorMsg]
e) -> [ErrorMsg]
e) [ParserError pos]
errs')
showErrorMessages :: String -> String -> String -> String -> String -> [ErrorMsg] -> String
showErrorMessages :: String
-> String -> String -> String -> String -> [ErrorMsg] -> String
showErrorMessages String
msgOr String
msgUnknown String
msgExpecting String
msgUnExpected String
msgEndOfInput [ErrorMsg]
msgs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ErrorMsg]
msgs = String
msgUnknown
| Bool
otherwise = forall a. [a] -> [[a]] -> [a]
intercalate (String
"; ") forall a b. (a -> b) -> a -> b
$ [String] -> [String]
clean forall a b. (a -> b) -> a -> b
$ [String
showSysUnExpect, String
showUnExpect, String
showExpect, String
showMessages]
where
isSysUnExpect :: ErrorMsg -> Bool
isSysUnExpect (SysUnExpect {}) = Bool
True
isSysUnExpect ErrorMsg
_ = Bool
False
isEOI :: ErrorMsg -> Bool
isEOI (EOI {}) = Bool
True
isEOI ErrorMsg
_ = Bool
False
isUnExpect :: ErrorMsg -> Bool
isUnExpect (UnExpect {}) = Bool
True
isUnExpect ErrorMsg
_ = Bool
False
isExpect :: ErrorMsg -> Bool
isExpect (Expect {}) = Bool
True
isExpect ErrorMsg
_ = Bool
False
([ErrorMsg]
sysUnExpect,[ErrorMsg]
msgs1) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\ErrorMsg
m -> ErrorMsg -> Bool
isSysUnExpect ErrorMsg
m Bool -> Bool -> Bool
|| ErrorMsg -> Bool
isEOI ErrorMsg
m) (forall a. Ord a => [a] -> [a]
sort [ErrorMsg]
msgs)
([ErrorMsg]
unExpect ,[ErrorMsg]
msgs2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span ErrorMsg -> Bool
isUnExpect [ErrorMsg]
msgs1
([ErrorMsg]
expect ,[ErrorMsg]
msgs3) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span ErrorMsg -> Bool
isExpect [ErrorMsg]
msgs2
showExpect :: String
showExpect = String -> [ErrorMsg] -> String
showMany String
msgExpecting [ErrorMsg]
expect
showUnExpect :: String
showUnExpect = String -> [ErrorMsg] -> String
showMany String
msgUnExpected [ErrorMsg]
unExpect
showSysUnExpect :: String
showSysUnExpect
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ErrorMsg]
sysUnExpect = String
""
| Bool
otherwise =
let msg :: ErrorMsg
msg = forall a. [a] -> a
head [ErrorMsg]
sysUnExpect
in String
msgUnExpected forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++
if (ErrorMsg -> Bool
isEOI ErrorMsg
msg) then String
msgEndOfInput forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ (ErrorMsg -> String
messageString forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [ErrorMsg]
sysUnExpect)
else ErrorMsg -> String
messageString forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [ErrorMsg]
sysUnExpect
showMessages :: String
showMessages = String -> [ErrorMsg] -> String
showMany String
"" [ErrorMsg]
msgs3
showMany :: String -> [ErrorMsg] -> String
showMany String
pre [ErrorMsg]
msgs = case [String] -> [String]
clean (forall a b. (a -> b) -> [a] -> [b]
map ErrorMsg -> String
messageString [ErrorMsg]
msgs) of
[] -> String
""
[String]
ms | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pre -> [String] -> String
commasOr [String]
ms
| Bool
otherwise -> String
pre forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ [String] -> String
commasOr [String]
ms
commasOr :: [String] -> String
commasOr [] = String
""
commasOr [String
m] = String
m
commasOr [String]
ms = [String] -> String
commaSep (forall a. [a] -> [a]
init [String]
ms) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
msgOr forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> a
last [String]
ms
commaSep :: [String] -> String
commaSep = String -> [String] -> String
seperate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
clean
seperate :: String -> [String] -> String
seperate String
_ [] = String
""
seperate String
_ [String
m] = String
m
seperate String
sep (String
m:[String]
ms) = String
m forall a. [a] -> [a] -> [a]
++ String
sep forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
seperate String
sep [String]
ms
clean :: [String] -> [String]
clean = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
instance (Show pos) => Show (ParserError pos) where
show :: ParserError pos -> String
show ParserError pos
e = forall pos. (pos -> String) -> ParserError pos -> String
showParserError forall a. Show a => a -> String
show ParserError pos
e
showParserError :: (pos -> String)
-> ParserError pos
-> String
showParserError :: forall pos. (pos -> String) -> ParserError pos -> String
showParserError pos -> String
showPos (ParserError Maybe pos
mPos [ErrorMsg]
msgs) =
let posStr :: String
posStr = case Maybe pos
mPos of
Maybe pos
Nothing -> String
"unknown position"
(Just pos
pos) -> pos -> String
showPos pos
pos
in String
"parse error at " forall a. [a] -> [a] -> [a]
++ String
posStr forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ (String
-> String -> String -> String -> String -> [ErrorMsg] -> String
showErrorMessages String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of" [ErrorMsg]
msgs)