-- | An Error handling scheme that can be used with 'Boomerang'
{-# LANGUAGE CPP, DeriveDataTypeable, TypeFamilies #-}
module Text.Boomerang.Error where

#if !MIN_VERSION_mtl(2,3,0)
import Control.Monad.Error (Error(..))
#endif
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
(ErrorMsg -> ErrorMsg -> Bool)
-> (ErrorMsg -> ErrorMsg -> Bool) -> Eq ErrorMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorMsg -> ErrorMsg -> Bool
== :: ErrorMsg -> ErrorMsg -> Bool
$c/= :: ErrorMsg -> ErrorMsg -> Bool
/= :: ErrorMsg -> ErrorMsg -> Bool
Eq, Eq ErrorMsg
Eq ErrorMsg =>
(ErrorMsg -> ErrorMsg -> Ordering)
-> (ErrorMsg -> ErrorMsg -> Bool)
-> (ErrorMsg -> ErrorMsg -> Bool)
-> (ErrorMsg -> ErrorMsg -> Bool)
-> (ErrorMsg -> ErrorMsg -> Bool)
-> (ErrorMsg -> ErrorMsg -> ErrorMsg)
-> (ErrorMsg -> ErrorMsg -> ErrorMsg)
-> Ord 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
$ccompare :: ErrorMsg -> ErrorMsg -> Ordering
compare :: ErrorMsg -> ErrorMsg -> Ordering
$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
>= :: ErrorMsg -> ErrorMsg -> Bool
$cmax :: ErrorMsg -> ErrorMsg -> ErrorMsg
max :: ErrorMsg -> ErrorMsg -> ErrorMsg
$cmin :: ErrorMsg -> ErrorMsg -> ErrorMsg
min :: ErrorMsg -> ErrorMsg -> ErrorMsg
Ord, ReadPrec [ErrorMsg]
ReadPrec ErrorMsg
Int -> ReadS ErrorMsg
ReadS [ErrorMsg]
(Int -> ReadS ErrorMsg)
-> ReadS [ErrorMsg]
-> ReadPrec ErrorMsg
-> ReadPrec [ErrorMsg]
-> Read ErrorMsg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ErrorMsg
readsPrec :: Int -> ReadS ErrorMsg
$creadList :: ReadS [ErrorMsg]
readList :: ReadS [ErrorMsg]
$creadPrec :: ReadPrec ErrorMsg
readPrec :: ReadPrec ErrorMsg
$creadListPrec :: ReadPrec [ErrorMsg]
readListPrec :: ReadPrec [ErrorMsg]
Read, Int -> ErrorMsg -> ShowS
[ErrorMsg] -> ShowS
ErrorMsg -> String
(Int -> ErrorMsg -> ShowS)
-> (ErrorMsg -> String) -> ([ErrorMsg] -> ShowS) -> Show ErrorMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorMsg -> ShowS
showsPrec :: Int -> ErrorMsg -> ShowS
$cshow :: ErrorMsg -> String
show :: ErrorMsg -> String
$cshowList :: [ErrorMsg] -> ShowS
showList :: [ErrorMsg] -> ShowS
Show, Typeable, Typeable ErrorMsg
Typeable ErrorMsg =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ErrorMsg -> c ErrorMsg)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ErrorMsg)
-> (ErrorMsg -> Constr)
-> (ErrorMsg -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> ErrorMsg -> ErrorMsg)
-> (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 u. (forall d. Data d => d -> u) -> ErrorMsg -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg)
-> Data ErrorMsg
ErrorMsg -> Constr
ErrorMsg -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorMsg -> c ErrorMsg
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorMsg -> c ErrorMsg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorMsg
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorMsg
$ctoConstr :: ErrorMsg -> Constr
toConstr :: ErrorMsg -> Constr
$cdataTypeOf :: ErrorMsg -> DataType
dataTypeOf :: ErrorMsg -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorMsg)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorMsg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorMsg)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorMsg)
$cgmapT :: (forall b. Data b => b -> b) -> ErrorMsg -> ErrorMsg
gmapT :: (forall b. Data b => b -> b) -> ErrorMsg -> ErrorMsg
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorMsg -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorMsg -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorMsg -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m ErrorMsg
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorMsg -> m 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
(ParserError pos -> ParserError pos -> Bool)
-> (ParserError pos -> ParserError pos -> Bool)
-> Eq (ParserError pos)
forall pos. Eq pos => ParserError pos -> ParserError pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: ParserError pos -> ParserError pos -> Bool
Eq, Eq (ParserError pos)
Eq (ParserError pos) =>
(ParserError pos -> ParserError pos -> Ordering)
-> (ParserError pos -> ParserError pos -> Bool)
-> (ParserError pos -> ParserError pos -> Bool)
-> (ParserError pos -> ParserError pos -> Bool)
-> (ParserError pos -> ParserError pos -> Bool)
-> (ParserError pos -> ParserError pos -> ParserError pos)
-> (ParserError pos -> ParserError pos -> ParserError pos)
-> Ord (ParserError pos)
ParserError pos -> ParserError pos -> Bool
ParserError pos -> ParserError pos -> Ordering
ParserError pos -> ParserError pos -> ParserError pos
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
$ccompare :: forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> Ordering
compare :: ParserError pos -> ParserError pos -> Ordering
$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
>= :: ParserError pos -> ParserError pos -> Bool
$cmax :: forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> ParserError pos
max :: ParserError pos -> ParserError pos -> ParserError pos
$cmin :: forall pos.
Ord pos =>
ParserError pos -> ParserError pos -> ParserError pos
min :: ParserError pos -> ParserError pos -> ParserError pos
Ord, Typeable, Typeable (ParserError pos)
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ParserError pos))
-> (ParserError pos -> Constr)
-> (ParserError pos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ParserError pos)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ParserError pos)))
-> ((forall b. Data b => b -> b)
    -> ParserError pos -> ParserError pos)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParserError pos -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParserError pos -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ParserError pos -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParserError pos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ParserError pos -> m (ParserError pos))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParserError pos -> m (ParserError pos))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParserError pos -> m (ParserError pos))
-> Data (ParserError pos)
ParserError pos -> Constr
ParserError pos -> DataType
(forall b. Data b => b -> b) -> ParserError pos -> ParserError pos
forall pos. Data pos => Typeable (ParserError pos)
forall pos. Data pos => ParserError pos -> Constr
forall pos. Data pos => ParserError pos -> DataType
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 u.
Int -> (forall d. Data d => d -> u) -> ParserError pos -> u
forall u. (forall d. Data d => d -> u) -> ParserError pos -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParserError pos -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParserError pos)
$ctoConstr :: forall pos. Data pos => ParserError pos -> Constr
toConstr :: ParserError pos -> Constr
$cdataTypeOf :: forall pos. Data pos => ParserError pos -> DataType
dataTypeOf :: ParserError pos -> DataType
$cdataCast1 :: forall pos (t :: * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ParserError pos))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParserError pos))
$cgmapT :: forall pos.
Data pos =>
(forall b. Data b => b -> b) -> ParserError pos -> ParserError pos
gmapT :: (forall b. Data b => b -> b) -> ParserError pos -> ParserError pos
$cgmapQl :: 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
$cgmapQr :: forall pos r r'.
Data pos =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParserError pos -> r
$cgmapQ :: forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> ParserError pos -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParserError pos -> u
$cgmapM :: forall pos (m :: * -> *).
(Data pos, Monad 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)
$cgmapMp :: 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)
$cgmapMo :: forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (ParserError pos)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParserError pos -> m (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
Maybe (Pos (ParserError p))
mPos

{-
instance ErrorList ParserError where
    listMsg s = [ParserError Nothing (Other s)]
-}

#if !MIN_VERSION_mtl(2,3,0)
instance Error (ParserError p) where
    strMsg s = ParserError Nothing [Message s]
#endif

-- | 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 = [ParserError pos -> Either (ParserError pos) a
forall a b. a -> Either a b
Left (Maybe pos -> [ErrorMsg] -> ParserError pos
forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError (pos -> Maybe pos
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 $ \tok
tok Pos (ParserError p)
pos ->
        (Either (ParserError p) ((a -> b, tok), p)
 -> Either (ParserError p) ((a -> b, tok), p))
-> [Either (ParserError p) ((a -> b, tok), p)]
-> [Either (ParserError p) ((a -> b, tok), p)]
forall a b. (a -> b) -> [a] -> [b]
map ((ParserError p -> Either (ParserError p) ((a -> b, tok), p))
-> (((a -> b, tok), p)
    -> Either (ParserError p) ((a -> b, tok), p))
-> Either (ParserError p) ((a -> b, tok), p)
-> Either (ParserError p) ((a -> b, tok), p)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(ParserError Maybe p
mPos [ErrorMsg]
errs) -> ParserError p -> Either (ParserError p) ((a -> b, tok), p)
forall a b. a -> Either a b
Left (ParserError p -> Either (ParserError p) ((a -> b, tok), p))
-> ParserError p -> Either (ParserError p) ((a -> b, tok), p)
forall a b. (a -> b) -> a -> b
$ Maybe p -> [ErrorMsg] -> ParserError p
forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError Maybe p
mPos ((String -> ErrorMsg
Expect String
msg) ErrorMsg -> [ErrorMsg] -> [ErrorMsg]
forall a. a -> [a] -> [a]
: [ErrorMsg]
errs)) ((a -> b, tok), p) -> Either (ParserError p) ((a -> b, tok), p)
forall a b. b -> Either a b
Right) (Parser (ParserError p) tok (a -> b)
-> tok
-> Pos (ParserError p)
-> [Either (ParserError p) ((a -> b, tok), Pos (ParserError p))]
forall e tok a.
Parser e tok a -> tok -> Pos e -> [Either e ((a, tok), Pos e)]
runParser (Boomerang (ParserError p) tok a b
-> Parser (ParserError p) tok (a -> b)
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 [ParserError pos] -> [ParserError pos]
forall e. (ErrorPosition e, Ord (Pos e)) => [e] -> [e]
bestErrors [ParserError pos]
errs of
      [] -> Maybe pos -> [ErrorMsg] -> ParserError pos
forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError Maybe pos
forall a. Maybe a
Nothing []
      errs' :: [ParserError pos]
errs'@(ParserError Maybe pos
pos [ErrorMsg]
_ : [ParserError pos]
_) ->
          Maybe pos -> [ErrorMsg] -> ParserError pos
forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError Maybe pos
pos ([ErrorMsg] -> [ErrorMsg]
forall a. Eq a => [a] -> [a]
nub ([ErrorMsg] -> [ErrorMsg]) -> [ErrorMsg] -> [ErrorMsg]
forall a b. (a -> b) -> a -> b
$ (ParserError pos -> [ErrorMsg]) -> [ParserError pos] -> [ErrorMsg]
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
    | [ErrorMsg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ErrorMsg]
msgs = String
msgUnknown
    | Bool
otherwise = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate (String
"; ") ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
clean ([String] -> [String]) -> [String] -> [String]
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) = (ErrorMsg -> Bool) -> [ErrorMsg] -> ([ErrorMsg], [ErrorMsg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\ErrorMsg
m -> ErrorMsg -> Bool
isSysUnExpect ErrorMsg
m Bool -> Bool -> Bool
|| ErrorMsg -> Bool
isEOI ErrorMsg
m) ([ErrorMsg] -> [ErrorMsg]
forall a. Ord a => [a] -> [a]
sort [ErrorMsg]
msgs)
      ([ErrorMsg]
unExpect   ,[ErrorMsg]
msgs2) = (ErrorMsg -> Bool) -> [ErrorMsg] -> ([ErrorMsg], [ErrorMsg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ErrorMsg -> Bool
isUnExpect [ErrorMsg]
msgs1
      ([ErrorMsg]
expect     ,[ErrorMsg]
msgs3) = (ErrorMsg -> Bool) -> [ErrorMsg] -> ([ErrorMsg], [ErrorMsg])
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
          | [ErrorMsg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ErrorMsg]
sysUnExpect = String
""
          | Bool
otherwise        =
              let msg :: ErrorMsg
msg = [ErrorMsg] -> ErrorMsg
forall a. HasCallStack => [a] -> a
head [ErrorMsg]
sysUnExpect
              in String
msgUnExpected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     if (ErrorMsg -> Bool
isEOI ErrorMsg
msg) then String
msgEndOfInput String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ErrorMsg -> String
messageString (ErrorMsg -> String) -> ErrorMsg -> String
forall a b. (a -> b) -> a -> b
$ [ErrorMsg] -> ErrorMsg
forall a. HasCallStack => [a] -> a
head [ErrorMsg]
sysUnExpect)
                                    else ErrorMsg -> String
messageString (ErrorMsg -> String) -> ErrorMsg -> String
forall a b. (a -> b) -> a -> b
$ [ErrorMsg] -> ErrorMsg
forall a. HasCallStack => [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 ((ErrorMsg -> String) -> [ErrorMsg] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ErrorMsg -> String
messageString [ErrorMsg]
msgs) of
                            [] -> String
""
                            [String]
ms | String -> Bool
forall a. [a] -> 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
""
      commasOr [String
m]        = String
m
      commasOr [String]
ms         = [String] -> String
commaSep ([String] -> [String]
forall a. HasCallStack => [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. HasCallStack => [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
_ []     = String
""
      seperate   String
_ [String
m]    = String
m
      seperate String
sep (String
m:[String]
ms) = 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]
ms

      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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)

instance (Show pos) => Show (ParserError pos) where
    show :: ParserError pos -> String
show ParserError pos
e = (pos -> String) -> ParserError pos -> String
forall pos. (pos -> String) -> ParserError pos -> String
showParserError pos -> String
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
posStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
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)