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


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

module Foreign.CUDA.Solver.Error
  where



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

-- system
import Control.Exception
import Data.Typeable
import Foreign.C.Types
import Language.Haskell.TH
import Text.Printf



{-# LINE 28 "./Foreign/CUDA/Solver/Error.chs" #-}



-- | Error codes used by cuSolver library functions
--
-- <http://docs.nvidia.com/cuda/cusolver/index.html#cuSolverSPstatus>
--
data Status = Success
            | NotInitialized
            | AllocFailed
            | InvalidValue
            | ArchMismatch
            | MappingError
            | ExecutionFailed
            | InternalError
            | MatrixTypeNotSupported
            | NotSupported
            | ZeroPivot
            | InvalidLicense
  deriving (Eq,Show)
instance Enum Status where
  succ Success = NotInitialized
  succ NotInitialized = AllocFailed
  succ AllocFailed = InvalidValue
  succ InvalidValue = ArchMismatch
  succ ArchMismatch = MappingError
  succ MappingError = ExecutionFailed
  succ ExecutionFailed = InternalError
  succ InternalError = MatrixTypeNotSupported
  succ MatrixTypeNotSupported = NotSupported
  succ NotSupported = ZeroPivot
  succ ZeroPivot = InvalidLicense
  succ InvalidLicense = error "Status.succ: InvalidLicense has no successor"

  pred NotInitialized = Success
  pred AllocFailed = NotInitialized
  pred InvalidValue = AllocFailed
  pred ArchMismatch = InvalidValue
  pred MappingError = ArchMismatch
  pred ExecutionFailed = MappingError
  pred InternalError = ExecutionFailed
  pred MatrixTypeNotSupported = InternalError
  pred NotSupported = MatrixTypeNotSupported
  pred ZeroPivot = NotSupported
  pred InvalidLicense = ZeroPivot
  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 InvalidLicense

  fromEnum Success = 0
  fromEnum NotInitialized = 1
  fromEnum AllocFailed = 2
  fromEnum InvalidValue = 3
  fromEnum ArchMismatch = 4
  fromEnum MappingError = 5
  fromEnum ExecutionFailed = 6
  fromEnum InternalError = 7
  fromEnum MatrixTypeNotSupported = 8
  fromEnum NotSupported = 9
  fromEnum ZeroPivot = 10
  fromEnum InvalidLicense = 11

  toEnum 0 = Success
  toEnum 1 = NotInitialized
  toEnum 2 = AllocFailed
  toEnum 3 = InvalidValue
  toEnum 4 = ArchMismatch
  toEnum 5 = MappingError
  toEnum 6 = ExecutionFailed
  toEnum 7 = InternalError
  toEnum 8 = MatrixTypeNotSupported
  toEnum 9 = NotSupported
  toEnum 10 = ZeroPivot
  toEnum 11 = InvalidLicense
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 37 "./Foreign/CUDA/Solver/Error.chs" #-}


-- Describe each error code
--
describe :: Status -> String
describe Success                = "success"
describe NotInitialized         = "library not initialised"
describe AllocFailed            = "resource allocation failed"
describe InvalidValue           = "unsupported value or parameter passed to a function"
describe ArchMismatch           = "unsupported on current architecture"
describe MappingError           = "access to GPU memory failed"
describe ExecutionFailed        = "execution failed"
describe InternalError          = "internal error"
describe MatrixTypeNotSupported = "matrix type not supported for this function"
describe NotSupported           = "operation not supported"
describe ZeroPivot              = "zero pivot"
describe InvalidLicense         = "invalid license"


-- Exceptions ------------------------------------------------------------------
--
data CUSolverException
  = ExitCode  Status
  | UserError String
  deriving Typeable

instance Exception CUSolverException

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


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

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


-- | 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)

-- | Throw an error if given error code is not CUSPARSE_STATUS_SUCCESS
--
{-# INLINE checkStatus #-}
checkStatus :: CInt -> IO ()
checkStatus = nothingIfOk . cToEnum