-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Data/NetCDF/Raw/Base.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- | Raw bindings for basic NetCDF functions.

module Data.NetCDF.Raw.Base where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Data.NetCDF.Raw.Utils



-- LIBRARY VERSION

-- const char *nc_inq_libvers(void);
nc_inq_libvers' :: IO ((String))
nc_inq_libvers' =
  nc_inq_libvers''_ >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 14 "./Data/NetCDF/Raw/Base.chs" #-}

nc_inq_libvers :: String
nc_inq_libvers = unsafePerformIO nc_inq_libvers'



-- RETURN VALUES

-- const char *nc_strerror(int ncerr);
nc_strerror' :: (Int) -> IO ((String))
nc_strerror' a1 =
  let {a1' = fromIntegral a1} in
  nc_strerror''_ a1' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 23 "./Data/NetCDF/Raw/Base.chs" #-}

nc_strerror :: Int -> String
nc_strerror = unsafePerformIO . nc_strerror'



-- FILE OPERATIONS

-- int nc_create(const char *path, int cmode, int *ncidp);
nc_create :: (String) -> (Int) -> IO ((Int), (Int))
nc_create a1 a2 =
  C2HSImp.withCString a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  nc_create'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 32 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc__create(const char *path, int cmode, size_t initialsz,
--                size_t *chunksizehintp, int *ncidp);
nc__create :: (String) -> (Int) -> (Int) -> IO ((Int), (Int), (Int))
nc__create a1 a2 a3 =
  C2HSImp.withCString a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  alloca $ \a4' ->
  alloca $ \a5' ->
  nc__create'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a4'>>= \a4'' ->
  peekIntConv  a5'>>= \a5'' ->
  return (res', a4'', a5'')

{-# LINE 38 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_open(const char *path, int mode, int *ncidp);
nc_open :: (String) -> (Int) -> IO ((Int), (Int))
nc_open a1 a2 =
  C2HSImp.withCString a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  nc_open'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 41 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc__open(const char *path, int mode,
--              size_t *chunksizehintp, int *ncidp);
nc__open :: (String) -> (Int) -> IO ((Int), (Int), (Int))
nc__open a1 a2 =
  C2HSImp.withCString a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  alloca $ \a4' ->
  nc__open'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (res', a3'', a4'')

{-# LINE 47 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_redef(int ncid);
nc_redef :: (Int) -> IO ((Int))
nc_redef a1 =
  let {a1' = fromIntegral a1} in
  nc_redef'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 50 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_enddef(int ncid);
nc_enddef :: (Int) -> IO ((Int))
nc_enddef a1 =
  let {a1' = fromIntegral a1} in
  nc_enddef'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 53 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc__enddef(int ncid, size_t h_minfree, size_t v_align,
--                size_t v_minfree, size_t r_align);
nc__enddef :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ((Int))
nc__enddef a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  nc__enddef'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 57 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_sync(int ncid);
nc_sync :: (Int) -> IO ((Int))
nc_sync a1 =
  let {a1' = fromIntegral a1} in
  nc_sync'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 60 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_close(int ncid);
nc_close :: (Int) -> IO ((Int))
nc_close a1 =
  let {a1' = fromIntegral a1} in
  nc_close'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 63 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_path(int ncid, size_t *pathlen, char *path);
-- *** TODO ***

-- int nc_inq(int ncid, int *ndimsp, int *nvarsp, int *nattsp,
--            int *unlimdimidp);
nc_inq :: (Int) -> IO ((Int), (Int), (Int), (Int), (Int))
nc_inq a1 =
  let {a1' = fromIntegral a1} in
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  alloca $ \a5' ->
  nc_inq'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  peekIntConv  a5'>>= \a5'' ->
  return (res', a2'', a3'', a4'', a5'')

{-# LINE 72 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_ndims(int ncid, int *ndimsp);
nc_inq_ndims :: (Int) -> IO ((Int), (Int))
nc_inq_ndims a1 =
  let {a1' = fromIntegral a1} in
  alloca $ \a2' ->
  nc_inq_ndims'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 75 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_nvars(int ncid, int *nvarsp);
nc_inq_nvars :: (Int) -> IO ((Int), (Int))
nc_inq_nvars a1 =
  let {a1' = fromIntegral a1} in
  alloca $ \a2' ->
  nc_inq_nvars'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 78 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_natts(int ncid, int *nattsp);
nc_inq_natts :: (Int) -> IO ((Int), (Int))
nc_inq_natts a1 =
  let {a1' = fromIntegral a1} in
  alloca $ \a2' ->
  nc_inq_natts'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 81 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_unlimdim(int ncid, int *unlimdimidp);
nc_inq_unlimdim :: (Int) -> IO ((Int), (Int))
nc_inq_unlimdim a1 =
  let {a1' = fromIntegral a1} in
  alloca $ \a2' ->
  nc_inq_unlimdim'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 84 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_format(int ncid, int *formatp);
nc_inq_format :: (Int) -> IO ((Int), (Int))
nc_inq_format a1 =
  let {a1' = fromIntegral a1} in
  alloca $ \a2' ->
  nc_inq_format'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 87 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_def_dim(int ncid, const char *name, size_t len, int *idp);
nc_def_dim :: (Int) -> (String) -> (Int) -> IO ((Int), (Int))
nc_def_dim a1 a2 a3 =
  let {a1' = fromIntegral a1} in
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  alloca $ \a4' ->
  nc_def_dim'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a4'>>= \a4'' ->
  return (res', a4'')

{-# LINE 91 "./Data/NetCDF/Raw/Base.chs" #-}




-- DIMENSIONS

-- int nc_inq_dimid(int ncid, const char *name, int *idp);
nc_inq_dimid :: (Int) -> (String) -> IO ((Int), (Int))
nc_inq_dimid a1 a2 =
  let {a1' = fromIntegral a1} in
  C2HSImp.withCString a2 $ \a2' ->
  alloca $ \a3' ->
  nc_inq_dimid'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 98 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_dim(int ncid, int dimid, char *name, size_t *lenp);
nc_inq_dim :: (Int) -> (Int) -> IO ((Int), (String), (Int))
nc_inq_dim a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  allocaName $ \a3' ->
  alloca $ \a4' ->
  nc_inq_dim'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekCString  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (res', a3'', a4'')

{-# LINE 102 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_dimname(int ncid, int dimid, char *name);
nc_inq_dimname :: (Int) -> (Int) -> IO ((Int), (String))
nc_inq_dimname a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  allocaName $ \a3' ->
  nc_inq_dimname'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekCString  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 106 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_dimlen(int ncid, int dimid, size_t *lenp);
nc_inq_dimlen :: (Int) -> (Int) -> IO ((Int), (Int))
nc_inq_dimlen a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  nc_inq_dimlen'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 109 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_rename_dim(int ncid, int dimid, const char *name);
nc_rename_dim :: (Int) -> (Int) -> (String) -> IO ((Int))
nc_rename_dim a1 a2 a3 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  C2HSImp.withCString a3 $ \a3' ->
  nc_rename_dim'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 112 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_unlimdims(int ncid, int *nunlimdimsp, int *unlimdimidsp);
-- *** TODO ***


-- VARIABLES

-- int nc_def_var(int ncid, const char *name, nc_type xtype, int ndims,
--                const int *dimidsp, int *varidp);
nc_def_var :: (Int) -> (String) -> (Int) -> (Int) -> ([Int]) -> IO ((Int), (Int))
nc_def_var a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  withIntArray a5 $ \a5' ->
  alloca $ \a6' ->
  nc_def_var'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a6'>>= \a6'' ->
  return (res', a6'')

{-# LINE 124 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_varid(int ncid, const char *name, int *varidp);
nc_inq_varid :: (Int) -> (String) -> IO ((Int), (Int))
nc_inq_varid a1 a2 =
  let {a1' = fromIntegral a1} in
  C2HSImp.withCString a2 $ \a2' ->
  alloca $ \a3' ->
  nc_inq_varid'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 127 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_var(int ncid, int varid, char *name, nc_type *xtypep,
--                int *ndimsp, int *dimidsp, int *nattsp);
nc_inq_var :: (Int) -> (Int) -> IO ((Int), (String), (Int), (Int), ([Int]), (Int))
nc_inq_var a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  allocaName $ \a3' ->
  alloca $ \a4' ->
  alloca $ \a5' ->
  allocaVarDims $ \a6' ->
  alloca $ \a7' ->
  nc_inq_var'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  peekCString  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  peekIntConv  a5'>>= \a5'' ->
  peekVarDims  a6'>>= \a6'' ->
  peekIntConv  a7'>>= \a7'' ->
  return (res', a3'', a4'', a5'', a6'', a7'')

{-# LINE 136 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_varname(int ncid, int varid, char *name);
nc_inq_varname :: (Int) -> (Int) -> IO ((Int), (String))
nc_inq_varname a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  allocaName $ \a3' ->
  nc_inq_varname'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekCString  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 140 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_vartype(int ncid, int varid, nc_type *xtypep);
nc_inq_vartype :: (Int) -> (Int) -> IO ((Int), (Int))
nc_inq_vartype a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  nc_inq_vartype'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 143 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_varndims(int ncid, int varid, int *ndimsp);
nc_inq_varndims :: (Int) -> (Int) -> IO ((Int), (Int))
nc_inq_varndims a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  nc_inq_varndims'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 146 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_vardimid(int ncid, int varid, int *dimidsp);
nc_inq_vardimid :: (Int) -> (Int) -> IO ((Int), ([Int]))
nc_inq_vardimid a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  allocaVarDims $ \a3' ->
  nc_inq_vardimid'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekVarDims  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 150 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_inq_varnatts(int ncid, int varid, int *nattsp);
nc_inq_varnatts :: (Int) -> (Int) -> IO ((Int), (Int))
nc_inq_varnatts a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  nc_inq_varnatts'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 153 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_rename_var(int ncid, int varid, const char *name);
nc_rename_var :: (Int) -> (Int) -> (String) -> IO ((Int))
nc_rename_var a1 a2 a3 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  C2HSImp.withCString a3 $ \a3' ->
  nc_rename_var'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 156 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_copy_var(int ncid_in, int varid, int ncid_out);
nc_copy_var :: (Int) -> (Int) -> (Int) -> IO ((Int))
nc_copy_var a1 a2 a3 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  nc_copy_var'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 159 "./Data/NetCDF/Raw/Base.chs" #-}


-- int nc_set_fill(int ncid, int fillmode, int *old_modep);
nc_set_fill :: (Int) -> (Int) -> IO ((Int), (Int))
nc_set_fill a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  nc_set_fill'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a3'>>= \a3'' ->
  return (res', a3'')

{-# LINE 162 "./Data/NetCDF/Raw/Base.chs" #-}


foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_libvers"
  nc_inq_libvers''_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_strerror"
  nc_strerror''_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_create"
  nc_create'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc__create"
  nc__create'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_open"
  nc_open'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc__open"
  nc__open'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_redef"
  nc_redef'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_enddef"
  nc_enddef'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc__enddef"
  nc__enddef'_ :: (C2HSImp.CInt -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_sync"
  nc_sync'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_close"
  nc_close'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq"
  nc_inq'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_ndims"
  nc_inq_ndims'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_nvars"
  nc_inq_nvars'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_natts"
  nc_inq_natts'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_unlimdim"
  nc_inq_unlimdim'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_format"
  nc_inq_format'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_def_dim"
  nc_def_dim'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_dimid"
  nc_inq_dimid'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_dim"
  nc_inq_dim'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_dimname"
  nc_inq_dimname'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_dimlen"
  nc_inq_dimlen'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_rename_dim"
  nc_rename_dim'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_def_var"
  nc_def_var'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_varid"
  nc_inq_varid'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_var"
  nc_inq_var'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_varname"
  nc_inq_varname'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_vartype"
  nc_inq_vartype'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_varndims"
  nc_inq_varndims'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_vardimid"
  nc_inq_vardimid'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_inq_varnatts"
  nc_inq_varnatts'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_rename_var"
  nc_rename_var'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_copy_var"
  nc_copy_var'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Data/NetCDF/Raw/Base.chs.h nc_set_fill"
  nc_set_fill'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))