-- 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/Internal/Types.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module      : Foreign.CUDA.BLAS.Sparse.Internal.Types
-- 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.Internal.Types
  where



-- other
import Prelude                                            hiding ( Either(..) )
import Foreign.Ptr



{-# LINE 22 "./Foreign/CUDA/BLAS/Sparse/Internal/Types.chs" #-}



-- | This type indicates whether the operation is performed only on indices
-- ('Symbolic') or on data and indices ('Numeric').
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparseactiont>
--
data Action = Symbolic
            | Numeric
  deriving (Eq,Show)
instance Enum Action where
  succ Symbolic = Numeric
  succ Numeric = error "Action.succ: Numeric has no successor"

  pred Numeric = Symbolic
  pred Symbolic = error "Action.pred: Symbolic 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 Numeric

  fromEnum Symbolic = 0
  fromEnum Numeric = 1

  toEnum 0 = Symbolic
  toEnum 1 = Numeric
  toEnum unmatched = error ("Action.toEnum: Cannot match " ++ show unmatched)

{-# LINE 32 "./Foreign/CUDA/BLAS/Sparse/Internal/Types.chs" #-}


-- | Indicates the underlying storage model for elements of matrices.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsedirectiont>
--
data Direction = Row
               | Column
  deriving (Eq,Show)
instance Enum Direction where
  succ Row = Column
  succ Column = error "Direction.succ: Column has no successor"

  pred Column = Row
  pred Row = error "Direction.pred: Row 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 Column

  fromEnum Row = 0
  fromEnum Column = 1

  toEnum 0 = Row
  toEnum 1 = Column
  toEnum unmatched = error ("Direction.toEnum: Cannot match " ++ show unmatched)

{-# LINE 40 "./Foreign/CUDA/BLAS/Sparse/Internal/Types.chs" #-}


-- | Indicates which operations need to be performed with the sparse matrix.
--
--   * @N@: no transpose selected
--   * @T@: transpose operation
--   * @C@: conjugate transpose
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparseoperationt>
--
data Operation = N
               | T
               | C
  deriving (Eq,Show)
instance Enum Operation where
  succ N = T
  succ T = C
  succ C = error "Operation.succ: C has no successor"

  pred T = N
  pred C = T
  pred N = error "Operation.pred: N 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 C

  fromEnum N = 0
  fromEnum T = 1
  fromEnum C = 2

  toEnum 0 = N
  toEnum 1 = T
  toEnum 2 = C
  toEnum unmatched = error ("Operation.toEnum: Cannot match " ++ show unmatched)

{-# LINE 55 "./Foreign/CUDA/BLAS/Sparse/Internal/Types.chs" #-}


-- | Used to specify the type of data underlying a @void*@ pointer. For example,
-- it is used in the routine <http://docs.nvidia.com/cuda/cusparse/index.html#cusparse-csrmvEx csrmvEx>.
--
data Type = R32f
          | R64f
          | R16f
          | R8i
          | C32f
          | C64f
          | C16f
          | C8i
          | R8u
          | C8u
          | R32i
          | C32i
          | R32u
          | C32u
  deriving (Eq,Show)
instance Enum Type where
  succ R32f = R64f
  succ R64f = R16f
  succ R16f = R8i
  succ R8i = C32f
  succ C32f = C64f
  succ C64f = C16f
  succ C16f = C8i
  succ C8i = R8u
  succ R8u = C8u
  succ C8u = R32i
  succ R32i = C32i
  succ C32i = R32u
  succ R32u = C32u
  succ C32u = error "Type.succ: C32u has no successor"

  pred R64f = R32f
  pred R16f = R64f
  pred R8i = R16f
  pred C32f = R8i
  pred C64f = C32f
  pred C16f = C64f
  pred C8i = C16f
  pred R8u = C8i
  pred C8u = R8u
  pred R32i = C8u
  pred C32i = R32i
  pred R32u = C32i
  pred C32u = R32u
  pred R32f = error "Type.pred: R32f 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 C32u

  fromEnum R32f = 0
  fromEnum R64f = 1
  fromEnum R16f = 2
  fromEnum R8i = 3
  fromEnum C32f = 4
  fromEnum C64f = 5
  fromEnum C16f = 6
  fromEnum C8i = 7
  fromEnum R8u = 8
  fromEnum C8u = 9
  fromEnum R32i = 10
  fromEnum C32i = 11
  fromEnum R32u = 12
  fromEnum C32u = 13

  toEnum 0 = R32f
  toEnum 1 = R64f
  toEnum 2 = R16f
  toEnum 3 = R8i
  toEnum 4 = C32f
  toEnum 5 = C64f
  toEnum 6 = C16f
  toEnum 7 = C8i
  toEnum 8 = R8u
  toEnum 9 = C8u
  toEnum 10 = R32i
  toEnum 11 = C32i
  toEnum 12 = R32u
  toEnum 13 = C32u
  toEnum unmatched = error ("Type.toEnum: Cannot match " ++ show unmatched)

{-# LINE 66 "./Foreign/CUDA/BLAS/Sparse/Internal/Types.chs" #-}



-- | Specify the algorithm to use, for example used in the routine
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparse-csrmvEx csrmvEx>.
--
data Algorithm = Alg0
               | Alg1
  deriving (Eq,Show)
instance Enum Algorithm where
  succ Alg0 = Alg1
  succ Alg1 = error "Algorithm.succ: Alg1 has no successor"

  pred Alg1 = Alg0
  pred Alg0 = error "Algorithm.pred: Alg0 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 Alg1

  fromEnum Alg0 = 0
  fromEnum Alg1 = 1

  toEnum 0 = Alg0
  toEnum 1 = Alg1
  toEnum unmatched = error ("Algorithm.toEnum: Cannot match " ++ show unmatched)

{-# LINE 78 "./Foreign/CUDA/BLAS/Sparse/Internal/Types.chs" #-}


-- | Indicates whether level information is used by some solver algorithms.
--
-- <http://docs.nvidia.com/cuda/cusparse/index.html#cusparsesolvepolicy_t>
--
data Policy = NoLevel
            | UseLevel
  deriving (Eq,Show)
instance Enum Policy where
  succ NoLevel = UseLevel
  succ UseLevel = error "Policy.succ: UseLevel has no successor"

  pred UseLevel = NoLevel
  pred NoLevel = error "Policy.pred: NoLevel 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 UseLevel

  fromEnum NoLevel = 0
  fromEnum UseLevel = 1

  toEnum 0 = NoLevel
  toEnum 1 = UseLevel
  toEnum unmatched = error ("Policy.toEnum: Cannot match " ++ show unmatched)

{-# LINE 86 "./Foreign/CUDA/BLAS/Sparse/Internal/Types.chs" #-}