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


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

  MatrixDescriptor(..),
  MatrixType(..),
  IndexBase(..),
  Diagonal(..),
  Fill(..),

  createMatDescr,
  destroyMatDescr,

  -- Querying properties
  getDiagonal,
  getFillMode,
  getIndexBase,
  getMatrixType,

  -- Setting properties
  setDiagonal,
  setFillMode,
  setIndexBase,
  setMatrixType,

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



-- | An opaque type used to describe the shape and properties of a matrix.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsematdescrt>
--
newtype MatrixDescriptor = MatrixDescriptor { useMatDescr :: ((C2HSImp.Ptr ()))}

-- | Indicates whether the diagonal elements of the matrix are unity. The
-- diagonal elements are always assumed to be present, but if 'Unit' is passed
-- to an API routine, then the routine assumes that all diagonal entries are
-- unity and will not read or modify those entries.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsediagtypet>
--
data Diagonal = NonUnit
              | Unit
  deriving (Eq,Show)
instance Enum Diagonal where
  succ NonUnit = Unit
  succ Unit = error "Diagonal.succ: Unit has no successor"

  pred Unit = NonUnit
  pred NonUnit = error "Diagonal.pred: NonUnit 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 Unit

  fromEnum NonUnit = 0
  fromEnum Unit = 1

  toEnum 0 = NonUnit
  toEnum 1 = Unit
  toEnum unmatched = error ("Diagonal.toEnum: Cannot match " ++ show unmatched)

{-# LINE 66 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Indicates whether the upper or lower part of the sparse matrix is stored.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsefillmodet>
--
data Fill = Lower
          | Upper
  deriving (Eq,Show)
instance Enum Fill where
  succ Lower = Upper
  succ Upper = error "Fill.succ: Upper has no successor"

  pred Upper = Lower
  pred Lower = error "Fill.pred: Lower 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 Upper

  fromEnum Lower = 0
  fromEnum Upper = 1

  toEnum 0 = Lower
  toEnum 1 = Upper
  toEnum unmatched = error ("Fill.toEnum: Cannot match " ++ show unmatched)

{-# LINE 74 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Indicates whether indexing of matrix elements starts at zero or one.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparseindexbaset>
--
data IndexBase = Zero
               | One
  deriving (Eq,Show)
instance Enum IndexBase where
  succ Zero = One
  succ One = error "IndexBase.succ: One has no successor"

  pred One = Zero
  pred Zero = error "IndexBase.pred: Zero 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 One

  fromEnum Zero = 0
  fromEnum One = 1

  toEnum 0 = Zero
  toEnum 1 = One
  toEnum unmatched = error ("IndexBase.toEnum: Cannot match " ++ show unmatched)

{-# LINE 82 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Indicates the type of matrix.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsematrixtypet>
--
data MatrixType = General
                | Symmetric
                | Hermitian
                | Triangular
  deriving (Eq,Show)
instance Enum MatrixType where
  succ General = Symmetric
  succ Symmetric = Hermitian
  succ Hermitian = Triangular
  succ Triangular = error "MatrixType.succ: Triangular has no successor"

  pred Symmetric = General
  pred Hermitian = Symmetric
  pred Triangular = Hermitian
  pred General = error "MatrixType.pred: General 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 Triangular

  fromEnum General = 0
  fromEnum Symmetric = 1
  fromEnum Hermitian = 2
  fromEnum Triangular = 3

  toEnum 0 = General
  toEnum 1 = Symmetric
  toEnum 2 = Hermitian
  toEnum 3 = Triangular
  toEnum unmatched = error ("MatrixType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 90 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}



-- | Create a new matrix descriptor, with matrix type 'General' and index base
-- 'Zero', while leaving other fields uninitialised.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsecreatematdescr>
--
{-# INLINEABLE createMatDescr #-}
createMatDescr :: IO ((MatrixDescriptor))
createMatDescr =
  alloca $ \a1' -> 
  createMatDescr'_ a1' >>= \res ->
  checkStatus res >> 
  peekMD  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 100 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}

  where
    peekMD = liftM MatrixDescriptor . peek

-- | Release memory associated with a matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsedestroymatdescr>
--
{-# INLINEABLE destroyMatDescr #-}
destroyMatDescr :: (MatrixDescriptor) -> IO ((()))
destroyMatDescr a1 =
  let {a1' = useMatDescr a1} in 
  destroyMatDescr'_ a1' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 110 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}



-- | Get the 'Diagonal' type field of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsegetmatdiagtype>
--
{-# INLINEABLE getDiagonal #-}
getDiagonal :: (MatrixDescriptor) -> IO ((Diagonal))
getDiagonal a1 =
  let {a1' = useMatDescr a1} in 
  getDiagonal'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 119 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Get the 'Fill' mode of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsegetmatfillmode>
--
{-# INLINEABLE getFillMode #-}
getFillMode :: (MatrixDescriptor) -> IO ((Fill))
getFillMode a1 =
  let {a1' = useMatDescr a1} in 
  getFillMode'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 127 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Get the 'IndexBase' mode of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsegetmatindexbase>
--
{-# INLINEABLE getIndexBase #-}
getIndexBase :: (MatrixDescriptor) -> IO ((IndexBase))
getIndexBase a1 =
  let {a1' = useMatDescr a1} in 
  getIndexBase'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 135 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Get the 'MatrixType' mode of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsegetmattype>
--
{-# INLINEABLE getMatrixType #-}
getMatrixType :: (MatrixDescriptor) -> IO ((MatrixType))
getMatrixType a1 =
  let {a1' = useMatDescr a1} in 
  getMatrixType'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 143 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}



-- | Set the 'Diagonal' type field of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsesetmatdiagtype>
--
{-# INLINEABLE setDiagonal #-}
setDiagonal :: (MatrixDescriptor) -> (Diagonal) -> IO ((()))
setDiagonal a1 a2 =
  let {a1' = useMatDescr a1} in 
  let {a2' = cFromEnum a2} in 
  setDiagonal'_ a1' a2' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 152 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Set the 'Fill' mode of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsesetmatfillmode>
--
{-# INLINEABLE setFillMode #-}
setFillMode :: (MatrixDescriptor) -> (Fill) -> IO ((()))
setFillMode a1 a2 =
  let {a1' = useMatDescr a1} in 
  let {a2' = cFromEnum a2} in 
  setFillMode'_ a1' a2' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 160 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Set the 'IndexBase' mode of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsesetmatindexbase>
--
{-# INLINEABLE setIndexBase #-}
setIndexBase :: (MatrixDescriptor) -> (IndexBase) -> IO ((()))
setIndexBase a1 a2 =
  let {a1' = useMatDescr a1} in 
  let {a2' = cFromEnum a2} in 
  setIndexBase'_ a1' a2' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 168 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}


-- | Set the 'MatrixType' mode of the matrix descriptor.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsesetmattype>
--
{-# INLINEABLE setMatrixType #-}
setMatrixType :: (MatrixDescriptor) -> (MatrixType) -> IO ((()))
setMatrixType a1 a2 =
  let {a1' = useMatDescr a1} in 
  let {a2' = cFromEnum a2} in 
  setMatrixType'_ a1' a2' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 176 "./Foreign/CUDA/BLAS/Sparse/Matrix/Descriptor.chs" #-}



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

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

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

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

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

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

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

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

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

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