-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/CUDA/FFT/Plan.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module      : Foreign.CUDA.FFT.Plan
-- Copyright   : [2013..2018] Robert Clifton-Everest, Trevor L. McDonell
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Foreign.CUDA.FFT.Plan (

  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 36 "./Foreign/CUDA/FFT/Plan.chs" #-}



-- | A handle used to store and access cuFFT plans.
--
-- A handle is created by the FFT planning functions (e.g. 'plan1D') and used
-- during execution of the transforms (e.g. 'Foreign.CUDA.FFT.Execute.execC2C').
--
-- The handle may be reused, but should be 'destroy'ed once it is no longer
-- required, in order to release associated GPU memory and other resources.
--
newtype Handle = Handle { useHandle :: (C2HSImp.CInt)}


-- | The cuFFT library supports complex- and real-valued transforms. This data
-- type enumerates the kind of transform a plan will execute.
--
-- Key:
--
--   * __R__: real (32-bit float)
--   * __D__: double (64-bit float)
--   * __C__: single-precision complex numbers (32-bit, interleaved)
--   * __Z__: double-precision complex numbers (64-bit, interleaved)
--
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 62 "./Foreign/CUDA/FFT/Plan.chs" #-}


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

-- |

-- | Creates a 1D FFT plan configured for a specified signal size and data type.
--
-- The third argument tells cuFFT how many 1D transforms, of size given by the
-- first argument, to configure. Consider using 'planMany' for multiple
-- transforms instead.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftplan1d>
--
{-# INLINEABLE plan1D #-}
plan1D :: (Int) -- ^ Size of the transformation
 -> (Type) -- ^ Transformation data type
 -> (Int) -- ^ Number of one-dimensional transforms to configure
 -> IO ((Handle))
plan1D a2 a3 a4 =
  alloca $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = cFromEnum a3} in 
  let {a4' = fromIntegral a4} in 
  plan1D'_ a1' a2' a3' a4' >>= \res ->
  checkStatus res >> 
  peekHdl  a1'>>= \a1'' -> 
  return (a1'')

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

  where
    peekHdl = liftM Handle . peek


-- | Creates a 2D FFT plan configuration for a specified signal size and data type.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftplan2d>
--
{-# INLINEABLE plan2D #-}
plan2D :: (Int) -- ^ The transform size in the /x/-dimension. This is the slowest changing dimension of a transform (strided in memory)
 -> (Int) -- ^ The transform size in the /y/-dimension. This is the fastest changing dimension of a transform (contiguous in memory)
 -> (Type) -- ^ Transformation data type
 -> IO ((Handle))
plan2D a2 a3 a4 =
  alloca $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = cFromEnum a4} in 
  plan2D'_ a1' a2' a3' a4' >>= \res ->
  checkStatus res >> 
  peekHdl  a1'>>= \a1'' -> 
  return (a1'')

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

  where
    peekHdl = liftM Handle . peek


-- | Creates a 3D FFT plan configuration for a specified signal size and data type.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftplan3d>
--
{-# INLINEABLE plan3D #-}
plan3D :: (Int) -- ^ The transform size in the /x/-dimension. This is the slowest changing dimension of the transform (strided in memory)
 -> (Int) -- ^ The transform size in the /y/-dimension.
 -> (Int) -- ^ The transform size in the /z/-dimension. This is the fastest changing dimension of the transform (contiguous in memory)
 -> (Type) -- ^ Transformation data type
 -> IO ((Handle))
plan3D 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 
  plan3D'_ a1' a2' a3' a4' a5' >>= \res ->
  checkStatus res >> 
  peekHdl  a1'>>= \a1'' -> 
  return (a1'')

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

  where
    peekHdl = liftM Handle . peek


-- | Creates a batched plan configuration for many signals of a specified size
-- and data type in either 1, 2 or 3 dimensions.
--
-- This function supports more complicated input and output data layouts. If not
-- specified (that is, 'Nothing' is passed for either of the second or third
-- parameters), contiguous data arrays are assumed.
--
-- Data layout configuration consists of three fields, respectively:
--
--   * storage dimensions of the input data in memory
--   * the distance between two successive input elements in the innermost (least significant) dimension
--   * the distance between the first element of two consecutive signals in a batch of the input data
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftplanmany>
--
planMany :: [Int]                   -- ^ The size of the transform in each dimension, where @(n !! 0)@ is the size of the outermost dimension, and @(n !! rank-1)@ the size of the innermost (contiguous) dimension of the transform.
         -> Maybe ([Int], Int, Int) -- ^ Input data layout. If 'Nothing', the data is assumed to be contiguous.
         -> Maybe ([Int], Int, Int) -- ^ Output data layout. If 'Nothing', the data is stored contiguously.
         -> Type                    -- ^ Transformation type
         -> Int                     -- ^ Batch size for this transform
         -> IO Handle
planMany n ilayout olayout t batch =
  cufftPlanMany (length n) n inembed istride idist onembed ostride odist t batch
  where
    (inembed, istride, idist) = fromMaybe ([], 0, 0) ilayout
    (onembed, ostride, odist) = fromMaybe ([], 0, 0) olayout

    peekHdl = liftM Handle . peek

    asArray [] f = f nullPtr
    asArray xs f = withArray (map fromIntegral xs) f

    cufftPlanMany :: (Int) -> ([Int]) -> ([Int]) -> (Int) -> (Int) -> ([Int]) -> (Int) -> (Int) -> (Type) -> (Int) -> IO ((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 ->
      checkStatus res >> 
      peekHdl  a1'>>= \a1'' -> 
      return (a1'')

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



-- | Release resources associated with the given plan. This function should be
-- called once a plan is no longer needed, to avoid wasting GPU memory.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftdestroy>
--
{-# INLINEABLE destroy #-}
destroy :: (Handle) -> IO ()
destroy a1 =
  let {a1' = useHandle a1} in 
  destroy'_ a1' >>= \res ->
  checkStatus res >> 
  return ()

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



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

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

foreign import ccall unsafe "Foreign/CUDA/FFT/Plan.chs.h cufftPlan3d"
  plan3D'_ :: ((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"
  destroy'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))