{-# LINE 1 "src/Numeric/FFTW/FFI/Type.hsc" #-}
module Numeric.FFTW.FFI.Type where

import qualified Foreign.C.Types as C
import Foreign.Ptr (Ptr)
import Foreign.Storable
          (Storable, sizeOf, alignment, peek, poke, peekByteOff, pokeByteOff)

import qualified Data.EnumBitSet as EnumSet






type Flags = EnumSet.T C.CUInt Flag
{-
Warning: Enum methods do not match flag positions.
Thus we keep the Flag type private.
-}
data Flag =
     Measure
   | DestroyInput
   | Unaligned
   | ConserveMemory
   | Exhaustive
   | PreserveInput
   | Patient
   | Estimate
   deriving (Eq, Ord, Enum)

measure         :: Flags
measure         = EnumSet.Cons 0
destroyInput    :: Flags
destroyInput    = EnumSet.Cons 1
unaligned       :: Flags
unaligned       = EnumSet.Cons 2
conserveMemory  :: Flags
conserveMemory  = EnumSet.Cons 4
exhaustive      :: Flags
exhaustive      = EnumSet.Cons 8
preserveInput   :: Flags
preserveInput   = EnumSet.Cons 16
patient         :: Flags
patient         = EnumSet.Cons 32
estimate        :: Flags
estimate        = EnumSet.Cons 64

{-# LINE 41 "src/Numeric/FFTW/FFI/Type.hsc" #-}


newtype Sign = Sign C.CInt
   deriving (Eq)

forward   :: Sign
forward   = Sign (-1)
backward  :: Sign
backward  = Sign 1

{-# LINE 50 "src/Numeric/FFTW/FFI/Type.hsc" #-}


newtype Kind = Kind C.CInt
   deriving (Eq)

r2hc     :: Kind
r2hc     = Kind 0
hc2r     :: Kind
hc2r     = Kind 1
dht      :: Kind
dht      = Kind 2
redft00  :: Kind
redft00  = Kind 3
redft10  :: Kind
redft10  = Kind 5
redft01  :: Kind
redft01  = Kind 4
redft11  :: Kind
redft11  = Kind 6
rodft00  :: Kind
rodft00  = Kind 7
rodft10  :: Kind
rodft10  = Kind 9
rodft01  :: Kind
rodft01  = Kind 8
rodft11  :: Kind
rodft11  = Kind 10

{-# LINE 68 "src/Numeric/FFTW/FFI/Type.hsc" #-}


{- |
Corresponds to the @fftw_iodim@ structure.
It completely describes the layout of each dimension,
before and after the transform.
-}
data IODim = IODim {
     ioDimN  :: Int -- ^ Logical size of dimension
   , ioDimIS :: Int -- ^ Stride along dimension in input array
   , ioDimOS :: Int -- ^ Stride along dimension in output array
   }
   deriving (Eq, Show)

instance Storable IODim where
   sizeOf _ = (12)
{-# LINE 84 "src/Numeric/FFTW/FFI/Type.hsc" #-}
   alignment _ = 4
{-# LINE 85 "src/Numeric/FFTW/FFI/Type.hsc" #-}
   peek p = do
      n'  <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 87 "src/Numeric/FFTW/FFI/Type.hsc" #-}
      is' <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 88 "src/Numeric/FFTW/FFI/Type.hsc" #-}
      os' <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 89 "src/Numeric/FFTW/FFI/Type.hsc" #-}
      return (IODim n' is' os')
   poke p (IODim n' is' os') = do
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) p  n'
{-# LINE 92 "src/Numeric/FFTW/FFI/Type.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 4) p is'
{-# LINE 93 "src/Numeric/FFTW/FFI/Type.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 8) p os'
{-# LINE 94 "src/Numeric/FFTW/FFI/Type.hsc" #-}


type Plan a = Ptr (PlanObj a)
data PlanObj a = PlanObj