-- GENERATED by C->Haskell Compiler, version 0.26.1 Budburst, 4 April 2015 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Data/Grib/Raw/Value.chs" #-}
{- |
Module      : Data.Grib.Raw.Value
Copyright   : (c) Mattias Jakobsson 2015
License     : GPL-3

Maintainer  : mjakob422@gmail.com
Stability   : unstable
Portability : portable

Access GRIB header and data values.

Most of the documentation herein was copied from the official
documentation of
<https://software.ecmwf.int/wiki/display/GRIB/Module+Index grib_api>.
-}

module Data.Grib.Raw.Value
       ( -- * Get values
         gribGetLong
       , gribGetDouble
       , gribGetLongArray
       , gribGetDoubleArray
       , gribGetDoubleElement
       , gribGetDoubleElements
       , gribGetString
       , gribGetBytes

       , gribGetOffset
       , gribGetSize
       , gribGetLength

         -- * Set values
       , gribSetLong
       , gribSetDouble
       , gribSetLongArray
       , gribSetDoubleArray
       , gribSetString
       , gribSetBytes

         -- * Copy values
       , gribCopyNamespace
       ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign   ( Ptr, alloca, allocaArray, peek, peekArray, with
                 , withArrayLen )
import Foreign.C ( CDouble, CLong, CSize, CString, peekCStringLen, withCString )

import Data.Grib.Raw.Handle
{-# LINE 48 "src/Data/Grib/Raw/Value.chs" #-}

import Data.Grib.Raw.Marshal





{-# LINE 54 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_offset(grib_handle* h, const char* key, size_t* offset);
--
-- |Get the number offset of a key in a message if several keys of
-- the same name are present, the offset of the last one is returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
gribGetOffset :: (GribHandle) -> (Key) -> IO ((Int))
gribGetOffset a1 a2 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  gribGetOffset'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  peekIntegral  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 68 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_size(grib_handle* h, const char* key, size_t* size);
--
-- |Get the number of coded value from a key, if several keys of the
-- same name are present, the total sum is returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
gribGetSize :: (GribHandle) -> (Key) -> IO ((Int))
gribGetSize a1 a2 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  gribGetSize'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  peekIntegral  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 82 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_length(grib_handle* h, const char* key, size_t *length);
--
-- |Get the length of the string representation of the key, if several
-- keys of the same name are present, the maximum length is returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
gribGetLength :: (GribHandle) -> (Key) -> IO ((Int))
gribGetLength a1 a2 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  gribGetLength'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  peekIntegral  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 96 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_long(grib_handle* h, const char* key, long* value);
--
-- |Get a long value from a key, if several keys of the same name are
-- present, the last one is returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
gribGetLong :: (GribHandle) -> (Key) -> IO ((Int))
gribGetLong a1 a2 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  gribGetLong'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  peekIntegral  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 110 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_double(grib_handle* h, const char* key, double* value);
--
-- |Get a double value from a key, if several keys of the same name
-- are present, the last one is returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
gribGetDouble :: (GribHandle) -> (Key) -> IO ((Double))
gribGetDouble a1 a2 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  gribGetDouble'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  peekReal  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 124 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_double_element(grib_handle* h, const char* key, int i,
--                             double* value);
--
-- There are no bounds check on i and a too large i often doesn't seem
-- to lead to a segmentation fault.
--
-- |Get as double the i-th element of the "key" array.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
--
-- __WARNING!__ There is no check if the index is out of bounds.
gribGetDoubleElement :: (GribHandle) -> (Key) -> (Int) -> IO ((Double))
gribGetDoubleElement a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  alloca $ \a4' -> 
  gribGetDoubleElement'_ a1' a2' a3' a4' >>= \res ->
  checkStatus res >> 
  peekReal  a4'>>= \a4'' -> 
  return (a4'')

{-# LINE 144 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_double_elements(grib_handle* h, const char* key, int* i,
--                              long size, double* value);
--
-- This function is not macro expanded since the length of the output
-- arguments depend on the length of the input arguments.
--
-- |Get as double array the elements of the "key" array whose indexes
-- are listed in the input array i.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
--
-- __WARNING!__ There is no check if the indices are out of bounds.
gribGetDoubleElements :: GribHandle -> Key -> [Int] -> IO [Double]
gribGetDoubleElements h key is =
  withGribHandle h                   $ \h'    ->
  withCString key                    $ \key'  ->
  withArrayLen (map fromIntegral is) $ \n is' ->
  allocaArray n                      $ \ds    -> do
    cCall h' key' is' (fromIntegral n) ds >>= checkStatus
    fmap (map realToFrac) $ peekArray n ds
  where cCall = grib_get_double_elements
{-# LINE 168 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_string(grib_handle* h, const char* key, char* mesg,
--                     size_t *length);
--
-- This function is not macro expanded since an output marshaller
-- would want to return another data type than the corresponding input
-- marshaller accepts.
--
-- |Get a string value from a key, if several keys of the same name
-- are present, the last one is returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribBufferTooSmall@ if the allocated string is
--   too small.
--
-- This function takes an allocated 'CString' and its length, which is
-- used to retrieve the string returned by the IO action.  The
-- 'CString' is not automatically allocated by this function since it
-- could potentially be re-used between multiple calls and the length
-- is not known beforehand.
gribGetString :: GribHandle  -- ^the handle to get the data from
              -> Key         -- ^the key to be searched
              -> CString     -- ^the address of a string where the
                             -- data will be retrieved
              -> Int         -- ^the allocated length of the string
              -> IO String   -- ^an IO action that will return the
                             -- string
gribGetString h key cs n =
  withGribHandle h      $ \h'   ->
  withCString key       $ \key' ->
  with (fromIntegral n) $ \n'   -> do
    cCall h' key' cs n' >>= checkStatus
    fmap (fromIntegral . subtract 1) (peek n') >>= curry peekCStringLen cs
  where cCall = grib_get_string
{-# LINE 205 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_bytes(grib_handle* h, const char* key, unsigned char* bytes,
--                    size_t *length);
--
-- |Get raw bytes values from a key.
--
-- If several keys of the same name are present, the last one is
-- returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribArrayTooSmall@ if the allocated array is
--   too small.
gribGetBytes :: (GribHandle) -- ^the handle to get the data from
 -> (Key) -- ^the key to be searched
 -> (Bytes) -- ^the address of a byte array where the data will be retrieved
 -> (Int) -- ^the allocated length of the byte array
 -> IO ((Bytes), (Int)) -- ^an IO action that will return the address of the byte array  and the number of bytes retrieved

gribGetBytes a1 a2 a3 a4 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = id a3} in 
  withIntegral a4 $ \a4' -> 
  gribGetBytes'_ a1' a2' a3' a4' >>= \res ->
  checkStatus res >> 
  let {a3'' = id  a3'} in 
  peekIntegral  a4'>>= \a4'' -> 
  return (a3'', a4'')

{-# LINE 233 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_double_array(grib_handle* h, const char* key, double* vals,
--                           size_t *length);
--
-- This function is not macro expanded since an output marshaller
-- would want to return another data type than the corresponding input
-- marshaller accepts.
--
-- |Get double array values from a key.
--
-- If several keys of the same name are present, the last one is
-- returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribArrayTooSmall@ if the allocated array is
--   too small.
--
-- This function takes an allocated array and its length, which is
-- used to retrieve the list returned by the IO action.  The array is
-- not automatically allocated by this function since it could
-- potentially be re-used between multiple calls and the length is not
-- known beforehand.
gribGetDoubleArray :: GribHandle   -- ^the handle to get the data from
                   -> Key          -- ^the key to be searched
                   -> Ptr CDouble  -- ^the address of a double array
                                   -- where the data will be retrieved
                   -> Int          -- ^the allocated length of the double
                                   -- array
                   -> IO [Double]  -- ^an IO action that will return the
                                   -- data in a list
gribGetDoubleArray h key ds n = withGribHandle h $ \h' ->
  fmap (map realToFrac) $ getArray (cCall h') key ds n
  where cCall = grib_get_double_array
{-# LINE 269 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_get_long_array(grib_handle* h, const char* key, long* vals,
--                         size_t *length);
--
-- This function is not macro expanded since an output marshaller
-- would want to return another data type than the corresponding input
-- marshaller accepts.
--
-- |Get long array values from a key.
--
-- If several keys of the same name are present, the last one is
-- returned.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribArrayTooSmall@ if the allocated array is
--   too small.
--
-- This function takes an allocated array and its length, which is
-- used to retrieve the list returned by the IO action.  The array is
-- not automatically allocated by this function since it could
-- potentially be re-used between multiple calls and the length is not
-- known beforehand.
gribGetLongArray :: GribHandle  -- ^the handle to get the data from
                 -> Key         -- ^the key to be searched
                 -> Ptr CLong   -- ^the address of a long array where
                                -- the data will be retrieved
                 -> Int         -- ^the allocated length of the long
                                -- array
                 -> IO [Int]    -- ^an IO action that will return the
                                -- data in a list
gribGetLongArray h key ls n = withGribHandle h $ \h' ->
  fmap (map fromIntegral) $ getArray (cCall h') key ls n
  where cCall = grib_get_long_array
{-# LINE 305 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_copy_namespace(grib_handle* dest, const char* name,
--                         grib_handle* src);
--
-- |Copy the keys belonging to a given namespace from a source handle
-- to a destination handle.
--
-- This operation may fail with:
--
--   * @isGribException GribNotImplemented@.
gribCopyNamespace :: (GribHandle) -- ^destination handle
 -> (Maybe String) -- ^namespace (pass @Nothing@  to copy all keys)
 -> (GribHandle) -- ^source handle
 -> IO () -- ^an IO action that will  copy the keys

gribCopyNamespace a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  maybeWithCString a2 $ \a2' -> 
  (withGribHandle) a3 $ \a3' -> 
  gribCopyNamespace'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 323 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_set_long(grib_handle* h, const char* key, long val);
--
-- |Set a long value from a key.
--
-- If several keys of the same name are present, the last one is set.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribReadOnly@ if the key is read-only.
gribSetLong :: (GribHandle) -> (Key) -> (Int) -> IO ()
gribSetLong a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  gribSetLong'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 340 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_set_double(grib_handle* h, const char* key, double val);
--

-- |Set a double value from a key.
--
-- If several keys of the same name are present, the last one is set.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribReadOnly@ if the key is read-only.
gribSetDouble :: (GribHandle) -> (Key) -> (Double) -> IO ()
gribSetDouble a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = realToFrac a3} in 
  gribSetDouble'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 358 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_set_string(grib_handle* h, const char* key, const char* mesg,
--                     size_t *length);
--
-- This function is not macro expanded since an output marshaller
-- would want to return another data type than the corresponding input
-- marshaller accepts.
--
-- |Set a string value from a key and return the actual packed length.
--
-- If several keys of the same name are present, the last one is set.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribReadOnly@ if the key is read-only.
gribSetString :: GribHandle -> Key -> String -> IO Int
gribSetString h key msg =
  withGribHandle h                 $ \h'   ->
  withCString key                  $ \key' ->
  withCString msg                  $ \msg' ->
  with (fromIntegral $ length msg) $ \n    -> do
    cCall h' key' msg' n >>= checkStatus
    fmap fromIntegral $ peek n
  where cCall = grib_set_string
{-# LINE 384 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_set_bytes(grib_handle* h, const char* key,
--                    const unsigned char* bytes, size_t *length);
--
-- |Set a bytes array from a key and return the actual packed length.
--
-- If several keys of the same name are present, the last one is set.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing.
gribSetBytes :: (GribHandle) -> (Key) -> (Bytes) -> (Int) -> IO ((Int))
gribSetBytes a1 a2 a3 a4 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = id a3} in 
  withIntegral a4 $ \a4' -> 
  gribSetBytes'_ a1' a2' a3' a4' >>= \res ->
  checkStatus res >> 
  peekIntegral  a4'>>= \a4'' -> 
  return (a4'')

{-# LINE 401 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_set_double_array(grib_handle* h, const char* key,
--                           const double* vals, size_t length);
--
-- |Set a double array from a key.
--
-- If several keys of the same name are present, the last one is set.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribReadOnly@ if the key is read-only.
--
-- __WARNING!__ Strange things seem to happen if an empty list is
-- passed in.
gribSetDoubleArray :: (GribHandle) -> (Key) -> ([Double]) -> IO ()
gribSetDoubleArray a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  withRealArrayLen a3 $ \(a3'1, a3'2) -> 
  gribSetDoubleArray'_ a1' a2' a3'1  a3'2 >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 422 "src/Data/Grib/Raw/Value.chs" #-}


-- int grib_set_long_array(grib_handle* h, const char* key, const long* vals,
--                         size_t length);
--
-- |Set a long array from a key.
--
-- If several keys of the same name are present, the last one is set.
--
-- This operation may fail with:
--
--   * @isGribException GribNotFound@ if the key is missing; or
--
--   * @isGribException GribReadOnly@ if the key is read-only.
gribSetLongArray :: (GribHandle) -> (Key) -> ([Int]) -> IO ()
gribSetLongArray a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  withIntegralArrayLen a3 $ \(a3'1, a3'2) -> 
  gribSetLongArray'_ a1' a2' a3'1  a3'2 >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 440 "src/Data/Grib/Raw/Value.chs" #-}


foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_offset"
  gribGetOffset'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_size"
  gribGetSize'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_length"
  gribGetLength'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_long"
  gribGetLong'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_double"
  gribGetDouble'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_double_element"
  gribGetDoubleElement'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_double_elements"
  grib_get_double_elements :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CLong -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_string"
  grib_get_string :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_bytes"
  gribGetBytes'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_double_array"
  grib_get_double_array :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_get_long_array"
  grib_get_long_array :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CLong) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_copy_namespace"
  gribCopyNamespace'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (GribHandle)) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_set_long"
  gribSetLong'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_set_double"
  gribSetDouble'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CDouble -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_set_string"
  grib_set_string :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_set_bytes"
  gribSetBytes'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_set_double_array"
  gribSetDoubleArray'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (CSize -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/Grib/Raw/Value.chs.h grib_set_long_array"
  gribSetLongArray'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CLong) -> (CSize -> (IO C2HSImp.CInt)))))