hnetcdf (empty) → 0.1.0.0
raw patch · 20 files changed
+2928/−0 lines, 20 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, containers, directory, either, errors, filepath, hnetcdf, repa, test-framework, test-framework-hunit, test-framework-quickcheck2, transformers, vector
Files
- Data/NetCDF.hs +166/−0
- Data/NetCDF/Metadata.hs +69/−0
- Data/NetCDF/PutGet.hs +113/−0
- Data/NetCDF/Raw.hs +13/−0
- Data/NetCDF/Raw/Attributes.chs +249/−0
- Data/NetCDF/Raw/Base.chs +162/−0
- Data/NetCDF/Raw/NetCDF4.chs +151/−0
- Data/NetCDF/Raw/PutGet.hs +372/−0
- Data/NetCDF/Raw/Utils.hs +63/−0
- Data/NetCDF/Storable.hs +153/−0
- Data/NetCDF/Store.hs +38/−0
- Data/NetCDF/Types.hs +75/−0
- Data/NetCDF/Utils.hs +64/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- hnetcdf.cabal +114/−0
- test/test-get.hs +405/−0
- test/test-raw-attributes.hs +94/−0
- test/test-raw-get-put.hs +465/−0
- test/test-raw-metadata.hs +130/−0
+ Data/NetCDF.hs view
@@ -0,0 +1,166 @@+-- | Bindings to the Unidata NetCDF data access library.+--+-- As well as conventional low-level FFI bindings to the functions+-- in the NetCDF library (in the "Data.NetCDF.Raw" modules),+-- @hnetcdf@ provides a higher-level Haskell interface (currently+-- only for reading data). This higher-level interface aims to+-- provide a "container polymorphic" view of NetCDF data allowing+-- NetCDF variables to be read into @Storable@ @Vectors@ and Repa+-- arrays easily.+--+-- For example:+--+-- > import Data.NetCDF+-- > import Foreign.C+-- > import qualified Data.Vector.Storable as SV+-- > ...+-- > type SVRet = IO (Either NcError (SV.Vector a))+-- > ...+-- > enc <- openFile "tst.nc" ReadMode+-- > case enc of+-- > Right nc -> do+-- > eval <- get nc "varname" :: SVRet CDouble+-- > ...+--+-- gets the full contents of a NetCDF variable as a @Storable@+-- @Vector@, while the following code reads the same variable+-- (assumed to be three-dimensional) into a Repa array:+--+-- > import Data.NetCDF+-- > import Foreign.C+-- > import qualified Data.Array.Repa as R+-- > import qualified Data.Array.Repa.Eval as RE+-- > import Data.Array.Repa.Repr.ForeignPtr (F)+-- > ...+-- > type RepaRet3 a = IO (Either NcError (R.Array F R.DIM3 a))+-- > ...+-- > enc <- openFile "tst.nc" ReadMode+-- > case enc of+-- > Right nc -> do+-- > eval <- get nc "varname" :: RepaRet3 CDouble+-- > ...++module Data.NetCDF+ ( module Data.NetCDF.Types+ , module Data.NetCDF.Metadata+ , NcStorable (..)+ , IOMode (..)+ , openFile, closeFile, withFile+ , get1, get, getA, getS ) where++import Data.NetCDF.Raw+import Data.NetCDF.Types+import Data.NetCDF.Metadata+import Data.NetCDF.PutGet+import Data.NetCDF.Storable+import Data.NetCDF.Store+import Data.NetCDF.Utils++import Control.Applicative ((<$>))+import Control.Exception (bracket)+import Control.Monad (forM, void)+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Control.Error+import Data.List+import qualified Data.Map as M+import Foreign.C+import System.IO (IOMode (..))++-- | Open a NetCDF file and read all metadata.+openFile :: FilePath -> IOMode -> NcIO NcInfo+openFile p mode = runAccess "openFile" p $ do+ ncid <- chk $ nc_open p (ncIOMode mode)+ (ndims, nvars, nattrs, unlim) <- chk $ nc_inq ncid+ dims <- forM [0..ndims-1] (read1Dim ncid unlim)+ attrs <- forM [0..nattrs-1] (read1Attr ncid ncGlobal)+ vars <- forM [0..nvars-1] (read1Var ncid dims)+ let mkMap nf = foldl (\m v -> M.insert (nf v) v m) M.empty+ dimmap = mkMap ncDimName dims+ attmap = mkMap ncAttrName attrs+ varmap = mkMap ncVarName vars+ varidmap = M.fromList $ zip (map ncVarName vars) [0..]+ return $ NcInfo p dimmap varmap attmap ncid varidmap++-- | Close a NetCDF file.+closeFile :: NcInfo -> IO ()+closeFile (NcInfo _ _ _ _ ncid _) = void $ nc_close ncid++-- | Bracket file use: a little different from the standard 'withFile'+-- function because of error handling.+withFile :: FilePath -> IOMode+ -> (NcInfo -> IO r) -> (NcError -> IO r) -> IO r+withFile p m ok err = bracket+ (openFile p m)+ (either (const $ return ()) closeFile)+ (either err ok)++-- | Read a single value from an open NetCDF file.+get1 :: NcStorable a => NcInfo -> NcVar -> [Int] -> NcIO a+get1 nc var idxs = runAccess "get1" (ncName nc) $+ chk $ get_var1 (ncId nc) ((ncVarIds nc) M.! (ncVarName var)) idxs++-- | Read a whole variable from an open NetCDF file.+get :: (NcStorable a, NcStore s) => NcInfo -> NcVar -> NcIO (s a)+get nc var = runAccess "get" (ncName nc) $ do+ let ncid = ncId nc+ varid = (ncVarIds nc) M.! (ncVarName var)+ sz = map ncDimLength $ ncVarDims var+ chk $ get_var ncid varid sz++-- | Read a slice of a variable from an open NetCDF file.+getA :: (NcStorable a, NcStore s)+ => NcInfo -> NcVar -> [Int] -> [Int] -> NcIO (s a)+getA nc var start count = runAccess "getA" (ncName nc) $ do+ let ncid = ncId nc+ varid = (ncVarIds nc) M.! (ncVarName var)+ chk $ get_vara ncid varid start count++-- | Read a strided slice of a variable from an open NetCDF file.+getS :: (NcStorable a, NcStore s)+ => NcInfo -> NcVar -> [Int] -> [Int] -> [Int] -> NcIO (s a)+getS nc var start count stride = runAccess "getS" (ncName nc) $ do+ let ncid = ncId nc+ varid = (ncVarIds nc) M.! (ncVarName var)+ chk $ get_vars ncid varid start count stride+++-- | Helper function to read a single NC dimension.+read1Dim :: Int -> Int -> Int -> Access NcDim+read1Dim ncid unlim dimid = do+ (name, len) <- chk $ nc_inq_dim ncid dimid+ return $ NcDim name len (dimid == unlim)++-- | Helper function to read a single NC attribute.+read1Attr :: Int -> Int -> Int -> Access NcAttr+read1Attr ncid varid attid = do+ n <- chk $ nc_inq_attname ncid varid attid+ (itype, len) <- chk $ nc_inq_att ncid varid n+ a <- readAttr ncid varid n (toEnum itype) len+ return a++-- | Helper function to read metadata for a single NC variable.+read1Var :: Int -> [NcDim] -> Int -> Access NcVar+read1Var ncid dims varid = do+ (n, itype, nvdims, vdimids, nvatts) <- chk $ nc_inq_var ncid varid+ let vdims = map (dims !!) $ take nvdims vdimids+ vattrs <- forM [0..nvatts-1] (read1Attr ncid varid)+ let vattmap = foldl (\m a -> M.insert (ncAttrName a) a m) M.empty vattrs+ return $ NcVar n (toEnum itype) vdims vattmap++-- | Read an attribute from a NetCDF variable with error handling.+readAttr :: Int -> Int -> String -> NcType -> Int -> Access NcAttr+readAttr nc var n NcChar l = readAttr' nc var n l nc_get_att_text+readAttr nc var n NcShort l = readAttr' nc var n l nc_get_att_short+readAttr nc var n NcInt l = readAttr' nc var n l nc_get_att_int+readAttr nc var n NcFloat l = readAttr' nc var n l nc_get_att_float+readAttr nc var n NcDouble l = readAttr' nc var n l nc_get_att_double+readAttr nc var n NcUInt l = readAttr' nc var n l nc_get_att_uint+readAttr _ _ n _ _ = return $ NcAttr n ([0] :: [CInt])++-- | Helper function for attribute reading.+readAttr' :: Show a => Int -> Int -> String -> Int+ -> (Int -> Int -> String -> Int -> IO (Int, [a])) -> Access NcAttr+readAttr' nc var n l rf = NcAttr n <$> (chk $ rf nc var n l)++
+ Data/NetCDF/Metadata.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE ExistentialQuantification, StandaloneDeriving #-}+-- | NetCDF file metadata handling: when a NetCDF file is opened,+-- metadata defining the dimensions, variables and attributes in the+-- file are read all at once to create a value of type `NcInfo`.++module Data.NetCDF.Metadata+ ( NcDim (..)+ , NcAttr (..)+ , NcVar (..)+ , NcInfo (..)+ , ncDim, ncAttr, ncVar, ncVarAttr+ ) where++import Data.NetCDF.Types+import qualified Data.Map as M+++-- | Information about a dimension: name, number of entries and+-- whether unlimited.+data NcDim = NcDim { ncDimName :: String+ , ncDimLength :: Int+ , ncDimUnlimited :: Bool+ } deriving Show++-- | Attribute value.+data NcAttr = forall a. Show a => NcAttr { ncAttrName :: String+ , ncAttrVals :: [a] }++deriving instance Show NcAttr++-- | Information about a variable: name, type, dimensions and+-- attributes.+data NcVar = NcVar { ncVarName :: String+ , ncVarType :: NcType+ , ncVarDims :: [NcDim]+ , ncVarAttrs :: M.Map String NcAttr+ } deriving Show++-- | Metadata information for a whole NetCDF file.+data NcInfo = NcInfo { ncName :: FilePath+ -- ^ File name.+ , ncDims :: M.Map String NcDim+ -- ^ Dimensions defined in file.+ , ncVars :: M.Map String NcVar+ -- ^ Variables defined in file.+ , ncAttrs :: M.Map String NcAttr+ -- ^ Global attributes defined in file.+ , ncId :: NcId+ -- ^ Low-level file access ID.+ , ncVarIds :: M.Map String NcId+ -- ^ Low-level IDs for variables.+ } deriving Show+++-- | Extract dimension metadata by name.+ncDim :: NcInfo -> String -> Maybe NcDim+ncDim nc n = M.lookup n $ ncDims nc++-- | Extract a global attribute by name.+ncAttr :: NcInfo -> String -> Maybe NcAttr+ncAttr nc n = M.lookup n $ ncAttrs nc++-- | Extract variable metadata by name.+ncVar :: NcInfo -> String -> Maybe NcVar+ncVar nc n = M.lookup n $ ncVars nc++-- | Extract an attribute for a given variable by name.+ncVarAttr :: NcVar -> String -> Maybe NcAttr+ncVarAttr v n = M.lookup n $ ncVarAttrs v
+ Data/NetCDF/PutGet.hs view
@@ -0,0 +1,113 @@+-- | Mid-level interface for reading and writing NetCDF data. The+-- functions in "Data.NetCDF" provide a more convenient interface.++module Data.NetCDF.PutGet+ ( put_var1 , put_var, put_vara, put_vars+ , get_var1 , get_var, get_vara, get_vars+ ) where++import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Storable+import Foreign.Marshal.Array+import Foreign.Marshal.Alloc+import Control.Applicative ((<$>))+import Control.Monad (liftM)+import Data.Word++import Data.NetCDF.Types+import Data.NetCDF.Storable+import Data.NetCDF.Store+import Data.NetCDF.Raw.PutGet++put_var1 :: NcStorable a => Int -> Int -> [Int] -> a -> IO Int+put_var1 nc var idxs v = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ alloca $ \iv -> do+ poke iv v+ withSizeArray idxs $ \idxsp -> do+ res <- ffi_put_var1 ncid varid idxsp iv+ return $ fromIntegral res++get_var1 :: NcStorable a => Int -> Int -> [Int] -> IO (Int, a)+get_var1 nc var idxs = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ alloca $ \iv -> do+ withSizeArray idxs $ \idxsp -> do+ res <- ffi_get_var1 ncid varid idxsp iv+ v <- peek iv+ return $ (fromIntegral res, v)++put_var :: (NcStorable a, NcStore s) => Int -> Int -> s a -> IO Int+put_var nc var v = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ is = toForeignPtr v+ withForeignPtr is $ \isp -> fromIntegral <$> ffi_put_var ncid varid isp++get_var :: (NcStorable a, NcStore s) => Int -> Int -> [Int] -> IO (Int, s a)+get_var nc var sz = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ is <- mallocForeignPtrArray (product sz)+ withForeignPtr is $ \isp -> do+ res <- ffi_get_var ncid varid isp+ return (fromIntegral res, fromForeignPtr is sz)++put_vara :: (NcStorable a, NcStore s) =>+ Int -> Int -> [Int] -> [Int] -> s a -> IO Int+put_vara nc var start count v = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ is = toForeignPtr v+ withForeignPtr is $ \isp ->+ withSizeArray start $ \startp ->+ withSizeArray count $ \countp -> do+ res <- ffi_put_vara ncid varid startp countp isp+ return $ fromIntegral res++get_vara :: (NcStorable a, NcStore s)+ => Int -> Int -> [Int] -> [Int] -> IO (Int, s a)+get_vara nc var start count = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ is <- mallocForeignPtrArray (product count)+ withForeignPtr is $ \isp ->+ withSizeArray start $ \s ->+ withSizeArray count $ \c -> do+ res <- ffi_get_vara ncid varid s c isp+ return (fromIntegral res, fromForeignPtr is (filter (>1) count))++put_vars :: (NcStorable a, NcStore s) =>+ Int -> Int -> [Int] -> [Int] -> [Int] -> s a -> IO Int+put_vars nc var start count stride v = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ is = toForeignPtr v+ withForeignPtr is $ \isp ->+ withSizeArray start $ \startp ->+ withSizeArray count $ \countp -> do+ withSizeArray stride $ \stridep -> do+ res <- ffi_put_vars ncid varid startp countp stridep isp+ return $ fromIntegral res++get_vars :: (NcStorable a, NcStore s)+ => Int -> Int -> [Int] -> [Int] -> [Int] -> IO (Int, s a)+get_vars nc var start count stride = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ is <- mallocForeignPtrArray (product count)+ withForeignPtr is $ \isp ->+ withSizeArray start $ \s ->+ withSizeArray count $ \c -> do+ withSizeArray stride $ \str -> do+ res <- ffi_get_vars ncid varid s c str isp+ return (fromIntegral res, fromForeignPtr is (filter (>1) count))++-- | Helper function for dealing with size (start, count, stride)+-- arrays.+withSizeArray :: (Storable a, Integral a) => [a] -> (Ptr CULong -> IO b) -> IO b+withSizeArray = withArray . liftM fromIntegral
+ Data/NetCDF/Raw.hs view
@@ -0,0 +1,13 @@+-- | Raw FFI bindings to Unidata NetCDF library.++module Data.NetCDF.Raw+ ( module Data.NetCDF.Raw.Base+ , module Data.NetCDF.Raw.PutGet+ , module Data.NetCDF.Raw.Attributes+ , module Data.NetCDF.Raw.NetCDF4+ ) where++import Data.NetCDF.Raw.Base+import Data.NetCDF.Raw.PutGet+import Data.NetCDF.Raw.Attributes+import Data.NetCDF.Raw.NetCDF4
+ Data/NetCDF/Raw/Attributes.chs view
@@ -0,0 +1,249 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Raw bindings for attribute handling functions.++module Data.NetCDF.Raw.Attributes where++import Data.Char+import Control.Monad (liftM)++import Data.NetCDF.Raw.Utils++#include <netcdf.h>++nc_put_att :: (Storable a, Storable b) =>+ (CInt -> CInt -> CString -> CInt -> CULong -> Ptr b -> IO CInt)+ -> (a -> b) -> Int -> Int -> String -> Int -> [a] -> IO Int+nc_put_att cfn conv nc var name xtype v = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ ncxtype = fromIntegral xtype+ ncsize = fromIntegral $ length v+ withCString name $ \namep -> do+ (withArray . liftM conv) v $ \vp -> do+ res <- cfn ncid varid namep ncxtype ncsize vp+ return $ fromIntegral res++-- int nc_put_att_text(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const char *op);+nc_put_att_text :: Int -> Int -> String -> Int -> String -> IO Int+nc_put_att_text = nc_put_att nc_put_att_text'_ convChar+ where convChar c+ | isAscii c = fromIntegral (ord c)+ | otherwise = 32+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_text"+ nc_put_att_text'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CChar -> IO CInt++-- int nc_put_att_uchar(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const unsigned char *op);+nc_put_att_uchar :: Int -> Int -> String -> Int -> [Word8] -> IO Int+nc_put_att_uchar = nc_put_att nc_put_att_uchar'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_uchar"+ nc_put_att_uchar'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CUChar -> IO CInt++-- int nc_put_att_schar(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const signed char *op);+nc_put_att_schar :: Int -> Int -> String -> Int -> [Word8] -> IO Int+nc_put_att_schar = nc_put_att nc_put_att_schar'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_schar"+ nc_put_att_schar'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CChar -> IO CInt++-- int nc_put_att_short(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const short *op);+nc_put_att_short :: Int -> Int -> String -> Int -> [Int] -> IO Int+nc_put_att_short = nc_put_att nc_put_att_short'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_short"+ nc_put_att_short'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CShort -> IO CInt++-- int nc_put_att_int(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const int *op);+nc_put_att_int :: Int -> Int -> String -> Int -> [Int] -> IO Int+nc_put_att_int = nc_put_att nc_put_att_int'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_int"+ nc_put_att_int'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CInt -> IO CInt++-- int nc_put_att_long(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const long *op);+nc_put_att_long :: Int -> Int -> String -> Int -> [Int] -> IO Int+nc_put_att_long = nc_put_att nc_put_att_long'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_long"+ nc_put_att_long'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CLong -> IO CInt++-- int nc_put_att_float(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const float *op);+nc_put_att_float :: Int -> Int -> String -> Int -> [Float] -> IO Int+nc_put_att_float = nc_put_att nc_put_att_float'_ realToFrac+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_float"+ nc_put_att_float'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CFloat -> IO CInt++-- int nc_put_att_double(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const double *op);+nc_put_att_double :: Int -> Int -> String -> Int -> [Double] -> IO Int+nc_put_att_double = nc_put_att nc_put_att_double'_ realToFrac+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_double"+ nc_put_att_double'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CDouble -> IO CInt++-- int nc_put_att_ushort(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const unsigned short *op);+nc_put_att_ushort :: Int -> Int -> String -> Int -> [Int] -> IO Int+nc_put_att_ushort = nc_put_att nc_put_att_ushort'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_ushort"+ nc_put_att_ushort'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CUShort -> IO CInt++-- int nc_put_att_uint(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const unsigned int *op);+nc_put_att_uint :: Int -> Int -> String -> Int -> [Int] -> IO Int+nc_put_att_uint = nc_put_att nc_put_att_uint'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_uint"+ nc_put_att_uint'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CUInt -> IO CInt++-- int nc_put_att_longlong(int ncid, int varid, const char *name, nc_type xtype,+-- size_t len, const long long *op);+nc_put_att_longlong :: Int -> Int -> String -> Int -> [Int] -> IO Int+nc_put_att_longlong = nc_put_att nc_put_att_longlong'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_longlong"+ nc_put_att_longlong'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CLLong -> IO CInt++-- int nc_put_att_ulonglong(int ncid, int varid, const char *name,+-- nc_type xtype, size_t len,+-- const unsigned long long *op);+nc_put_att_ulonglong :: Int -> Int -> String -> Int -> [Int] -> IO Int+nc_put_att_ulonglong = nc_put_att nc_put_att_ulonglong'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_put_att_ulonglong"+ nc_put_att_ulonglong'_ :: CInt -> CInt -> CString -> CInt -> CULong+ -> Ptr CULLong -> IO CInt+++-- int nc_inq_attname(int ncid, int varid, int attnum, char *name);+{#fun nc_inq_attname { `Int', `Int', `Int',+ allocaName- `String' peekCString* } -> `Int' #}++-- int nc_inq_att(int ncid, int varid, const char *name,+-- nc_type *xtypep, size_t *lenp);+{#fun nc_inq_att { `Int', `Int', `String', alloca- `Int' peekIntConv*,+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_attid(int ncid, int varid, const char *name, int *idp);+{#fun nc_inq_attid { `Int', `Int', `String',+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_atttype(int ncid, int varid, const char *name, nc_type *xtypep);+{#fun nc_inq_atttype { `Int', `Int', `String',+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_attlen(int ncid, int varid, const char *name, size_t *lenp);+{#fun nc_inq_attlen { `Int', `Int', `String',+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_copy_att(int ncid_in, int varid_in, const char *name,+-- int ncid_out, int varid_out);+{#fun nc_copy_att { `Int', `Int', `String', `Int', `Int' } -> `Int' #}++-- int nc_rename_att(int ncid, int varid, const char *name,+-- const char *newname);+{#fun nc_rename_att { `Int', `Int', `String', `String' } -> `Int' #}++-- int nc_del_att(int ncid, int varid, const char *name);+{#fun nc_del_att { `Int', `Int', `String' } -> `Int' #}+++nc_get_att :: (Storable a, Storable b) =>+ (CInt -> CInt -> CString -> Ptr a -> IO CInt)+ -> (a -> b) -> Int -> Int -> String -> Int -> IO (Int, [b])+nc_get_att cfn conv nc var name cnt = do+ let ncid = fromIntegral nc+ varid = fromIntegral var+ withCString name $ \namep -> do+ allocaArray cnt $ \vp -> do+ res <- cfn ncid varid namep vp+ vs <- peekArray cnt vp+ return $ (fromIntegral res, map conv vs)++-- int nc_get_att_text(int ncid, int varid, const char *name, char *ip);+nc_get_att_text :: Int -> Int -> String -> Int -> IO (Int, String)+nc_get_att_text ncid var name ip = do+ (s, str) <- nc_get_att nc_get_att_text'_ (chr . fromIntegral) ncid var name ip+ return (s, takeWhile (/='\NUL') str)+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_text"+ nc_get_att_text'_ :: CInt -> CInt -> CString -> Ptr CChar -> IO CInt++-- int nc_get_att_uchar(int ncid, int varid, const char *name,+-- unsigned char *ip);+nc_get_att_uchar :: Int -> Int -> String -> Int -> IO (Int, [CChar])+nc_get_att_uchar = nc_get_att nc_get_att_uchar'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_uchar"+ nc_get_att_uchar'_ :: CInt -> CInt -> CString -> Ptr CUChar -> IO CInt++-- int nc_get_att_schar(int ncid, int varid, const char *name, signed char *ip);+nc_get_att_schar :: Int -> Int -> String -> Int -> IO (Int, [CSChar])+nc_get_att_schar = nc_get_att nc_get_att_schar'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_schar"+ nc_get_att_schar'_ :: CInt -> CInt -> CString -> Ptr CChar -> IO CInt++-- int nc_get_att_short(int ncid, int varid, const char *name, short *ip);+nc_get_att_short :: Int -> Int -> String -> Int -> IO (Int, [CShort])+nc_get_att_short = nc_get_att nc_get_att_short'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_short"+ nc_get_att_short'_ :: CInt -> CInt -> CString -> Ptr CShort -> IO CInt++-- int nc_get_att_int(int ncid, int varid, const char *name, int *ip);+nc_get_att_int :: Int -> Int -> String -> Int -> IO (Int, [CInt])+nc_get_att_int = nc_get_att nc_get_att_int'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_int"+ nc_get_att_int'_ :: CInt -> CInt -> CString -> Ptr CInt -> IO CInt++-- int nc_get_att_long(int ncid, int varid, const char *name, long *ip);+nc_get_att_long :: Int -> Int -> String -> Int -> IO (Int, [CLong])+nc_get_att_long = nc_get_att nc_get_att_long'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_long"+ nc_get_att_long'_ :: CInt -> CInt -> CString -> Ptr CLong -> IO CInt++-- int nc_get_att_float(int ncid, int varid, const char *name, float *ip);+nc_get_att_float :: Int -> Int -> String -> Int -> IO (Int, [CFloat])+nc_get_att_float = nc_get_att nc_get_att_float'_ realToFrac+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_float"+ nc_get_att_float'_ :: CInt -> CInt -> CString -> Ptr CFloat -> IO CInt++-- int nc_get_att_double(int ncid, int varid, const char *name, double *ip);+nc_get_att_double :: Int -> Int -> String -> Int -> IO (Int, [CDouble])+nc_get_att_double = nc_get_att nc_get_att_double'_ realToFrac+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_double"+ nc_get_att_double'_ :: CInt -> CInt -> CString -> Ptr CDouble -> IO CInt++-- int nc_get_att_ushort(int ncid, int varid, const char *name,+-- unsigned short *ip);+nc_get_att_ushort :: Int -> Int -> String -> Int -> IO (Int, [CUShort])+nc_get_att_ushort = nc_get_att nc_get_att_ushort'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_ushort"+ nc_get_att_ushort'_ :: CInt -> CInt -> CString -> Ptr CUShort -> IO CInt++-- int nc_get_att_uint(int ncid, int varid, const char *name, unsigned int *ip);+nc_get_att_uint :: Int -> Int -> String -> Int -> IO (Int, [CUInt])+nc_get_att_uint = nc_get_att nc_get_att_uint'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_uint"+ nc_get_att_uint'_ :: CInt -> CInt -> CString -> Ptr CUInt -> IO CInt++-- int nc_get_att_longlong(int ncid, int varid, const char *name,+-- long long *ip);+nc_get_att_longlong :: Int -> Int -> String -> Int -> IO (Int, [CLLong])+nc_get_att_longlong = nc_get_att nc_get_att_longlong'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_longlong"+ nc_get_att_longlong'_ :: CInt -> CInt -> CString -> Ptr CLLong -> IO CInt++-- int nc_get_att_ulonglong(int ncid, int varid, const char *name,+-- unsigned long long *ip);+nc_get_att_ulonglong :: Int -> Int -> String -> Int -> IO (Int, [CULLong])+nc_get_att_ulonglong = nc_get_att nc_get_att_ulonglong'_ fromIntegral+foreign import ccall safe "Data/NetCDF/Raw.chs.h nc_get_att_ulonglong"+ nc_get_att_ulonglong'_ :: CInt -> CInt -> CString -> Ptr CULLong -> IO CInt
+ Data/NetCDF/Raw/Base.chs view
@@ -0,0 +1,162 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Raw bindings for basic NetCDF functions.++module Data.NetCDF.Raw.Base where++import Data.NetCDF.Raw.Utils++#include <netcdf.h>++-- LIBRARY VERSION++-- const char *nc_inq_libvers(void);+{#fun nc_inq_libvers as nc_inq_libvers' { } -> `String' #}+nc_inq_libvers :: String+nc_inq_libvers = unsafePerformIO nc_inq_libvers'++++-- RETURN VALUES++-- const char *nc_strerror(int ncerr);+{#fun nc_strerror as nc_strerror' { `Int' } -> `String' #}+nc_strerror :: Int -> String+nc_strerror = unsafePerformIO . nc_strerror'++++-- FILE OPERATIONS++-- int nc_create(const char *path, int cmode, int *ncidp);+{#fun nc_create { `String', `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc__create(const char *path, int cmode, size_t initialsz,+-- size_t *chunksizehintp, int *ncidp);+{#fun nc__create { `String', `Int', `Int',+ alloca- `Int' peekIntConv*,+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_open(const char *path, int mode, int *ncidp);+{#fun nc_open { `String', `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc__open(const char *path, int mode,+-- size_t *chunksizehintp, int *ncidp);+{#fun nc__open { `String', `Int',+ alloca- `Int' peekIntConv*,+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_redef(int ncid);+{#fun nc_redef { `Int' } -> `Int' #}++-- int nc_enddef(int ncid);+{#fun nc_enddef { `Int' } -> `Int' #}++-- int nc__enddef(int ncid, size_t h_minfree, size_t v_align,+-- size_t v_minfree, size_t r_align);+{#fun nc__enddef { `Int', `Int', `Int', `Int', `Int' } -> `Int' #}++-- int nc_sync(int ncid);+{#fun nc_sync { `Int' } -> `Int' #}++-- int nc_close(int ncid);+{#fun nc_close { `Int' } -> `Int' #}++-- 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);+{#fun nc_inq { `Int', alloca- `Int' peekIntConv*, alloca- `Int' peekIntConv*,+ alloca- `Int' peekIntConv*,+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_ndims(int ncid, int *ndimsp);+{#fun nc_inq_ndims { `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_nvars(int ncid, int *nvarsp);+{#fun nc_inq_nvars { `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_natts(int ncid, int *nattsp);+{#fun nc_inq_natts { `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_unlimdim(int ncid, int *unlimdimidp);+{#fun nc_inq_unlimdim { `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_format(int ncid, int *formatp);+{#fun nc_inq_format { `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_def_dim(int ncid, const char *name, size_t len, int *idp);+{#fun nc_def_dim { `Int', `String', `Int',+ alloca- `Int' peekIntConv* } -> `Int' #}++++-- DIMENSIONS++-- int nc_inq_dimid(int ncid, const char *name, int *idp);+{#fun nc_inq_dimid { `Int', `String', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_dim(int ncid, int dimid, char *name, size_t *lenp);+{#fun nc_inq_dim { `Int', `Int', allocaName- `String' peekCString*,+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_dimname(int ncid, int dimid, char *name);+{#fun nc_inq_dimname { `Int', `Int',+ allocaName- `String' peekCString* } -> `Int' #}++-- int nc_inq_dimlen(int ncid, int dimid, size_t *lenp);+{#fun nc_inq_dimlen { `Int', `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_rename_dim(int ncid, int dimid, const char *name);+{#fun nc_rename_dim { `Int', `Int', `String' } -> `Int' #}++-- 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);+{#fun nc_def_var { `Int', `String', `Int', `Int',+ withIntArray* `[Int]',+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_varid(int ncid, const char *name, int *varidp);+{#fun nc_inq_varid { `Int', `String', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_var(int ncid, int varid, char *name, nc_type *xtypep,+-- int *ndimsp, int *dimidsp, int *nattsp);+{#fun nc_inq_var { `Int', `Int',+ allocaName- `String' peekCString*,+ alloca- `Int' peekIntConv*,+ alloca- `Int' peekIntConv*,+ allocaVarDims- `[Int]' peekVarDims*,+ alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_varname(int ncid, int varid, char *name);+{#fun nc_inq_varname { `Int', `Int',+ allocaName- `String' peekCString* } -> `Int' #}++-- int nc_inq_vartype(int ncid, int varid, nc_type *xtypep);+{#fun nc_inq_vartype { `Int', `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_varndims(int ncid, int varid, int *ndimsp);+{#fun nc_inq_varndims { `Int', `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_inq_vardimid(int ncid, int varid, int *dimidsp);+{#fun nc_inq_vardimid { `Int', `Int',+ allocaVarDims- `[Int]' peekVarDims* } -> `Int' #}++-- int nc_inq_varnatts(int ncid, int varid, int *nattsp);+{#fun nc_inq_varnatts { `Int', `Int', alloca- `Int' peekIntConv* } -> `Int' #}++-- int nc_rename_var(int ncid, int varid, const char *name);+{#fun nc_rename_var { `Int', `Int', `String' } -> `Int' #}++-- int nc_copy_var(int ncid_in, int varid, int ncid_out);+{#fun nc_copy_var { `Int', `Int', `Int' } -> `Int' #}++-- int nc_set_fill(int ncid, int fillmode, int *old_modep);+{#fun nc_set_fill { `Int', `Int', alloca- `Int' peekIntConv* } -> `Int' #}
+ Data/NetCDF/Raw/NetCDF4.chs view
@@ -0,0 +1,151 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Raw bindings for NetCDF4 features (not implemented).++module Data.NetCDF.Raw.NetCDF4 where++#include <netcdf.h>++--------------------------------------------------------------------------------+--+-- UNSUPPORTED FEATURES (NetCDF-4)+--+--------------------------------------------------------------------------------++-- USER DEFINED TYPES+--+-- int nc_def_compound(int ncid, size_t size,+-- const char *name, nc_type *typeidp);+-- int nc_insert_compound(int ncid, nc_type xtype, const char *name,+-- size_t offset, nc_type field_typeid);+-- int nc_insert_array_compound(int ncid, nc_type xtype, const char *name,+-- size_t offset, nc_type field_typeid,+-- int ndims, const int *dim_sizes);+-- int nc_inq_type(int ncid, nc_type xtype, char *name, size_t *size);+-- int nc_inq_compound(int ncid, nc_type xtype, char *name, size_t *sizep,+-- size_t *nfieldsp);+-- int nc_inq_compound_name(int ncid, nc_type xtype, char *name);+-- int nc_inq_compound_size(int ncid, nc_type xtype, size_t *sizep);+-- int nc_inq_compound_nfields(int ncid, nc_type xtype, size_t *nfieldsp);+-- int nc_inq_compound_fieldname(int ncid, nc_type xtype, int fieldid,+-- char *name);+-- int nc_inq_compound_fieldindex(int ncid, nc_type xtype, const char *name,+-- int *fieldidp);+-- int nc_inq_compound_fieldoffset(int ncid, nc_type xtype, int fieldid,+-- size_t *offsetp);+-- int nc_inq_compound_fieldtype(int ncid, nc_type xtype, int fieldid,+-- nc_type *field_typeidp);+-- int nc_inq_compound_fieldndims(int ncid, nc_type xtype, int fieldid,+-- int *ndimsp);+-- int nc_inq_compound_fielddim_sizes(int ncid, nc_type xtype, int fieldid,+-- int *dim_sizes);+-- typedef struct {+-- size_t len; /**< Length of VL data (in base type units) */+-- void *p; /**< Pointer to VL data */+-- } nc_vlen_t;+-- int nc_def_vlen(int ncid, const char *name,+-- nc_type base_typeid, nc_type *xtypep);+-- int nc_inq_vlen(int ncid, nc_type xtype, char *name, size_t *datum_sizep,+-- nc_type *base_nc_typep);+-- int nc_free_vlen(nc_vlen_t *vl);+-- int nc_put_vlen_element(int ncid, int typeid1, void *vlen_element,+-- size_t len, const void *data);+-- int nc_get_vlen_element(int ncid, int typeid1, const void *vlen_element,+-- size_t *len, void *data);+-- int nc_free_string(size_t len, char **data);+-- int nc_inq_user_type(int ncid, nc_type xtype, char *name, size_t *size,+-- nc_type *base_nc_typep, size_t *nfieldsp, int *classp);+-- int nc_def_enum(int ncid, nc_type base_typeid, const char *name,+-- nc_type *typeidp);+-- int nc_insert_enum(int ncid, nc_type xtype, const char *name,+-- const void *value);+-- int nc_inq_enum_member(int ncid, nc_type xtype, int idx, char *name,+-- void *value);+-- int nc_inq_enum_ident(int ncid, nc_type xtype, long long value,+-- char *identifier);+-- int nc_def_opaque(int ncid, size_t size, const char *name, nc_type *xtypep);+-- int nc_inq_opaque(int ncid, nc_type xtype, char *name, size_t *sizep);+-- int nc_inq_typeid(int ncid, const char *name, nc_type *typeidp);+-- int nc_inq_compound_field(int ncid, nc_type xtype, int fieldid, char *name,+-- size_t *offsetp, nc_type *field_typeidp,+-- int *ndimsp, int *dim_sizesp);+-- int nc_free_vlens(size_t len, nc_vlen_t vlens[]);+-- int nc_inq_enum(int ncid, nc_type xtype, char *name, nc_type *base_nc_typep,+-- size_t *base_sizep, size_t *num_membersp);++-- GROUPS+--+-- int nc_inq_ncid(int ncid, const char *name, int *grp_ncid);+-- int nc_inq_grps(int ncid, int *numgrps, int *ncids);+-- int nc_inq_grpname(int ncid, char *name);+-- int nc_inq_grpname_full(int ncid, size_t *lenp, char *full_name);+-- int nc_inq_grpname_len(int ncid, size_t *lenp);+-- int nc_inq_grp_parent(int ncid, int *parent_ncid);+-- int nc_inq_grp_ncid(int ncid, const char *grp_name, int *grp_ncid);+-- int nc_inq_grp_full_ncid(int ncid, const char *full_name, int *grp_ncid);+-- int nc_inq_varids(int ncid, int *nvars, int *varids);+-- int nc_inq_dimids(int ncid, int *ndims, int *dimids, int include_parents);+-- int nc_inq_typeids(int ncid, int *ntypes, int *typeids);+-- int nc_def_grp(int parent_ncid, const char *name, int *new_ncid);++-- NETCDF-4 VARIABLES+--+-- int nc_def_var_deflate(int ncid, int varid, int shuffle, int deflate,+-- int deflate_level);+-- int nc_inq_var_deflate(int ncid, int varid, int *shufflep,+-- int *deflatep, int *deflate_levelp);+-- int nc_def_var_fletcher32(int ncid, int varid, int fletcher32);+-- int nc_inq_var_fletcher32(int ncid, int varid, int *fletcher32p);+-- int nc_def_var_chunking(int ncid, int varid, int storage,+-- const size_t *chunksizesp);+-- int nc_inq_var_chunking(int ncid, int varid, int *storagep,+-- size_t *chunksizesp);+-- int nc_def_var_fill(int ncid, int varid, int no_fill,+-- const void *fill_value);+-- int nc_inq_var_fill(int ncid, int varid, int *no_fill, void *fill_valuep);+-- int nc_def_var_endian(int ncid, int varid, int endian);+-- int nc_inq_var_endian(int ncid, int varid, int *endianp);+-- int nc_set_chunk_cache(size_t size, size_t nelems, float preemption);+-- int nc_get_chunk_cache(size_t *sizep, size_t *nelemsp, float *preemptionp);+-- int nc_set_var_chunk_cache(int ncid, int varid, size_t size, size_t nelems,+-- float preemption);+-- int nc_get_var_chunk_cache(int ncid, int varid, size_t *sizep,+-- size_t *nelemsp, float *preemptionp);+-- int nc_inq_var_szip(int ncid, int varid, int *options_maskp,+-- int *pixels_per_blockp);++-- Variable length strings are only supported in NetCDF-4 files, which+-- we don't handle yet.+--+-- int nc_put_var_string(int ncid, int varid, const char **op);+-- int nc_get_var_string(int ncid, int varid, char **ip);+-- int nc_put_var1_string(int ncid, int varid, const size_t *indexp,+-- const char **op);+-- int nc_get_var1_string(int ncid, int varid, const size_t *indexp,+-- char **ip);+-- int nc_put_vara_string(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const char **op);+-- int nc_get_vara_string(int ncid, int varid, const size_t *startp,+-- const size_t *countp, char **ip);+-- int nc_put_vars_string(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const char **op);+-- int nc_get_vars_string(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- char **ip);+-- int nc_put_varm_string(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, const char **op);+-- int nc_get_varm_string(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, char **ip);+-- int nc_put_att_string(int ncid, int varid, const char *name,+-- size_t len, const char **op);+-- int nc_get_att_string(int ncid, int varid, const char *name, char **ip);++-- MISCELLANEOUS+--+-- int nc_var_par_access(int ncid, int varid, int par_access);+-- int nc_inq_type_equal(int ncid1, nc_type typeid1, int ncid2,+-- nc_type typeid2, int *equal);+-- int nc_set_default_format(int format, int *old_formatp);
+ Data/NetCDF/Raw/PutGet.hs view
@@ -0,0 +1,372 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Raw FFI bindings for NetCDF functions for reading and writing+-- data values.++module Data.NetCDF.Raw.PutGet where++import Data.NetCDF.Raw.Utils+++-- WRITING AND READING SINGLE DATA VALUES++nc_put_var1_htext :: CInt -> CInt -> Ptr CULong -> String -> IO CInt+nc_put_var1_htext ncid varid idx s =+ withCString s $ nc_put_var1_text'_ ncid varid idx+foreign import ccall safe "netcdf.h nc_put_var1_text"+ nc_put_var1_text'_ :: CInt -> CInt -> Ptr CULong -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_uchar"+ nc_put_var1_uchar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_schar"+ nc_put_var1_schar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_short"+ nc_put_var1_short'_ :: CInt -> CInt -> Ptr CULong -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_int"+ nc_put_var1_int'_ :: CInt -> CInt -> Ptr CULong -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_long"+ nc_put_var1_long'_ :: CInt -> CInt -> Ptr CULong -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_float"+ nc_put_var1_float'_ :: CInt -> CInt -> Ptr CULong -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_double"+ nc_put_var1_double'_ :: CInt -> CInt -> Ptr CULong -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_ushort"+ nc_put_var1_ushort'_ :: CInt -> CInt -> Ptr CULong -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_uint"+ nc_put_var1_uint'_ :: CInt -> CInt -> Ptr CULong -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_longlong"+ nc_put_var1_longlong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var1_ulonglong"+ nc_put_var1_ulonglong'_ :: CInt -> CInt -> Ptr CULong+ -> Ptr CULLong -> IO CInt++nc_get_var1_htext :: CInt -> CInt -> Ptr CULong -> IO (CInt, String)+nc_get_var1_htext ncid varid idx =+ allocaArray 1 $ \sp -> do+ res <- nc_get_var1_text'_ ncid varid idx sp+ s <- peekCString sp+ return (res, s)+foreign import ccall safe "netcdf.h nc_get_var1_text"+ nc_get_var1_text'_ :: CInt -> CInt -> Ptr CULong -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_uchar"+ nc_get_var1_uchar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_schar"+ nc_get_var1_schar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_short"+ nc_get_var1_short'_ :: CInt -> CInt -> Ptr CULong -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_int"+ nc_get_var1_int'_ :: CInt -> CInt -> Ptr CULong -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_long"+ nc_get_var1_long'_ :: CInt -> CInt -> Ptr CULong -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_float"+ nc_get_var1_float'_ :: CInt -> CInt -> Ptr CULong -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_double"+ nc_get_var1_double'_ :: CInt -> CInt -> Ptr CULong -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_ushort"+ nc_get_var1_ushort'_ :: CInt -> CInt -> Ptr CULong -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_uint"+ nc_get_var1_uint'_ :: CInt -> CInt -> Ptr CULong -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_longlong"+ nc_get_var1_longlong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var1_ulonglong"+ nc_get_var1_ulonglong'_ :: CInt -> CInt -> Ptr CULong+ -> Ptr CULLong -> IO CInt+++-- WRITING AND READING WHOLE VARIABLES++nc_put_var_htext :: CInt -> CInt -> String -> IO CInt+nc_put_var_htext ncid varid s = withCString s $ nc_put_var_text'_ ncid varid+foreign import ccall safe "netcdf.h nc_put_var_text"+ nc_put_var_text'_ :: CInt -> CInt -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_uchar"+ nc_put_var_uchar'_ :: CInt -> CInt -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_schar"+ nc_put_var_schar'_ :: CInt -> CInt -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_short"+ nc_put_var_short'_ :: CInt -> CInt -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_int"+ nc_put_var_int'_ :: CInt -> CInt -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_long"+ nc_put_var_long'_ :: CInt -> CInt -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_float"+ nc_put_var_float'_ :: CInt -> CInt -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_double"+ nc_put_var_double'_ :: CInt -> CInt -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_ushort"+ nc_put_var_ushort'_ :: CInt -> CInt -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_uint"+ nc_put_var_uint'_ :: CInt -> CInt -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_longlong"+ nc_put_var_longlong'_ :: CInt -> CInt -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_var_ulonglong"+ nc_put_var_ulonglong'_ :: CInt -> CInt -> Ptr CULLong -> IO CInt++nc_get_var_htext :: CInt -> CInt -> Int -> IO (CInt, String)+nc_get_var_htext ncid varid len =+ allocaArray len $ \sp -> do+ res <- nc_get_var_text'_ ncid varid sp+ s <- peekCString sp+ return (res, s)+foreign import ccall safe "netcdf.h nc_get_var_text"+ nc_get_var_text'_ :: CInt -> CInt -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_uchar"+ nc_get_var_uchar'_ :: CInt -> CInt -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_schar"+ nc_get_var_schar'_ :: CInt -> CInt -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_short"+ nc_get_var_short'_ :: CInt -> CInt -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_int"+ nc_get_var_int'_ :: CInt -> CInt -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_long"+ nc_get_var_long'_ :: CInt -> CInt -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_float"+ nc_get_var_float'_ :: CInt -> CInt -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_double"+ nc_get_var_double'_ :: CInt -> CInt -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_ushort"+ nc_get_var_ushort'_ :: CInt -> CInt -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_uint"+ nc_get_var_uint'_ :: CInt -> CInt -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_longlong"+ nc_get_var_longlong'_ :: CInt -> CInt -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_var_ulonglong"+ nc_get_var_ulonglong'_ :: CInt -> CInt -> Ptr CULLong -> IO CInt+++-- WRITING AND READING AN ARRAY++foreign import ccall safe "netcdf.h nc_put_vara_text"+ nc_put_vara_text'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_uchar"+ nc_put_vara_uchar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_schar"+ nc_put_vara_schar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_short"+ nc_put_vara_short'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_int"+ nc_put_vara_int'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_long"+ nc_put_vara_long'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_float"+ nc_put_vara_float'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_double"+ nc_put_vara_double'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_ushort"+ nc_put_vara_ushort'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_uint"+ nc_put_vara_uint'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_longlong"+ nc_put_vara_longlong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vara_ulonglong"+ nc_put_vara_ulonglong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CULLong -> IO CInt++-- nc_get_vara_htext :: CInt -> CInt -> Ptr CULong -> Ptr CULong+-- -> IO (CInt, String)+-- nc_get_vara_htext ncid varid start count =+-- allocaArray (product count) $ \sp -> do+-- res <- nc_get_vara_text'_ ncid varid start count sp+-- s <- peekCString sp+-- return (res, s)+foreign import ccall safe "netcdf.h nc_get_vara_text"+ nc_get_vara_text'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_uchar"+ nc_get_vara_uchar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_schar"+ nc_get_vara_schar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_short"+ nc_get_vara_short'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_int"+ nc_get_vara_int'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_long"+ nc_get_vara_long'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_float"+ nc_get_vara_float'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_double"+ nc_get_vara_double'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_ushort"+ nc_get_vara_ushort'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_uint"+ nc_get_vara_uint'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_longlong"+ nc_get_vara_longlong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vara_ulonglong"+ nc_get_vara_ulonglong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CULLong -> IO CInt+++-- WRITING AND READING A SLICED ARRAY++foreign import ccall safe "netcdf.h nc_put_vars_text"+ nc_put_vars_text'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_uchar"+ nc_put_vars_uchar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_schar"+ nc_put_vars_schar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_short"+ nc_put_vars_short'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_int"+ nc_put_vars_int'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_long"+ nc_put_vars_long'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_float"+ nc_put_vars_float'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_double"+ nc_put_vars_double'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_ushort"+ nc_put_vars_ushort'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_uint"+ nc_put_vars_uint'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_longlong"+ nc_put_vars_longlong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CULong -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_put_vars_ulonglong"+ nc_put_vars_ulonglong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CULong -> Ptr CULLong -> IO CInt++foreign import ccall safe "netcdf.h nc_get_vars_text"+ nc_get_vars_text'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_uchar"+ nc_get_vars_uchar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CUChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_schar"+ nc_get_vars_schar'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CSChar -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_short"+ nc_get_vars_short'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_int"+ nc_get_vars_int'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_long"+ nc_get_vars_long'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_float"+ nc_get_vars_float'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CFloat -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_double"+ nc_get_vars_double'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CDouble -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_ushort"+ nc_get_vars_ushort'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CUShort -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_uint"+ nc_get_vars_uint'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr CUInt -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_longlong"+ nc_get_vars_longlong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CULong -> Ptr CLLong -> IO CInt+foreign import ccall safe "netcdf.h nc_get_vars_ulonglong"+ nc_get_vars_ulonglong'_ :: CInt -> CInt -> Ptr CULong -> Ptr CULong+ -> Ptr CULong -> Ptr CULLong -> IO CInt+++-- WRITING AND READING A MAPPED ARRAY++-- int nc_put_varm_text(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const char *op);+-- int nc_put_varm_uchar(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const unsigned char *op);+-- int nc_put_varm_schar(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const signed char *op);+-- int nc_put_varm_short(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const short *op);+-- int nc_put_varm_int(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const int *op);+-- int nc_put_varm_long(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const long *op);+-- int nc_put_varm_float(int ncid, int varid,const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const float *op);+-- int nc_put_varm_double(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, const double *op);+-- int nc_put_varm_ushort(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, const unsigned short *op);+-- int nc_put_varm_uint(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, const unsigned int *op);+-- int nc_put_varm_longlong(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, const long long *op);+-- int nc_put_varm_ulonglong(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp,+-- const unsigned long long *op);++-- int nc_get_varm_text(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, char *ip);+-- int nc_get_varm_uchar(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, unsigned char *ip);+-- int nc_get_varm_schar(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, signed char *ip);+-- int nc_get_varm_short(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, short *ip);+-- int nc_get_varm_int(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, int *ip);+-- int nc_get_varm_long(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, long *ip);+-- int nc_get_varm_float(int ncid, int varid,const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t *imapp, float *ip);+-- int nc_get_varm_double(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, double *ip);+-- int nc_get_varm_ushort(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, unsigned short *ip);+-- int nc_get_varm_uint(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, unsigned int *ip);+-- int nc_get_varm_longlong(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, long long *ip);+-- int nc_get_varm_ulonglong(int ncid, int varid, const size_t *startp,+-- const size_t *countp, const ptrdiff_t *stridep,+-- const ptrdiff_t * imapp, unsigned long long *ip);
+ Data/NetCDF/Raw/Utils.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | FFI utility functions for raw bindings.++module Data.NetCDF.Raw.Utils+ ( module Data.NetCDF.Raw.Utils+ , module Foreign+ , module Foreign.C+ , unsafePerformIO+ ) where++import Control.Monad (liftM)+import Foreign hiding (unsafePerformIO)+import Foreign.C+import System.IO.Unsafe (unsafePerformIO)++ncMaxName, ncMaxDims, ncMaxVars, ncMaxAttrs, ncMaxVarDims :: Int+ncMaxName = 256+ncMaxDims = 1024+ncMaxVars = 8192+ncMaxAttrs = 8192+ncMaxVarDims = 1024+++-- | FFI utilities++peekIntConv :: (Storable a, Integral a, Integral b) => Ptr a -> IO b+peekIntConv = liftM fromIntegral . peek++peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b+peekFloatConv = liftM realToFrac . peek++withIntArray :: (Storable a, Integral a) => [a] -> (Ptr CInt -> IO b) -> IO b+withIntArray = withArray . liftM fromIntegral++withIntPtrConv :: (Storable a, Storable b, Integral a, Integral b)+ => a -> (Ptr b -> IO c) -> IO c+withIntPtrConv val f =+ alloca $ \ptr -> do+ poke ptr (fromIntegral val)+ f ptr++withFloatPtrConv :: (Storable a, Storable b, RealFloat a, RealFloat b)+ => a -> (Ptr b -> IO c) -> IO c+withFloatPtrConv val f =+ alloca $ \ptr -> do+ poke ptr (realToFrac val)+ f ptr++withCStringPtr :: String -> (Ptr CString -> IO a) -> IO a+withCStringPtr val f =+ withCString val $ \inner -> do+ alloca $ \outer -> do+ poke outer inner+ f outer++allocaName :: (Ptr a -> IO b) -> IO b+allocaName = allocaBytes ncMaxName++allocaVarDims :: (Ptr CInt -> IO b) -> IO b+allocaVarDims = allocaArray ncMaxVarDims+peekVarDims :: Ptr CInt -> IO [Int]+peekVarDims = liftM (map fromIntegral) . peekArray ncMaxVarDims
+ Data/NetCDF/Storable.hs view
@@ -0,0 +1,153 @@+-- | The mapping between types that can be stored in a NetCDF file and+-- the FFI functions needed to read and write those values is+-- maintained by the `NcStorable` type class.++module Data.NetCDF.Storable+ ( NcStorable (..)+ ) where++import Foreign.C+import Foreign.Ptr+import Foreign.Storable++import Data.NetCDF.Types+import Data.NetCDF.Store+import Data.NetCDF.Raw.PutGet+++-- | Class to collect the NetCDF FFI functions needed to read and+-- write values in a NetCDF file for a given type.+class Storable a => NcStorable a where+ ncType :: a -> NcType+ ffi_put_var1 :: CInt -> CInt -> Ptr CULong -> Ptr a -> IO CInt+ ffi_get_var1 :: CInt -> CInt -> Ptr CULong -> Ptr a -> IO CInt+ ffi_put_var :: CInt -> CInt -> Ptr a -> IO CInt+ ffi_get_var :: CInt -> CInt -> Ptr a -> IO CInt+ ffi_put_vara :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr a -> IO CInt+ ffi_get_vara :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr a -> IO CInt+ ffi_put_vars :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr a -> IO CInt+ ffi_get_vars :: CInt -> CInt -> Ptr CULong -> Ptr CULong -> Ptr CULong+ -> Ptr a -> IO CInt+++instance NcStorable CSChar where+ -- #define NC_BYTE 1 /**< signed 1 byte integer */+ ncType _ = NcByte+ ffi_put_var1 = nc_put_var1_schar'_+ ffi_get_var1 = nc_get_var1_schar'_+ ffi_put_var = nc_put_var_schar'_+ ffi_get_var = nc_get_var_schar'_+ ffi_put_vara = nc_put_vara_schar'_+ ffi_get_vara = nc_get_vara_schar'_+ ffi_put_vars = nc_put_vars_schar'_+ ffi_get_vars = nc_get_vars_schar'_++instance NcStorable CChar where+ -- #define NC_CHAR 2 /**< ISO/ASCII character */+ ncType _ = NcChar+ ffi_put_var1 = nc_put_var1_text'_+ ffi_get_var1 = nc_get_var1_text'_+ ffi_put_var = nc_put_var_text'_+ ffi_get_var = nc_get_var_text'_+ ffi_put_vara = nc_put_vara_text'_+ ffi_get_vara = nc_get_vara_text'_+ ffi_put_vars = nc_put_vars_text'_+ ffi_get_vars = nc_get_vars_text'_++instance NcStorable CShort where+ -- #define NC_SHORT 3 /**< signed 2 byte integer */+ ncType _ = NcShort+ ffi_put_var1 = nc_put_var1_short'_+ ffi_get_var1 = nc_get_var1_short'_+ ffi_put_var = nc_put_var_short'_+ ffi_get_var = nc_get_var_short'_+ ffi_put_vara = nc_put_vara_short'_+ ffi_get_vara = nc_get_vara_short'_+ ffi_put_vars = nc_put_vars_short'_+ ffi_get_vars = nc_get_vars_short'_++instance NcStorable CInt where+ -- #define NC_INT 4 /**< signed 4 byte integer */+ ncType _ = NcInt+ ffi_put_var1 = nc_put_var1_int'_+ ffi_get_var1 = nc_get_var1_int'_+ ffi_put_var = nc_put_var_int'_+ ffi_get_var = nc_get_var_int'_+ ffi_put_vara = nc_put_vara_int'_+ ffi_get_vara = nc_get_vara_int'_+ ffi_put_vars = nc_put_vars_int'_+ ffi_get_vars = nc_get_vars_int'_++instance NcStorable CFloat where+ -- #define NC_FLOAT 5 /**< single precision floating point number */+ ncType _ = NcFloat+ ffi_put_var1 = nc_put_var1_float'_+ ffi_get_var1 = nc_get_var1_float'_+ ffi_put_var = nc_put_var_float'_+ ffi_get_var = nc_get_var_float'_+ ffi_put_vara = nc_put_vara_float'_+ ffi_get_vara = nc_get_vara_float'_+ ffi_put_vars = nc_put_vars_float'_+ ffi_get_vars = nc_get_vars_float'_++instance NcStorable CDouble where+ -- #define NC_DOUBLE 6 /**< double precision floating point number */+ ncType _ = NcDouble+ ffi_put_var1 = nc_put_var1_double'_+ ffi_get_var1 = nc_get_var1_double'_+ ffi_put_var = nc_put_var_double'_+ ffi_get_var = nc_get_var_double'_+ ffi_put_vara = nc_put_vara_double'_+ ffi_get_vara = nc_get_vara_double'_+ ffi_put_vars = nc_put_vars_double'_+ ffi_get_vars = nc_get_vars_double'_++instance NcStorable CUChar where+ -- #define NC_UBYTE 7 /**< unsigned 1 byte int */+ ncType _ = NcUByte+ ffi_put_var1 = nc_put_var1_uchar'_+ ffi_get_var1 = nc_get_var1_uchar'_+ ffi_put_var = nc_put_var_uchar'_+ ffi_get_var = nc_get_var_uchar'_+ ffi_put_vara = nc_put_vara_uchar'_+ ffi_get_vara = nc_get_vara_uchar'_+ ffi_put_vars = nc_put_vars_uchar'_+ ffi_get_vars = nc_get_vars_uchar'_++instance NcStorable CUShort where+ -- #define NC_USHORT 8 /**< unsigned 2-byte int */+ ncType _ = NcUShort+ ffi_put_var1 = nc_put_var1_ushort'_+ ffi_get_var1 = nc_get_var1_ushort'_+ ffi_put_var = nc_put_var_ushort'_+ ffi_get_var = nc_get_var_ushort'_+ ffi_put_vara = nc_put_vara_ushort'_+ ffi_get_vara = nc_get_vara_ushort'_+ ffi_put_vars = nc_put_vars_ushort'_+ ffi_get_vars = nc_get_vars_ushort'_++instance NcStorable CUInt where+ -- #define NC_UINT 9 /**< unsigned 4-byte int */+ ncType _ = NcUInt+ ffi_put_var1 = nc_put_var1_uint'_+ ffi_get_var1 = nc_get_var1_uint'_+ ffi_put_var = nc_put_var_uint'_+ ffi_get_var = nc_get_var_uint'_+ ffi_put_vara = nc_put_vara_uint'_+ ffi_get_vara = nc_get_vara_uint'_+ ffi_put_vars = nc_put_vars_uint'_+ ffi_get_vars = nc_get_vars_uint'_++instance NcStorable CLong where+ -- #define NC_INT64 10 /**< signed 8-byte int */+ ncType _ = NcInt64+ ffi_put_var1 = nc_put_var1_long'_+ ffi_get_var1 = nc_get_var1_long'_+ ffi_put_var = nc_put_var_long'_+ ffi_get_var = nc_get_var_long'_+ ffi_put_vara = nc_put_vara_long'_+ ffi_get_vara = nc_get_vara_long'_+ ffi_put_vars = nc_put_vars_long'_+ ffi_get_vars = nc_get_vars_long'_+
+ Data/NetCDF/Store.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleInstances #-}+-- | The /store polymorphism/ for the functions to get the values of+-- NetCDF variables relies on a simple `NcStore` typeclass for+-- converting between /store/ values and @ForeignPtr@s.++module Data.NetCDF.Store where++import Data.List (reverse)+import Foreign.Storable+import Foreign.ForeignPtr++import Data.Vector.Storable hiding (reverse)++import Data.Array.Repa+import qualified Data.Array.Repa as R+import qualified Data.Array.Repa.Repr.ForeignPtr as RF+import Data.Array.Repa.Repr.ForeignPtr (F)++import Data.NetCDF.Types++-- | Class representing containers suitable for storing values read+-- from NetCDF variables. Just has methods to convert back and forth+-- between the store and a foreign pointer, and to perform simple+-- mapping over the store.+class NcStore s where+ toForeignPtr :: Storable e => s e -> ForeignPtr e+ fromForeignPtr :: Storable e => ForeignPtr e -> [Int] -> s e+ smap :: (Storable a, Storable b) => (a -> b) -> s a -> s b++instance NcStore Vector where+ toForeignPtr = fst . unsafeToForeignPtr0+ fromForeignPtr p s = unsafeFromForeignPtr0 p (Prelude.product s)+ smap = Data.Vector.Storable.map++instance Shape sh => NcStore (Array F sh) where+ toForeignPtr = RF.toForeignPtr+ fromForeignPtr p s = RF.fromForeignPtr (shapeOfList $ reverse s) p+ smap f s = computeS $ R.map f s
+ Data/NetCDF/Types.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DeriveDataTypeable #-}+-- | Basic utility type definitions for NetCDF bindings.++module Data.NetCDF.Types where++import Control.Exception+import Data.Typeable+import System.FilePath+import System.IO (IOMode (..))++-- | Representation for NetCDF external data types.+--+data NcType = NcByte -- ^ Signed 1 byte integer+ | NcChar -- ^ ISO/ASCII character+ | NcShort -- ^ Signed 2 byte integer+ | NcInt -- ^ Signed 4 byte integer+ | NcFloat -- ^ Single precision floating point+ | NcDouble -- ^ Double precision floating point+ | NcUByte -- ^ Unsigned 1 byte int+ | NcUShort -- ^ Unsigned 2-byte int+ | NcUInt -- ^ Unsigned 4-byte int+ | NcInt64 -- ^ Signed 8-byte int+ | NcUInt64 -- ^ Unsigned 8-byte int+ | NcString -- ^ String+ deriving (Eq, Show)++instance Enum NcType where+ fromEnum NcByte = 1+ fromEnum NcChar = 2+ fromEnum NcShort = 3+ fromEnum NcInt = 4+ fromEnum NcFloat = 5+ fromEnum NcDouble = 6+ fromEnum NcUByte = 7+ fromEnum NcUShort = 8+ fromEnum NcUInt = 9+ fromEnum NcInt64 = 10+ fromEnum NcUInt64 = 11+ fromEnum NcString = 12+ toEnum n = case n of+ 1 -> NcByte+ 2 -> NcChar+ 3 -> NcShort+ 4 -> NcInt+ 5 -> NcFloat+ 6 -> NcDouble+ 7 -> NcUByte+ 8 -> NcUShort+ 9 -> NcUInt+ 10 -> NcInt64+ 11 -> NcUInt64+ 12 -> NcString+ _ -> throw (NcInvalidType n)++-- | Internal representation of NetCDF IDs.+type NcId = Int++-- | NetCDF error types.+data NcError = NcError String Int String FilePath+ | NcInvalidArgs String+ | NcInvalidType Int+ deriving (Show, Typeable)++instance Exception NcError++-- | Convenience function to convert `IOMode` values to integer values+-- for calls to NetCDF functions.+ncIOMode :: IOMode -> Int+ncIOMode ReadMode = 0+ncIOMode WriteMode = 1+ncIOMode _ = throw (NcInvalidArgs "IO mode")++-- | Fake variable identifier for global attributes.+ncGlobal :: Int+ncGlobal = -1
+ Data/NetCDF/Utils.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+module Data.NetCDF.Utils where++import Data.NetCDF.Raw+import Data.NetCDF.Types++import Control.Monad.Trans.Class+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Either++-- | Simple synonym to tidy up signatures.+type NcIO a = IO (Either NcError a)++-- | Monad stack to help with handling errors from FFI functions.+type Access a = ReaderT (String, FilePath) (EitherT NcError IO) a++-- | Utility function to run access monad stack.+runAccess :: String -> String -> Access a -> NcIO a+runAccess f p = runEitherT . flip runReaderT (f, p)++-- | Utility class to make dealing with status return from foreign+-- NetCDF functions a little easier.+class Checkable a where+ type OutType a :: *+ status :: a -> Int+ proj :: a -> OutType a++instance Checkable (Int, a) where+ type OutType (Int, a) = a+ status (s, _) = s+ proj (_, a) = a++instance Checkable (Int, a, b) where+ type OutType (Int, a, b) = (a, b)+ status (s, _, _) = s+ proj (_, a, b) = (a, b)++instance Checkable (Int, a, b, c) where+ type OutType (Int, a, b, c) = (a, b, c)+ status (s, _, _, _) = s+ proj (_, a, b, c) = (a, b, c)++instance Checkable (Int, a, b, c, d) where+ type OutType (Int, a, b, c, d) = (a, b, c, d)+ status (s, _, _, _, _) = s+ proj (_, a, b, c, d) = (a, b, c, d)++instance Checkable (Int, a, b, c, d, e) where+ type OutType (Int, a, b, c, d, e) = (a, b, c, d, e)+ status (s, _, _, _, _, _) = s+ proj (_, a, b, c, d, e) = (a, b, c, d, e)++-- | Perform an IO action that returns a tuple with an integer status+-- and some return values, processing errors.+chk :: Checkable a => IO a -> Access (OutType a)+chk act = do+ res <- lift $ liftIO $ act+ let st = status res+ val = proj res+ (f, p) <- ask+ lift $ if st == 0+ then right val+ else left $ NcError f st (nc_strerror st) p
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Ian Ross++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Ian Ross nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hnetcdf.cabal view
@@ -0,0 +1,114 @@+name: hnetcdf+version: 0.1.0.0+synopsis: Haskell NetCDF library+description:+ Bindings to the Unidata NetCDF library, along with a higher-level+ Haskell interface that attempts to provide container polymorphic+ data access (initially just Storable vectors and Repa arrays).+license: BSD3+license-file: LICENSE+author: Ian Ross+maintainer: ian@skybluetrades.net+copyright: Copyright (2013) Ian Ross+category: Data+build-type: Simple+cabal-version: >=1.8+homepage: https://github.com/ian-ross/hnetcdf++source-repository head+ type: git+ location: https://github.com/ian-ross/hnetcdf++Library+ exposed-modules: Data.NetCDF+ Data.NetCDF.Metadata+ Data.NetCDF.PutGet+ Data.NetCDF.Storable+ Data.NetCDF.Store+ Data.NetCDF.Types+ Data.NetCDF.Utils+ Data.NetCDF.Raw+ Data.NetCDF.Raw.Base+ Data.NetCDF.Raw.PutGet+ Data.NetCDF.Raw.Attributes+ Data.NetCDF.Raw.NetCDF4+ Data.NetCDF.Raw.Utils+ build-depends: base >= 4.3 && < 5,+ containers >= 0.4 && < 0.6,+ filepath >= 1.3 && < 1.4,+ transformers >= 0.2 && < 0.4,+ either >= 3.4.1 && < 3.5,+ errors >= 1.4.2 && < 1.5,+ vector >= 0.9 && < 0.11,+ repa >= 3.2 && < 3.3+ build-tools: c2hs+ extra-libraries: netcdf++Test-Suite test-raw-metadata+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test-raw-metadata.hs+ build-depends: hnetcdf,+ base >= 4.3 && < 5,+ containers >= 0.4 && < 0.6,+ vector >= 0.9 && < 0.11,+ repa >= 3.2 && < 3.3,+ test-framework >= 0.3,+ test-framework-hunit,+ test-framework-quickcheck2 >= 0.3,+ HUnit,+ QuickCheck+ extra-libraries: netcdf++Test-Suite test-raw-get-put+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test-raw-get-put.hs+ build-depends: hnetcdf,+ base >= 4.3 && < 5,+ containers >= 0.4 && < 0.6,+ vector >= 0.9 && < 0.11,+ repa >= 3.2 && < 3.3,+ directory >= 1.1 && < 1.3,+ test-framework >= 0.3,+ test-framework-hunit,+ test-framework-quickcheck2 >= 0.3,+ HUnit,+ QuickCheck+ extra-libraries: netcdf++Test-Suite test-raw-attributes+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test-raw-attributes.hs+ build-depends: hnetcdf,+ base >= 4.3 && < 5,+ containers >= 0.4 && < 0.6,+ vector >= 0.9 && < 0.11,+ repa >= 3.2 && < 3.3,+ directory >= 1.1 && < 1.3,+ test-framework >= 0.3,+ test-framework-hunit,+ test-framework-quickcheck2 >= 0.3,+ HUnit,+ QuickCheck+ extra-libraries: netcdf++Test-Suite test-get+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test-get.hs+ build-depends: hnetcdf,+ base >= 4.3 && < 5,+ containers >= 0.4 && < 0.6,+ errors >= 1.4.2 && < 1.5,+ vector >= 0.9 && < 0.11,+ repa >= 3.2 && < 3.3,+ directory >= 1.1 && < 1.3,+ test-framework >= 0.3,+ test-framework-hunit,+ test-framework-quickcheck2 >= 0.3,+ HUnit,+ QuickCheck+ extra-libraries: netcdf+
+ test/test-get.hs view
@@ -0,0 +1,405 @@+{-# LANGUAGE ScopedTypeVariables #-}+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test, assert)+import qualified Data.Vector.Storable as SV+import qualified Data.Array.Repa as R+import qualified Data.Array.Repa.Eval as RE+import Data.Array.Repa.Repr.ForeignPtr (F)+import Control.Error+import Control.Monad++import Foreign.C+import Data.NetCDF++main :: IO ()+main = defaultMain tests++infile :: FilePath+infile = "test/tst-raw-get-put.nc"++fwit :: CFloat+fwit = undefined++iwit :: CInt+iwit = undefined++swit :: CShort+swit = undefined++tests :: [Test]+tests =+ [ testGroup "Single item access functions"+ [ testCase "Read (float)" (getVar1 infile "vf" fwit)+ , testCase "Read (int)" (getVar1 infile "vi" iwit)+ , testCase "Read (short)" (getVar1 infile "vs" swit)+ ],+ testGroup "Whole variable access functions"+ [ testCase "Read (float, SV)" (getVarSV infile "vf" fwit)+ , testCase "Read (int, SV)" (getVarSV infile "vi" iwit)+ , testCase "Read (short, SV)" (getVarSV infile "vs" swit)+ , testCase "Read (float, Repa)" (getVarRepa infile "vf" fwit)+ , testCase "Read (int, Repa)" (getVarRepa infile "vi" iwit)+ , testCase "Read (short, Repa)" (getVarRepa infile "vs" swit)+ ],+ testGroup "Variable slice access functions"+ [ testCase "Read (float, SV)" (getVarASV infile "vf" fwit)+ , testCase "Read (int, SV)" (getVarASV infile "vi" iwit)+ , testCase "Read (short, SV)" (getVarASV infile "vs" swit)+ , testCase "Read (float, Repa)" (getVarARepa infile "vf" fwit)+ , testCase "Read (int, Repa)" (getVarARepa infile "vi" iwit)+ , testCase "Read (short, Repa)" (getVarARepa infile "vs" swit)+ ],+ testGroup "Strided slice access functions"+ [ testCase "Read (float, SV)" (getVarSSV infile "vf" fwit)+ , testCase "Read (int, SV)" (getVarSSV infile "vi" iwit)+ , testCase "Read (short, SV)" (getVarSSV infile "vs" swit)+ , testCase "Read (float, Repa)" (getVarSRepa infile "vf" fwit)+ , testCase "Read (int, Repa)" (getVarSRepa infile "vi" iwit)+ , testCase "Read (short, Repa)" (getVarSRepa infile "vs" swit)+ ]+ ]+++type SVRet a = IO (Either NcError (SV.Vector a))+type RepaRet3 a = IO (Either NcError (R.Array F R.DIM3 a))+type RepaRet1 a = IO (Either NcError (R.Array F R.DIM1 a))+++--------------------------------------------------------------------------------+--+-- SINGLE ITEM READ+--+--------------------------------------------------------------------------------++getVar1 :: forall a. (Eq a, Num a, Show a, NcStorable a)+ => FilePath -> String -> a -> Assertion+getVar1 f v _ = do+ enc <- openFile f ReadMode+ assertBool "failed to open file" $ isRight enc+ let Right nc = enc+ case ncVar nc v of+ Nothing -> assertBool "missing variable" False+ Just var -> do+ let [nz, ny, nx] = map ncDimLength $ ncVarDims var+ forM_ [1..nx] $ \ix -> do+ forM_ [1..ny] $ \iy -> do+ forM_ [1..nz] $ \iz -> do+ eval <- get1 nc var [iz-1, iy-1, ix-1] :: IO (Either NcError a)+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right val -> do+ let trueval = fromIntegral $ ix + 10 * iy + 100 * iz+ assertBool ("value error: " ++ show val +++ " instead of " ++ show trueval)+ (val == trueval)+ void $ closeFile nc++-- getVar1 :: FilePath -> String -> Assertion+-- getVar1 f v = do+-- enc <- openFile f ReadMode+-- assertBool "failed to open file" $ isRight enc+-- let Right nc = enc+-- case ncVar nc v of+-- Nothing -> assertBool "missing variable" False+-- Just var -> do+-- let [nz, ny, nx] = map ncDimLength $ ncVarDims var+-- typ = ncVarType var+-- forM_ [1..nx] $ \ix -> do+-- forM_ [1..ny] $ \iy -> do+-- forM_ [1..nz] $ \iz -> do+-- eval <- get1 nc var [iz-1, iy-1, ix-1] :: IO (Either NcError a)+-- case eval of+-- Left e -> assertBool ("read error: " ++ show e) False+-- Right val -> do+-- let trueval = fromIntegral $ ix + 10 * iy + 100 * iz+-- assertBool ("value error: " ++ show val +++-- " instead of " ++ show trueval)+-- (val == trueval)+-- void $ closeFile nc++++--------------------------------------------------------------------------------+--+-- WHOLE VARIABLE READ+--+--------------------------------------------------------------------------------++getVarSV :: forall a. (Eq a, Num a, Show a, NcStorable a)+ => FilePath -> String -> a -> Assertion+getVarSV f v _ = do+ enc <- openFile f ReadMode+ assertBool "failed to open file" $ isRight enc+ let Right nc = enc+ case ncVar nc v of+ Nothing -> assertBool "missing variable" False+ Just var -> do+ eval <- get nc var :: SVRet a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right val -> do+ let [nz, ny, nx] = map ncDimLength $ ncVarDims var+ truevals = [fromIntegral $ ix + 10 * iy + 100 * iz |+ ix <- [1..nx], iy <- [1..ny], iz <- [1..nz]]+ idxs = [(iz - 1) * ny * nx + (iy - 1) * nx + (ix - 1) |+ ix <- [1..nx], iy <- [1..ny], iz <- [1..nz]]+ tstvals = [val SV.! i | i <- idxs]+ assertBool ("value error: " ++ show tstvals +++ " instead of " ++ show truevals)+ (and $ zipWith (==) tstvals truevals)+ void $ closeFile nc++getVarRepa :: forall a. (Eq a, Num a, Show a, NcStorable a)+ => FilePath -> String -> a -> Assertion+getVarRepa f v _ = do+ enc <- openFile f ReadMode+ assertBool "failed to open file" $ isRight enc+ let Right nc = enc+ case ncVar nc v of+ Nothing -> assertBool "missing variable" False+ Just var -> do+ eval <- get nc var :: RepaRet3 a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right val -> do+ let [nz, ny, nx] = map ncDimLength $ ncVarDims var+ truevals = [fromIntegral $ ix + 10 * iy + 100 * iz |+ ix <- [1..nx], iy <- [1..ny], iz <- [1..nz]]+ idxs = [R.ix3 (iz-1) (iy-1) (ix-1) |+ ix <- [1..nx], iy <- [1..ny], iz <- [1..nz]]+ tstvals = [val R.! i | i <- idxs]+ assertBool ("Value error: " ++ show tstvals +++ "instead of " ++ show truevals)+ (and $ zipWith (==) tstvals truevals)+ void $ closeFile nc++++--------------------------------------------------------------------------------+--+-- VARIABLE SLICE READ+--+--------------------------------------------------------------------------------++getVarASV :: forall a. (Num a, Show a, Eq a, NcStorable a)+ => FilePath -> String -> a -> Assertion+getVarASV f v _ = do+ enc <- openFile f ReadMode+ assertBool "failed to open file" $ isRight enc+ let Right nc = enc+ case ncVar nc v of+ Nothing -> assertBool "missing variable" False+ Just var -> do+ let [nz, ny, nx] = map ncDimLength $ ncVarDims var+ forM_ [1..nx] $ \ix -> do+ forM_ [1..ny] $ \iy -> do+ let start = [0, iy-1, ix-1]+ count = [nz, 1, 1]+ eval <- getA nc var start count :: SVRet a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = SV.generate nz+ (\iz -> fromIntegral $ ix + 10 * iy + 100 * (iz+1))+ assertBool ("1: value error: " ++ show vals +++ " instead of " ++ show truevals) (vals == truevals)+ forM_ [1..nx] $ \ix -> do+ forM_ [1..nz] $ \iz -> do+ let start = [iz-1, 0, ix-1]+ count = [1, ny, 1]+ eval <- getA nc var start count :: SVRet a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = SV.generate ny+ (\iy -> fromIntegral $ ix + 10 * (iy+1) + 100 * iz)+ assertBool ("2: value error: " ++ show vals +++ " instead of " ++ show truevals) (vals == truevals)+ forM_ [1..ny] $ \iy -> do+ forM_ [1..nz] $ \iz -> do+ let start = [iz-1, iy-1, 0]+ count = [1, 1, nx]+ eval <- getA nc var start count :: SVRet a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = SV.generate nx+ (\ix -> fromIntegral $ (ix+1) + 10 * iy + 100 * iz)+ assertBool ("3: value error: " ++ show vals +++ " instead of " ++ show truevals) (vals == truevals)++getVarARepa :: forall a. (Num a, Show a, Eq a, NcStorable a)+ => FilePath -> String -> a -> Assertion+getVarARepa f v _ = do+ enc <- openFile f ReadMode+ assertBool "failed to open file" $ isRight enc+ let Right nc = enc+ case ncVar nc v of+ Nothing -> assertBool "missing variable" False+ Just var -> do+ let [nz, ny, nx] = map ncDimLength $ ncVarDims var+ forM_ [1..nx] $ \ix -> do+ forM_ [1..ny] $ \iy -> do+ let start = [0, iy-1, ix-1]+ count = [nz, 1, 1]+ eval <- getA nc var start count :: RepaRet1 a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = [fromIntegral $ ix+10*iy+100*iz | iz <- [1..nz]]+ tstvals = [vals R.! (R.ix1 (iz - 1)) | iz <- [1..nz]]+ assertBool ("1: value error: " ++ show tstvals +++ " instead of " ++ show truevals) (tstvals == truevals)+ forM_ [1..nx] $ \ix -> do+ forM_ [1..nz] $ \iz -> do+ let start = [iz-1, 0, ix-1]+ count = [1, ny, 1]+ eval <- getA nc var start count :: RepaRet1 a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = [fromIntegral $ ix+10*iy+100*iz | iy <- [1..ny]]+ tstvals = [vals R.! (R.ix1 (iy - 1)) | iy <- [1..ny]]+ assertBool ("2: value error: " ++ show tstvals +++ " instead of " ++ show truevals) (tstvals == truevals)+ forM_ [1..ny] $ \iy -> do+ forM_ [1..nz] $ \iz -> do+ let start = [iz-1, iy-1, 0]+ count = [1, 1, nx]+ eval <- getA nc var start count :: RepaRet1 a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = [fromIntegral $ ix+10*iy+100*iz | ix<-[1..nx]]+ tstvals = [vals R.! (R.ix1 (ix - 1)) | ix <- [1..nx]]+ assertBool ("3: value error: " ++ show tstvals +++ " instead of " ++ show truevals) (tstvals == truevals)+++--------------------------------------------------------------------------------+--+-- STRIDED SLICE READ+--+--------------------------------------------------------------------------------++getVarSSV :: forall a. (Num a, Show a, Eq a, NcStorable a)+ => FilePath -> String -> a -> Assertion+getVarSSV f v _ = do+ enc <- openFile f ReadMode+ assertBool "failed to open file" $ isRight enc+ let Right nc = enc+ case ncVar nc v of+ Nothing -> assertBool "missing variable" False+ Just var -> do+ let [nz, ny, nx] = map ncDimLength $ ncVarDims var+ forM_ [1..nx] $ \ix -> do+ forM_ [1..ny] $ \iy -> do+ forM_ [1..nz] $ \s -> do+ let start = [0, iy-1, ix-1]+ count = [(nz + s - 1) `div` s, 1, 1]+ stride = [s, 1, 1]+ eval <- getS nc var start count stride :: SVRet a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = SV.generate ((nz + s - 1) `div` s)+ (\iz -> fromIntegral $+ ix + 10 * iy + 100 * (iz * s + 1))+ assertBool ("1: value error: " ++ show vals +++ " instead of " ++ show truevals) (vals == truevals)+ forM_ [1..nx] $ \ix -> do+ forM_ [1..nz] $ \iz -> do+ forM_ [1..ny] $ \s -> do+ let start = [iz-1, 0, ix-1]+ count = [1, (ny + s - 1) `div` s, 1]+ stride = [1, s, 1]+ eval <- getS nc var start count stride :: SVRet a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = SV.generate ((ny + s - 1) `div` s)+ (\iy -> fromIntegral $+ ix + 10 * (iy * s + 1) + 100 * iz)+ assertBool ("2: value error: " ++ show vals +++ " instead of " ++ show truevals) (vals == truevals)+ forM_ [1..ny] $ \iy -> do+ forM_ [1..nz] $ \iz -> do+ forM_ [1..nx] $ \s -> do+ let start = [iz-1, iy-1, 0]+ count = [1, 1, (nx + s - 1) `div` s]+ stride = [1, 1, s]+ eval <- getS nc var start count stride :: SVRet a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = SV.generate ((nx + s - 1) `div` s)+ (\ix -> fromIntegral $+ (ix * s + 1) + 10 * iy + 100 * iz)+ assertBool ("3: value error: " ++ show vals +++ " instead of " ++ show truevals) (vals == truevals)++getVarSRepa :: forall a. (Num a, Show a, Eq a, NcStorable a)+ => FilePath -> String -> a -> Assertion+getVarSRepa f v _ = do+ enc <- openFile f ReadMode+ assertBool "failed to open file" $ isRight enc+ let Right nc = enc+ case ncVar nc v of+ Nothing -> assertBool "missing variable" False+ Just var -> do+ let [nz, ny, nx] = map ncDimLength $ ncVarDims var+ forM_ [1..nx] $ \ix -> do+ forM_ [1..ny] $ \iy -> do+ forM_ [1..nz-1] $ \s -> do+ let start = [0, iy-1, ix-1]+ count = [(nz + s - 1) `div` s, 1, 1]+ stride = [s, 1, 1]+ eval <- getS nc var start count stride :: RepaRet1 a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = [fromIntegral $+ ix + 10 * iy + 100 * ((iz - 1) * s + 1) |+ iz <- [1..(nz + s - 1) `div` s]]+ tstvals = [vals R.! (R.ix1 (iz - 1)) |+ iz <- [1..(nz + s - 1) `div` s]]+ assertBool ("1: value error: " ++ show tstvals +++ " instead of " ++ show truevals)+ (tstvals == truevals)+ forM_ [1..nx] $ \ix -> do+ forM_ [1..nz] $ \iz -> do+ forM_ [1..ny-1] $ \s -> do+ let start = [iz-1, 0, ix-1]+ count = [1, (ny + s - 1) `div` s, 1]+ stride = [1, s, 1]+ eval <- getS nc var start count stride :: RepaRet1 a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = [fromIntegral $+ ix + 10 * ((iy - 1) * s + 1) + 100 * iz |+ iy <- [1..(ny + s - 1) `div` s]]+ tstvals = [vals R.! (R.ix1 (iy - 1)) |+ iy <- [1..(ny + s - 1) `div` s]]+ assertBool ("2: value error: " ++ show tstvals +++ " instead of " ++ show truevals)+ (tstvals == truevals)+ forM_ [1..ny] $ \iy -> do+ forM_ [1..nz] $ \iz -> do+ forM_ [1..nx-1] $ \s -> do+ let start = [iz-1, iy-1, 0]+ count = [1, 1, (nx + s - 1) `div` s]+ stride = [1, 1, s]+ eval <- getS nc var start count stride :: RepaRet1 a+ case eval of+ Left e -> assertBool ("read error: " ++ show e) False+ Right vals -> do+ let truevals = [fromIntegral $+ ((ix - 1) * s + 1) + 10 * iy + 100 * iz |+ ix <- [1..(nx + s - 1) `div` s]]+ tstvals = [vals R.! (R.ix1 (ix - 1)) |+ ix <- [1..(nx + s - 1) `div` s]]+ assertBool ("3: value error: " ++ show tstvals +++ " instead of " ++ show truevals)+ (tstvals == truevals)
+ test/test-raw-attributes.hs view
@@ -0,0 +1,94 @@+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.HUnit hiding (Test, assert)+import Test.QuickCheck+import Test.QuickCheck.Monadic+import System.Directory+import Data.List (zip4)+import qualified Data.Vector.Storable as SV+import Control.Monad++import Data.NetCDF.Raw++main :: IO ()+main = defaultMain tests++infile, outfile :: FilePath+infile = "test/tst-raw-get-put.nc"+outfile = "test/tmp-tst-attributes.nc"++-- Fake variable ID for global attributes.+nc_global :: Int+nc_global = -1++tests :: [Test]+tests =+ [ testGroup "Attribute processing"+ [ testCase "Read" rawReadAttributes+-- , testCase "Write" rawWriteAttributes+ ]+ ]+++--------------------------------------------------------------------------------+--+-- READING ATTRIBUTES+--+--------------------------------------------------------------------------------++rawReadAttributes :: Assertion+rawReadAttributes = do+ (res1, ncid) <- nc_open infile 0+ assertBool ("nc_open error:" ++ nc_strerror res1) (res1 == 0)++ (res7, xvarid) <- nc_inq_varid ncid "x"+ assertBool ("nc_inq_var error:" ++ nc_strerror res7) (res7 == 0)+ (res8, yvarid) <- nc_inq_varid ncid "y"+ assertBool ("nc_inq_var error:" ++ nc_strerror res8) (res8 == 0)+ (res9, zvarid) <- nc_inq_varid ncid "z"+ assertBool ("nc_inq_var error:" ++ nc_strerror res9) (res9 == 0)+ (res10, vfvarid) <- nc_inq_varid ncid "vf"+ assertBool ("nc_inq_var error:" ++ nc_strerror res10) (res10 == 0)+ (res11, vivarid) <- nc_inq_varid ncid "vi"+ assertBool ("nc_inq_var error:" ++ nc_strerror res11) (res11 == 0)+ (res12, vsvarid) <- nc_inq_varid ncid "vs"+ assertBool ("nc_inq_var error:" ++ nc_strerror res12) (res12 == 0)++ (res13, att1len) <- nc_inq_attlen ncid xvarid "long_name"+ assertBool ("nc_inq_attlen error:" ++ nc_strerror res13) (res13 == 0)+ (res14, att1) <- nc_get_att_text ncid xvarid "long_name" att1len+ assertBool ("nc_get_att_text error:" ++ nc_strerror res14)+ (res14 == 0 && att1 == "longitude")+ (res15, att2len) <- nc_inq_attlen ncid xvarid "units"+ assertBool ("nc_inq_attlen error:" ++ nc_strerror res15) (res15 == 0)+ (res16, att2) <- nc_get_att_text ncid xvarid "units" att2len+ assertBool ("nc_get_att_text error:" ++ nc_strerror res16)+ (res16 == 0 && att2 == "degrees_east")+ (res17, att3len) <- nc_inq_attlen ncid xvarid "missing_value"+ assertBool ("nc_inq_attlen error:" ++ nc_strerror res17) (res17 == 0)+ (res18, att3) <- nc_get_att_float ncid xvarid "missing_value" att3len+ assertBool ("nc_get_att_text error:" ++ nc_strerror res18)+ (res18 == 0 && length att3 == 1 && abs (head att3 + 99999.0) < 1E-6)++ (res19, att4len) <- nc_inq_attlen ncid vivarid "missing_value"+ assertBool ("nc_inq_attlen error:" ++ nc_strerror res19) (res19 == 0)+ (res20, att4) <- nc_get_att_int ncid vivarid "missing_value" att4len+ assertBool ("nc_get_att_int error:" ++ nc_strerror res20)+ (res20 == 0 && att4 == [-99999])+ (res21, att5len) <- nc_inq_attlen ncid vsvarid "missing_value"+ assertBool ("nc_inq_attlen error:" ++ nc_strerror res21) (res21 == 0)+ (res22, att5) <- nc_get_att_short ncid vsvarid "missing_value" att5len+ assertBool ("nc_get_att_short error:" ++ nc_strerror res22)+ (res22 == 0 && att5 == [-9999])++ (res23, att6len) <- nc_inq_attlen ncid nc_global "title"+ assertBool ("nc_inq_attlen error:" ++ nc_strerror res23) (res23 == 0)+ (res24, att6) <- nc_get_att_text ncid nc_global "title" att6len+ assertBool ("nc_get_att_text error:" ++ nc_strerror res24)+ (res24 == 0 && att6 == "Produced using Emacs by IR")++ res8 <- nc_close ncid+ assertBool ("nc_close error:" ++ nc_strerror res8) (res8 == 0)++
+ test/test-raw-get-put.hs view
@@ -0,0 +1,465 @@+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.HUnit hiding (Test, assert)+import Test.QuickCheck+import Test.QuickCheck.Monadic+import System.Directory+import Data.List (zip4)+import qualified Data.Vector.Storable as SV+import Control.Monad++import Data.NetCDF.Raw++main :: IO ()+main = defaultMain tests++infile, outfile :: FilePath+infile = "test/tst-raw-get-put.nc"+outfile = "test/tmp-tst-raw-get-put.nc"++tests :: [Test]+tests = [ ]+-- tests =+-- [ testGroup "Single item access functions"+-- [ testCase "Read (float)" (rawGetVar1 infile "vf" nc_get_var1_float)+-- , testCase "Read (int)" (rawGetVar1 infile "vi" nc_get_var1_int)+-- , testCase "Read (short)" (rawGetVar1 infile "vs" nc_get_var1_short)+-- , testCase "Write" rawPutVar1 ],+-- testGroup "Whole variable access functions"+-- [ testCase "Read (float)" (rawGetVar infile "vf" nc_get_var_float)+-- , testCase "Read (int)" (rawGetVar infile "vi" nc_get_var_int)+-- , testCase "Read (short)" (rawGetVar infile "vs" nc_get_var_short)+-- , testCase "Write" rawPutVar ],+-- testGroup "Array access functions"+-- [ testCase "Read (float)" (rawGetVarA infile "vf" nc_get_vara_float)+-- , testCase "Read (int)" (rawGetVarA infile "vi" nc_get_vara_int)+-- , testCase "Read (short)" (rawGetVarA infile "vs" nc_get_vara_short)+-- , testCase "Write" rawPutVarA ],+-- testGroup "Stride access functions"+-- [ testProperty "Read (float)"+-- (monadicIO $ rawGetVarS infile "vf" nc_get_vars_float)+-- , testProperty "Read (int)"+-- (monadicIO $ rawGetVarS infile "vi" nc_get_vars_int)+-- , testProperty "Read (short)"+-- (monadicIO $ rawGetVarS infile "vs" nc_get_vars_short) ]+-- ]+++--------------------------------------------------------------------------------+--+-- SINGLE ITEM READ/WRITE+--+--------------------------------------------------------------------------------++-- rawGetVar1 :: (Num a, Show a, Eq a) => FilePath -> String+-- -> (Int -> Int -> [Int] -> IO (Int, a)) -> Assertion+-- rawGetVar1 f v rdfn = do+-- (res1, ncid) <- nc_open f 0+-- assertBool ("nc_open error:" ++ nc_strerror res1) (res1 == 0)++-- (res2, ndims) <- nc_inq_ndims ncid+-- assertBool ("nc_inq_ndims error:" ++ nc_strerror res2) (res2 == 0)+-- assertEqual "ndims /= 3" 3 ndims+-- (res3, nvars) <- nc_inq_nvars ncid+-- assertBool ("nc_inq_nvars error:" ++ nc_strerror res3) (res3 == 0)+-- assertEqual "nvars /= 6" 6 nvars++-- (res4, xname, nx) <- nc_inq_dim ncid 0+-- (res5, yname, ny) <- nc_inq_dim ncid 1+-- (res6, zname, nz) <- nc_inq_dim ncid 2+-- assertBool "nc_inq_dim error!" $+-- res4 == 0 && res5 == 0 && res6 == 0 &&+-- xname == "x" && yname == "y" && zname == "z"++-- (res7, vvarid) <- nc_inq_varid ncid v+-- assertBool ("nc_inq_var error:" ++ nc_strerror res7) (res7 == 0)++-- forM_ [1..nx] $ \ix -> do+-- forM_ [1..ny] $ \iy -> do+-- forM_ [1..nz] $ \iz -> do+-- (res, val) <- rdfn ncid vvarid [iz-1, iy-1, ix-1]+-- assertBool ("nc_get_var1 error:" ++ nc_strerror res) (res == 0)+-- let trueval = fromIntegral $ ix + 10 * iy + 100 * iz+-- assertBool ("value error: " ++ show val +++-- " instead of " ++ show trueval)+-- (val == trueval)++-- res8 <- nc_close ncid+-- assertBool ("nc_close error:" ++ nc_strerror res8) (res8 == 0)+++-- rawPutVar1 :: Assertion+-- rawPutVar1 = do+-- ex <- doesFileExist outfile+-- when ex $ removeFile outfile++-- (res1, ncid) <- nc_create outfile 0+-- assertBool ("nc_create error:" ++ nc_strerror res1) (res1 == 0)++-- (res2, xdimid) <- nc_def_dim ncid "x" 10+-- (res3, ydimid) <- nc_def_dim ncid "y" 5+-- (res4, zdimid) <- nc_def_dim ncid "z" 3+-- assertBool "nc_def_dim error!" $ res2 == 0 && res3 == 0 && res4 == 0++-- (res5, xvarid) <- nc_def_var ncid "x" 5 1 [xdimid]+-- (res6, yvarid) <- nc_def_var ncid "y" 5 1 [ydimid]+-- (res7, zvarid) <- nc_def_var ncid "z" 5 1 [zdimid]+-- assertBool "nc_def_var error!" $ res5 == 0 && res6 == 0 && res7 == 0++-- (res8, vfvarid) <- nc_def_var ncid "vf" 5 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res8) (res8 == 0)++-- (res9, vivarid) <- nc_def_var ncid "vi" 4 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res9) (res9 == 0)++-- (res10, vsvarid) <- nc_def_var ncid "vs" 3 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res10) (res10 == 0)++-- res11 <- nc_enddef ncid+-- assertBool ("nc_enddef error:" ++ nc_strerror res11) (res11 == 0)++-- forM_ [1..10] $ \ix -> do+-- res <- nc_put_var1_float ncid xvarid [ix-1] (fromIntegral ix)+-- assertBool ("nc_put_var1_float error:" ++ nc_strerror res) (res == 0)++-- forM_ [1..5] $ \iy -> do+-- res <- nc_put_var1_float ncid yvarid [iy-1] (fromIntegral iy)+-- assertBool ("nc_put_var1_float error:" ++ nc_strerror res) (res == 0)++-- forM_ [1..3] $ \iz -> do+-- res <- nc_put_var1_float ncid zvarid [iz-1] (fromIntegral iz)+-- assertBool ("nc_put_var1_float error:" ++ nc_strerror res) (res == 0)++-- forM_ [1..10] $ \ix -> do+-- forM_ [1..5] $ \iy -> do+-- forM_ [1..3] $ \iz -> do+-- let val = fromIntegral $ ix + 10 * iy + 100 * iz+-- res <- nc_put_var1_float ncid vfvarid [iz-1, iy-1, ix-1] val+-- assertBool ("nc_put_var1_float error:" ++ nc_strerror res) (res == 0)++-- forM_ [1..10] $ \ix -> do+-- forM_ [1..5] $ \iy -> do+-- forM_ [1..3] $ \iz -> do+-- let val = fromIntegral $ ix + 10 * iy + 100 * iz+-- res <- nc_put_var1_int ncid vivarid [iz-1, iy-1, ix-1] val+-- assertBool ("nc_put_var1_int error:" ++ nc_strerror res) (res == 0)++-- forM_ [1..10] $ \ix -> do+-- forM_ [1..5] $ \iy -> do+-- forM_ [1..3] $ \iz -> do+-- let val = fromIntegral $ ix + 10 * iy + 100 * iz+-- res <- nc_put_var1_short ncid vsvarid [iz-1, iy-1, ix-1] val+-- assertBool ("nc_put_var1_short error:" ++ nc_strerror res) (res == 0)++-- res12 <- nc_close ncid+-- assertBool ("nc_close error:" ++ nc_strerror res12) (res12 == 0)++-- rawGetVar1 outfile "vf" nc_get_var1_float+-- rawGetVar1 outfile "vi" nc_get_var1_int+-- rawGetVar1 outfile "vs" nc_get_var1_short+++--------------------------------------------------------------------------------+--+-- WHOLE VARIABLE READ/WRITE+--+--------------------------------------------------------------------------------++-- rawGetVar :: (Num a, Show a, Eq a, SV.Storable a) => FilePath -> String+-- -> (Int -> Int -> Int -> IO (Int, SV.Vector a)) -> Assertion+-- rawGetVar f v rdfn = do+-- (res1, ncid) <- nc_open f 0+-- assertBool ("nc_open error:" ++ nc_strerror res1) (res1 == 0)++-- (res2, ndims) <- nc_inq_ndims ncid+-- assertBool ("nc_inq_ndims error:" ++ nc_strerror res2) (res2 == 0)+-- assertEqual "ndims /= 3" 3 ndims+-- (res3, nvars) <- nc_inq_nvars ncid+-- assertBool ("nc_inq_nvars error:" ++ nc_strerror res3) (res3 == 0)+-- assertEqual "nvars /= 6" 6 nvars++-- (res4, xname, nx) <- nc_inq_dim ncid 0+-- (res5, yname, ny) <- nc_inq_dim ncid 1+-- (res6, zname, nz) <- nc_inq_dim ncid 2+-- assertBool "nc_inq_dim error!" $+-- res4 == 0 && res5 == 0 && res6 == 0 &&+-- xname == "x" && yname == "y" && zname == "z"++-- (res7, vvarid) <- nc_inq_varid ncid v+-- assertBool ("nc_inq_var error:" ++ nc_strerror res7) (res7 == 0)++-- (res8, vals) <- rdfn ncid vvarid (nx * ny * nz)+-- assertBool ("nc_get_var error:" ++ nc_strerror res8) (res8 == 0)++-- forM_ [1..nx] $ \ix -> do+-- forM_ [1..ny] $ \iy -> do+-- forM_ [1..nz] $ \iz -> do+-- let trueval = fromIntegral $ ix + 10 * iy + 100 * iz+-- idx = (iz - 1) * ny * nx + (iy - 1) * nx + (ix - 1)+-- assertBool ("value error: " ++ show (vals SV.! idx) +++-- " instead of " ++ show trueval)+-- ((vals SV.! idx) == trueval)++-- res8 <- nc_close ncid+-- assertBool ("nc_close error:" ++ nc_strerror res8) (res8 == 0)+++-- rawPutVar :: Assertion+-- rawPutVar = do+-- ex <- doesFileExist outfile+-- when ex $ removeFile outfile++-- (res1, ncid) <- nc_create outfile 0+-- assertBool ("nc_create error:" ++ nc_strerror res1) (res1 == 0)++-- let nx = 10+-- ny = 5+-- nz = 3++-- (res2, xdimid) <- nc_def_dim ncid "x" nx+-- (res3, ydimid) <- nc_def_dim ncid "y" ny+-- (res4, zdimid) <- nc_def_dim ncid "z" nz+-- assertBool "nc_def_dim error!" $ res2 == 0 && res3 == 0 && res4 == 0++-- (res5, xvarid) <- nc_def_var ncid "x" 5 1 [xdimid]+-- (res6, yvarid) <- nc_def_var ncid "y" 5 1 [ydimid]+-- (res7, zvarid) <- nc_def_var ncid "z" 5 1 [zdimid]+-- assertBool "nc_def_var error!" $ res5 == 0 && res6 == 0 && res7 == 0++-- (res8, vfvarid) <- nc_def_var ncid "vf" 5 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res8) (res8 == 0)++-- (res9, vivarid) <- nc_def_var ncid "vi" 4 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res9) (res9 == 0)++-- (res10, vsvarid) <- nc_def_var ncid "vs" 3 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res10) (res10 == 0)++-- res11 <- nc_enddef ncid+-- assertBool ("nc_enddef error:" ++ nc_strerror res11) (res11 == 0)++-- let xvals = SV.generate nx (fromIntegral . (+1))+-- yvals = SV.generate ny (fromIntegral . (*10) . (+1))+-- zvals = SV.generate nz (fromIntegral . (*100) . (+1))+-- vfvals = gen nx ny nz+-- vivals = gen nx ny nz+-- vsvals = gen nx ny nz++-- res12 <- nc_put_var_float ncid xvarid xvals+-- assertBool ("nc_put_var_float error:" ++ nc_strerror res12) (res12 == 0)++-- res13 <- nc_put_var_float ncid yvarid yvals+-- assertBool ("nc_put_var_float error:" ++ nc_strerror res13) (res13 == 0)++-- res14 <- nc_put_var_float ncid zvarid zvals+-- assertBool ("nc_put_var_float error:" ++ nc_strerror res14) (res14 == 0)++-- res15 <- nc_put_var_float ncid vfvarid vfvals+-- assertBool ("nc_put_var_float error:" ++ nc_strerror res15) (res15 == 0)++-- res16 <- nc_put_var_int ncid vivarid vivals+-- assertBool ("nc_put_var_int error:" ++ nc_strerror res16) (res16 == 0)++-- res17 <- nc_put_var_short ncid vsvarid vsvals+-- assertBool ("nc_put_var_short error:" ++ nc_strerror res17) (res17 == 0)++-- res18 <- nc_close ncid+-- assertBool ("nc_close error:" ++ nc_strerror res18) (res18 == 0)++-- rawGetVar1 outfile "vf" nc_get_var1_float+-- rawGetVar1 outfile "vi" nc_get_var1_int+-- rawGetVar1 outfile "vs" nc_get_var1_short+++-- gen :: (Num a, SV.Storable a) => Int -> Int -> Int -> SV.Vector a+-- gen nx ny nz = SV.generate (nx * ny * nz) $ \i ->+-- let ix = i `mod` nx + 1+-- iy = (i `div` nx) `mod` ny + 1+-- iz = i `div` (nx * ny) + 1+-- in fromIntegral $ 100 * iz + 10 * iy + ix+++--------------------------------------------------------------------------------+--+-- ARRAY READ/WRITE+--+--------------------------------------------------------------------------------++-- rawGetVarA :: (Num a, Show a, Eq a, SV.Storable a) => FilePath -> String+-- -> (Int -> Int -> [Int] -> [Int] -> IO (Int, SV.Vector a))+-- -> Assertion+-- rawGetVarA f v rdfn = do+-- (res1, ncid) <- nc_open f 0+-- assertBool ("nc_open error:" ++ nc_strerror res1) (res1 == 0)++-- (res2, ndims) <- nc_inq_ndims ncid+-- assertBool ("nc_inq_ndims error:" ++ nc_strerror res2) (res2 == 0)+-- assertEqual "ndims /= 3" 3 ndims+-- (res3, nvars) <- nc_inq_nvars ncid+-- assertBool ("nc_inq_nvars error:" ++ nc_strerror res3) (res3 == 0)+-- assertEqual "nvars /= 6" 6 nvars++-- (res4, xname, nx) <- nc_inq_dim ncid 0+-- (res5, yname, ny) <- nc_inq_dim ncid 1+-- (res6, zname, nz) <- nc_inq_dim ncid 2+-- assertBool "nc_inq_dim error!" $+-- res4 == 0 && res5 == 0 && res6 == 0 &&+-- xname == "x" && yname == "y" && zname == "z"++-- (res7, vvarid) <- nc_inq_varid ncid v+-- assertBool ("nc_inq_var error:" ++ nc_strerror res7) (res7 == 0)++-- forM_ [1..nx] $ \ix -> do+-- forM_ [1..ny] $ \iy -> do+-- let start = [0, iy-1, ix-1]+-- count = [nz, 1, 1]+-- (res, vals) <- rdfn ncid vvarid start count+-- assertBool ("nc_get_var error:" ++ nc_strerror res) (res == 0)+-- let truevals = SV.generate nz+-- (\iz -> fromIntegral $ ix + 10 * iy + 100 * (iz+1))+-- assertBool ("1: value error: " ++ show vals +++-- " instead of " ++ show truevals) (vals == truevals)++-- forM_ [1..nx] $ \ix -> do+-- forM_ [1..nz] $ \iz -> do+-- let start = [iz-1, 0, ix-1]+-- count = [1, ny, 1]+-- (res, vals) <- rdfn ncid vvarid start count+-- assertBool ("nc_get_var error:" ++ nc_strerror res) (res == 0)+-- let truevals = SV.generate ny+-- (\iy -> fromIntegral $ ix + 10 * (iy+1) + 100 * iz)+-- assertBool ("2: value error: " ++ show vals +++-- " instead of " ++ show truevals) (vals == truevals)++-- forM_ [1..ny] $ \iy -> do+-- forM_ [1..nz] $ \iz -> do+-- let start = [iz-1, iy-1, 0]+-- count = [1, 1, nx]+-- (res, vals) <- rdfn ncid vvarid start count+-- assertBool ("nc_get_var error:" ++ nc_strerror res) (res == 0)+-- let truevals = SV.generate nx+-- (\ix -> fromIntegral $ (ix+1) + 10 * iy + 100 * iz)+-- assertBool ("3: value error: " ++ show vals +++-- " instead of " ++ show truevals) (vals == truevals)++-- res8 <- nc_close ncid+-- assertBool ("nc_close error:" ++ nc_strerror res8) (res8 == 0)+++-- rawPutVarA :: Assertion+-- rawPutVarA = do+-- ex <- doesFileExist outfile+-- when ex $ removeFile outfile++-- (res1, ncid) <- nc_create outfile 0+-- assertBool ("nc_create error:" ++ nc_strerror res1) (res1 == 0)++-- let nx = 10+-- ny = 5+-- nz = 3++-- (res2, xdimid) <- nc_def_dim ncid "x" nx+-- (res3, ydimid) <- nc_def_dim ncid "y" ny+-- (res4, zdimid) <- nc_def_dim ncid "z" nz+-- assertBool "nc_def_dim error!" $ res2 == 0 && res3 == 0 && res4 == 0++-- (res5, xvarid) <- nc_def_var ncid "x" 5 1 [xdimid]+-- (res6, yvarid) <- nc_def_var ncid "y" 5 1 [ydimid]+-- (res7, zvarid) <- nc_def_var ncid "z" 5 1 [zdimid]+-- assertBool "nc_def_var error!" $ res5 == 0 && res6 == 0 && res7 == 0++-- (res8, vfvarid) <- nc_def_var ncid "vf" 5 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res8) (res8 == 0)++-- (res9, vivarid) <- nc_def_var ncid "vi" 4 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res9) (res9 == 0)++-- (res10, vsvarid) <- nc_def_var ncid "vs" 3 3 [zdimid, ydimid, xdimid]+-- assertBool ("nc_def_var error:" ++ nc_strerror res10) (res10 == 0)++-- res11 <- nc_enddef ncid+-- assertBool ("nc_enddef error:" ++ nc_strerror res11) (res11 == 0)++-- let xvals = SV.generate nx (fromIntegral . (+1))+-- yvals = SV.generate ny (fromIntegral . (*10) . (+1))+-- zvals = SV.generate nz (fromIntegral . (*100) . (+1))++-- res12 <- nc_put_var_float ncid xvarid xvals+-- assertBool ("nc_put_var_float error:" ++ nc_strerror res12) (res12 == 0)++-- res13 <- nc_put_var_float ncid yvarid yvals+-- assertBool ("nc_put_var_float error:" ++ nc_strerror res13) (res13 == 0)++-- res14 <- nc_put_var_float ncid zvarid zvals+-- assertBool ("nc_put_var_float error:" ++ nc_strerror res14) (res14 == 0)++-- forM_ [1..nx] $ \ix -> do+-- forM_ [1..ny] $ \iy -> do+-- let start = [0, iy-1, ix-1]+-- count = [nz, 1, 1]+-- vals = SV.generate nz+-- (\iz -> fromIntegral $ ix + 10 * iy + 100 * (iz+1))+-- res <- nc_put_vara_float ncid vfvarid start count vals+-- assertBool ("nc_put_vara_float error:" ++ nc_strerror res) (res == 0)++-- forM_ [1..nx] $ \ix -> do+-- forM_ [1..nz] $ \iz -> do+-- let start = [iz-1, 0, ix-1]+-- count = [1, ny, 1]+-- vals = SV.generate ny+-- (\iy -> fromIntegral $ ix + 10 * (iy+1) + 100 * iz)+-- res <- nc_put_vara_int ncid vivarid start count vals+-- assertBool ("nc_put_vara_int error:" ++ nc_strerror res) (res == 0)++-- forM_ [1..ny] $ \iy -> do+-- forM_ [1..nz] $ \iz -> do+-- let start = [iz-1, iy-1, 0]+-- count = [1, 1, nx]+-- vals = SV.generate nx+-- (\ix -> fromIntegral $ (ix+1) + 10 * iy + 100 * iz)+-- res <- nc_put_vara_short ncid vsvarid start count vals+-- assertBool ("nc_put_vara_short error:" ++ nc_strerror res) (res == 0)++-- res18 <- nc_close ncid+-- assertBool ("nc_close error:" ++ nc_strerror res18) (res18 == 0)++-- rawGetVarA outfile "vf" nc_get_vara_float+-- rawGetVarA outfile "vi" nc_get_vara_int+-- rawGetVarA outfile "vs" nc_get_vara_short+++--------------------------------------------------------------------------------+--+-- STRIDED READ/WRITE+--+--------------------------------------------------------------------------------++-- rawGetVarS :: (Num a, Show a, Eq a, SV.Storable a) => FilePath -> String+-- -> (Int -> Int -> [Int] -> [Int] -> [Int] -> IO (Int, SV.Vector a))+-- -> PropertyM IO ()+-- rawGetVarS f v rdfn = do+-- [nx, ny, nz] <- run $ do+-- (_, ncid) <- nc_open f 0+-- (_, _, nx) <- nc_inq_dim ncid 0+-- (_, _, ny) <- nc_inq_dim ncid 1+-- (_, _, nz) <- nc_inq_dim ncid 2+-- _ <- nc_close ncid+-- return [nx, ny, nz]+-- start <- mapM pick $ map choose [(0, nz - 1), (0, ny - 1), (0, nx - 1)]+-- let left = zipWith (-) [nz, ny, nx] start+-- stride <- mapM pick $ map choose $ zip (repeat 1) left+-- count <- mapM pick $ map choose $ zip (repeat 1) (zipWith div left stride)+-- let [izs, iys, ixs] =+-- map (\(s, c, str, n) -> [i | i <- take c [s, s + str..], i < n]) $+-- zip4 start count stride [nz, ny, nx]+-- vs = [fromIntegral $ 100 * (iz + 1) + 10 * (iy + 1) + (ix + 1) |+-- iz <- izs, iy <- iys, ix <- ixs]+-- truevals = SV.fromList vs+-- vals <- run $ do+-- (_, ncid) <- nc_open f 0+-- (_, vvarid) <- nc_inq_varid ncid v+-- (_, vals) <- rdfn ncid vvarid start count stride+-- _ <- nc_close ncid+-- return vals+-- assert $ vals == truevals
+ test/test-raw-metadata.hs view
@@ -0,0 +1,130 @@+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)+import Data.Char+import Control.Monad++import Data.NetCDF.Raw++main :: IO ()+main = defaultMain tests++infile :: FilePath+infile = "test/tst-bathymetry.nc"++tests :: [Test]+tests =+ [ testGroup "Raw basic functions"+ [ testCase "Raw basic functions #1" rawBasic1 ]+ , testGroup "Raw NetCDF file access 1"+ [ testCase "Raw meta-data access: counts" rawMetaDataNums+ , testCase "Raw meta-data access: dimensions" rawMetaDataDims+ , testCase "Raw meta-data access: variables" rawMetaDataVars ]+ ]+++rawBasic1 :: Assertion+rawBasic1 = do+ let vers = nc_inq_libvers+ assertBool ("bad nc_inq_libvers value: " ++ vers) (isDigit $ head vers)+++rawMetaDataNums :: Assertion+rawMetaDataNums = do+ (res1, ncid) <- nc_open infile 0+ assertBool ("nc_open error:" ++ nc_strerror res1) (res1 == 0)++ (res2, ndims) <- nc_inq_ndims ncid+ assertBool ("nc_inq_ndims error:" ++ nc_strerror res2) (res2 == 0)+ assertEqual "ndims /= 2" 2 ndims+ (res3, nvars) <- nc_inq_nvars ncid+ assertBool ("nc_inq_nvars error:" ++ nc_strerror res3) (res3 == 0)+ assertEqual "nvars /= 4" 4 nvars+ (res4, natts) <- nc_inq_natts ncid+ assertBool ("nc_inq_natts error:" ++ nc_strerror res4) (res4 == 0)+ assertEqual "natts /= 3" 3 natts++ res5 <- nc_close ncid+ assertBool ("nc_close error:" ++ nc_strerror res5) (res5 == 0)+++rawMetaDataDims :: Assertion+rawMetaDataDims = do+ (res1, ncid) <- nc_open infile 0+ assertBool ("nc_open error:" ++ nc_strerror res1) (res1 == 0)++ (res2, did1) <- nc_inq_dimid ncid "lat"+ assertBool ("nc_inq_dimid error:" ++ nc_strerror res2) (res2 == 0)+ assertEqual "did(lat) /= 0" 0 did1+ (res3, did2) <- nc_inq_dimid ncid "lon"+ assertBool ("nc_inq_dimid error:" ++ nc_strerror res3) (res3 == 0)+ assertEqual "did(lon) /= 1" 1 did2+ (res4, _) <- nc_inq_dimid ncid "foo"+ assertBool "nc_inq_dimid error" (res4 /= 0)++ (res5, dimname0) <- nc_inq_dimname ncid 0+ assertBool ("nc_inq_dimname error:" ++ nc_strerror res5) (res5 == 0)+ assertEqual "dimname0 /= 'lat'" "lat" dimname0+ (res6, dimname1) <- nc_inq_dimname ncid 1+ assertBool ("nc_inq_dimname error:" ++ nc_strerror res6) (res6 == 0)+ assertEqual "dimname1 /= 'lon'" "lon" dimname1+ (res7, _) <- nc_inq_dimname ncid 2+ assertBool "nc_inq_dimname error" (res7 /= 0)++ (res8, dimlen0) <- nc_inq_dimlen ncid 0+ assertBool ("nc_inq_dimlen error:" ++ nc_strerror res8) (res8 == 0)+ assertEqual "dimlen0 /= 144" 144 dimlen0+ (res9, dimlen1) <- nc_inq_dimlen ncid 1+ assertBool ("nc_inq_dimlen error:" ++ nc_strerror res9) (res9 == 0)+ assertEqual "dimlen1 /= 288" 288 dimlen1+ (res10, _) <- nc_inq_dimlen ncid 2+ assertBool "nc_inq_dimlen error" (res10 /= 0)++ (res11, dimname0', dimlen0') <- nc_inq_dim ncid 0+ assertBool ("nc_inq_dim error:" ++ nc_strerror res11) (res11 == 0)+ assertEqual "dimname0' /= 'lat'" "lat" dimname0'+ assertEqual "dimlen0' /= 144" 144 dimlen0'+ (res12, dimname1', dimlen1') <- nc_inq_dim ncid 1+ assertBool ("nc_inq_dim error:" ++ nc_strerror res12) (res12 == 0)+ assertEqual "dimname1' /= 'lon'" "lon" dimname1'+ assertEqual "dimlen1' /= 288" 288 dimlen1'+ (res13, _, _) <- nc_inq_dim ncid 2+ assertBool "nc_inq_dim error" (res13 /= 0)++ res14 <- nc_close ncid+ assertBool ("nc_close error:" ++ nc_strerror res14) (res14 == 0)+++data Var = Var { _varId :: Int+ , _varName :: String+ , _varNcType :: Int+ , _varDims :: [Int]+ , _varNAtts :: Int }++vars :: [Var]+vars = [ Var 0 "bathorig" 5 [0,1] 3+ , Var 1 "depthmask" 5 [0,1] 3+ , Var 2 "lat" 5 [0] 3+ , Var 3 "lon" 5 [1] 3 ]++rawMetaDataVars :: Assertion+rawMetaDataVars = do+ (res1, ncid) <- nc_open infile 0+ assertBool ("nc_open error:" ++ nc_strerror res1) (res1 == 0)++ forM_ vars $ \(Var vid' name' nctype' dims' natts') -> do+ (res2, vid) <- nc_inq_varid ncid name'+ assertBool ("nc_inq_varid error:" ++ nc_strerror res2) (res2 == 0)+ assertEqual ("vid(" ++ name' ++ ") /= " ++ show vid') vid' vid+ (res3, name, nctype, ndims, dims, natts) <- nc_inq_var ncid vid+ assertBool ("nc_inq_var error:" ++ nc_strerror res3) (res3 == 0)+ assertEqual ("name(" ++ name' ++ ") /= '" ++ name' ++ "'") name' name+ assertEqual ("nctype(" ++ name' ++ ") /= " ++ show nctype') nctype' nctype+ assertEqual ("ndims(" ++ name' ++ ") /= " ++ show (length dims'))+ (length dims') ndims+ assertEqual ("dims(" ++ name' ++ ") /= " ++ show dims')+ dims' (take ndims dims)+ assertEqual ("natts(" ++ name' ++ ") /= " ++ show natts') natts' natts++ res4 <- nc_close ncid+ assertBool ("nc_close error:" ++ nc_strerror res4) (res4 == 0)