{-# LINE 1 "src/System/Socket/Internal/Exception.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
{-# LINE 2 "src/System/Socket/Internal/Exception.hsc" #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  System.Socket.Internal.Exception
-- Copyright   :  (c) Lars Petersen 2015
-- License     :  MIT
--
-- Maintainer  :  info@lars-petersen.net
-- Stability   :  experimental
--------------------------------------------------------------------------------
module System.Socket.Internal.Exception
  ( SocketException (..)
  , eOk
  , eInterrupted
  , eBadFileDescriptor
  , eInvalid
  , ePipe
  , eWouldBlock
  , eAgain
  , eNotSocket
  , eDestinationAddressRequired
  , eMessageSize
  , eProtocolType
  , eNoProtocolOption
  , eProtocolNotSupported
  , eSocketTypeNotSupported
  , eOperationNotSupported
  , eProtocolFamilyNotSupported
  , eAddressFamilyNotSupported
  , eAddressInUse
  , eAddressNotAvailable
  , eNetworkDown
  , eNetworkUnreachable
  , eNetworkReset
  , eConnectionAborted
  , eConnectionReset
  , eNoBufferSpace
  , eIsConnected
  , eNotConnected
  , eShutdown
  , eTooManyReferences
  , eTimedOut
  , eConnectionRefused
  , eHostDown
  , eHostUnreachable
  , eAlready
  , eInProgress
  ) where

import Control.Exception
import Data.Typeable
import Foreign.C.Types


{-# LINE 55 "src/System/Socket/Internal/Exception.hsc" #-}

-- | Contains the error code that can be matched against.
--
--   Hint: Use guards or @MultiWayIf@ to match against specific exceptions:
--
--   > if | e == eAddressInUse -> ...
--   >    | e == eAddressNotAvailable -> ...
--   >    | otherwise -> ...
newtype SocketException
      = SocketException CInt
  deriving (Typeable, Eq, Ord)

instance Exception SocketException

instance Show SocketException where
  show e
    | e == eOk                           = "eOk"
    | e == eInterrupted                  = "eInterrupted"
    | e == eBadFileDescriptor            = "eBadFileDescriptor"
    | e == eInvalid                      = "eInvalid"
    | e == ePipe                         = "ePipe"
    | e == eWouldBlock                   = "eWouldBlock"
    | e == eAgain                        = "eAgain"
    | e == eNotSocket                    = "eNotSocket"
    | e == eDestinationAddressRequired   = "eDestinationAddressRequired"
    | e == eMessageSize                  = "eMessageSize"
    | e == eProtocolType                 = "eProtocolType"
    | e == eNoProtocolOption             = "eNoProtocolOption"
    | e == eProtocolNotSupported         = "eProtocolNotSupported"
    | e == eSocketTypeNotSupported       = "eSocketTypeNotSupported"
    | e == eOperationNotSupported        = "eOperationNotSupported"
    | e == eProtocolFamilyNotSupported   = "eProtocolFamilyNotSupported"
    | e == eAddressFamilyNotSupported    = "eAddressFamilyNotSupported"
    | e == eAddressInUse                 = "eAddressInUse"
    | e == eAddressNotAvailable          = "eAddressNotAvailable"
    | e == eNetworkDown                  = "eNetworkDown"
    | e == eNetworkUnreachable           = "eNetworkUnreachable"
    | e == eNetworkReset                 = "eNetworkReset"
    | e == eConnectionAborted            = "eConnectionAborted"
    | e == eConnectionReset              = "eConnectionReset"
    | e == eNoBufferSpace                = "eNoBufferSpace"
    | e == eIsConnected                  = "eIsConnected"
    | e == eNotConnected                 = "eNotConnected"
    | e == eShutdown                     = "eShutdown"
    | e == eTooManyReferences            = "eTooManyReferences"
    | e == eTimedOut                     = "eTimedOut"
    | e == eConnectionRefused            = "eConnectionRefused"
    | e == eHostDown                     = "eHostDown"
    | e == eHostUnreachable              = "eHostUnreachable"
    | e == eAlready                      = "eAlready"
    | e == eInProgress                   = "eInProgress"
    | otherwise                          = let SocketException n = e
                                           in "SocketException " ++ show n

-- | > SocketException "No error"
eOk                         :: SocketException
eOk                          = SocketException (0)
{-# LINE 112 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Interrupted system call"
--
--   NOTE: This exception shall not be thrown by any public operation in this
--   library, but is handled internally.
eInterrupted                :: SocketException
eInterrupted                 = SocketException (4)
{-# LINE 119 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Bad file descriptor"
eBadFileDescriptor          :: SocketException
eBadFileDescriptor           = SocketException (9)
{-# LINE 123 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Invalid argument"
eInvalid                    :: SocketException
eInvalid                     = SocketException (22)
{-# LINE 127 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Broken pipe"
ePipe                       :: SocketException
ePipe                        = SocketException (32)
{-# LINE 131 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Resource temporarily unavailable"
--
--   NOTE: This exception shall not be thrown by any public operation in this
--   library, but is handled internally.
eWouldBlock                 :: SocketException
eWouldBlock                  = SocketException (11)
{-# LINE 138 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Resource temporarily unavailable"
eAgain                      :: SocketException
eAgain                       = SocketException (11)
{-# LINE 142 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Socket operation on non-socket"
--
--  NOTE: This should be ruled out by the type system.
eNotSocket                  :: SocketException
eNotSocket                   = SocketException (88)
{-# LINE 148 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Destination address required"
eDestinationAddressRequired :: SocketException
eDestinationAddressRequired  = SocketException (89)
{-# LINE 152 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Message too long"
eMessageSize                :: SocketException
eMessageSize                 = SocketException (90)
{-# LINE 156 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Protocol wrong type for socket"

--  NOTE: This should be ruled out by the type system.
eProtocolType               :: SocketException
eProtocolType                = SocketException (91)
{-# LINE 162 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Protocol not available"
eNoProtocolOption           :: SocketException
eNoProtocolOption            = SocketException (92)
{-# LINE 166 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Protocol not supported"
eProtocolNotSupported       :: SocketException
eProtocolNotSupported        = SocketException (93)
{-# LINE 170 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Socket type not supported"
eSocketTypeNotSupported     :: SocketException
eSocketTypeNotSupported      = SocketException (94)
{-# LINE 174 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Operation not supported"
eOperationNotSupported      :: SocketException
eOperationNotSupported       = SocketException (95)
{-# LINE 178 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Protocol family not supported"
eProtocolFamilyNotSupported :: SocketException
eProtocolFamilyNotSupported  = SocketException (96)
{-# LINE 182 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Address family not supported by protocol"
eAddressFamilyNotSupported  :: SocketException
eAddressFamilyNotSupported   = SocketException (97)
{-# LINE 186 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Address already in use"
eAddressInUse               :: SocketException
eAddressInUse                = SocketException (98)
{-# LINE 190 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Cannot assign requested address"
eAddressNotAvailable        :: SocketException
eAddressNotAvailable         = SocketException (99)
{-# LINE 194 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Network is down"
eNetworkDown                :: SocketException
eNetworkDown                 = SocketException (100)
{-# LINE 198 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Network is unreachable"
eNetworkUnreachable         :: SocketException
eNetworkUnreachable          = SocketException (101)
{-# LINE 202 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Network dropped connection on reset"
eNetworkReset               :: SocketException
eNetworkReset                = SocketException (102)
{-# LINE 206 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Software caused connection abort"
eConnectionAborted          :: SocketException
eConnectionAborted           = SocketException (103)
{-# LINE 210 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Connection reset by peer"
eConnectionReset            :: SocketException
eConnectionReset             = SocketException (104)
{-# LINE 214 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "No buffer space available"
eNoBufferSpace              :: SocketException
eNoBufferSpace               = SocketException (105)
{-# LINE 218 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Transport endpoint is already connected"
eIsConnected                :: SocketException
eIsConnected                 = SocketException (106)
{-# LINE 222 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Transport endpoint is not connected"
eNotConnected               :: SocketException
eNotConnected                = SocketException (107)
{-# LINE 226 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Cannot send after transport endpoint shutdown"
eShutdown                   :: SocketException
eShutdown                    = SocketException (108)
{-# LINE 230 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Too many references: cannot splice"
eTooManyReferences          :: SocketException
eTooManyReferences           = SocketException (109)
{-# LINE 234 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Connection timed out"
eTimedOut                   :: SocketException
eTimedOut                    = SocketException (110)
{-# LINE 238 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Connection refused"
eConnectionRefused          :: SocketException
eConnectionRefused           = SocketException (111)
{-# LINE 242 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Host is down"
eHostDown                   :: SocketException
eHostDown                    = SocketException (112)
{-# LINE 246 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "No route to host"
eHostUnreachable            :: SocketException
eHostUnreachable             = SocketException (113)
{-# LINE 250 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Operation already in progress"
--
--   NOTE: This exception shall not be thrown by any public operation in this
--   library, but is handled internally.
eAlready                    :: SocketException
eAlready                     = SocketException (114)
{-# LINE 257 "src/System/Socket/Internal/Exception.hsc" #-}

-- | > SocketException "Operation now in progress"
eInProgress                 :: SocketException
eInProgress                  = SocketException (115)
{-# LINE 261 "src/System/Socket/Internal/Exception.hsc" #-}