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

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

The context is a long life configuration object of the grib_api.  It
is used to define special allocation and free routines or to set
special grib_api behaviours and variables.

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

{-# LANGUAGE ForeignFunctionInterface #-}

module Data.Grib.Raw.Context
       ( -- * The GRIB Context
         GribContext(..)
       , defaultGribContext
       , gribContextGetDefault
       , gribContextNew
       , gribContextDelete
       , gribContextSetMemoryProc
       , gribContextSetPersistentMemoryProc
       , gribContextSetBufferMemoryProc
       , gribContextSetPrintProc
       , gribContextSetLoggingProc

         -- ** Control GTS Mode
       , gribGtsHeaderOn
       , gribGtsHeaderOff

         -- ** Control Gribex Mode
       , gribGribexModeOn
       , gribGribexModeOff
       , gribGetGribexMode

         -- ** Control Multi-field Support
       , gribMultiSupportOn
       , gribMultiSupportOff

         -- * Foreign Function Type Definitions
       , GribFreeProc
       , GribMallocProc
       , GribReallocProc
       , GribLogProc
       , GribPrintProc
       , GribDataReadProc
       , GribDataWriteProc
       , GribDataTellProc
       , GribDataSeekProc
       , GribDataEofProc
       ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign
import Foreign.C




-- typedef struct grib_context grib_context;
--
-- It doesn't seem like grib_context_delete() can be used in general,
-- hence no foreign pointer.
--
-- |The context is a long life configuration object of the grib_api. It is
-- used to define special allocation and free routines or to set
-- special grib_api behaviours and variables.
newtype GribContext = GribContext (C2HSImp.Ptr (GribContext)) deriving (Eq, Show)

-- |A 'GribContext' containing a null pointer which makes the
-- functions receiving it use the default grib context.
defaultGribContext :: GribContext
defaultGribContext = GribContext nullPtr

-- typedef void (*grib_free_proc)(const grib_context* c, void* data);
--
-- |Grib free procedure, format of a procedure referenced in the
-- context that is used to free memory.
type GribFreeProc = C2HSImp.FunPtr (((GribContext) -> ((C2HSImp.Ptr ()) -> (IO ()))))
{-# LINE 85 "src/Data/Grib/Raw/Context.chs" #-}


-- This comment is inserted to help Haddock keep all docs.

-- typedef void* (*grib_malloc_proc)(const grib_context* c, size_t length);
--
-- |Grib malloc procedure, format of a procedure referenced in the
-- context that is used to allocate memory.
type GribMallocProc = C2HSImp.FunPtr (((GribContext) -> (C2HSImp.CULong -> (IO (C2HSImp.Ptr ())))))
{-# LINE 93 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef void* (*grib_realloc_proc)(const grib_context* c, void* data,
--                                    size_t length);
--
-- |Grib realloc procedure, format of a procedure referenced in the
-- context that is used to reallocate memory.
type GribReallocProc = C2HSImp.FunPtr (((GribContext) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> (IO (C2HSImp.Ptr ()))))))
{-# LINE 100 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef void (*grib_log_proc)(const grib_context* c, int level,
--                               const char* mesg);
--
-- |Grib loc proc, format of a procedure referenced in the context
-- that is used to log internal messages.
type GribLogProc = C2HSImp.FunPtr (((GribContext) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))))
{-# LINE 107 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef void (*grib_print_proc)(const grib_context* c, void* descriptor,
--                                 const char* mesg);
--
-- |Grib print proc, format of a procedure referenced in the context
-- that is used to print external messages.
type GribPrintProc = C2HSImp.FunPtr (((GribContext) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))))
{-# LINE 114 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef size_t (*grib_data_read_proc)(const grib_context* c, void *ptr,
--                                       size_t size, void *stream);
--
-- |Grib data read proc, format of a procedure referenced in the
-- context that is used to read from a stream in a resource.
type GribDataReadProc = C2HSImp.FunPtr (((GribContext) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))))))
{-# LINE 121 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef size_t (*grib_data_write_proc)(const grib_context* c, const void *ptr,
--                                        size_t size,  void *stream);
--
-- |Grib data read write, format of a procedure referenced in the
-- context that is used to write to a stream from a resource.
type GribDataWriteProc = C2HSImp.FunPtr (((GribContext) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))))))
{-# LINE 128 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef off_t (*grib_data_tell_proc)(const grib_context* c, void *stream);
--
-- |Grib data tell, format of a procedure referenced in the context
-- that is used to tell the current position in a stream.
type GribDataTellProc = C2HSImp.FunPtr (((GribContext) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CLong))))
{-# LINE 134 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef off_t (*grib_data_seek_proc)(const grib_context* c, off_t offset,
--                                      int whence, void *stream);
--
-- |Grib data seek, format of a procedure referenced in the context
-- that is used to seek the current position in a stream.
type GribDataSeekProc = C2HSImp.FunPtr (((GribContext) -> (C2HSImp.CLong -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CLong))))))
{-# LINE 141 "src/Data/Grib/Raw/Context.chs" #-}


-- typedef int (*grib_data_eof_proc)(const grib_context* c, void *stream);
--
-- |Grib data eof, format of a procedure referenced in the context
-- that is used to test end of file.
type GribDataEofProc = C2HSImp.FunPtr (((GribContext) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))
{-# LINE 147 "src/Data/Grib/Raw/Context.chs" #-}


-- grib_context* grib_context_get_default(void);
--
-- |Get the static default context.
--
-- Note that the returned object is different from
-- 'defaultGribContext', since that is just a null pointer and this is
-- a pointer to the real thing.  They should, however, be able to be
-- used interchangeably with all the functions in this package.
gribContextGetDefault :: IO ((GribContext))
gribContextGetDefault =
  gribContextGetDefault'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 157 "src/Data/Grib/Raw/Context.chs" #-}


-- grib_context* grib_context_new(grib_context* c);
--
-- |Create and allocate a new context from a parent context.
gribContextNew :: (GribContext) -> IO ((GribContext))
gribContextNew a1 =
  let {a1' = id a1} in 
  gribContextNew'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 162 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_context_delete(grib_context* c);
--
-- It doesn't seem safe to call this function in general, not even
-- with contexts created by 'gribContextNew' since fields of the
-- default context is first copied (by 'gribContextNew') and then
-- deleted (by this function).
--
-- |Frees the cached definition files of the context.
gribContextDelete :: (GribContext) -> IO ()
gribContextDelete a1 =
  let {a1' = id a1} in 
  gribContextDelete'_ a1' >>
  return ()

{-# LINE 172 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_gts_header_on(grib_context* c);
--
-- |Set the gts header mode on.  The GTS headers will be preserved.
gribGtsHeaderOn :: (GribContext) -> IO ()
gribGtsHeaderOn a1 =
  let {a1' = id a1} in 
  gribGtsHeaderOn'_ a1' >>
  return ()

{-# LINE 177 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_gts_header_off(grib_context* c);
--
-- |Set the gts header mode off.  The GTS headers will be deleted.
gribGtsHeaderOff :: (GribContext) -> IO ()
gribGtsHeaderOff a1 =
  let {a1' = id a1} in 
  gribGtsHeaderOff'_ a1' >>
  return ()

{-# LINE 182 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_gribex_mode_on(grib_context* c);
--
-- |Set the gribex mode on.  Grib files will be compatible with
-- gribex.
gribGribexModeOn :: (GribContext) -> IO ()
gribGribexModeOn a1 =
  let {a1' = id a1} in 
  gribGribexModeOn'_ a1' >>
  return ()

{-# LINE 188 "src/Data/Grib/Raw/Context.chs" #-}


-- int grib_get_gribex_mode(grib_context* c);
--
-- |Get the gribex mode.
gribGetGribexMode :: (GribContext) -> IO ((Bool))
gribGetGribexMode a1 =
  let {a1' = id a1} in 
  gribGetGribexMode'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 193 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_gribex_mode_off(grib_context* c);
--
-- |Set the gribex mode off.  Grib files won't be always compatible
-- with gribex.
gribGribexModeOff :: (GribContext) -> IO ()
gribGribexModeOff a1 =
  let {a1' = id a1} in 
  gribGribexModeOff'_ a1' >>
  return ()

{-# LINE 199 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_context_set_memory_proc(grib_context* c, grib_malloc_proc griballoc,
--                                   grib_free_proc gribfree,
--                                   grib_realloc_proc gribrealloc);
--
-- |Sets memory procedures of the context.
gribContextSetMemoryProc :: (GribContext) -> (GribMallocProc) -> (GribFreeProc) -> (GribReallocProc) -> IO ()
gribContextSetMemoryProc a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  let {a4' = id a4} in 
  gribContextSetMemoryProc'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 211 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_context_set_persistent_memory_proc(grib_context* c,
--                                              grib_malloc_proc griballoc,
--                                              grib_free_proc gribfree);
--
-- |Sets memory procedures of the context for persistent data.
gribContextSetPersistentMemoryProc :: (GribContext) -> (GribMallocProc) -> (GribFreeProc) -> IO ()
gribContextSetPersistentMemoryProc a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  gribContextSetPersistentMemoryProc'_ a1' a2' a3' >>
  return ()

{-# LINE 222 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_context_set_buffer_memory_proc(grib_context* c,
--                                          grib_malloc_proc griballoc,
--                                          grib_free_proc gribfree,
--                                          grib_realloc_proc gribrealloc);
--
-- |Sets memory procedures of the context for large buffers.
gribContextSetBufferMemoryProc :: (GribContext) -> (GribMallocProc) -> (GribFreeProc) -> (GribReallocProc) -> IO ()
gribContextSetBufferMemoryProc a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  let {a4' = id a4} in 
  gribContextSetBufferMemoryProc'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 235 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_context_set_print_proc(grib_context* c, grib_print_proc printp);
--
-- |Sets the context printing procedure used for user interaction.
gribContextSetPrintProc :: (GribContext) -> (GribPrintProc) -> IO ()
gribContextSetPrintProc a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  gribContextSetPrintProc'_ a1' a2' >>
  return ()

{-# LINE 243 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_context_set_logging_proc(grib_context* c, grib_log_proc logp);
--
-- |Sets the context logging procedure used for system (warning,
-- errors, infos ...) messages.
gribContextSetLoggingProc :: (GribContext) -> (GribLogProc) -> IO ()
gribContextSetLoggingProc a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  gribContextSetLoggingProc'_ a1' a2' >>
  return ()

{-# LINE 252 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_multi_support_on(grib_context* c);
--
-- |Turn on support for multiple fields in single grib messages.
gribMultiSupportOn :: (GribContext) -> IO ()
gribMultiSupportOn a1 =
  let {a1' = id a1} in 
  gribMultiSupportOn'_ a1' >>
  return ()

{-# LINE 257 "src/Data/Grib/Raw/Context.chs" #-}


-- void grib_multi_support_off(grib_context* c);
--
-- |Turn off support for multiple fields in single grib messages.
gribMultiSupportOff :: (GribContext) -> IO ()
gribMultiSupportOff a1 =
  let {a1' = id a1} in 
  gribMultiSupportOff'_ a1' >>
  return ()

{-# LINE 262 "src/Data/Grib/Raw/Context.chs" #-}


foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_get_default"
  gribContextGetDefault'_ :: (IO (GribContext))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_new"
  gribContextNew'_ :: ((GribContext) -> (IO (GribContext)))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_delete"
  gribContextDelete'_ :: ((GribContext) -> (IO ()))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_gts_header_on"
  gribGtsHeaderOn'_ :: ((GribContext) -> (IO ()))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_gts_header_off"
  gribGtsHeaderOff'_ :: ((GribContext) -> (IO ()))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_gribex_mode_on"
  gribGribexModeOn'_ :: ((GribContext) -> (IO ()))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_get_gribex_mode"
  gribGetGribexMode'_ :: ((GribContext) -> (IO C2HSImp.CInt))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_gribex_mode_off"
  gribGribexModeOff'_ :: ((GribContext) -> (IO ()))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_set_memory_proc"
  gribContextSetMemoryProc'_ :: ((GribContext) -> ((GribMallocProc) -> ((GribFreeProc) -> ((GribReallocProc) -> (IO ())))))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_set_persistent_memory_proc"
  gribContextSetPersistentMemoryProc'_ :: ((GribContext) -> ((GribMallocProc) -> ((GribFreeProc) -> (IO ()))))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_set_buffer_memory_proc"
  gribContextSetBufferMemoryProc'_ :: ((GribContext) -> ((GribMallocProc) -> ((GribFreeProc) -> ((GribReallocProc) -> (IO ())))))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_set_print_proc"
  gribContextSetPrintProc'_ :: ((GribContext) -> ((GribPrintProc) -> (IO ())))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_context_set_logging_proc"
  gribContextSetLoggingProc'_ :: ((GribContext) -> ((GribLogProc) -> (IO ())))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_multi_support_on"
  gribMultiSupportOn'_ :: ((GribContext) -> (IO ()))

foreign import ccall safe "Data/Grib/Raw/Context.chs.h grib_multi_support_off"
  gribMultiSupportOff'_ :: ((GribContext) -> (IO ()))