-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/CUDA/FFT/Error.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module      : Foreign.CUDA.FFT.Error
-- Copyright   : [2013..2018] Robert Clifton-Everest, Trevor L. McDonell
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Foreign.CUDA.FFT.Error
  where



-- friends
import Foreign.CUDA.FFT.Internal.C2HS

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



{-# LINE 26 "./Foreign/CUDA/FFT/Error.chs" #-}



-- | Error codes used by cuFFT library functions
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#cufftresult>
--
data Result = Success
            | InvalidPlan
            | AllocFailed
            | InvalidType
            | InvalidValue
            | InternalError
            | ExecFailed
            | SetupFailed
            | InvalidSize
            | UnalignedData
            | IncompleteParameterList
            | InvalidDevice
            | ParseError
            | NoWorkspace
            | NotImplemented
            | LicenseError
            | NotSupported
  deriving (Eq,Show)
instance Enum Result where
  succ Success = InvalidPlan
  succ InvalidPlan = AllocFailed
  succ AllocFailed = InvalidType
  succ InvalidType = InvalidValue
  succ InvalidValue = InternalError
  succ InternalError = ExecFailed
  succ ExecFailed = SetupFailed
  succ SetupFailed = InvalidSize
  succ InvalidSize = UnalignedData
  succ UnalignedData = IncompleteParameterList
  succ IncompleteParameterList = InvalidDevice
  succ InvalidDevice = ParseError
  succ ParseError = NoWorkspace
  succ NoWorkspace = NotImplemented
  succ NotImplemented = LicenseError
  succ LicenseError = NotSupported
  succ NotSupported = error "Result.succ: NotSupported has no successor"

  pred InvalidPlan = Success
  pred AllocFailed = InvalidPlan
  pred InvalidType = AllocFailed
  pred InvalidValue = InvalidType
  pred InternalError = InvalidValue
  pred ExecFailed = InternalError
  pred SetupFailed = ExecFailed
  pred InvalidSize = SetupFailed
  pred UnalignedData = InvalidSize
  pred IncompleteParameterList = UnalignedData
  pred InvalidDevice = IncompleteParameterList
  pred ParseError = InvalidDevice
  pred NoWorkspace = ParseError
  pred NotImplemented = NoWorkspace
  pred LicenseError = NotImplemented
  pred NotSupported = LicenseError
  pred Success = error "Result.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 NotSupported

  fromEnum Success = 0
  fromEnum InvalidPlan = 1
  fromEnum AllocFailed = 2
  fromEnum InvalidType = 3
  fromEnum InvalidValue = 4
  fromEnum InternalError = 5
  fromEnum ExecFailed = 6
  fromEnum SetupFailed = 7
  fromEnum InvalidSize = 8
  fromEnum UnalignedData = 9
  fromEnum IncompleteParameterList = 10
  fromEnum InvalidDevice = 11
  fromEnum ParseError = 12
  fromEnum NoWorkspace = 13
  fromEnum NotImplemented = 14
  fromEnum LicenseError = 15
  fromEnum NotSupported = 16

  toEnum 0 = Success
  toEnum 1 = InvalidPlan
  toEnum 2 = AllocFailed
  toEnum 3 = InvalidType
  toEnum 4 = InvalidValue
  toEnum 5 = InternalError
  toEnum 6 = ExecFailed
  toEnum 7 = SetupFailed
  toEnum 8 = InvalidSize
  toEnum 9 = UnalignedData
  toEnum 10 = IncompleteParameterList
  toEnum 11 = InvalidDevice
  toEnum 12 = ParseError
  toEnum 13 = NoWorkspace
  toEnum 14 = NotImplemented
  toEnum 15 = LicenseError
  toEnum 16 = NotSupported
  toEnum unmatched = error ("Result.toEnum: Cannot match " ++ show unmatched)

{-# LINE 35 "./Foreign/CUDA/FFT/Error.chs" #-}


-- | Describe an error code
--
describe :: Result -> String
describe Success                 = "success"
describe InvalidPlan             = "invalid plan handle"
describe AllocFailed             = "resource allocation failed"
describe InvalidType             = "no longer used"
describe InvalidValue            = "unsupported value or parameter passed to a function"
describe InternalError           = "internal error"
describe ExecFailed              = "failed to execute an FFT on the GPU"
describe SetupFailed             = "the CUFFT library failed to initialize"
describe InvalidSize             = "invalid transform size"
describe UnalignedData           = "no longer used"
describe IncompleteParameterList = "missing parameters in call"
describe InvalidDevice           = "execution of a plan was on a different GPU than plan creation"
describe ParseError              = "internal plan database error"
describe NoWorkspace             = "no workspace has been provided prior to plan execution"
describe NotImplemented          = "not implemented"
describe LicenseError            = "cufft license error"
describe NotSupported            = "operation not supported for given parameters"


-- Exceptions ------------------------------------------------------------------
--
data CUFFTException
  = ExitCode  Result
  | UserError String
  deriving Typeable

instance Exception CUFFTException

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


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


-- | 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 :: (Result, 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 :: Result -> IO ()
nothingIfOk status =
    case status of
        Success -> return  ()
        _       -> throwIO (ExitCode status)

{-# INLINE checkStatus #-}
checkStatus :: CInt -> IO ()
checkStatus = nothingIfOk . cToEnum