    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE Safe #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.Parsec.Error
    -- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
    -- License     :  BSD-style (see the LICENSE file)
    --
    -- Maintainer  :  derek.a.elkins@gmail.com
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- Parse errors
    --
    -----------------------------------------------------------------------------

    module Text.Parsec.Error
        ( Message ( SysUnExpect, UnExpect, Expect, Message )
        , messageString
        , ParseError, errorPos, errorMessages, errorIsUnknown
        , showErrorMessages
        , newErrorMessage, newErrorUnknown
        , addErrorMessage, setErrorPos, setErrorMessage
        , mergeError
        ) where

    import Data.List ( nub, sort )
    import Data.Typeable ( Typeable )

    import Text.Parsec.Pos

    -- | This abstract data type represents parse error messages. There are
    -- four kinds of messages:
    --
    -- >  data Message = SysUnExpect String
    -- >               | UnExpect String
    -- >               | Expect String
    -- >               | Message String
    --
    -- The fine distinction between different kinds of parse errors allows
    -- the system to generate quite good error messages for the user. It
    -- also allows error messages that are formatted in different
    -- languages. Each kind of message is generated by different combinators:
    --
    --     * A 'SysUnExpect' message is automatically generated by the
    --       'Text.Parsec.Combinator.satisfy' combinator. The argument is the
    --       unexpected input.
    --
    --     * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected'
    --       combinator. The argument describes the
    --       unexpected item.
    --
    --     * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>'
    --       combinator. The argument describes the expected item.
    --
    --     * A 'Message' message is generated by the 'fail'
    --       combinator. The argument is some general parser message.

    data Message = SysUnExpect !String -- @ library generated unexpect
                 | UnExpect    !String -- @ unexpected something
                 | Expect      !String -- @ expecting something
                 | Message     !String -- @ raw message
        deriving ( Typeable )

    instance Enum Message where
        fromEnum :: Message -> Int
    fromEnum (SysUnExpect String
    _) = Int
    0
        fromEnum (UnExpect    String
    _) = Int
    1
        fromEnum (Expect      String
    _) = Int
    2
        fromEnum (Message     String
    _) = Int
    3
        toEnum :: Int -> Message
    toEnum Int
    _ = forall a. HasCallStack => String -> a
    error String
    "toEnum is undefined for Message"

    -- < Return 'True' only when 'compare' would return 'EQ'.

    instance Eq Message where

        Message
    m1 == :: Message -> Message -> Bool
    == Message
    m2 = forall a. Enum a => a -> Int
    fromEnum Message
    m1 forall a. Eq a => a -> a -> Bool
    == forall a. Enum a => a -> Int
    fromEnum Message
    m2

    -- < Compares two error messages without looking at their content. Only
    -- the constructors are compared where:
    --
    -- > 'SysUnExpect' < 'UnExpect' < 'Expect' < 'Message'

    instance Ord Message where
        compare :: Message -> Message -> Ordering
    compare Message
    msg1 Message
    msg2 = forall a. Ord a => a -> a -> Ordering
    compare (forall a. Enum a => a -> Int
    fromEnum Message
    msg1) (forall a. Enum a => a -> Int
    fromEnum Message
    msg2)

    -- | Extract the message string from an error message

    messageString :: Message -> String
    messageString :: Message -> String
    messageString (SysUnExpect String
    s) = String
    s
    messageString (UnExpect    String
    s) = String
    s
    messageString (Expect      String
    s) = String
    s
    messageString (Message     String
    s) = String
    s

    -- | The abstract data type @ParseError@ represents parse errors. It
    -- provides the source position ('SourcePos') of the error
    -- and a list of error messages ('Message'). A @ParseError@
    -- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an
    -- instance of the 'Show' and 'Eq' classes.

    data ParseError = ParseError !SourcePos [Message]
        deriving ( Typeable )

    -- | Extracts the source position from the parse error

    errorPos :: ParseError -> SourcePos
    errorPos :: ParseError -> SourcePos
    errorPos (ParseError SourcePos
    pos [Message]
    _msgs)
        = SourcePos
    pos

    -- | Extracts the list of error messages from the parse error

    errorMessages :: ParseError -> [Message]
    errorMessages :: ParseError -> [Message]
    errorMessages (ParseError SourcePos
    _pos [Message]
    msgs)
        = forall a. Ord a => [a] -> [a]
    sort [Message]
    msgs

    errorIsUnknown :: ParseError -> Bool
    errorIsUnknown :: ParseError -> Bool
    errorIsUnknown (ParseError SourcePos
    _pos [Message]
    msgs)
        = forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    msgs

    -- < Create parse errors

    newErrorUnknown :: SourcePos -> ParseError
    newErrorUnknown :: SourcePos -> ParseError
    newErrorUnknown SourcePos
    pos
        = SourcePos -> [Message] -> ParseError
    ParseError SourcePos
    pos []

    newErrorMessage :: Message -> SourcePos -> ParseError
    newErrorMessage :: Message -> SourcePos -> ParseError
    newErrorMessage Message
    msg SourcePos
    pos
        = SourcePos -> [Message] -> ParseError
    ParseError SourcePos
    pos [Message
    msg]

    addErrorMessage :: Message -> ParseError -> ParseError
    addErrorMessage :: Message -> ParseError -> ParseError
    addErrorMessage Message
    msg (ParseError SourcePos
    pos [Message]
    msgs)
        = SourcePos -> [Message] -> ParseError
    ParseError SourcePos
    pos (Message
    msgforall a. a -> [a] -> [a]
    :[Message]
    msgs)

    setErrorPos :: SourcePos -> ParseError -> ParseError
    setErrorPos :: SourcePos -> ParseError -> ParseError
    setErrorPos SourcePos
    pos (ParseError SourcePos
    _ [Message]
    msgs)
        = SourcePos -> [Message] -> ParseError
    ParseError SourcePos
    pos [Message]
    msgs

    setErrorMessage :: Message -> ParseError -> ParseError
    setErrorMessage :: Message -> ParseError -> ParseError
    setErrorMessage Message
    msg (ParseError SourcePos
    pos [Message]
    msgs)
        = SourcePos -> [Message] -> ParseError
    ParseError SourcePos
    pos (Message
    msg forall a. a -> [a] -> [a]
    : forall a. (a -> Bool) -> [a] -> [a]
    filter (Message
    msg forall a. Eq a => a -> a -> Bool
    /=) [Message]
    msgs)

    mergeError :: ParseError -> ParseError -> ParseError
    mergeError :: ParseError -> ParseError -> ParseError
    mergeError e1 :: ParseError
    e1@(ParseError SourcePos
    pos1 [Message]
    msgs1) e2 :: ParseError
    e2@(ParseError SourcePos
    pos2 [Message]
    msgs2)
        -- prefer meaningful errors
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    msgs2 Bool -> Bool -> Bool
    && Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    msgs1) = ParseError
    e1
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    msgs1 Bool -> Bool -> Bool
    && Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    msgs2) = ParseError
    e2
        | Bool
    otherwise
        = case SourcePos
    pos1 forall a. Ord a => a -> a -> Ordering
    `compare` SourcePos
    pos2 of
            -- select the longest match
            Ordering
    EQ -> SourcePos -> [Message] -> ParseError
    ParseError SourcePos
    pos1 ([Message]
    msgs1 forall a. [a] -> [a] -> [a]
    ++ [Message]
    msgs2)
            Ordering
    GT -> ParseError
    e1
            Ordering
    LT -> ParseError
    e2

    instance Show ParseError where
        show :: ParseError -> String
    show ParseError
    err
            = forall a. Show a => a -> String
    show (ParseError -> SourcePos
    errorPos ParseError
    err) forall a. [a] -> [a] -> [a]
    ++ String
    ":" forall a. [a] -> [a] -> [a]
    ++
              String
    -> String -> String -> String -> String -> [Message] -> String
    showErrorMessages String
    "or" String
    "unknown parse error"
                                String
    "expecting" String
    "unexpected" String
    "end of input"
                               (ParseError -> [Message]
    errorMessages ParseError
    err)

    instance Eq ParseError where
        ParseError
    l == :: ParseError -> ParseError -> Bool
    == ParseError
    r
            = ParseError -> SourcePos
    errorPos ParseError
    l forall a. Eq a => a -> a -> Bool
    == ParseError -> SourcePos
    errorPos ParseError
    r Bool -> Bool -> Bool
    && ParseError -> [String]
    messageStrs ParseError
    l forall a. Eq a => a -> a -> Bool
    == ParseError -> [String]
    messageStrs ParseError
    r
            where
              messageStrs :: ParseError -> [String]
    messageStrs = forall a b. (a -> b) -> [a] -> [b]
    map Message -> String
    messageString forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> [Message]
    errorMessages

    -- Language independent show function

    --  TODO
    -- < The standard function for showing error messages. Formats a list of
    --    error messages in English. This function is used in the |Show|
    --    instance of |ParseError <#ParseError>|. The resulting string will be
    --    formatted like:
    --
    --    |unexpected /{The first UnExpect or a SysUnExpect message}/;
    --    expecting /{comma separated list of Expect messages}/;
    --    /{comma separated list of Message messages}/

    showErrorMessages ::
        String -> String -> String -> String -> String -> [Message] -> String
    showErrorMessages :: String
    -> String -> String -> String -> String -> [Message] -> String
    showErrorMessages String
    msgOr String
    msgUnknown String
    msgExpecting String
    msgUnExpected String
    msgEndOfInput [Message]
    msgs
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    msgs = String
    msgUnknown
        | Bool
    otherwise = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map (String
    "\n"forall a. [a] -> [a] -> [a]
    ++) 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
          ([Message]
    sysUnExpect,[Message]
    msgs1) = forall a. (a -> Bool) -> [a] -> ([a], [a])
    span ((String -> Message
    SysUnExpect String
    "") forall a. Eq a => a -> a -> Bool
    ==) [Message]
    msgs
          ([Message]
    unExpect,[Message]
    msgs2)    = forall a. (a -> Bool) -> [a] -> ([a], [a])
    span ((String -> Message
    UnExpect    String
    "") forall a. Eq a => a -> a -> Bool
    ==) [Message]
    msgs1
          ([Message]
    expect,[Message]
    messages)   = forall a. (a -> Bool) -> [a] -> ([a], [a])
    span ((String -> Message
    Expect      String
    "") forall a. Eq a => a -> a -> Bool
    ==) [Message]
    msgs2

          showExpect :: String
    showExpect      = String -> [Message] -> String
    showMany String
    msgExpecting [Message]
    expect
          showUnExpect :: String
    showUnExpect    = String -> [Message] -> String
    showMany String
    msgUnExpected [Message]
    unExpect
          showSysUnExpect :: String
    showSysUnExpect | Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    unExpect) Bool -> Bool -> Bool
    ||
                            forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Message]
    sysUnExpect = String
    ""
                          | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    firstMsg    = String
    msgUnExpected forall a. [a] -> [a] -> [a]
    ++ String
    " " forall a. [a] -> [a] -> [a]
    ++ String
    msgEndOfInput
                          | Bool
    otherwise        = String
    msgUnExpected forall a. [a] -> [a] -> [a]
    ++ String
    " " forall a. [a] -> [a] -> [a]
    ++ String
    firstMsg
              where
                  firstMsg :: String
    firstMsg  = Message -> String
    messageString (forall a. [a] -> a
    head [Message]
    sysUnExpect)

          showMessages :: String
    showMessages      = String -> [Message] -> String
    showMany String
    "" [Message]
    messages

          -- helpers
          showMany :: String -> [Message] -> String
    showMany String
    pre [Message]
    msgs3 = case [String] -> [String]
    clean (forall a b. (a -> b) -> [a] -> [b]
    map Message -> String
    messageString [Message]
    msgs3) 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
    separate String
    ", " forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    clean

          separate :: String -> [String] -> String
    separate   String
    _ []     = String
    ""
          separate   String
    _ [String
    m]    = String
    m
          separate String
    sep (String
    m:[String]
    ms) = String
    m forall a. [a] -> [a] -> [a]
    ++ String
    sep forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    separate 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)