diff --git a/Data/NetCDF.hs b/Data/NetCDF.hs --- a/Data/NetCDF.hs +++ b/Data/NetCDF.hs @@ -50,6 +50,7 @@ , withReadFile, withCreateFile , get1, get, getA, getS , put1, put, putA, putS + , put1_String , coardsScale ) where import Data.NetCDF.Raw @@ -62,7 +63,8 @@ import Control.Exception (bracket) import Control.Monad (forM, forM_, void) -import Control.Error +import Data.Bits ((.|.)) +import Data.Maybe (fromMaybe) import qualified Data.Map as M import Foreign.C import System.IO (IOMode (..)) @@ -89,7 +91,7 @@ -- variables and attributes in the file. createFile :: NcInfo NcWrite -> NcIO (NcInfo NcWrite) createFile (NcInfo n ds vs as _ _) = runAccess "createFile" n $ do - ncid <- chk $ nc_create n ncClobber + ncid <- chk $ nc_create n (ncClobber .|. ncNetCDF4) newds <- forM (M.toList ds) (write1Dim ncid . snd) let dimids = M.fromList $ zip (M.keys ds) newds forM_ (M.toList as) (write1Attr ncid ncGlobal) @@ -160,6 +162,11 @@ put1 nc var idxs val = runAccess "put1" (ncName nc) $ chk $ put_var1 (ncId nc) ((ncVarIds nc) M.! (ncVarName var)) idxs val +-- | Write a single text value to an open NetCDF file. +put1_String :: NcInfo NcWrite -> NcVar -> [Int] -> String -> NcIO () +put1_String nc var idxs val = runAccess "put1_String" (ncName nc) $ + chk $ put_var1_String (ncId nc) ((ncVarIds nc) M.! (ncVarName var)) idxs val + -- | Write a whole variable to an open NetCDF file. put :: (NcStorable a, NcStore s, NcStoreExtraCon s a) => NcInfo NcWrite -> NcVar -> s a -> NcIO () @@ -235,6 +242,7 @@ readAttr nc var n NcFloat l = readAttr' nc var n l NcAttrFloat nc_get_att_float readAttr nc var n NcDouble l = readAttr' nc var n l NcAttrDouble nc_get_att_double +readAttr _ _ _ NcString _ = fail "hnetcdf.readAttr cannot yet handle attributes of type NcString" -- | Helper function for attribute reading. readAttr' :: Int -> Int -> String -> Int -> ([a] -> NcAttr) diff --git a/Data/NetCDF/PutGet.hs b/Data/NetCDF/PutGet.hs --- a/Data/NetCDF/PutGet.hs +++ b/Data/NetCDF/PutGet.hs @@ -5,6 +5,7 @@ module Data.NetCDF.PutGet ( put_var1 , put_var, put_vara, put_vars , get_var1 , get_var, get_vara, get_vars + , put_var1_String ) where import Foreign.C @@ -16,6 +17,7 @@ import Control.Applicative ((<$>)) import Control.Monad (liftM) +import Data.NetCDF.Raw.PutGet (nc_put_var1_String) import Data.NetCDF.Storable import Data.NetCDF.Store @@ -28,6 +30,13 @@ withSizeArray idxs $ \idxsp -> do res <- ffi_put_var1 ncid varid idxsp iv return $ fromIntegral res + +put_var1_String :: Int -> Int -> [Int] -> String -> IO Int +put_var1_String nc var idxs v = do + let ncid = fromIntegral nc + varid = fromIntegral var + fmap fromIntegral $ withSizeArray idxs $ \idxsp -> do + nc_put_var1_String ncid varid idxsp v get_var1 :: NcStorable a => Int -> Int -> [Int] -> IO (Int, a) get_var1 nc var idxs = do diff --git a/Data/NetCDF/Raw/PutGet.hs b/Data/NetCDF/Raw/PutGet.hs --- a/Data/NetCDF/Raw/PutGet.hs +++ b/Data/NetCDF/Raw/PutGet.hs @@ -10,6 +10,12 @@ -- WRITING AND READING SINGLE DATA VALUES +nc_put_var1_String :: CInt -> CInt -> Ptr CULong -> String -> IO CInt +nc_put_var1_String ncid varid idx s = + withCStringPtr s $ nc_put_var1'_ ncid varid idx +foreign import ccall safe "netcdf.h nc_put_var1" + nc_put_var1'_ :: CInt -> CInt -> Ptr CULong -> Ptr (Ptr CChar) -> IO CInt + 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 diff --git a/Data/NetCDF/Types.hs b/Data/NetCDF/Types.hs --- a/Data/NetCDF/Types.hs +++ b/Data/NetCDF/Types.hs @@ -15,6 +15,7 @@ | NcInt -- ^ Signed 4 byte integer | NcFloat -- ^ Single precision floating point | NcDouble -- ^ Double precision floating point + | NcString -- ^ Strings deriving (Eq, Show) instance Enum NcType where @@ -24,6 +25,7 @@ fromEnum NcInt = 4 fromEnum NcFloat = 5 fromEnum NcDouble = 6 + fromEnum NcString = 12 toEnum n = case n of 1 -> NcByte 2 -> NcChar @@ -31,6 +33,7 @@ 4 -> NcInt 5 -> NcFloat 6 -> NcDouble + 12 -> NcString _ -> throw (NcInvalidType n) -- | Internal representation of NetCDF IDs. diff --git a/Data/NetCDF/Utils.hs b/Data/NetCDF/Utils.hs --- a/Data/NetCDF/Utils.hs +++ b/Data/NetCDF/Utils.hs @@ -7,17 +7,17 @@ import Control.Monad.Trans.Class import Control.Monad.IO.Class import Control.Monad.Trans.Reader -import Control.Monad.Trans.Either +import Control.Monad.Trans.Except -- | 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 +type Access a = ReaderT (String, FilePath) (ExceptT 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) +runAccess f p = runExceptT . flip runReaderT (f, p) -- | Utility class to make dealing with status return from foreign -- NetCDF functions a little easier. @@ -65,5 +65,5 @@ val = proj res (f, p) <- ask lift $ if st == 0 - then right val - else left $ NcError f st (nc_strerror st) p + then ExceptT (return $ Right val) + else ExceptT (return $ Left $ NcError f st (nc_strerror st) p) diff --git a/hnetcdf.cabal b/hnetcdf.cabal --- a/hnetcdf.cabal +++ b/hnetcdf.cabal @@ -1,5 +1,5 @@ name: hnetcdf -version: 0.4.0.0 +version: 0.5.0.0 cabal-version: >=1.8 build-type: Simple license: BSD3 @@ -28,13 +28,11 @@ library build-depends: base >= 4.3 && <5, - containers >= 0.5.0.0 && <0.6, - either >= 4.4 && <4.5, - errors >= 2.0 && <2.2, + containers >= 0.5.0.0 && <0.7, filepath >= 1.4 && <1.5, repa >= 3.4 && <3.5, transformers >= 0.2 && <0.6, - vector >= 0.10.9 && <0.12 + vector >= 0.12 && <0.13 exposed-modules: Data.NetCDF Data.NetCDF.Vector @@ -84,8 +82,8 @@ test-framework >= 0.8 && <0.9, test-framework-hunit >= 0.3 && <0.4, test-framework-quickcheck2 >= 0.3 && <0.4, - HUnit >= 1.2.5.2 && <1.4, - QuickCheck >= 2.8.1 && <2.9 + HUnit >= 1.6 && <1.7, + QuickCheck >= 2.10 && <2.13 type: exitcode-stdio-1.0 main-is: test-raw-metadata.hs extra-libraries: