-- 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/Predict/Internal/Raw.chs" #-}
-----------------------------------------------------------
-- |
-- module:                      MXNet.Core.Predict.Internal.Raw
-- copyright:                   (c) 2016 Tao He
-- license:                     MIT
-- maintainer:                  sighingnow@gmail.com
--
-- Direct C FFI bindings for <mxnet/c_predict_api.h>.
--
{-# LANGUAGE Safe #-}
{-# LANGUAGE ForeignFunctionInterface #-}

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



import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable

import C2HS.C.Extra.Marshal

import MXNet.Core.Types.Internal.Raw
{-# LINE 27 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}




-- | Create a predictor.
mxPredCreate :: (String) -- ^ The JSON string of the symbol.
 -> (Ptr ()) -- ^ The in-memory raw bytes of parameter ndarray file.
 -> (Int) -- ^ The size of parameter ndarray file.
 -> (Int) -- ^ The device type, 1: cpu, 2:gpu.
 -> (Int) -- ^ The device id of the predictor.
 -> (MXUInt) -- ^ Number of input nodes to the net.
 -> ([String]) -- ^ The name of input argument.
 -> ([MXUInt]) -> ([MXUInt]) -> IO ((Int), (PredictorHandle)) -- ^ The created predictor handle.

mxPredCreate a1 a2 a3 a4 a5 a6 a7 a8 a9 =
  C2HSImp.withCString a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  let {a6' = id a6} in 
  withStringArray a7 $ \a7' -> 
  withArray a8 $ \a8' -> 
  withArray a9 $ \a9' -> 
  alloca $ \a10' -> 
  mxPredCreate'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a10'>>= \a10'' -> 
  return (res', a10'')

{-# LINE 44 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Create a predictor wich customized outputs.
mxPredCreatePartialOut :: (String) -> (Ptr ()) -> (Int) -> (Int) -> (Int) -> (MXUInt) -> ([String]) -- ^ The names of input arguments.
 -> ([MXUInt]) -> ([MXUInt]) -> (MXUInt) -- ^ Number of output nodes to the net.
 -> IO ((Int), (String), (PredictorHandle)) -- ^ The name of output argument and created predictor handle.

mxPredCreatePartialOut a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 =
  C2HSImp.withCString a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  let {a6' = id a6} in 
  withStringArray a7 $ \a7' -> 
  withArray a8 $ \a8' -> 
  withArray a9 $ \a9' -> 
  let {a10' = id a10} in 
  alloca $ \a11' -> 
  alloca $ \a12' -> 
  mxPredCreatePartialOut'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a11'>>= \a11'' -> 
  peek  a12'>>= \a12'' -> 
  return (res', a11'', a12'')

{-# LINE 61 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


mxPredGetOutputShapeImpl :: (PredictorHandle) -> (MXUInt) -> IO ((Int), (Ptr MXUInt), (MXUInt))
mxPredGetOutputShapeImpl a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  mxPredGetOutputShapeImpl'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  return (res', a3'', a4'')

{-# LINE 68 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Get the shape of output node.
mxPredGetOutputShape :: PredictorHandle             -- ^ The predictor handle.
                     -> MXUInt                      -- ^ The index of output node, set to 0
                                                    -- if there is only one output.
                     -> IO (Int, [MXUInt], MXUInt)  -- ^ Output dimension and the shape data.
mxPredGetOutputShape handle index = do
    (res, p, d) <- mxPredGetOutputShapeImpl handle index
    shapes <- peekArray (fromIntegral d) p
    return (res, shapes, d)

-- | Set the input data of predictor.
mxPredSetInput :: (PredictorHandle) -> (String) -- ^ The name of input node to set.
 -> ([MXFloat]) -- ^ The pointer to the data to be set.
 -> (MXUInt) -- ^ The size of data array, used for safety check.
 -> IO ((Int))
mxPredSetInput a1 a2 a3 a4 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  withArray a3 $ \a3' -> 
  let {a4' = id a4} in 
  mxPredSetInput'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 86 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Run a forward pass to get the output.
mxPredForward :: (PredictorHandle) -> IO ((Int))
mxPredForward a1 =
  let {a1' = id a1} in 
  mxPredForward'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 91 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Run a interactive forward pass to get the output.
mxPredPartialForward :: (PredictorHandle) -> (Int) -- ^ The current step to run forward on.
 -> IO ((Int), (Int)) -- ^ The number of steps left.

mxPredPartialForward a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  mxPredPartialForward'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 99 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Get the output value of prediction.
mxPredGetOutput :: (PredictorHandle) -> (MXUInt) -- ^ The index of output node, set to 0 if there is only one output.
 -> (Ptr MXFloat) -- ^ __/User allocated/__ data to hold the output.
 -> (MXUInt) -- ^ The size of data array, used for safe checking.
 -> IO ((Int))
mxPredGetOutput a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  let {a4' = id a4} in 
  mxPredGetOutput'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 107 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Free a predictor handle.
mxPredFree :: (PredictorHandle) -> IO ((Int))
mxPredFree a1 =
  let {a1' = id a1} in 
  mxPredFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 112 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Create a NDArray List by loading from ndarray file.
mxNDListCreate :: (Ptr CChar) -- ^ The byte contents of nd file to be loaded.
 -> (Int) -- ^ The size of the nd file to be loaded.
 -> IO ((Int), (NDListHandle), (MXUInt)) -- ^ The out put NDListHandle and length of the list.

mxNDListCreate a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  mxNDListCreate'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  return (res', a3'', a4'')

{-# LINE 121 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


mxNDListGetImpl :: (NDListHandle) -> (MXUInt) -> IO ((Int), (String), (Ptr MXFloat), (Ptr MXUInt), (MXUInt))
mxNDListGetImpl a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  alloca $ \a6' -> 
  mxNDListGetImpl'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  peek  a5'>>= \a5'' -> 
  peek  a6'>>= \a6'' -> 
  return (res', a3'', a4'', a5'', a6'')

{-# LINE 130 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


-- | Get an element from list.
mxNDListGet :: NDListHandle
            -> MXUInt                                       -- ^ The index in the list.
            -> IO (Int,
                   String, Ptr MXFloat, [MXUInt], MXUInt)   -- ^ The name of output, the data
                                                            -- region of the item, the shape of
                                                            -- the item and shape's dimension.
mxNDListGet handle index = do
    (res, name, output, p, d) <- mxNDListGetImpl handle index
    shapes <- peekArray (fromIntegral d) p
    return (res, name, output, shapes, d)

-- | Free a predictor handle.
mxNDListFree :: (NDListHandle) -> IO ((Int))
mxNDListFree a1 =
  let {a1' = id a1} in 
  mxNDListFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 147 "src/MXNet/Core/Predict/Internal/Raw.chs" #-}


foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredCreate"
  mxPredCreate'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (PredictorHandle)) -> (IO C2HSImp.CInt)))))))))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredCreatePartialOut"
  mxPredCreatePartialOut'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (PredictorHandle)) -> (IO C2HSImp.CInt)))))))))))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredGetOutputShape"
  mxPredGetOutputShapeImpl'_ :: ((PredictorHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredSetInput"
  mxPredSetInput'_ :: ((PredictorHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredForward"
  mxPredForward'_ :: ((PredictorHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredPartialForward"
  mxPredPartialForward'_ :: ((PredictorHandle) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredGetOutput"
  mxPredGetOutput'_ :: ((PredictorHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXPredFree"
  mxPredFree'_ :: ((PredictorHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXNDListCreate"
  mxNDListCreate'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (NDListHandle)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXNDListGet"
  mxNDListGetImpl'_ :: ((NDListHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CFloat)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "MXNet/Core/Predict/Internal/Raw.chs.h MXNDListFree"
  mxNDListFree'_ :: ((NDListHandle) -> (IO C2HSImp.CInt))