-- 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/Handle.chs" #-}
{- |
Module      : Data.Grib.Raw.Handle
Copyright   : (c) Mattias Jakobsson 2015
License     : GPL-3

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

The grib_handle is the structure giving access to parsed grib values
by keys.

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

{-# LANGUAGE TupleSections #-}

module Data.Grib.Raw.Handle
       ( -- * The GRIB Handle
         GribHandle(..)
       , gribHandleNewFromFile
       , gribHandleNewFromTemplate
       , gribHandleNewFromSamples
       , gribHandleClone
       , gribWriteMessage
       , withGribHandle

         -- ** Operations on raw messages
       , gribGetMessage
       , gribGetMessageCopy
       , gribHandleNewFromMessage
       , gribHandleNewFromMessageCopy
       , gribHandleNewFromMultiMessage

         -- * The GRIB Multi Field Handle
       , GribMultiHandle(..)
       , gribMultiHandleNew
       , gribMultiHandleAppend
       , gribMultiHandleWrite
       , withGribMultiHandle

         -- * Utilities
       , gribCountInFile
       ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign
import Foreign.C

import Data.Grib.Raw.CFile
{-# LINE 51 "src/Data/Grib/Raw/Handle.chs" #-}

import Data.Grib.Raw.Context
{-# LINE 52 "src/Data/Grib/Raw/Handle.chs" #-}

import Data.Grib.Raw.Marshal





{-# LINE 58 "src/Data/Grib/Raw/Handle.chs" #-}


{-# LINE 59 "src/Data/Grib/Raw/Handle.chs" #-}


-- typedef struct grib_handle grib_handle;
--
-- |Grib handle, structure giving access to parsed grib values by
-- keys.
newtype GribHandle = GribHandle (C2HSImp.ForeignPtr (GribHandle))
withGribHandle :: GribHandle -> (C2HSImp.Ptr GribHandle -> IO b) -> IO b
withGribHandle (GribHandle fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 67 "src/Data/Grib/Raw/Handle.chs" #-}


instance Eq GribHandle where
  GribHandle f1 == GribHandle f2 = f1 == f2

instance Show GribHandle where
  show (GribHandle f) = "GribHandle " ++ show f

checkHandle :: Ptr GribHandle -> IO GribHandle
checkHandle = checkForeignPtr GribHandle gribHandleFinalizer

-- int grib_count_in_file(grib_context *c, FILE *f, int *n);
--
-- |Counts the messages contained in a file resource.
gribCountInFile :: (GribContext) -> (CFilePtr) -> IO ((Int))
gribCountInFile a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  gribCountInFile'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  peekIntegral  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 85 "src/Data/Grib/Raw/Handle.chs" #-}


-- grib_handle* grib_handle_new_from_file(grib_context* c, FILE* f, int* error);
--
-- |Create a handle from a file resource.
--
-- The file is read until a message is found. The message is then
-- copied.
gribHandleNewFromFile :: (GribContext) -> (CFilePtr) -> IO ((GribHandle))
gribHandleNewFromFile a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  gribHandleNewFromFile'_ a1' a2' a3' >>= \res ->
  (\x -> C2HSImp.newForeignPtr gribHandleFinalizer x >>= (return . GribHandle)) res >>= \res' ->
  checkStatusPtr  a3'>>
  return (res')

{-# LINE 97 "src/Data/Grib/Raw/Handle.chs" #-}


-- int grib_write_message(grib_handle* h,const char* file,const char* mode);
--
-- |Write a coded message to a file given its name and the C file mode
-- string, in that order.
gribWriteMessage :: (GribHandle) -> (FilePath) -> (String) -> IO ()
gribWriteMessage a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  C2HSImp.withCString a3 $ \a3' -> 
  gribWriteMessage'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 107 "src/Data/Grib/Raw/Handle.chs" #-}


-- grib_handle* grib_handle_new_from_message(grib_context* c, void* data,
--                                           size_t data_len);
--
-- |Create a handle from a user message in memory.
--
-- The message will not be freed at the end. The message will be
-- copied as soon as a modification is needed.
--
-- This operation may fail with:
--
--   * @NullPtrReturned@ if the message is invalid or a problem is
--   encountered.
--
-- __WARNING!__ This method does not handle a message of zero length
-- gracefully.
gribHandleNewFromMessage :: (GribContext) -> (Message) -> (Int) -> IO ((GribHandle))
gribHandleNewFromMessage a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  gribHandleNewFromMessage'_ a1' a2' a3' >>= \res ->
  checkHandle res >>= \res' ->
  return (res')

{-# LINE 128 "src/Data/Grib/Raw/Handle.chs" #-}


-- grib_handle* grib_handle_new_from_multi_message(grib_context* c,void** data,
--                                                 size_t *data_len,int* error);
--
-- |Create a handle from a user message in memory.
--
-- The message will not be freed at the end. The message will be
-- copied as soon as a modification is needed. This function works
-- also with multi field messages.
gribHandleNewFromMultiMessage :: (GribContext) -> (Message) -> (Int) -> IO ((GribHandle), (Message), (Int))
gribHandleNewFromMultiMessage a1 a2 a3 =
  let {a1' = id a1} in 
  with a2 $ \a2' -> 
  withIntegral a3 $ \a3' -> 
  alloca $ \a4' -> 
  gribHandleNewFromMultiMessage'_ a1' a2' a3' a4' >>= \res ->
  (\x -> C2HSImp.newForeignPtr gribHandleFinalizer x >>= (return . GribHandle)) res >>= \res' ->
  peek  a2'>>= \a2'' -> 
  peekIntegral  a3'>>= \a3'' -> 
  checkStatusPtr  a4'>>
  return (res', a2'', a3'')

{-# LINE 143 "src/Data/Grib/Raw/Handle.chs" #-}


-- grib_handle* grib_handle_new_from_message_copy(grib_context* c,
--                                                const void* data,
--                                                size_t data_len);
--
-- |Create a handle from a user message.
--
-- The message is copied and will be freed with the handle.
--
-- This operation may fail with:
--
--   * @NullPtrReturned@ if the message is invalid or a problem is
--   encountered.
gribHandleNewFromMessageCopy :: (GribContext) -> (Message) -> (Int) -> IO ((GribHandle))
gribHandleNewFromMessageCopy a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  gribHandleNewFromMessageCopy'_ a1' a2' a3' >>= \res ->
  checkHandle res >>= \res' ->
  return (res')

{-# LINE 161 "src/Data/Grib/Raw/Handle.chs" #-}


-- DEPRECATED grib_handle* grib_handle_new_from_template(grib_context* c,
--                                                       const char* res_name);
--
-- |/This function has been deprecated in GRIB API./
--
-- Create a handle from a read_only template resource.
--
-- The message is copied at the creation of the handle.
--
-- This operation may fail with:
--
--   * @NullPtrReturned@ if the resource is invalid or a problem is
--   encountered.
gribHandleNewFromTemplate :: (GribContext) -> (String) -> IO ((GribHandle))
gribHandleNewFromTemplate a1 a2 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  gribHandleNewFromTemplate'_ a1' a2' >>= \res ->
  checkHandle res >>= \res' ->
  return (res')

{-# LINE 179 "src/Data/Grib/Raw/Handle.chs" #-}


-- grib_handle* grib_handle_new_from_samples(grib_context* c,
--                                           const char* res_name);
--
-- |Create a handle from a message contained in a samples directory.
--
-- The message is copied at the creation of the handle.
--
-- This operation may fail with:
--
--   * @NullPtrReturned@ if the resource is invalid or a problem is
--   encountered.
gribHandleNewFromSamples :: (GribContext) -- ^the context from which the handle will be  created (NULL for default context)
 -> (String) -- ^the resource name
 -> IO ((GribHandle))
gribHandleNewFromSamples a1 a2 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  gribHandleNewFromSamples'_ a1' a2' >>= \res ->
  checkHandle res >>= \res' ->
  return (res')

{-# LINE 196 "src/Data/Grib/Raw/Handle.chs" #-}


-- grib_handle* grib_handle_clone(grib_handle *h);
--
-- |Clone an existing handle using the context of the original handle.
--
-- The message is copied and reparsed.
--
-- This operation may fail with:
--
--   * @NullPtrReturned@ if the message is invalid or a problem is
--   encountered.
gribHandleClone :: (GribHandle) -> IO ((GribHandle))
gribHandleClone a1 =
  (withGribHandle) a1 $ \a1' -> 
  gribHandleClone'_ a1' >>= \res ->
  checkHandle res >>= \res' ->
  return (res')

{-# LINE 208 "src/Data/Grib/Raw/Handle.chs" #-}


-- typedef struct grib_multi_handle grib_multi_handle;
--
-- |Grib multi field handle, structure used to build multi fields
-- messages.
newtype GribMultiHandle = GribMultiHandle (C2HSImp.ForeignPtr (GribMultiHandle))
withGribMultiHandle :: GribMultiHandle -> (C2HSImp.Ptr GribMultiHandle -> IO b) -> IO b
withGribMultiHandle (GribMultiHandle fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 216 "src/Data/Grib/Raw/Handle.chs" #-}


instance Eq GribMultiHandle where
  GribMultiHandle f1 == GribMultiHandle f2 = f1 == f2

instance Show GribMultiHandle where
  show (GribMultiHandle f) = "GribMultiHandle " ++ show f

checkMultiHandle :: Ptr GribMultiHandle -> IO GribMultiHandle
checkMultiHandle = checkForeignPtr GribMultiHandle gribMultiHandleFinalizer

-- grib_multi_handle* grib_multi_handle_new(grib_context* c);
--
-- |Create an empty multi field handle.
--
-- This operation may fail with:
--
--   * @NullPtrReturned@ if a problem is encountered.
gribMultiHandleNew :: (GribContext) -> IO ((GribMultiHandle))
gribMultiHandleNew a1 =
  let {a1' = id a1} in 
  gribMultiHandleNew'_ a1' >>= \res ->
  checkMultiHandle res >>= \res' ->
  return (res')

{-# LINE 236 "src/Data/Grib/Raw/Handle.chs" #-}


-- int grib_multi_handle_append(grib_handle* h, int start_section,
--                              grib_multi_handle* mh);
--
-- |Append the sections starting with start_section of the message
-- pointed by h at the end of the multi field handle mh.
gribMultiHandleAppend :: (GribHandle) -> (Int) -> (GribMultiHandle) -> IO ()
gribMultiHandleAppend a1 a2 a3 =
  (withGribHandle) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  (withGribMultiHandle) a3 $ \a3' -> 
  gribMultiHandleAppend'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 247 "src/Data/Grib/Raw/Handle.chs" #-}


-- int grib_multi_handle_write(grib_multi_handle* mh, FILE* f);
--
-- |Write a multi field handle in a file.
gribMultiHandleWrite :: (GribMultiHandle) -> (CFilePtr) -> IO ()
gribMultiHandleWrite a1 a2 =
  (withGribMultiHandle) a1 $ \a1' -> 
  let {a2' = id a2} in 
  gribMultiHandleWrite'_ a1' a2' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 255 "src/Data/Grib/Raw/Handle.chs" #-}


-- int grib_get_message(grib_handle* h, const void** message,
--                      size_t *message_length);
--
-- |Getting the message attached to a handle.
gribGetMessage :: (GribHandle) -> IO ((Message), (Int))
gribGetMessage a1 =
  (withGribHandle) a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  gribGetMessage'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  peek  a2'>>= \a2'' -> 
  peekIntegral  a3'>>= \a3'' -> 
  return (a2'', a3'')

{-# LINE 265 "src/Data/Grib/Raw/Handle.chs" #-}


-- int grib_get_message_copy(grib_handle* h, void* message,
--                           size_t *message_length);
--
-- |Getting a copy of the message attached to a handle.
--
-- This operation may fail with:
--
--   * @isGribException GribBufferTooSmall@ if the allocated message
--   is too small.
gribGetMessageCopy :: (GribHandle) -- ^the grib handle to which the buffer should be returned
 -> (Message) -- ^the pointer to the data buffer to be filled
 -> (Int) -- ^the size in number of bytes of the allocated empty message
 -> IO ((Message), (Int)) -- ^an IO action that will return the pointer to the data buffer  and the number of bytes retrieved

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

{-# LINE 286 "src/Data/Grib/Raw/Handle.chs" #-}


foreign import ccall "Data/Grib/Raw/Handle.chs.h &grib_handle_delete"
  gribHandleFinalizer :: C2HSImp.FinalizerPtr GribHandle

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_count_in_file"
  gribCountInFile'_ :: ((GribContext) -> ((CFilePtr) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_handle_new_from_file"
  gribHandleNewFromFile'_ :: ((GribContext) -> ((CFilePtr) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO (C2HSImp.Ptr (GribHandle))))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_write_message"
  gribWriteMessage'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_handle_new_from_message"
  gribHandleNewFromMessage'_ :: ((GribContext) -> ((C2HSImp.Ptr ()) -> (CSize -> (IO (C2HSImp.Ptr (GribHandle))))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_handle_new_from_multi_message"
  gribHandleNewFromMultiMessage'_ :: ((GribContext) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr CSize) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO (C2HSImp.Ptr (GribHandle)))))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_handle_new_from_message_copy"
  gribHandleNewFromMessageCopy'_ :: ((GribContext) -> ((C2HSImp.Ptr ()) -> (CSize -> (IO (C2HSImp.Ptr (GribHandle))))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_handle_new_from_template"
  gribHandleNewFromTemplate'_ :: ((GribContext) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr (GribHandle)))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_handle_new_from_samples"
  gribHandleNewFromSamples'_ :: ((GribContext) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr (GribHandle)))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_handle_clone"
  gribHandleClone'_ :: ((C2HSImp.Ptr (GribHandle)) -> (IO (C2HSImp.Ptr (GribHandle))))

foreign import ccall "Data/Grib/Raw/Handle.chs.h &grib_multi_handle_delete"
  gribMultiHandleFinalizer :: C2HSImp.FinalizerPtr GribMultiHandle

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_multi_handle_new"
  gribMultiHandleNew'_ :: ((GribContext) -> (IO (C2HSImp.Ptr (GribMultiHandle))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_multi_handle_append"
  gribMultiHandleAppend'_ :: ((C2HSImp.Ptr (GribHandle)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (GribMultiHandle)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_multi_handle_write"
  gribMultiHandleWrite'_ :: ((C2HSImp.Ptr (GribMultiHandle)) -> ((CFilePtr) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_get_message"
  gribGetMessage'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/Grib/Raw/Handle.chs.h grib_get_message_copy"
  gribGetMessageCopy'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt))))