-- GENERATED by C->Haskell Compiler, version 0.28.1 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.String

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



{-# LINE 30 "./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 45 "./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 55 "./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)))