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

  Hybrid(..),
  HybridPartition(..),

  createHYB,
  destroyHYB,

) 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 33 "./Foreign/CUDA/BLAS/Sparse/Matrix/Hybrid.chs" #-}



-- | An opaque structure holding the matrix in hybrid (HYB) format.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsehybmatt>
--
newtype Hybrid = Hybrid { useHYB :: ((C2HSImp.Ptr ()))}

-- | Indicates how to perform the partitioning of the matrix into regular (ELL)
-- and irregular (COO) parts of the HYB format.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsehybpartitiont>
--
data HybridPartition = Auto
                     | User
                     | Max
  deriving (Eq,Show)
instance Enum HybridPartition where
  succ Auto = User
  succ User = Max
  succ Max = error "HybridPartition.succ: Max has no successor"

  pred User = Auto
  pred Max = User
  pred Auto = error "HybridPartition.pred: Auto 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 Max

  fromEnum Auto = 0
  fromEnum User = 1
  fromEnum Max = 2

  toEnum 0 = Auto
  toEnum 1 = User
  toEnum 2 = Max
  toEnum unmatched = error ("HybridPartition.toEnum: Cannot match " ++ show unmatched)

{-# LINE 49 "./Foreign/CUDA/BLAS/Sparse/Matrix/Hybrid.chs" #-}



-- | Create a new (opaque) hybrid matrix.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsecreatehybmat>
--
{-# INLINEABLE createHYB #-}
createHYB :: IO ((Hybrid))
createHYB =
  alloca $ \a1' ->
  createHYB'_ a1' >>= \res ->
  checkStatus res >>
  peekHYB  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 58 "./Foreign/CUDA/BLAS/Sparse/Matrix/Hybrid.chs" #-}

  where
    peekHYB = liftM Hybrid . peek


-- | Destroy and release any memory associated with a hybrid matrix.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsedestroyhybmat>
--
{-# INLINEABLE destroyHYB #-}
destroyHYB :: (Hybrid) -> IO ((()))
destroyHYB a1 =
  let {a1' = useHYB a1} in
  destroyHYB'_ a1' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 69 "./Foreign/CUDA/BLAS/Sparse/Matrix/Hybrid.chs" #-}



foreign import ccall unsafe "Foreign/CUDA/BLAS/Sparse/Matrix/Hybrid.chs.h cusparseCreateHybMat"
  createHYB'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/BLAS/Sparse/Matrix/Hybrid.chs.h cusparseDestroyHybMat"
  destroyHYB'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))