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


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

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

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



-- Friends
import Foreign.CUDA.Solver.Error
import Foreign.CUDA.Solver.Internal.C2HS

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



{-# LINE 32 "./Foreign/CUDA/Solver/Dense/Context.chs" #-}



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


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

{-# LINE 52 "./Foreign/CUDA/Solver/Dense/Context.chs" #-}

  where
    peekHdl = liftM Handle . peek

-- | This function releases resources used by the cuSolverDN library.
--
-- <http://docs.nvidia.com/cuda/cusolver/index.html#cuSolverDNdestroy>
--
{-# INLINEABLE destroy #-}
destroy :: (Handle) -> IO ((()))
destroy a1 =
  let {a1' = useHandle a1} in 
  destroy'_ a1' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 62 "./Foreign/CUDA/Solver/Dense/Context.chs" #-}



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

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