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


{-# LINE 1 "./Foreign/CUDA/BLAS/Sparse/Context.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module      : Foreign.CUDA.BLAS.Sparse.Context
-- 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.BLAS.Sparse.Context (

  -- * Context management
  Handle(..),
  create, destroy,

  -- ** Utilities
  PointerMode(..),
  setPointerMode,
  getPointerMode,

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



-- Friends
import Foreign.CUDA.BLAS.Sparse.Error
import Foreign.CUDA.BLAS.Sparse.Internal.C2HS

-- System
import Foreign
import Foreign.C
import Control.Monad                                      ( liftM )



{-# LINE 36 "./Foreign/CUDA/BLAS/Sparse/Context.chs" #-}



-- | An opaque handle to the cuSPARSE library context, which is passed to all
-- library function calls.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsehandlet>
--
newtype Handle = Handle { useHandle :: ((C2HSImp.Ptr ()))}

-- | This function initializes the cuSPARSE library and creates a handle on the
-- cuSPARSE context. It must be called before any other cuSPARSE API function is
-- invoked. It allocates hardware resources necessary for accessing the GPU.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsecreate>
--
{-# INLINEABLE create #-}
create :: IO ((Handle))
create =
  alloca $ \a1' ->
  create'_ a1' >>= \res ->
  checkStatus res >>
  peekHdl  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 54 "./Foreign/CUDA/BLAS/Sparse/Context.chs" #-}

  where
    peekHdl = liftM Handle . peek


-- | This function releases CPU-side resources used by the cuSPARSE library. The
-- release of GPU-side resources may be deferred until the application shuts
-- down.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsedestroy>
--
{-# INLINEABLE destroy #-}
destroy :: (Handle) -> IO ((()))
destroy a1 =
  let {a1' = useHandle a1} in
  destroy'_ a1' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 67 "./Foreign/CUDA/BLAS/Sparse/Context.chs" #-}



-- | For functions which take scalar value arguments, determines whether those
-- values are passed by reference on the host or device.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsepointermode_t>
--
data PointerMode = Host
                 | Device
  deriving (Eq,Show)
instance Enum PointerMode where
  succ Host = Device
  succ Device = error "PointerMode.succ: Device has no successor"

  pred Device = Host
  pred Host = error "PointerMode.pred: Host 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 Device

  fromEnum Host = 0
  fromEnum Device = 1

  toEnum 0 = Host
  toEnum 1 = Device
  toEnum unmatched = error ("PointerMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 77 "./Foreign/CUDA/BLAS/Sparse/Context.chs" #-}



-- | Set the pointer mode used by cuSPARSE library functions.
--
-- The default mode is for values to be passed by reference from the host.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsesetpointermode>
--
{-# INLINEABLE setPointerMode #-}
setPointerMode :: (Handle) -> (PointerMode) -> IO ((()))
setPointerMode a1 a2 =
  let {a1' = useHandle a1} in
  let {a2' = cFromEnum a2} in
  setPointerMode'_ a1' a2' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 91 "./Foreign/CUDA/BLAS/Sparse/Context.chs" #-}


-- | Get the pointer mode used by cuSPARSE library functions to pass scalar
-- arguments.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsegetpointermode>
--
{-# INLINEABLE getPointerMode #-}
getPointerMode :: (Handle) -> IO ((PointerMode))
getPointerMode a1 =
  let {a1' = useHandle a1} in
  alloca $ \a2' ->
  getPointerMode'_ a1' a2' >>= \res ->
  checkStatus res >>
  peekPM  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 103 "./Foreign/CUDA/BLAS/Sparse/Context.chs" #-}

  where
    peekPM = liftM cToEnum . peek


foreign import ccall unsafe "Foreign/CUDA/BLAS/Sparse/Context.chs.h cusparseCreate"
  create'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/BLAS/Sparse/Context.chs.h cusparseDestroy"
  destroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/BLAS/Sparse/Context.chs.h cusparseSetPointerMode"
  setPointerMode'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/BLAS/Sparse/Context.chs.h cusparseGetPointerMode"
  getPointerMode'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))