    {-# LANGUAGE ExistentialQuantification #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.C.Data.Error
    -- Copyright   :  (c) 2008 Benedikt Huber, Manuel M. T. Chakravarty
    -- License     :  BSD-style
    -- Maintainer  :  benedikt.huber@gmail.com
    -- Stability   :  experimental
    -- Portability :  ghc
    --
    -- Base type for errors occurring in parsing, analysing and pretty-printing.
    -- With ideas from Simon Marlow's
    -- "An extensible dynamically-typed hierarchy of execeptions [2006]"
    -----------------------------------------------------------------------------
    module Language.C.Data.Error (
        -- * Severity Level
        ErrorLevel(..), isHardError,
        -- * Error class
        Error(..), errorPos, errorLevel, errorMsgs,
        -- * Error 'supertype'
        CError(..),
        -- * Infos attached to errors
        ErrorInfo(..),showError,showErrorInfo,mkErrorInfo,
        -- * Default error types
        UnsupportedFeature, unsupportedFeature, unsupportedFeature_,
        UserError, userErr,
        -- * Raising internal errors
        internalErr,
    )
    where

    import Data.Typeable (Typeable, cast)
    import Language.C.Data.Node
    import Language.C.Data.Position

    -- | Error levels (severity)
    data ErrorLevel = LevelWarn
                    | LevelError
                    | LevelFatal
                  deriving (ErrorLevel -> ErrorLevel -> Bool
    (ErrorLevel -> ErrorLevel -> Bool)
    -> (ErrorLevel -> ErrorLevel -> Bool) -> Eq ErrorLevel
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ErrorLevel -> ErrorLevel -> Bool
    == :: ErrorLevel -> ErrorLevel -> Bool
    $c/= :: ErrorLevel -> ErrorLevel -> Bool
    /= :: ErrorLevel -> ErrorLevel -> Bool
    Eq, Eq ErrorLevel
    Eq ErrorLevel =>
    (ErrorLevel -> ErrorLevel -> Ordering)
    -> (ErrorLevel -> ErrorLevel -> Bool)
    -> (ErrorLevel -> ErrorLevel -> Bool)
    -> (ErrorLevel -> ErrorLevel -> Bool)
    -> (ErrorLevel -> ErrorLevel -> Bool)
    -> (ErrorLevel -> ErrorLevel -> ErrorLevel)
    -> (ErrorLevel -> ErrorLevel -> ErrorLevel)
    -> Ord ErrorLevel
    ErrorLevel -> ErrorLevel -> Bool
    ErrorLevel -> ErrorLevel -> Ordering
    ErrorLevel -> ErrorLevel -> ErrorLevel
    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 :: ErrorLevel -> ErrorLevel -> Ordering
    compare :: ErrorLevel -> ErrorLevel -> Ordering
    $c< :: ErrorLevel -> ErrorLevel -> Bool
    < :: ErrorLevel -> ErrorLevel -> Bool
    $c<= :: ErrorLevel -> ErrorLevel -> Bool
    <= :: ErrorLevel -> ErrorLevel -> Bool
    $c> :: ErrorLevel -> ErrorLevel -> Bool
    > :: ErrorLevel -> ErrorLevel -> Bool
    $c>= :: ErrorLevel -> ErrorLevel -> Bool
    >= :: ErrorLevel -> ErrorLevel -> Bool
    $cmax :: ErrorLevel -> ErrorLevel -> ErrorLevel
    max :: ErrorLevel -> ErrorLevel -> ErrorLevel
    $cmin :: ErrorLevel -> ErrorLevel -> ErrorLevel
    min :: ErrorLevel -> ErrorLevel -> ErrorLevel
    Ord)

    instance Show ErrorLevel where
        show :: ErrorLevel -> String
    show ErrorLevel
    LevelWarn  = String
    "WARNING"
        show ErrorLevel
    LevelError = String
    "ERROR"
        show ErrorLevel
    LevelFatal = String
    "FATAL ERROR"

    -- | return @True@ when the given error makes it impossible to continue
    --   analysis or compilation.
    isHardError :: (Error ex) => ex -> Bool
    isHardError :: forall ex. Error ex => ex -> Bool
    isHardError = ( ErrorLevel -> ErrorLevel -> Bool
    forall a. Ord a => a -> a -> Bool
    > ErrorLevel
    LevelWarn) (ErrorLevel -> Bool) -> (ex -> ErrorLevel) -> ex -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ex -> ErrorLevel
    forall e. Error e => e -> ErrorLevel
    errorLevel

    -- | information attached to every error in Language.C
    data ErrorInfo = ErrorInfo ErrorLevel Position [String]

    -- to facilitate newtype deriving
    instance Show ErrorInfo where show :: ErrorInfo -> String
    show = String -> ErrorInfo -> String
    showErrorInfo String
    "error"
    instance Error ErrorInfo where
        errorInfo :: ErrorInfo -> ErrorInfo
    errorInfo = ErrorInfo -> ErrorInfo
    forall a. a -> a
    id
        changeErrorLevel :: ErrorInfo -> ErrorLevel -> ErrorInfo
    changeErrorLevel (ErrorInfo ErrorLevel
    _ Position
    pos [String]
    msgs) ErrorLevel
    lvl' = ErrorLevel -> Position -> [String] -> ErrorInfo
    ErrorInfo ErrorLevel
    lvl' Position
    pos [String]
    msgs

    mkErrorInfo :: ErrorLevel -> String -> NodeInfo -> ErrorInfo
    mkErrorInfo :: ErrorLevel -> String -> NodeInfo -> ErrorInfo
    mkErrorInfo ErrorLevel
    lvl String
    msg NodeInfo
    node = ErrorLevel -> Position -> [String] -> ErrorInfo
    ErrorInfo ErrorLevel
    lvl (NodeInfo -> Position
    posOfNode NodeInfo
    node) (String -> [String]
    lines String
    msg)

    -- | `supertype' of all errors
    data CError
        = forall err. (Error err) => CError err

    -- | errors in Language.C are instance of 'Error'
    class (Typeable e, Show e) => Error e where
        -- | obtain source location etc. of an error
        errorInfo        :: e -> ErrorInfo
        -- | wrap error in 'CError'
        toError          :: e -> CError
        -- | try to cast a generic 'CError' to the specific error type
        fromError     :: CError -> Maybe e
        -- | modify the error level
        changeErrorLevel :: e -> ErrorLevel -> e

        -- default implementation
        fromError (CError err
    e) = err -> Maybe e
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast err
    e
        toError = e -> CError
    forall err. Error err => err -> CError
    CError
        changeErrorLevel e
    e ErrorLevel
    lvl =
            if e -> ErrorLevel
    forall e. Error e => e -> ErrorLevel
    errorLevel e
    e ErrorLevel -> ErrorLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    == ErrorLevel
    lvl
                then e
    e
                else String -> e
    forall a. HasCallStack => String -> a
    error (String -> e) -> String -> e
    forall a b. (a -> b) -> a -> b
    $ String
    "changeErrorLevel: not possible for " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ e -> String
    forall a. Show a => a -> String
    show e
    e

    instance Show CError where
        show :: CError -> String
    show (CError err
    e) = err -> String
    forall a. Show a => a -> String
    show err
    e
    instance Error CError where
        errorInfo :: CError -> ErrorInfo
    errorInfo (CError err
    err) = err -> ErrorInfo
    forall e. Error e => e -> ErrorInfo
    errorInfo err
    err
        toError :: CError -> CError
    toError = CError -> CError
    forall a. a -> a
    id
        fromError :: CError -> Maybe CError
    fromError = CError -> Maybe CError
    forall a. a -> Maybe a
    Just
        changeErrorLevel :: CError -> ErrorLevel -> CError
    changeErrorLevel (CError err
    e) = err -> CError
    forall err. Error err => err -> CError
    CError (err -> CError) -> (ErrorLevel -> err) -> ErrorLevel -> CError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . err -> ErrorLevel -> err
    forall e. Error e => e -> ErrorLevel -> e
    changeErrorLevel err
    e

    -- | position of an @Error@
    errorPos   :: (Error e) => e -> Position
    errorPos :: forall e. Error e => e -> Position
    errorPos = ( \(ErrorInfo ErrorLevel
    _ Position
    pos [String]
    _) -> Position
    pos ) (ErrorInfo -> Position) -> (e -> ErrorInfo) -> e -> Position
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> ErrorInfo
    forall e. Error e => e -> ErrorInfo
    errorInfo

    -- | severity level of an @Error@
    errorLevel :: (Error e) => e -> ErrorLevel
    errorLevel :: forall e. Error e => e -> ErrorLevel
    errorLevel = ( \(ErrorInfo ErrorLevel
    lvl Position
    _ [String]
    _) -> ErrorLevel
    lvl ) (ErrorInfo -> ErrorLevel) -> (e -> ErrorInfo) -> e -> ErrorLevel
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> ErrorInfo
    forall e. Error e => e -> ErrorInfo
    errorInfo

    -- | message lines of an @Error@
    errorMsgs   :: (Error e) => e -> [String]
    errorMsgs :: forall e. Error e => e -> [String]
    errorMsgs = ( \(ErrorInfo ErrorLevel
    _ Position
    _ [String]
    msgs) -> [String]
    msgs ) (ErrorInfo -> [String]) -> (e -> ErrorInfo) -> e -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> ErrorInfo
    forall e. Error e => e -> ErrorInfo
    errorInfo

    -- | error raised if a operation requires an unsupported or not yet implemented feature.
    data UnsupportedFeature = UnsupportedFeature String Position
    instance Error UnsupportedFeature where
        errorInfo :: UnsupportedFeature -> ErrorInfo
    errorInfo (UnsupportedFeature String
    msg Position
    pos) = ErrorLevel -> Position -> [String] -> ErrorInfo
    ErrorInfo ErrorLevel
    LevelError Position
    pos (String -> [String]
    lines String
    msg)
    instance Show UnsupportedFeature where show :: UnsupportedFeature -> String
    show = String -> UnsupportedFeature -> String
    forall e. Error e => String -> e -> String
    showError String
    "Unsupported Feature"

    unsupportedFeature :: (Pos a) => String -> a -> UnsupportedFeature
    unsupportedFeature :: forall a. Pos a => String -> a -> UnsupportedFeature
    unsupportedFeature String
    msg a
    a = String -> Position -> UnsupportedFeature
    UnsupportedFeature String
    msg (a -> Position
    forall a. Pos a => a -> Position
    posOf a
    a)

    unsupportedFeature_ :: String -> UnsupportedFeature
    unsupportedFeature_ :: String -> UnsupportedFeature
    unsupportedFeature_ String
    msg = String -> Position -> UnsupportedFeature
    UnsupportedFeature String
    msg Position
    internalPos

    -- | unspecified error raised by the user (in case the user does not want to define
    --   her own error types).
    newtype UserError     = UserError ErrorInfo
    instance Error UserError where
        errorInfo :: UserError -> ErrorInfo
    errorInfo (UserError ErrorInfo
    info) = ErrorInfo
    info
    instance Show UserError where show :: UserError -> String
    show = String -> UserError -> String
    forall e. Error e => String -> e -> String
    showError String
    "User Error"

    userErr :: String -> UserError
    userErr :: String -> UserError
    userErr String
    msg = ErrorInfo -> UserError
    UserError (ErrorLevel -> Position -> [String] -> ErrorInfo
    ErrorInfo ErrorLevel
    LevelError Position
    internalPos (String -> [String]
    lines String
    msg))

    -- other errors to be defined elsewhere

    showError :: (Error e) => String -> e -> String
    showError :: forall e. Error e => String -> e -> String
    showError String
    short_msg = String -> ErrorInfo -> String
    showErrorInfo String
    short_msg (ErrorInfo -> String) -> (e -> ErrorInfo) -> e -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> ErrorInfo
    forall e. Error e => e -> ErrorInfo
    errorInfo

    -- | converts an error into a string using a fixed format
    --
    -- * either the lines of the long error message or the short message has to be non-empty
    --
    -- * the format is
    --
    -- >    <fname>:<row>: (column <col>) [<err lvl>]
    -- >      >>> <line_1>
    -- >      <line_2>
    -- >        ...
    -- >      <line_n>
    showErrorInfo :: String -> ErrorInfo -> String
    showErrorInfo :: String -> ErrorInfo -> String
    showErrorInfo String
    short_msg (ErrorInfo ErrorLevel
    level Position
    pos [String]
    msgs) =
        String
    header String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    showMsgLines (if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    short_msg then [String]
    msgs else String
    short_msgString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    msgs)
        where
        header :: String
    header = Position -> String
    showPos Position
    pos String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "[" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ErrorLevel -> String
    forall a. Show a => a -> String
    show ErrorLevel
    level String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
        showPos :: Position -> String
    showPos Position
    p | Position -> Bool
    isSourcePos Position
    p = Position -> String
    posFile Position
    p String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Position -> Int
    posRow Position
    pos) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                    String
    "(column " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Position -> Int
    posColumn Position
    pos) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ") "
                  | Bool
    otherwise = Position -> String
    forall a. Show a => a -> String
    show Position
    p String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":: "
        showMsgLines :: [String] -> String
    showMsgLines []     = ShowS
    forall a. String -> a
    internalErr String
    "No short message or error message provided."
        showMsgLines (String
    x:[String]
    xs) = String
    indent String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ">>> " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines (ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    indentString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) [String]
    xs)

    -- internal errors
    internalErrPrefix :: String
    internalErrPrefix :: String
    internalErrPrefix = [String] -> String
    unlines [ String
    "Language.C : Internal Error" ,
                                  String
    "This is propably a bug, and should be reported at "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                  String
    "http://www.sivity.net/projects/language.c/newticket"]

    -- | raise a fatal internal error; message may have multiple lines
    internalErr     :: String -> a
    internalErr :: forall a. String -> a
    internalErr String
    msg  = String -> a
    forall a. HasCallStack => String -> a
    error (String
    internalErrPrefix String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                           String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    indentLines String
    msg
                           String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")
    indent :: String
    indent :: String
    indent = String
    "  "
    indentLines :: String -> String
    indentLines :: ShowS
    indentLines = [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    indentString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines