diff --git a/Data/NetCDF.hs b/Data/NetCDF.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF.hs @@ -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) + + diff --git a/Data/NetCDF/Metadata.hs b/Data/NetCDF/Metadata.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Metadata.hs @@ -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 diff --git a/Data/NetCDF/PutGet.hs b/Data/NetCDF/PutGet.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/PutGet.hs @@ -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 diff --git a/Data/NetCDF/Raw.hs b/Data/NetCDF/Raw.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Raw.hs @@ -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 diff --git a/Data/NetCDF/Raw/Attributes.chs b/Data/NetCDF/Raw/Attributes.chs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Raw/Attributes.chs @@ -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 + +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 diff --git a/Data/NetCDF/Raw/Base.chs b/Data/NetCDF/Raw/Base.chs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Raw/Base.chs @@ -0,0 +1,162 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | Raw bindings for basic NetCDF functions. + +module Data.NetCDF.Raw.Base where + +import Data.NetCDF.Raw.Utils + +#include + +-- 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' #} diff --git a/Data/NetCDF/Raw/NetCDF4.chs b/Data/NetCDF/Raw/NetCDF4.chs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Raw/NetCDF4.chs @@ -0,0 +1,151 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | Raw bindings for NetCDF4 features (not implemented). + +module Data.NetCDF.Raw.NetCDF4 where + +#include + +-------------------------------------------------------------------------------- +-- +-- 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); diff --git a/Data/NetCDF/Raw/PutGet.hs b/Data/NetCDF/Raw/PutGet.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Raw/PutGet.hs @@ -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); diff --git a/Data/NetCDF/Raw/Utils.hs b/Data/NetCDF/Raw/Utils.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Raw/Utils.hs @@ -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 diff --git a/Data/NetCDF/Storable.hs b/Data/NetCDF/Storable.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Storable.hs @@ -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'_ + diff --git a/Data/NetCDF/Store.hs b/Data/NetCDF/Store.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Store.hs @@ -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 diff --git a/Data/NetCDF/Types.hs b/Data/NetCDF/Types.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Types.hs @@ -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 diff --git a/Data/NetCDF/Utils.hs b/Data/NetCDF/Utils.hs new file mode 100644 --- /dev/null +++ b/Data/NetCDF/Utils.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hnetcdf.cabal b/hnetcdf.cabal new file mode 100644 --- /dev/null +++ b/hnetcdf.cabal @@ -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 + diff --git a/test/test-get.hs b/test/test-get.hs new file mode 100644 --- /dev/null +++ b/test/test-get.hs @@ -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) diff --git a/test/test-raw-attributes.hs b/test/test-raw-attributes.hs new file mode 100644 --- /dev/null +++ b/test/test-raw-attributes.hs @@ -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) + + diff --git a/test/test-raw-get-put.hs b/test/test-raw-get-put.hs new file mode 100644 --- /dev/null +++ b/test/test-raw-get-put.hs @@ -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 diff --git a/test/test-raw-metadata.hs b/test/test-raw-metadata.hs new file mode 100644 --- /dev/null +++ b/test/test-raw-metadata.hs @@ -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)