{-# LINE 1 "Graphics/ImageMagick/MagickCore/Types/FFI/Exception.hsc" #-}
{-# LANGUAGE CPP                      #-}
{-# LINE 2 "Graphics/ImageMagick/MagickCore/Types/FFI/Exception.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Graphics.ImageMagick.MagickCore.Types.FFI.Exception
    where

import           Foreign.Storable
import           Foreign.C.Types

{-# LINE 11 "Graphics/ImageMagick/MagickCore/Types/FFI/Exception.hsc" #-}

newtype ExceptionType = ExceptionType { unExceptionType :: CInt }
                      deriving (Eq,Show,Storable)

undefinedException  :: ExceptionType
undefinedException  = ExceptionType 0
warningException   :: ExceptionType
warningException   = ExceptionType 300
resourceLimitWarning   :: ExceptionType
resourceLimitWarning   = ExceptionType 300
typeWarning   :: ExceptionType
typeWarning   = ExceptionType 305
optionWarning   :: ExceptionType
optionWarning   = ExceptionType 310
delegateWarning   :: ExceptionType
delegateWarning   = ExceptionType 315
missingDelegateWarning   :: ExceptionType
missingDelegateWarning   = ExceptionType 320
corruptImageWarning   :: ExceptionType
corruptImageWarning   = ExceptionType 325
fileOpenWarning   :: ExceptionType
fileOpenWarning   = ExceptionType 330
blobWarning   :: ExceptionType
blobWarning   = ExceptionType 335
streamWarning   :: ExceptionType
streamWarning   = ExceptionType 340
cacheWarning   :: ExceptionType
cacheWarning   = ExceptionType 345
coderWarning   :: ExceptionType
coderWarning   = ExceptionType 350
filterWarning   :: ExceptionType
filterWarning   = ExceptionType 352
moduleWarning   :: ExceptionType
moduleWarning   = ExceptionType 355
drawWarning   :: ExceptionType
drawWarning   = ExceptionType 360
imageWarning   :: ExceptionType
imageWarning   = ExceptionType 365
wandWarning   :: ExceptionType
wandWarning   = ExceptionType 370
randomWarning   :: ExceptionType
randomWarning   = ExceptionType 375
xServerWarning   :: ExceptionType
xServerWarning   = ExceptionType 380
monitorWarning   :: ExceptionType
monitorWarning   = ExceptionType 385
registryWarning   :: ExceptionType
registryWarning   = ExceptionType 390
configureWarning   :: ExceptionType
configureWarning   = ExceptionType 395
policyWarning   :: ExceptionType
policyWarning   = ExceptionType 399
errorException   :: ExceptionType
errorException   = ExceptionType 400
resourceLimitError   :: ExceptionType
resourceLimitError   = ExceptionType 400
typeError   :: ExceptionType
typeError   = ExceptionType 405
optionError   :: ExceptionType
optionError   = ExceptionType 410
delegateError   :: ExceptionType
delegateError   = ExceptionType 415
missingDelegateError   :: ExceptionType
missingDelegateError   = ExceptionType 420
corruptImageError   :: ExceptionType
corruptImageError   = ExceptionType 425
fileOpenError   :: ExceptionType
fileOpenError   = ExceptionType 430
blobError   :: ExceptionType
blobError   = ExceptionType 435
streamError   :: ExceptionType
streamError   = ExceptionType 440
cacheError   :: ExceptionType
cacheError   = ExceptionType 445
coderError   :: ExceptionType
coderError   = ExceptionType 450
filterError   :: ExceptionType
filterError   = ExceptionType 452
moduleError   :: ExceptionType
moduleError   = ExceptionType 455
drawError   :: ExceptionType
drawError   = ExceptionType 460
imageError   :: ExceptionType
imageError   = ExceptionType 465
wandError   :: ExceptionType
wandError   = ExceptionType 470
randomError   :: ExceptionType
randomError   = ExceptionType 475
xServerError   :: ExceptionType
xServerError   = ExceptionType 480
monitorError   :: ExceptionType
monitorError   = ExceptionType 485
registryError   :: ExceptionType
registryError   = ExceptionType 490
configureError   :: ExceptionType
configureError   = ExceptionType 495
policyError   :: ExceptionType
policyError   = ExceptionType 499
fatalErrorException   :: ExceptionType
fatalErrorException   = ExceptionType 700
resourceLimitFatalError   :: ExceptionType
resourceLimitFatalError   = ExceptionType 700
typeFatalError   :: ExceptionType
typeFatalError   = ExceptionType 705
optionFatalError   :: ExceptionType
optionFatalError   = ExceptionType 710
delegateFatalError   :: ExceptionType
delegateFatalError   = ExceptionType 715
missingDelegateFatalError   :: ExceptionType
missingDelegateFatalError   = ExceptionType 720
corruptImageFatalError   :: ExceptionType
corruptImageFatalError   = ExceptionType 725
fileOpenFatalError   :: ExceptionType
fileOpenFatalError   = ExceptionType 730
blobFatalError   :: ExceptionType
blobFatalError   = ExceptionType 735
streamFatalError   :: ExceptionType
streamFatalError   = ExceptionType 740
cacheFatalError   :: ExceptionType
cacheFatalError   = ExceptionType 745
coderFatalError   :: ExceptionType
coderFatalError   = ExceptionType 750
filterFatalError   :: ExceptionType
filterFatalError   = ExceptionType 752
moduleFatalError   :: ExceptionType
moduleFatalError   = ExceptionType 755
drawFatalError   :: ExceptionType
drawFatalError   = ExceptionType 760
imageFatalError   :: ExceptionType
imageFatalError   = ExceptionType 765
wandFatalError   :: ExceptionType
wandFatalError   = ExceptionType 770
randomFatalError   :: ExceptionType
randomFatalError   = ExceptionType 775
xServerFatalError   :: ExceptionType
xServerFatalError   = ExceptionType 780
monitorFatalError   :: ExceptionType
monitorFatalError   = ExceptionType 785
registryFatalError   :: ExceptionType
registryFatalError   = ExceptionType 790
configureFatalError   :: ExceptionType
configureFatalError   = ExceptionType 795
policyFatalError   :: ExceptionType
policyFatalError   = ExceptionType 799

{-# LINE 87 "Graphics/ImageMagick/MagickCore/Types/FFI/Exception.hsc" #-}

data ExceptionSeverity  = Undefined | Warning | Error | FatalError
                        deriving (Eq, Show)

toSeverity :: ExceptionType -> ExceptionSeverity
toSeverity x = go ((unExceptionType x) `div` 100) 
  where 
    go 3 = Warning
    go 4 = Error
    go 7 = FatalError
    go _ = Undefined