-- GENERATED by C->Haskell Compiler, version 0.28.2 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/CUDA/FFT/Plan.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Foreign.CUDA.FFT.Plan (

  -- * Context
  Handle(..),
  Type(..),
  plan1D,
  plan2D,
  plan3D,
  planMany,
  destroy,

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



-- Friends
import Foreign.CUDA.FFT.Error
import Foreign.CUDA.FFT.Internal.C2HS

-- System
import Foreign
import Foreign.C
import Control.Monad                            ( liftM )
import Data.Maybe



{-# LINE 28 "./Foreign/CUDA/FFT/Plan.chs" #-}



-- | Operations handle
--
newtype Handle = Handle { useHandle :: (C2HSImp.CInt)}

data Type = C2C
          | R2C
          | C2R
          | Z2Z
          | D2Z
          | Z2D
  deriving (Eq,Show)
instance Enum Type where
  succ C2C = R2C
  succ R2C = C2R
  succ C2R = Z2Z
  succ Z2Z = D2Z
  succ D2Z = Z2D
  succ Z2D = error "Type.succ: Z2D has no successor"

  pred R2C = C2C
  pred C2R = R2C
  pred Z2Z = C2R
  pred D2Z = Z2Z
  pred Z2D = D2Z
  pred C2C = error "Type.pred: C2C 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 Z2D

  fromEnum C2C = 41
  fromEnum R2C = 42
  fromEnum C2R = 44
  fromEnum Z2Z = 105
  fromEnum D2Z = 106
  fromEnum Z2D = 108

  toEnum 41 = C2C
  toEnum 42 = R2C
  toEnum 44 = C2R
  toEnum 105 = Z2Z
  toEnum 106 = D2Z
  toEnum 108 = Z2D
  toEnum unmatched = error ("Type.toEnum: Cannot match " ++ show unmatched)

{-# LINE 37 "./Foreign/CUDA/FFT/Plan.chs" #-}


-- Context management ----------------------------------------------------------
--

-- | Creates a 1D FFT plan configuration for a specified signal size and data type.
-- The third argument tells CUFFT how many 1D transforms to configure.
--
plan1D :: Int -> Type -> Int -> IO Handle
plan1D nx t batch = resultIfOk =<< cufftPlan1d nx t batch

cufftPlan1d :: (Int) -> (Type) -> (Int) -> IO ((Result), (Handle))
cufftPlan1d a2 a3 a4 =
  alloca $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = cFromEnum a3} in 
  let {a4' = fromIntegral a4} in 
  cufftPlan1d'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  peekHdl  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 52 "./Foreign/CUDA/FFT/Plan.chs" #-}

  where
    peekHdl = liftM Handle . peek

-- | Creates a 2D FFT plan configuration for a specified signal size and data type.
--
plan2D :: Int -> Int -> Type -> IO Handle
plan2D nx ny t = resultIfOk =<< cufftPlan2d nx ny t

cufftPlan2d :: (Int) -> (Int) -> (Type) -> IO ((Result), (Handle))
cufftPlan2d a2 a3 a4 =
  alloca $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = cFromEnum a4} in 
  cufftPlan2d'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  peekHdl  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 65 "./Foreign/CUDA/FFT/Plan.chs" #-}

  where
    peekHdl = liftM Handle . peek

-- | Creates a 3D FFT plan configuration for a specified signal size and data type.
--
plan3D :: Int -> Int -> Int -> Type -> IO Handle
plan3D nx ny nz t = resultIfOk =<< cufftPlan3d nx ny nz t

cufftPlan3d :: (Int) -> (Int) -> (Int) -> (Type) -> IO ((Result), (Handle))
cufftPlan3d a2 a3 a4 a5 =
  alloca $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = cFromEnum a5} in 
  cufftPlan3d'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = cToEnum res} in
  peekHdl  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 79 "./Foreign/CUDA/FFT/Plan.chs" #-}

  where
    peekHdl = liftM Handle . peek

-- | Creates a batched plan configuration for many signals of a specified size in
-- either 1, 2 or 3 dimensions, and of the specified data type.
--
planMany :: [Int]                   -- ^ The size of each dimension
         -> Maybe ([Int], Int, Int) -- ^ Storage dimensions of the output data,
                                    -- the stride, and the distance between
                                    -- signals for the input data
         -> Maybe ([Int], Int, Int) -- ^ As above but for the output data
         -> Type                    -- ^ The type of the transformation.
         -> Int                     -- ^ The batch size (either 1, 2 or 3)
         -> IO Handle
planMany n ilayout olayout t batch
  = do
      let (inembed, istride, idist) = fromMaybe ([], 0, 0) ilayout
      let (onembed, ostride, odist) = fromMaybe ([], 0, 0) olayout
      resultIfOk =<< cufftPlanMany (length n) n inembed istride idist onembed ostride odist t batch

cufftPlanMany :: (Int) -> ([Int]) -> ([Int]) -> (Int) -> (Int) -> ([Int]) -> (Int) -> (Int) -> (Type) -> (Int) -> IO ((Result), (Handle))
cufftPlanMany a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 =
  alloca $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  asArray a3 $ \a3' -> 
  asArray a4 $ \a4' -> 
  let {a5' = fromIntegral a5} in 
  let {a6' = fromIntegral a6} in 
  asArray a7 $ \a7' -> 
  let {a8' = fromIntegral a8} in 
  let {a9' = fromIntegral a9} in 
  let {a10' = cFromEnum a10} in 
  let {a11' = fromIntegral a11} in 
  cufftPlanMany'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' >>= \res ->
  let {res' = cToEnum res} in
  peekHdl  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 111 "./Foreign/CUDA/FFT/Plan.chs" #-}

  where
    peekHdl = liftM Handle . peek
    asArray [] f = f nullPtr
    asArray xs f = withArray (map fromIntegral xs) f

-- | This function releases hardware resources used by the CUFFT plan. The
-- release of GPU resources may be deferred until the application exits. This
-- function is usually the last call with a particular handle to the CUFFT
-- plan.
--
destroy :: Handle -> IO ()
destroy ctx = nothingIfOk =<< cufftDestroy ctx

cufftDestroy :: (Handle) -> IO ((Result))
cufftDestroy a1 =
  let {a1' = useHandle a1} in 
  cufftDestroy'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 126 "./Foreign/CUDA/FFT/Plan.chs" #-}



foreign import ccall unsafe "Foreign/CUDA/FFT/Plan.chs.h cufftPlan1d"
  cufftPlan1d'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/FFT/Plan.chs.h cufftPlan2d"
  cufftPlan2d'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/FFT/Plan.chs.h cufftPlan3d"
  cufftPlan3d'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "Foreign/CUDA/FFT/Plan.chs.h cufftPlanMany"
  cufftPlanMany'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))))))

foreign import ccall unsafe "Foreign/CUDA/FFT/Plan.chs.h cufftDestroy"
  cufftDestroy'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))