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


{-# LINE 1 "./Foreign/NVVM/Error.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.NVVM.Error
-- Copyright : [2016] Trevor L. McDonell
-- License   : BSD
--
-- Error handling
--
--------------------------------------------------------------------------------

module Foreign.NVVM.Error (

  Status(..),
  describe,
  resultIfOk, nothingIfOk,
  nvvmError, nvvmErrorIO, requireSDK,

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



import Foreign.NVVM.Internal.C2HS
import Foreign.C
import Foreign.Ptr
import System.IO.Unsafe

import Control.Exception
import Data.Typeable
import Language.Haskell.TH
import Text.Printf



{-# LINE 32 "./Foreign/NVVM/Error.chs" #-}



-- Return codes
-- ------------

-- | NVVM API function return code
--
data Status = Success
            | OutOfMemory
            | ProgramCreationFailure
            | IRVersionMismatch
            | InvalidInput
            | InvalidProgram
            | InvalidIR
            | InvalidOption
            | NoModuleInProgram
            | CompilationFailure
  deriving (Eq,Show)
instance Enum Status where
  succ Success = OutOfMemory
  succ OutOfMemory = ProgramCreationFailure
  succ ProgramCreationFailure = IRVersionMismatch
  succ IRVersionMismatch = InvalidInput
  succ InvalidInput = InvalidProgram
  succ InvalidProgram = InvalidIR
  succ InvalidIR = InvalidOption
  succ InvalidOption = NoModuleInProgram
  succ NoModuleInProgram = CompilationFailure
  succ CompilationFailure = error "Status.succ: CompilationFailure has no successor"

  pred OutOfMemory = Success
  pred ProgramCreationFailure = OutOfMemory
  pred IRVersionMismatch = ProgramCreationFailure
  pred InvalidInput = IRVersionMismatch
  pred InvalidProgram = InvalidInput
  pred InvalidIR = InvalidProgram
  pred InvalidOption = InvalidIR
  pred NoModuleInProgram = InvalidOption
  pred CompilationFailure = NoModuleInProgram
  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 CompilationFailure

  fromEnum Success = 0
  fromEnum OutOfMemory = 1
  fromEnum ProgramCreationFailure = 2
  fromEnum IRVersionMismatch = 3
  fromEnum InvalidInput = 4
  fromEnum InvalidProgram = 5
  fromEnum InvalidIR = 6
  fromEnum InvalidOption = 7
  fromEnum NoModuleInProgram = 8
  fromEnum CompilationFailure = 9

  toEnum 0 = Success
  toEnum 1 = OutOfMemory
  toEnum 2 = ProgramCreationFailure
  toEnum 3 = IRVersionMismatch
  toEnum 4 = InvalidInput
  toEnum 5 = InvalidProgram
  toEnum 6 = InvalidIR
  toEnum 7 = InvalidOption
  toEnum 8 = NoModuleInProgram
  toEnum 9 = CompilationFailure
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 47 "./Foreign/NVVM/Error.chs" #-}



-- | Get the descriptive message string for the given result code
--
describe :: (Status) -> (String)
describe a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = cFromEnum a1} in 
  describe'_ a1' >>= \res ->
  peekCString res >>= \res' ->
  return (res')

{-# LINE 57 "./Foreign/NVVM/Error.chs" #-}



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

data NVVMException
  = ExitCode Status
  | UserError String
  deriving Typeable

instance Exception NVVMException

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


-- | Throw an exception. Exceptions may be thrown from pure code, but can only
-- be caught in the 'IO' monad.
--
{-# RULES "nvvmError/IO" nvvmError = nvvmErrorIO #-}
{-# NOINLINE [1] nvvmError #-}
nvvmError :: String -> a
nvvmError s = throw (UserError s)

-- | Raise an NVVM exception in the 'IO' monad
--
nvvmErrorIO :: String -> IO a
nvvmErrorIO s = throwIO (UserError s)

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


-- Helper functions
-- ----------------

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

-- | Throw an exception on an unsuccessful return code
--
{-# INLINE nothingIfOk #-}
nothingIfOk :: Status -> IO ()
nothingIfOk status =
  case status of
    Success -> return ()
    _       -> throwIO (ExitCode status)


foreign import ccall unsafe "Foreign/NVVM/Error.chs.h nvvmGetErrorString"
  describe'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))