-- GENERATED by C->Haskell Compiler, version 0.28.2 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Driver/Error.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Error
-- Copyright : [2009..2017] Trevor L. McDonell
-- License   : BSD
--
-- Error handling
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Error (

  -- * CUDA Errors
  Status(..), CUDAException(..),
  describe,
  cudaError, cudaErrorIO, requireSDK,
  resultIfOk, nothingIfOk,

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



-- Friends
import Foreign.CUDA.Internal.C2HS
import Text.Show.Describe

-- System
import Control.Exception
import Control.Monad
import Data.Typeable
import Foreign.C
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import Language.Haskell.TH
import System.IO.Unsafe
import Text.Printf




{-# LINE 42 "src/Foreign/CUDA/Driver/Error.chs" #-}



--------------------------------------------------------------------------------
-- Return Status
--------------------------------------------------------------------------------

--
-- Error Codes
--
data Status = Success
            | InvalidValue
            | OutOfMemory
            | NotInitialized
            | Deinitialized
            | ProfilerDisabled
            | ProfilerNotInitialized
            | ProfilerAlreadyStarted
            | ProfilerAlreadyStopped
            | NoDevice
            | InvalidDevice
            | InvalidImage
            | InvalidContext
            | ContextAlreadyCurrent
            | MapFailed
            | UnmapFailed
            | ArrayIsMapped
            | AlreadyMapped
            | NoBinaryForGPU
            | AlreadyAcquired
            | NotMapped
            | NotMappedAsArray
            | NotMappedAsPointer
            | EccUncorrectable
            | UnsupportedLimit
            | ContextAlreadyInUse
            | PeerAccessUnsupported
            | InvalidPTX
            | InvalidGraphicsContext
            | NvlinkUncorrectable
            | InvalidSource
            | FileNotFound
            | SharedObjectSymbolNotFound
            | SharedObjectInitFailed
            | OperatingSystem
            | InvalidHandle
            | NotFound
            | NotReady
            | IllegalAddress
            | LaunchOutOfResources
            | LaunchTimeout
            | LaunchIncompatibleTexturing
            | PeerAccessAlreadyEnabled
            | PeerAccessNotEnabled
            | PrimaryContextActive
            | ContextIsDestroyed
            | Assert
            | TooManyPeers
            | HostMemoryAlreadyRegistered
            | HostMemoryNotRegistered
            | HardwareStackError
            | IllegalInstruction
            | MisalignedAddress
            | InvalidAddressSpace
            | InvalidPC
            | LaunchFailed
            | NotPermitted
            | NotSupported
            | Unknown
  deriving (Eq,Show)
instance Enum Status where
  succ Success = InvalidValue
  succ InvalidValue = OutOfMemory
  succ OutOfMemory = NotInitialized
  succ NotInitialized = Deinitialized
  succ Deinitialized = ProfilerDisabled
  succ ProfilerDisabled = ProfilerNotInitialized
  succ ProfilerNotInitialized = ProfilerAlreadyStarted
  succ ProfilerAlreadyStarted = ProfilerAlreadyStopped
  succ ProfilerAlreadyStopped = NoDevice
  succ NoDevice = InvalidDevice
  succ InvalidDevice = InvalidImage
  succ InvalidImage = InvalidContext
  succ InvalidContext = ContextAlreadyCurrent
  succ ContextAlreadyCurrent = MapFailed
  succ MapFailed = UnmapFailed
  succ UnmapFailed = ArrayIsMapped
  succ ArrayIsMapped = AlreadyMapped
  succ AlreadyMapped = NoBinaryForGPU
  succ NoBinaryForGPU = AlreadyAcquired
  succ AlreadyAcquired = NotMapped
  succ NotMapped = NotMappedAsArray
  succ NotMappedAsArray = NotMappedAsPointer
  succ NotMappedAsPointer = EccUncorrectable
  succ EccUncorrectable = UnsupportedLimit
  succ UnsupportedLimit = ContextAlreadyInUse
  succ ContextAlreadyInUse = PeerAccessUnsupported
  succ PeerAccessUnsupported = InvalidPTX
  succ InvalidPTX = InvalidGraphicsContext
  succ InvalidGraphicsContext = NvlinkUncorrectable
  succ NvlinkUncorrectable = InvalidSource
  succ InvalidSource = FileNotFound
  succ FileNotFound = SharedObjectSymbolNotFound
  succ SharedObjectSymbolNotFound = SharedObjectInitFailed
  succ SharedObjectInitFailed = OperatingSystem
  succ OperatingSystem = InvalidHandle
  succ InvalidHandle = NotFound
  succ NotFound = NotReady
  succ NotReady = IllegalAddress
  succ IllegalAddress = LaunchOutOfResources
  succ LaunchOutOfResources = LaunchTimeout
  succ LaunchTimeout = LaunchIncompatibleTexturing
  succ LaunchIncompatibleTexturing = PeerAccessAlreadyEnabled
  succ PeerAccessAlreadyEnabled = PeerAccessNotEnabled
  succ PeerAccessNotEnabled = PrimaryContextActive
  succ PrimaryContextActive = ContextIsDestroyed
  succ ContextIsDestroyed = Assert
  succ Assert = TooManyPeers
  succ TooManyPeers = HostMemoryAlreadyRegistered
  succ HostMemoryAlreadyRegistered = HostMemoryNotRegistered
  succ HostMemoryNotRegistered = HardwareStackError
  succ HardwareStackError = IllegalInstruction
  succ IllegalInstruction = MisalignedAddress
  succ MisalignedAddress = InvalidAddressSpace
  succ InvalidAddressSpace = InvalidPC
  succ InvalidPC = LaunchFailed
  succ LaunchFailed = NotPermitted
  succ NotPermitted = NotSupported
  succ NotSupported = Unknown
  succ Unknown = error "Status.succ: Unknown has no successor"

  pred InvalidValue = Success
  pred OutOfMemory = InvalidValue
  pred NotInitialized = OutOfMemory
  pred Deinitialized = NotInitialized
  pred ProfilerDisabled = Deinitialized
  pred ProfilerNotInitialized = ProfilerDisabled
  pred ProfilerAlreadyStarted = ProfilerNotInitialized
  pred ProfilerAlreadyStopped = ProfilerAlreadyStarted
  pred NoDevice = ProfilerAlreadyStopped
  pred InvalidDevice = NoDevice
  pred InvalidImage = InvalidDevice
  pred InvalidContext = InvalidImage
  pred ContextAlreadyCurrent = InvalidContext
  pred MapFailed = ContextAlreadyCurrent
  pred UnmapFailed = MapFailed
  pred ArrayIsMapped = UnmapFailed
  pred AlreadyMapped = ArrayIsMapped
  pred NoBinaryForGPU = AlreadyMapped
  pred AlreadyAcquired = NoBinaryForGPU
  pred NotMapped = AlreadyAcquired
  pred NotMappedAsArray = NotMapped
  pred NotMappedAsPointer = NotMappedAsArray
  pred EccUncorrectable = NotMappedAsPointer
  pred UnsupportedLimit = EccUncorrectable
  pred ContextAlreadyInUse = UnsupportedLimit
  pred PeerAccessUnsupported = ContextAlreadyInUse
  pred InvalidPTX = PeerAccessUnsupported
  pred InvalidGraphicsContext = InvalidPTX
  pred NvlinkUncorrectable = InvalidGraphicsContext
  pred InvalidSource = NvlinkUncorrectable
  pred FileNotFound = InvalidSource
  pred SharedObjectSymbolNotFound = FileNotFound
  pred SharedObjectInitFailed = SharedObjectSymbolNotFound
  pred OperatingSystem = SharedObjectInitFailed
  pred InvalidHandle = OperatingSystem
  pred NotFound = InvalidHandle
  pred NotReady = NotFound
  pred IllegalAddress = NotReady
  pred LaunchOutOfResources = IllegalAddress
  pred LaunchTimeout = LaunchOutOfResources
  pred LaunchIncompatibleTexturing = LaunchTimeout
  pred PeerAccessAlreadyEnabled = LaunchIncompatibleTexturing
  pred PeerAccessNotEnabled = PeerAccessAlreadyEnabled
  pred PrimaryContextActive = PeerAccessNotEnabled
  pred ContextIsDestroyed = PrimaryContextActive
  pred Assert = ContextIsDestroyed
  pred TooManyPeers = Assert
  pred HostMemoryAlreadyRegistered = TooManyPeers
  pred HostMemoryNotRegistered = HostMemoryAlreadyRegistered
  pred HardwareStackError = HostMemoryNotRegistered
  pred IllegalInstruction = HardwareStackError
  pred MisalignedAddress = IllegalInstruction
  pred InvalidAddressSpace = MisalignedAddress
  pred InvalidPC = InvalidAddressSpace
  pred LaunchFailed = InvalidPC
  pred NotPermitted = LaunchFailed
  pred NotSupported = NotPermitted
  pred Unknown = NotSupported
  pred Success = error "Status.pred: Success has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Unknown

  fromEnum Success = 0
  fromEnum InvalidValue = 1
  fromEnum OutOfMemory = 2
  fromEnum NotInitialized = 3
  fromEnum Deinitialized = 4
  fromEnum ProfilerDisabled = 5
  fromEnum ProfilerNotInitialized = 6
  fromEnum ProfilerAlreadyStarted = 7
  fromEnum ProfilerAlreadyStopped = 8
  fromEnum NoDevice = 100
  fromEnum InvalidDevice = 101
  fromEnum InvalidImage = 200
  fromEnum InvalidContext = 201
  fromEnum ContextAlreadyCurrent = 202
  fromEnum MapFailed = 205
  fromEnum UnmapFailed = 206
  fromEnum ArrayIsMapped = 207
  fromEnum AlreadyMapped = 208
  fromEnum NoBinaryForGPU = 209
  fromEnum AlreadyAcquired = 210
  fromEnum NotMapped = 211
  fromEnum NotMappedAsArray = 212
  fromEnum NotMappedAsPointer = 213
  fromEnum EccUncorrectable = 214
  fromEnum UnsupportedLimit = 215
  fromEnum ContextAlreadyInUse = 216
  fromEnum PeerAccessUnsupported = 217
  fromEnum InvalidPTX = 218
  fromEnum InvalidGraphicsContext = 219
  fromEnum NvlinkUncorrectable = 220
  fromEnum InvalidSource = 300
  fromEnum FileNotFound = 301
  fromEnum SharedObjectSymbolNotFound = 302
  fromEnum SharedObjectInitFailed = 303
  fromEnum OperatingSystem = 304
  fromEnum InvalidHandle = 400
  fromEnum NotFound = 500
  fromEnum NotReady = 600
  fromEnum IllegalAddress = 700
  fromEnum LaunchOutOfResources = 701
  fromEnum LaunchTimeout = 702
  fromEnum LaunchIncompatibleTexturing = 703
  fromEnum PeerAccessAlreadyEnabled = 704
  fromEnum PeerAccessNotEnabled = 705
  fromEnum PrimaryContextActive = 708
  fromEnum ContextIsDestroyed = 709
  fromEnum Assert = 710
  fromEnum TooManyPeers = 711
  fromEnum HostMemoryAlreadyRegistered = 712
  fromEnum HostMemoryNotRegistered = 713
  fromEnum HardwareStackError = 714
  fromEnum IllegalInstruction = 715
  fromEnum MisalignedAddress = 716
  fromEnum InvalidAddressSpace = 717
  fromEnum InvalidPC = 718
  fromEnum LaunchFailed = 719
  fromEnum NotPermitted = 800
  fromEnum NotSupported = 801
  fromEnum Unknown = 999

  toEnum 0 = Success
  toEnum 1 = InvalidValue
  toEnum 2 = OutOfMemory
  toEnum 3 = NotInitialized
  toEnum 4 = Deinitialized
  toEnum 5 = ProfilerDisabled
  toEnum 6 = ProfilerNotInitialized
  toEnum 7 = ProfilerAlreadyStarted
  toEnum 8 = ProfilerAlreadyStopped
  toEnum 100 = NoDevice
  toEnum 101 = InvalidDevice
  toEnum 200 = InvalidImage
  toEnum 201 = InvalidContext
  toEnum 202 = ContextAlreadyCurrent
  toEnum 205 = MapFailed
  toEnum 206 = UnmapFailed
  toEnum 207 = ArrayIsMapped
  toEnum 208 = AlreadyMapped
  toEnum 209 = NoBinaryForGPU
  toEnum 210 = AlreadyAcquired
  toEnum 211 = NotMapped
  toEnum 212 = NotMappedAsArray
  toEnum 213 = NotMappedAsPointer
  toEnum 214 = EccUncorrectable
  toEnum 215 = UnsupportedLimit
  toEnum 216 = ContextAlreadyInUse
  toEnum 217 = PeerAccessUnsupported
  toEnum 218 = InvalidPTX
  toEnum 219 = InvalidGraphicsContext
  toEnum 220 = NvlinkUncorrectable
  toEnum 300 = InvalidSource
  toEnum 301 = FileNotFound
  toEnum 302 = SharedObjectSymbolNotFound
  toEnum 303 = SharedObjectInitFailed
  toEnum 304 = OperatingSystem
  toEnum 400 = InvalidHandle
  toEnum 500 = NotFound
  toEnum 600 = NotReady
  toEnum 700 = IllegalAddress
  toEnum 701 = LaunchOutOfResources
  toEnum 702 = LaunchTimeout
  toEnum 703 = LaunchIncompatibleTexturing
  toEnum 704 = PeerAccessAlreadyEnabled
  toEnum 705 = PeerAccessNotEnabled
  toEnum 708 = PrimaryContextActive
  toEnum 709 = ContextIsDestroyed
  toEnum 710 = Assert
  toEnum 711 = TooManyPeers
  toEnum 712 = HostMemoryAlreadyRegistered
  toEnum 713 = HostMemoryNotRegistered
  toEnum 714 = HardwareStackError
  toEnum 715 = IllegalInstruction
  toEnum 716 = MisalignedAddress
  toEnum 717 = InvalidAddressSpace
  toEnum 718 = InvalidPC
  toEnum 719 = LaunchFailed
  toEnum 800 = NotPermitted
  toEnum 801 = NotSupported
  toEnum 999 = Unknown
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 59 "src/Foreign/CUDA/Driver/Error.chs" #-}



-- |
-- Return a descriptive error string associated with a particular error code
--
instance Describe Status where
  describe status =
    case cuGetErrorString status of
      (Success, msg) -> msg
      (err, _)       -> throw (ExitCode err)

cuGetErrorString :: (Status) -> ((Status), (String))
cuGetErrorString a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = cFromEnum a1} in 
  alloca $ \a2' -> 
  cuGetErrorString'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  ppeek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 74 "src/Foreign/CUDA/Driver/Error.chs" #-}

    where
      ppeek = peek >=> peekCString


--------------------------------------------------------------------------------
-- Exceptions
--------------------------------------------------------------------------------

data CUDAException
  = ExitCode Status
  | UserError String
  deriving Typeable

instance Exception CUDAException

instance Show CUDAException where
  showsPrec _ (ExitCode  s) = showString ("CUDA Exception: " ++ describe s)
  showsPrec _ (UserError s) = showString ("CUDA Exception: " ++ s)


-- |
-- Raise a CUDAException. Exceptions can be thrown from pure code, but can only
-- be caught in the 'IO' monad.
--
{-# RULES "cudaError/IO" cudaError = cudaErrorIO #-}
{-# NOINLINE [1] cudaError #-}
cudaError :: String -> a
cudaError s = throw (UserError s)

-- |
-- Raise a CUDAException in the IO Monad
--
cudaErrorIO :: String -> IO a
cudaErrorIO s = throwIO (UserError s)

-- |
-- A specially formatted error message
--
requireSDK :: Name -> Double -> a
requireSDK n v = cudaError $ printf "'%s' requires at least cuda-%3.1f\n" (show n) v


--------------------------------------------------------------------------------
-- Helper Functions
--------------------------------------------------------------------------------


-- |
-- Return the results of a function on successful execution, otherwise throw an
-- exception with an error string associated with the return code
--
{-# INLINE resultIfOk #-}
resultIfOk :: (Status, a) -> IO a
resultIfOk (status, !result) =
    case status of
        Success -> return  result
        _       -> throwIO (ExitCode status)


-- |
-- Throw an exception with an error string associated with an unsuccessful
-- return code, otherwise return unit.
--
{-# INLINE nothingIfOk #-}
nothingIfOk :: Status -> IO ()
nothingIfOk status =
    case status of
        Success -> return  ()
        _       -> throwIO (ExitCode status)


foreign import ccall unsafe "Foreign/CUDA/Driver/Error.chs.h cuGetErrorString"
  cuGetErrorString'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))