-- | 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
(ErrorMsg -> ErrorMsg -> Bool)
-> (ErrorMsg -> ErrorMsg -> Bool) -> Eq ErrorMsg
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
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
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
$cp1Ord :: Eq 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
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
(Int -> ErrorMsg -> ShowS)
-> (ErrorMsg -> String) -> ([ErrorMsg] -> ShowS) -> Show ErrorMsg
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
DataType
Constr
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 -> DataType
ErrorMsg -> Constr
(forall b. Data b => b -> b) -> ErrorMsg -> ErrorMsg
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorMsg -> c ErrorMsg
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cMessage :: Constr
$cExpect :: Constr
$cUnExpect :: Constr
$cEOI :: Constr
$cSysUnExpect :: Constr
$tErrorMsg :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorMsg -> u
gmapQ :: (forall d. Data d => d -> u) -> ErrorMsg -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorMsg -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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
/= :: 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, 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
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
$cp1Ord :: forall pos. Ord pos => Eq (ParserError pos)
Ord, Typeable, Typeable (ParserError pos)
DataType
Constr
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 -> DataType
ParserError pos -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (ParserError pos))
(forall b. Data b => b -> b) -> ParserError pos -> ParserError pos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParserError pos -> c (ParserError pos)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParserError pos)
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 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))
$cParserError :: Constr
$tParserError :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> ParserError pos -> [u]
$cgmapQ :: forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> ParserError pos -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall pos. Data pos => Typeable (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)]
-}

instance Error (ParserError p) where
    strMsg :: String -> ParserError p
strMsg String
s = Maybe p -> [ErrorMsg] -> ParserError p
forall pos. Maybe pos -> [ErrorMsg] -> ParserError pos
ParserError Maybe p
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 :: 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 <?> :: 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 = (tok
 -> Pos (ParserError p)
 -> [Either (ParserError p) ((a -> b, tok), Pos (ParserError p))])
-> Parser (ParserError p) tok (a -> b)
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((tok
  -> Pos (ParserError p)
  -> [Either (ParserError p) ((a -> b, tok), Pos (ParserError p))])
 -> Parser (ParserError p) tok (a -> b))
-> (tok
    -> Pos (ParserError p)
    -> [Either (ParserError p) ((a -> b, tok), Pos (ParserError p))])
-> Parser (ParserError p) tok (a -> b)
forall a b. (a -> b) -> a -> b
$ \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 :: [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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null [ErrorMsg]
sysUnExpect = String
""
          | Bool
otherwise        =
              let msg :: ErrorMsg
msg = [ErrorMsg] -> ErrorMsg
forall a. [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. [a] -> a
head [ErrorMsg]
sysUnExpect)
                                    else ErrorMsg -> String
messageString (ErrorMsg -> String) -> ErrorMsg -> String
forall a b. (a -> b) -> a -> b
$ [ErrorMsg] -> ErrorMsg
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 ((ErrorMsg -> String) -> [ErrorMsg] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ErrorMsg -> String
messageString [ErrorMsg]
msgs) 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
""
      commasOr [String
m]        = String
m
      commasOr [String]
ms         = [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
_ []     = 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 (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 :: (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)