-- 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

         -- ** Control GTS Mode
       , gribGtsHeaderOn
       , gribGtsHeaderOff

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

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

         -- * GRIB API Version
       , gribGetApiVersion
       ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Foreign ( nullPtr )




-- long grib_get_api_version(void);
--
-- |Get the current version of GRIB API as an integer.
--
-- The major version is multiplied by 10000, the minor by 100 and then
-- they are summed together with the revision version to form the
-- integer. For example, version 1.13.1 would be 11301.
gribGetApiVersion :: (Int)
gribGetApiVersion =
  C2HSImp.unsafePerformIO $
  gribGetApiVersion'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


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

-- 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

-- 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 85 "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 90 "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 100 "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 105 "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 110 "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 116 "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 121 "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 127 "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 132 "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 137 "src/Data/Grib/Raw/Context.chs" #-}


foreign import ccall unsafe "Data/Grib/Raw/Context.chs.h grib_get_api_version"
  gribGetApiVersion'_ :: (IO C2HSImp.CLong)

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

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

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

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

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

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

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

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

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

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