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


{-# LINE 1 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
-----------------------------------------------------------
-- |
-- module:                      MXNet.Core.Types.Internal.Raw
-- copyright:                   (c) 2016-2017 Tao He
-- license:                     MIT
-- maintainer:                  sighingnow@gmail.com
--
-- Collect data type defintions into a single raw binding module to avoid redefinitions.
--
{-# LANGUAGE Safe #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module MXNet.Core.Types.Internal.Raw where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable





-- | Handle size_t type.

{-# LINE 28 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


{---------------------------------------------------------------------
- Primitive type alias.
---------------------------------------------------------------------}

-- | NNUint type alias.
type NNUInt = CUInt

-- | MXUint type alias.
type MXUInt = CUInt

-- | MXFloat type alias.
type MXFloat = CFloat

{---------------------------------------------------------------------
- <nnvm/c_api.h>
---------------------------------------------------------------------}

-- | Handle to a function that takes param and creates symbol.

type OpHandle = C2HSImp.Ptr (())
{-# LINE 49 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


{- FIXME maybe a bug from c2hs, when make a type alias of OpHandle, the
   generated CFFI function will not be correct.

{#pointer OpHandle newtype #}

instance Storable OpHandle where
    sizeOf (OpHandle t) = sizeOf t
    alignment (OpHandle t) = alignment t
    peek p = fmap OpHandle (peek (castPtr p))
    poke p (OpHandle t) = poke (castPtr p) t

--}

-- | Handle to a symbol that can be bind as operator.
newtype SymbolHandle = SymbolHandle (C2HSImp.Ptr (SymbolHandle))
{-# LINE 65 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable SymbolHandle where
    sizeOf (SymbolHandle t) = sizeOf t
    alignment (SymbolHandle t) = alignment t
    peek p = fmap SymbolHandle (peek (castPtr p))
    poke p (SymbolHandle t) = poke (castPtr p) t

-- | Handle to Graph.
newtype GraphHandle = GraphHandle (C2HSImp.Ptr (GraphHandle))
{-# LINE 74 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable GraphHandle where
    sizeOf (GraphHandle t) = sizeOf t
    alignment (GraphHandle t) = alignment t
    peek p = fmap GraphHandle (peek (castPtr p))
    poke p (GraphHandle t) = poke (castPtr p) t

{---------------------------------------------------------------------
- <mxnet/c_api.h>
---------------------------------------------------------------------}

-- | Handle to NDArray.
newtype NDArrayHandle = NDArrayHandle (C2HSImp.Ptr (NDArrayHandle))
{-# LINE 87 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable NDArrayHandle where
    sizeOf (NDArrayHandle t) = sizeOf t
    alignment (NDArrayHandle t) = alignment t
    peek p = fmap NDArrayHandle (peek (castPtr p))
    poke p (NDArrayHandle t) = poke (castPtr p) t

-- | Handle to a mxnet narray function that changes NDArray.
newtype FunctionHandle = FunctionHandle (C2HSImp.Ptr (FunctionHandle))
{-# LINE 96 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable FunctionHandle where
    sizeOf (FunctionHandle t) = sizeOf t
    alignment (FunctionHandle t) = alignment t
    peek p = fmap FunctionHandle (peek (castPtr p))
    poke p (FunctionHandle t) = poke (castPtr p) t

-- | Handle to a function that takes param and creates symbol.
type AtomicSymbolCreator = OpHandle

-- | Handle to a AtomicSymbol.
newtype AtomicSymbolHandle = AtomicSymbolHandle (C2HSImp.Ptr (AtomicSymbolHandle))
{-# LINE 108 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable AtomicSymbolHandle where
    sizeOf (AtomicSymbolHandle t) = sizeOf t
    alignment (AtomicSymbolHandle t) = alignment t
    peek p = fmap AtomicSymbolHandle (peek (castPtr p))
    poke p (AtomicSymbolHandle t) = poke (castPtr p) t

newtype ExecutorHandle = ExecutorHandle (C2HSImp.Ptr (ExecutorHandle))
{-# LINE 116 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


-- | Handle to an Executor.
instance Storable ExecutorHandle where
    sizeOf (ExecutorHandle t) = sizeOf t
    alignment (ExecutorHandle t) = alignment t
    peek p = fmap ExecutorHandle (peek (castPtr p))
    poke p (ExecutorHandle t) = poke (castPtr p) t

-- | Handle a dataiter creator.
newtype DataIterCreator = DataIterCreator (C2HSImp.Ptr (DataIterCreator))
{-# LINE 126 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable DataIterCreator where
    sizeOf (DataIterCreator t) = sizeOf t
    alignment (DataIterCreator t) = alignment t
    peek p = fmap DataIterCreator (peek (castPtr p))
    poke p (DataIterCreator t) = poke (castPtr p) t

-- | Handle to a DataIterator.
newtype DataIterHandle = DataIterHandle (C2HSImp.Ptr (DataIterHandle))
{-# LINE 135 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable DataIterHandle where
    sizeOf (DataIterHandle t) = sizeOf t
    alignment (DataIterHandle t) = alignment t
    peek p = fmap DataIterHandle (peek (castPtr p))
    poke p (DataIterHandle t) = poke (castPtr p) t

-- | Handle to KVStore.
newtype KVStoreHandle = KVStoreHandle (C2HSImp.Ptr (KVStoreHandle))
{-# LINE 144 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable KVStoreHandle where
    sizeOf (KVStoreHandle t) = sizeOf t
    alignment (KVStoreHandle t) = alignment t
    peek p = fmap KVStoreHandle (peek (castPtr p))
    poke p (KVStoreHandle t) = poke (castPtr p) t

-- | Handle to RecordIO.
newtype RecordIOHandle = RecordIOHandle (C2HSImp.Ptr (RecordIOHandle))
{-# LINE 153 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable RecordIOHandle where
    sizeOf (RecordIOHandle t) = sizeOf t
    alignment (RecordIOHandle t) = alignment t
    peek p = fmap RecordIOHandle (peek (castPtr p))
    poke p (RecordIOHandle t) = poke (castPtr p) t

-- | Handle to MXRtc.
newtype RtcHandle = RtcHandle (C2HSImp.Ptr (RtcHandle))
{-# LINE 162 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable RtcHandle where
    sizeOf (RtcHandle t) = sizeOf t
    alignment (RtcHandle t) = alignment t
    peek p = fmap RtcHandle (peek (castPtr p))
    poke p (RtcHandle t) = poke (castPtr p) t

-- | Callback: ExecutorMonitorCallback.
newtype ExecutorMonitorCallback = ExecutorMonitorCallback (C2HSImp.FunPtr (ExecutorMonitorCallback))
{-# LINE 171 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


-- | Callback: CustomOpPropCreator.
newtype CustomOpPropCreator = CustomOpPropCreator (C2HSImp.FunPtr (CustomOpPropCreator))
{-# LINE 174 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


-- | Callback: MXKVStoreUpdater, user-defined updater for the kvstore.
type MXKVStoreUpdater = Int             -- ^ The key.
                      -> NDArrayHandle  -- ^ The pushed value on the key.
                      -> NDArrayHandle  -- ^ The value stored on local on the key.
                      -> Ptr ()         -- ^ The additional handle to the updater.
                      -> IO Int

foreign import ccall "wrapper"
    makeMXKVStoreUpdater :: MXKVStoreUpdater -> IO (FunPtr MXKVStoreUpdater)

-- | Callback: MXKVStoreServerController, the prototype of a server controller.
type MXKVStoreServerController = Int        -- ^ The head of the command.
                               -> Ptr CChar -- ^ The body of the command.
                               -> Ptr ()    -- ^ Helper handle for implementing controller.
                               -> IO Int

foreign import ccall "wrapper"
    makeMXKVStoreServerController :: MXKVStoreServerController -> IO (FunPtr MXKVStoreServerController)

{---------------------------------------------------------------------
- <mxnet/c_predict_api.h>
---------------------------------------------------------------------}

-- | Handle to Predictor.
newtype PredictorHandle = PredictorHandle (C2HSImp.Ptr (PredictorHandle))
{-# LINE 200 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable PredictorHandle where
    sizeOf (PredictorHandle t) = sizeOf t
    alignment (PredictorHandle t) = alignment t
    peek p = fmap PredictorHandle (peek (castPtr p))
    poke p (PredictorHandle t) = poke (castPtr p) t

-- | Handle to NDArrayList.
newtype NDListHandle = NDListHandle (C2HSImp.Ptr (NDListHandle))
{-# LINE 209 "src/MXNet/Core/Types/Internal/Raw.chs" #-}


instance Storable NDListHandle where
    sizeOf (NDListHandle t) = sizeOf t
    alignment (NDListHandle t) = alignment t
    peek p = fmap NDListHandle (peek (castPtr p))
    poke p (NDListHandle t) = poke (castPtr p) t