-- GENERATED by C->Haskell Compiler, version 0.20.1 The shapeless maps, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


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

module Foreign.CUDA.Cublas.Types (

  -- * Types
  Handle(..), Status(..),
  Operation(..),
  SideMode(..),FillMode(..), DiagType(..), PointerMode(..), AtomicsMode(..),

) where

import Foreign (Ptr)



{-# LINE 16 "./Foreign/CUDA/Cublas/Types.chs" #-}



-- | Types

newtype Handle = Handle { useHandle :: ((Ptr ()))}

data Status = Success
            | NotInitialized
            | AllocFailed
            | InvalidValue
            | ArchMismatch
            | MappingError
            | ExecutionFailed
            | InternalError
            | NotSupported
            | LicenseError
  deriving (Eq,Show)
instance Enum Status where
  succ Success = NotInitialized
  succ NotInitialized = AllocFailed
  succ AllocFailed = InvalidValue
  succ InvalidValue = ArchMismatch
  succ ArchMismatch = MappingError
  succ MappingError = ExecutionFailed
  succ ExecutionFailed = InternalError
  succ InternalError = NotSupported
  succ NotSupported = LicenseError
  succ LicenseError = error "Status.succ: LicenseError has no successor"

  pred NotInitialized = Success
  pred AllocFailed = NotInitialized
  pred InvalidValue = AllocFailed
  pred ArchMismatch = InvalidValue
  pred MappingError = ArchMismatch
  pred ExecutionFailed = MappingError
  pred InternalError = ExecutionFailed
  pred NotSupported = InternalError
  pred LicenseError = NotSupported
  pred Success = error "Status.pred: Success 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 LicenseError

  fromEnum Success = 0
  fromEnum NotInitialized = 1
  fromEnum AllocFailed = 3
  fromEnum InvalidValue = 7
  fromEnum ArchMismatch = 8
  fromEnum MappingError = 11
  fromEnum ExecutionFailed = 13
  fromEnum InternalError = 14
  fromEnum NotSupported = 15
  fromEnum LicenseError = 16

  toEnum 0 = Success
  toEnum 1 = NotInitialized
  toEnum 3 = AllocFailed
  toEnum 7 = InvalidValue
  toEnum 8 = ArchMismatch
  toEnum 11 = MappingError
  toEnum 13 = ExecutionFailed
  toEnum 14 = InternalError
  toEnum 15 = NotSupported
  toEnum 16 = LicenseError
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 25 "./Foreign/CUDA/Cublas/Types.chs" #-}


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 29 "./Foreign/CUDA/Cublas/Types.chs" #-}


data SideMode = SideLeft
              | SideRight
  deriving (Eq,Show)
instance Enum SideMode where
  succ SideLeft = SideRight
  succ SideRight = error "SideMode.succ: SideRight has no successor"

  pred SideRight = SideLeft
  pred SideLeft = error "SideMode.pred: SideLeft 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 SideRight

  fromEnum SideLeft = 0
  fromEnum SideRight = 1

  toEnum 0 = SideLeft
  toEnum 1 = SideRight
  toEnum unmatched = error ("SideMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 33 "./Foreign/CUDA/Cublas/Types.chs" #-}


data FillMode = Lower
              | Upper
  deriving (Eq,Show)
instance Enum FillMode where
  succ Lower = Upper
  succ Upper = error "FillMode.succ: Upper has no successor"

  pred Upper = Lower
  pred Lower = error "FillMode.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 ("FillMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 37 "./Foreign/CUDA/Cublas/Types.chs" #-}


data DiagType = NonUnit
              | Unit
  deriving (Eq,Show)
instance Enum DiagType where
  succ NonUnit = Unit
  succ Unit = error "DiagType.succ: Unit has no successor"

  pred Unit = NonUnit
  pred NonUnit = error "DiagType.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 ("DiagType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 41 "./Foreign/CUDA/Cublas/Types.chs" #-}


data PointerMode = Host
                 | Device
  deriving (Eq,Show)
instance Enum PointerMode where
  succ Host = Device
  succ Device = error "PointerMode.succ: Device has no successor"

  pred Device = Host
  pred Host = error "PointerMode.pred: Host 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 Device

  fromEnum Host = 0
  fromEnum Device = 1

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

{-# LINE 45 "./Foreign/CUDA/Cublas/Types.chs" #-}


data AtomicsMode = NotAllowed
                 | Allowed
  deriving (Eq,Show)
instance Enum AtomicsMode where
  succ NotAllowed = Allowed
  succ Allowed = error "AtomicsMode.succ: Allowed has no successor"

  pred Allowed = NotAllowed
  pred NotAllowed = error "AtomicsMode.pred: NotAllowed 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 Allowed

  fromEnum NotAllowed = 0
  fromEnum Allowed = 1

  toEnum 0 = NotAllowed
  toEnum 1 = Allowed
  toEnum unmatched = error ("AtomicsMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 49 "./Foreign/CUDA/Cublas/Types.chs" #-}