{-# LINE 1 "GHC/Packing/PackException.hsc" #-}
{-# LANGUAGE MagicHash, DeriveDataTypeable #-}

{-| 

Module      : GHC.Packing.PackException
Copyright   : (c) Jost Berthold, 2010-2015,
License     : BSD3
Maintainer  : jost.berthold@gmail.com
Stability   : experimental
Portability : no (depends on GHC internals)

Exception type for packman library, using magic constants #include'd
from a C header file shared with the foreign primitive operation code.

'PackException's can occur at Haskell level or in the foreign primop.

All Haskell-level exceptions are cases of invalid data when /reading/
and /deserialising/ 'GHC.Packing.Serialised' data:

* 'P_BinaryMismatch': serialised data were produced by a
different executable (must be the same binary).
* 'P_TypeMismatch': serialised data have the wrong type
* 'P_ParseError': serialised data could not be parsed (from binary or
text format)

The exceptions caused by the foreign primops (return codes) 
indicate errors at the C level. Most of them can occur when
serialising data; the exception is 'P_GARBLED' which indicates that
serialised data is garbled.

-}

module GHC.Packing.PackException
    ( PackException(..)
    , decodeEx
    , isBHExc
    ) where

-- bring in error codes from cbits/Errors.h


import GHC.Exts
import GHC.Prim
import Control.Exception
import Data.Typeable

-- | Packing exception codes, matching error codes implemented in the
-- runtime system or describing errors which can occur within Haskell.
data PackException =
    -- keep in sync with Errors.h
    P_SUCCESS      -- ^ no error, ==0.
        -- Internal code, should never be seen by users.
        | P_BLACKHOLE    -- ^ RTS: packing hit a blackhole.
        -- Used internally, not passed to users.
        | P_NOBUFFER     -- ^ RTS: buffer too small
        | P_CANNOTPACK  -- ^ RTS: contains closure which cannot be packed (MVar, TVar)
        | P_UNSUPPORTED  -- ^ RTS: contains unsupported closure type (implementation missing)
        | P_IMPOSSIBLE   -- ^ RTS: impossible case (stack frame, message,...RTS bug!)
        | P_GARBLED       -- ^ RTS: corrupted data for deserialisation

        -- Error codes from inside Haskell
        | P_ParseError     -- ^ Haskell: Packet data could not be parsed
        | P_BinaryMismatch -- ^ Haskell: Executable binaries do not match
        | P_TypeMismatch   -- ^ Haskell: Packet data encodes unexpected type
     deriving (Eq, Ord, Typeable)

-- | decodes an 'Int#' to a @'PackException'@. Magic constants are read
-- from file /cbits///Errors.h/.
decodeEx :: Int# -> PackException
decodeEx 0#     = P_SUCCESS -- unexpected
{-# LINE 71 "GHC/Packing/PackException.hsc" #-}
decodeEx 1#   = P_BLACKHOLE
{-# LINE 72 "GHC/Packing/PackException.hsc" #-}
decodeEx 2#    = P_NOBUFFER
{-# LINE 73 "GHC/Packing/PackException.hsc" #-}
decodeEx 3# = P_CANNOTPACK
{-# LINE 74 "GHC/Packing/PackException.hsc" #-}
decodeEx 4# = P_UNSUPPORTED
{-# LINE 75 "GHC/Packing/PackException.hsc" #-}
decodeEx 5#  = P_IMPOSSIBLE
{-# LINE 76 "GHC/Packing/PackException.hsc" #-}
decodeEx 6#     = P_GARBLED
{-# LINE 77 "GHC/Packing/PackException.hsc" #-}
decodeEx 7#     = P_ParseError
{-# LINE 78 "GHC/Packing/PackException.hsc" #-}
decodeEx 8# = P_BinaryMismatch
{-# LINE 79 "GHC/Packing/PackException.hsc" #-}
decodeEx 9#   = P_TypeMismatch
{-# LINE 80 "GHC/Packing/PackException.hsc" #-}
decodeEx i#  = error $ "Error value " ++ show (I# i#) ++ " not defined!"

instance Show PackException where
    -- keep in sync with Errors.h
    show P_SUCCESS = "No error." -- we do not expect to see this
    show P_BLACKHOLE     = "Packing hit a blackhole"
    show P_NOBUFFER      = "Pack buffer too small"
    show P_CANNOTPACK    = "Data contain a closure that cannot be packed (MVar, TVar)"
    show P_UNSUPPORTED   = "Contains an unsupported closure type (whose implementation is missing)"
    show P_IMPOSSIBLE    = "An impossible case happened (stack frame, message). This is probably a bug."
    show P_GARBLED       = "Garbled data for deserialisation"
    show P_ParseError     = "Packet parse error"
    show P_BinaryMismatch = "Executable binaries do not match"
    show P_TypeMismatch   = "Packet data has unexpected type"

instance Exception PackException

-- | internal: checks if the given code indicates 'P_BLACKHOLE'
isBHExc :: Int# -> Bool
isBHExc 1#   = True
{-# LINE 100 "GHC/Packing/PackException.hsc" #-}
isBHExc e# = False