-- | An Error handling scheme that can be used with 'Boomerang'
{-# 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)

-- | extract the 'String' from an 'ErrorMsg'.
-- Note: the resulting 'String' will not include any information about what constructor it came from.
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 ErrorList ParserError where
    listMsg s = [ParserError Nothing (Other s)]
-}

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]

-- | lift a 'pos' and '[ErrorMsg]' into a parse error
--
-- This is intended to be used inside a 'Parser' like this:
--
-- > Parser $ \tok pos -> mkParserError pos [Message "just some error..."]
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 <?>

-- | annotate a parse error with an additional 'Expect' message
--
-- > satisfy isUpper <?> 'an uppercase character'
(<?>) :: 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) }

-- | condense the 'ParserError's with the highest parse position into a single 'ParserError'
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')

-- | Helper function for turning '[ErrorMsg]' into a user-friendly 'String'
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

-- | turn a parse error into a user-friendly error message
showParserError :: (pos -> String) -- ^ function to turn the error position into a 'String'
               -> ParserError pos  -- ^ the 'ParserError'
               -> 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)