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

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

import           Foreign.C.Types

{-# LINE 9 "Graphics/ImageMagick/MagickCore/Types/FFI/Constitute.hsc" #-}

newtype StorageType = StorageType { unStorageType :: CInt }
          deriving (Eq, Show)

undefinedPixel  :: StorageType
undefinedPixel  = StorageType 0
charPixel  :: StorageType
charPixel  = StorageType 1
doublePixel  :: StorageType
doublePixel  = StorageType 2
floatPixel  :: StorageType
floatPixel  = StorageType 3
integerPixel  :: StorageType
integerPixel  = StorageType 4
longPixel  :: StorageType
longPixel  = StorageType 5
quantumPixel  :: StorageType
quantumPixel  = StorageType 6
shortPixel  :: StorageType
shortPixel  = StorageType 7

{-# LINE 23 "Graphics/ImageMagick/MagickCore/Types/FFI/Constitute.hsc" #-}