-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/CUDA/Cusparse/Types.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Foreign.CUDA.Cusparse.Types (

  -- * Types
  Handle(..), HybMat(..), MatDescr(..),
  Csrsv2Info(..), Csric02Info (..), Csrilu02Info (..),
  Bsrsv2Info(..), Bsric02Info (..), Bsrilu02Info (..),
  SolvePolicy (..),  SolveAnalysisInfo(..),
  Operation(..), Status(..),
  Action(..), Direction(..), FillMode(..), PointerMode(..), DiagType(..),
  IndexBase(..), MatrixType(..), HybPartition(..),

) where

import Foreign (Ptr)



{-# LINE 20 "./Foreign/CUDA/Cusparse/Types.chs" #-}



-- | Types
--
newtype Handle = Handle { useHandle :: ((Ptr ()))}

newtype HybMat = HybMat { useHybMat :: ((Ptr ()))}

newtype MatDescr = MatDescr { useMatDescr :: ((Ptr ()))}

newtype Csrsv2Info = Csrsv2Info { useCsrsv2Info :: ((Ptr ()))}
newtype Csric02Info = Csric02Info { useCsric02Info :: ((Ptr ()))}
newtype Csrilu02Info = Csrilu02Info { useCsrilu02Info :: ((Ptr ()))}
newtype Bsrsv2Info = Bsrsv2Info { useBsrsv2Info :: ((Ptr ()))}
newtype Bsric02Info = Bsric02Info { useBsric02Info :: ((Ptr ()))}
newtype Bsrilu02Info = Bsrilu02Info { useBsrilu02Info :: ((Ptr ()))}

newtype SolveAnalysisInfo = SolveAnalysisInfo { useSolveAnalysisInfo :: ((Ptr ()))}

data SolvePolicy = NoLevel
                 | UseLevel
                 deriving (Eq,Show)
instance Enum SolvePolicy where
  fromEnum NoLevel = 0
  fromEnum UseLevel = 1

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

{-# LINE 42 "./Foreign/CUDA/Cusparse/Types.chs" #-}



data Status = Success
            | NotInitialized
            | AllocFailed
            | InvalidValue
            | ArchMismatch
            | MappingError
            | ExecutionFailed
            | InternalError
            | MatrixTypeNotSupported
            | ZeroPivot
            deriving (Eq,Show)
instance Enum Status where
  fromEnum Success = 0
  fromEnum NotInitialized = 1
  fromEnum AllocFailed = 2
  fromEnum InvalidValue = 3
  fromEnum ArchMismatch = 4
  fromEnum MappingError = 5
  fromEnum ExecutionFailed = 6
  fromEnum InternalError = 7
  fromEnum MatrixTypeNotSupported = 8
  fromEnum ZeroPivot = 9

  toEnum 0 = Success
  toEnum 1 = NotInitialized
  toEnum 2 = AllocFailed
  toEnum 3 = InvalidValue
  toEnum 4 = ArchMismatch
  toEnum 5 = MappingError
  toEnum 6 = ExecutionFailed
  toEnum 7 = InternalError
  toEnum 8 = MatrixTypeNotSupported
  toEnum 9 = ZeroPivot
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 47 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data Action = Symbolic
            | Numeric
            deriving (Eq,Show)
instance Enum Action where
  fromEnum Symbolic = 0
  fromEnum Numeric = 1

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

{-# LINE 51 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data Direction = Row
               | Column
               deriving (Eq,Show)
instance Enum Direction where
  fromEnum Row = 0
  fromEnum Column = 1

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

{-# LINE 55 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data Operation = NonTranspose
               | Transpose
               | ConjugateTranspose
               deriving (Eq,Show)
instance Enum Operation where
  fromEnum NonTranspose = 0
  fromEnum Transpose = 1
  fromEnum ConjugateTranspose = 2

  toEnum 0 = NonTranspose
  toEnum 1 = Transpose
  toEnum 2 = ConjugateTranspose
  toEnum unmatched = error ("Operation.toEnum: Cannot match " ++ show unmatched)

{-# LINE 59 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data IndexBase = Zero
               | One
               deriving (Eq,Show)
instance Enum IndexBase where
  fromEnum Zero = 0
  fromEnum One = 1

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

{-# LINE 63 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data HybPartition = Auto
                  | User
                  | Max
                  deriving (Eq,Show)
instance Enum HybPartition where
  fromEnum Auto = 0
  fromEnum User = 1
  fromEnum Max = 2

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

{-# LINE 67 "./Foreign/CUDA/Cusparse/Types.chs" #-}



data MatrixType = General
                | Symmetric
                | Hermitian
                | Triangular
                deriving (Eq,Show)
instance Enum MatrixType where
  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 72 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data FillMode = Lower
              | Upper
              deriving (Eq,Show)
instance Enum FillMode where
  fromEnum Lower = 0
  fromEnum Upper = 1

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

{-# LINE 76 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data DiagType = NonUnit
              | Unit
              deriving (Eq,Show)
instance Enum DiagType where
  fromEnum NonUnit = 0
  fromEnum Unit = 1

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

{-# LINE 80 "./Foreign/CUDA/Cusparse/Types.chs" #-}


data PointerMode = Host
                 | Device
                 deriving (Eq,Show)
instance Enum PointerMode where
  fromEnum Host = 0
  fromEnum Device = 1

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

{-# LINE 84 "./Foreign/CUDA/Cusparse/Types.chs" #-}