hgrib 0.2.0.0 → 0.3.0.0

raw patch · 22 files changed

+639/−256 lines, 22 filesdep +transformersbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−0
• README.md +49/−53
• examples/get.hs +27/−37
• hgrib.cabal +12/−6
• src/Data/Grib.hs +156/−0
• src/Data/Grib/Exception.hs +55/−0
• src/Data/Grib/Raw.hs +0/−2
• src/Data/Grib/Raw/Error.chs +78/−0
• src/Data/Grib/Raw/Exception.chs +0/−116
• src/Data/Grib/Raw/Handle.chs +8/−3
• src/Data/Grib/Raw/KeysIterator.chs +1/−1
• src/Data/Grib/Raw/Marshal.hs +12/−2
• src/Data/Grib/Raw/Nearest.chs +19/−19
• src/Data/Grib/Raw/Value.chs +3/−2
• test/Data/Grib/Raw/HandleSpec.hs +9/−6
• test/Data/Grib/Raw/IndexSpec.hs +1/−0
• test/Data/Grib/Raw/Test.hs +10/−9
• test/Data/Grib/Raw/ValueSpec.hs +1/−0
• test/Data/Grib/Test.hs +45/−0
• test/Data/GribSpec.hs +130/−0
• test/stage/not_a_grib.txt +1/−0
• test/stage/test_uuid.grib2 binary

@@ -1,5 +1,27 @@ # HGrib Change Log +## 0.3.0.0++* Added a `GribIO` monad in `Data.Grib`, which is a higher-level+  abstraction for reading GRIB files over the raw bindings in+  `Data.Grib.Raw`.++* Moved `Data.Grib.Raw.Exception` up to `Data.Grib`.++* `Data.Grib.Raw` no longer re-exports the `Exception` module+  mentioned above.++* Made `gribHandleNewFromFile` return a `Maybe GribHandle` instead of+  a plain `GribHandle`.  `Nothing` is returned if no more messages+  could be read from the given stream.++* Re-organized the test utility modules.++* Moved `Data.Grib.Raw.Marshal` from other to exposed modules, but it+  should still be considered an internal module and it is not included+  in the documentation.++ ## 0.2.0.0  * Extended the compatible version range of GRIB API and the Haskell

@@ -1,13 +1,15 @@ # HGrib -[![Build Status](https://travis-ci.org/mjakob/hgrib.svg?branch=develop)](https://travis-ci.org/mjakob/hgrib)+[![Build Status](https://travis-ci.org/mjakob/hgrib.svg?branch=master)](https://travis-ci.org/mjakob/hgrib)  Unofficial bindings for [ECMWF][]'s [GRIB API][] library for reading-[WMO FM-92 GRIB][] edition 1 and edition 2 messages.+and writing [WMO FM-92 GRIB][] edition 1 and edition 2 messages. -In this version of HGrib, raw bindings for the [documented][GRIB Docs]-part of GRIB API is available.  Future versions are intended to-include a higher-level Haskell interface.+In this version of HGrib, a read-only monadic Haskell interface to+GRIB API is provided.  Raw bindings for the [documented][GRIB Docs]+parts of GRIB API are also available.  Future versions are intended to+expand the higher-level Haskell interface to include, among other+things, write support.   ## Installation@@ -32,68 +34,62 @@  ## Usage -Right now, only raw bindings for the [documented][GRIB Docs] part of-GRIB API is available in `Data.Grib.Raw`.  Much of the documentation-is copied into HGrib's [reference documentation][HGrib Docs] generated-by [Haddock][].  To be able to work with these bindings, bindings for-C's `fopen` is provided in `Data.Grib.Raw.CFile` (which is re-exported-by `Data.Grib.Raw`).  An example of usage is GRIB API's-[get.c][GRIB Get] example re-written with HGrib's bindings:+HGrib provides a high-level monadic Haskell interface to GRIB API in+`Data.Grib`. An example of its usage is GRIB API's [get.c][GRIB Get]+example re-written with HGrib:  ```haskell-import Control.Exception (assert)-import Data.Grib.Raw-import Foreign           (allocaArray, allocaBytes)-import Text.Printf       (printf)---filename :: FilePath-filename = "test/stage/regular_latlon_surface.grib1"--assertIO :: Bool -> IO ()-assertIO = flip assert $ return ()+import Control.Exception ( assert )+import Data.Grib+import Text.Printf       ( printf )  main :: IO ()-main = do-  h <- withBinaryCFile filename ReadMode $-         gribHandleNewFromFile defaultGribContext--  _ <- gribSetString h "file" filename+main = let filename = "test/stage/regular_latlon_surface.grib1" in+  runGribIO_ filename $ do+    setString "file" filename -  gribGetLong h "Ni" >>= printf "numberOfPointsAlongAParallel=%d\n"-  gribGetLong h "Nj" >>= printf "numberOfPointsAlongAMeridian=%d\n"+    getLong "Ni" >>= liftIO . printf "numberOfPointsAlongAParallel=%d\n"+    getLong "Nj" >>= liftIO . printf "numberOfPointsAlongAMeridian=%d\n" -  gribGetDouble h "yFirst" >>= printf "latitudeOfFirstGridPointInDegrees=%g\n"-  gribGetDouble h "xFirst" >>= printf "longitudeOfFirstGridPointInDegrees=%g\n"-  gribGetDouble h "yLast"  >>= printf "latitudeOfLastGridPointInDegrees=%g\n"-  gribGetDouble h "xLast"  >>= printf "longitudeOfLastGridPointInDegrees=%g\n"-  gribGetDouble h "DyInDegrees" >>= printf "jDirectionIncrementInDegrees=%g\n"-  gribGetDouble h "DxInDegrees" >>= printf "iDirectionIncrementInDegrees=%g\n"+    getDouble "yFirst" >>=+      liftIO . printf "latitudeOfFirstGridPointInDegrees=%g\n"+    getDouble "xFirst" >>=+      liftIO . printf "longitudeOfFirstGridPointInDegrees=%g\n"+    getDouble "yLast"  >>=+      liftIO . printf "latitudeOfLastGridPointInDegrees=%g\n"+    getDouble "xLast"  >>=+      liftIO . printf "longitudeOfLastGridPointInDegrees=%g\n"+    getDouble "DyInDegrees" >>=+      liftIO . printf "jDirectionIncrementInDegrees=%g\n"+    getDouble "DxInDegrees" >>=+      liftIO . printf "iDirectionIncrementInDegrees=%g\n" -  len <- gribGetLength h "packingType"-  allocaBytes len $ \bufr -> do-    packingType <- gribGetString h "packingType" bufr len-    printf "packingType=%s (%d)\n" packingType (length packingType + 1)+    getString "packingType" >>= liftIO . printf "packingType=%s\n" -  size <- gribGetSize h "values"-  allocaArray size $ \array -> do-    values <- gribGetDoubleArray h "values" array size-    let average = sum values / (fromIntegral . length $ values)-    printf "There are %d values, average is %g\n" size average+    values <- getValues+    let numValues = length values+        average   = sum values / fromIntegral numValues+    liftIO $ printf "There are %d values, average is %g\n" numValues average -  len' <- gribGetLength h "file"-  assertIO $ len' == 1 + length filename-  allocaBytes len' $ \bufr' -> do-    file <- gribGetString h "file" bufr' len'-    assertIO $ file == filename+    filename' <- getString "file"+    liftIO $ assert (filename' == filename) (return ()) ``` +Raw bindings for the [documented][GRIB Docs] part of GRIB API is also+available in `Data.Grib.Raw`.  To be able to work with these bindings,+bindings for C's `fopen` is provided in `Data.Grib.Raw.CFile` (which+is re-exported by `Data.Grib.Raw`). +For more information, see HGrib's+[reference documentation][HGrib Docs] generated by [Haddock][].++ ## Contributing -Issues and pull requests are most welcome!  In particular, let me know-if there is any undocumented part of GRIB API that you would like to-have included.+Issues, feature and pull requests are most welcome!  In particular,+please give suggestions on what you would like to see in the+higher-level interface and let me know if there is any undocumented+part of GRIB API that you would like to have included.   ## Licenses

@@ -1,45 +1,35 @@-import Control.Exception (assert)-import Data.Grib.Raw-import Foreign           (allocaArray, allocaBytes)-import Text.Printf       (printf)+import Control.Exception ( assert )+import Data.Grib+import Text.Printf       ( printf )  -filename :: FilePath-filename = "test/stage/regular_latlon_surface.grib1"--assertIO :: Bool -> IO ()-assertIO = flip assert $ return ()- main :: IO ()-main = do-  h <- withBinaryCFile filename ReadMode $-         gribHandleNewFromFile defaultGribContext--  gribSetString h "file" filename+main = let filename = "test/stage/regular_latlon_surface.grib1" in+  runGribIO_ filename $ do+    setString "file" filename -  gribGetLong h "Ni" >>= printf "numberOfPointsAlongAParallel=%d\n"-  gribGetLong h "Nj" >>= printf "numberOfPointsAlongAMeridian=%d\n"+    getLong "Ni" >>= liftIO . printf "numberOfPointsAlongAParallel=%d\n"+    getLong "Nj" >>= liftIO . printf "numberOfPointsAlongAMeridian=%d\n" -  gribGetDouble h "yFirst" >>= printf "latitudeOfFirstGridPointInDegrees=%g\n"-  gribGetDouble h "xFirst" >>= printf "longitudeOfFirstGridPointInDegrees=%g\n"-  gribGetDouble h "yLast"  >>= printf "latitudeOfLastGridPointInDegrees=%g\n"-  gribGetDouble h "xLast"  >>= printf "longitudeOfLastGridPointInDegrees=%g\n"-  gribGetDouble h "DyInDegrees" >>= printf "jDirectionIncrementInDegrees=%g\n"-  gribGetDouble h "DxInDegrees" >>= printf "iDirectionIncrementInDegrees=%g\n"+    getDouble "yFirst" >>=+      liftIO . printf "latitudeOfFirstGridPointInDegrees=%g\n"+    getDouble "xFirst" >>=+      liftIO . printf "longitudeOfFirstGridPointInDegrees=%g\n"+    getDouble "yLast"  >>=+      liftIO . printf "latitudeOfLastGridPointInDegrees=%g\n"+    getDouble "xLast"  >>=+      liftIO . printf "longitudeOfLastGridPointInDegrees=%g\n"+    getDouble "DyInDegrees" >>=+      liftIO . printf "jDirectionIncrementInDegrees=%g\n"+    getDouble "DxInDegrees" >>=+      liftIO . printf "iDirectionIncrementInDegrees=%g\n" -  len <- gribGetLength h "packingType"-  allocaBytes len $ \bufr -> do-    packingType <- gribGetString h "packingType" bufr len-    printf "packingType=%s (%d)\n" packingType (length packingType + 1)+    getString "packingType" >>= liftIO . printf "packingType=%s\n" -  size <- gribGetSize h "values"-  allocaArray size $ \array -> do-    values <- gribGetDoubleArray h "values" array size-    let average = sum values / (fromIntegral . length $ values)-    printf "There are %d values, average is %g\n" size average+    values <- getValues+    let numValues = length values+        average   = sum values / fromIntegral numValues+    liftIO $ printf "There are %d values, average is %g\n" numValues average -  len' <- gribGetLength h "file"-  assertIO $ len' == 1 + length filename-  allocaBytes len' $ \bufr' -> do-    file <- gribGetString h "file" bufr' len'-    assertIO $ file == filename+    filename' <- getString "file"+    liftIO $ assert (filename' == filename) (return ())

@@ -1,7 +1,7 @@ -- Package description for HGrib.  name:                hgrib-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Unofficial bindings for GRIB API description:     Unofficial bindings to ECMWF's GRIB API library for reading WMO@@ -20,8 +20,10 @@ extra-source-files:     CHANGELOG.md     README.md+    test/stage/not_a_grib.txt     test/stage/regular_latlon_surface.grib1     test/stage/regular_latlon_surface.grib2+    test/stage/test_uuid.grib2  source-repository head   type:      git@@ -31,14 +33,15 @@ source-repository this   type:      git   location:  https://github.com/mjakob/hgrib.git-  tag:       0.2.0.0+  tag:       0.3.0.0  library   default-language:  Haskell2010   hs-source-dirs:    src   exposed-modules:+      Data.Grib+      Data.Grib.Exception       Data.Grib.Raw-      Data.Grib.Raw.Exception        -- These modules need to go above any modules importing them via c2hs:       Data.Grib.Raw.CFile@@ -46,17 +49,18 @@       Data.Grib.Raw.Handle        -- These modules can import any of the modules above via c2hs:+      Data.Grib.Raw.Error       Data.Grib.Raw.Index       Data.Grib.Raw.Iterator       Data.Grib.Raw.KeysIterator+      Data.Grib.Raw.Marshal       Data.Grib.Raw.Nearest       Data.Grib.Raw.Types       Data.Grib.Raw.Value -  other-modules:-      Data.Grib.Raw.Marshal   build-depends:-      base >= 4.5 && < 4.9+      base         >= 4.5 && < 4.9+    , transformers >= 0.3 && < 0.5   build-tools:       c2hs == 0.26.*   extra-libraries:@@ -70,6 +74,7 @@   main-is:           Spec.hs   hs-source-dirs:    test   other-modules:+      Data.GribSpec       Data.Grib.Raw.CFileSpec       Data.Grib.Raw.ContextSpec       Data.Grib.Raw.HandleSpec@@ -79,6 +84,7 @@       Data.Grib.Raw.NearestSpec       Data.Grib.Raw.Test       Data.Grib.Raw.ValueSpec+      Data.Grib.Test   build-depends:       base      >= 4.5 && < 4.9     , directory >= 1.1 && < 1.3

@@ -0,0 +1,156 @@+{- |+Module      : Data.Grib+Description : High-level GRIB library.+Copyright   : (c) Mattias Jakobsson 2015+License     : GPL-3++Maintainer  : mjakob422@gmail.com+Stability   : unstable+Portability : portable+-}++module Data.Grib ( -- *The GRIB Monad+                   GribIO+                 , runGribIO+                 , runGribIO_+                 , GribEnv++                   -- **Get values+                   --+                   -- |These operations may fail with:+                   --+                   --  * 'isGribException' 'GribNotFound' if the key+                   --    is missing.+                 , getDouble+                 , getLong+                 , getString+                 , getValues++                   -- **Set values+                   --+                   -- |These operations may fail with:+                   --+                   --  * 'isGribException' 'GribNotFound' if the key+                   --    is missing; or+                   --+                   --  * 'isGribException' 'GribReadOnly' if the key+                   --    is read-only.+                 , setDouble+                 , setLong+                 , setString+                 , setValues++                   -- **Utilities+                 , getFilename+                 , getIndex+                 , getHandle+                 , liftIO+                 ) where++import Control.Monad              ( void )+import Control.Monad.IO.Class     ( liftIO )+import Control.Monad.Trans.Reader ( ReaderT, ask, runReaderT )+import Foreign                    ( allocaArray, allocaBytes )++-- Hack to have Applicative in base < 4.8 but avoid warning in base >= 4.8:+import Control.Applicative+import Prelude++import Data.Grib.Raw+++-- Helper that extracts a list of grib handles from a file.+handles :: FilePath -> IO [GribHandle]+handles path = withBinaryCFile path ReadMode go+  where go file = gribHandleNewFromFile defaultGribContext file >>=+                  maybe (return []) (\h' -> (h' :) <$> go file)++-- |The reader environment of 'GribIO' containing the current+-- filename, a 'GribHandle', and its index in the file.+data GribEnv = GribEnv+               { filename :: FilePath+               , index    :: Int+               , handle   :: GribHandle+               }++-- Helper that generates a list of environments for GribIO.+envs :: FilePath -> IO [GribEnv]+envs path = fmap (zipWith3 GribEnv (repeat path) [0..]) (handles path)++-- |The 'GribIO' monad is a 'ReaderT' monad transformer over the+-- 'IO' monad with a 'GribEnv' environment.+type GribIO = ReaderT GribEnv IO++-- |Run an action on each GRIB message in a file and collect the+-- results.+--+-- This operation may fail with:+--+--   * any 'IOError' raised by 'openBinaryCFile';+--+--   * any 'Data.Grib.Exception.GribError' raised by+--   'gribHandleNewFromFile'; or+--+--   * any other exception raised by the given 'GribIO' action.+runGribIO :: FilePath  -- ^a path to a GRIB file+          -> GribIO a  -- ^an action to take on each GRIB message in the file+          -> IO [a]    -- ^the results of the actions+runGribIO path m = envs path >>= mapM (runReaderT m)++-- |Like 'runGribIO', but discard the results.+runGribIO_ :: FilePath -> GribIO a -> IO ()+runGribIO_ path m = envs path >>= mapM_ (runReaderT m)++-- |Return the name of the file being read.+getFilename :: GribIO FilePath+getFilename = fmap filename ask++-- |Return the zero-based index of the current message in the file.+getIndex :: GribIO Int+getIndex = fmap index ask++-- |Return the current 'GribHandle' for use with the 'Data.Grib.Raw'+-- GRIB API bindings.+getHandle :: GribIO GribHandle+getHandle = fmap handle ask++-- |Get the value for a key as a float.+getDouble :: Key -> GribIO Double+getDouble key = getHandle >>= liftIO . flip gribGetDouble key++-- |Get the value for a key as an integer.+getLong :: Key -> GribIO Int+getLong key = getHandle >>= liftIO . flip gribGetLong key++-- |Get the value for a key as a string.+getString :: Key -> GribIO String+getString key = getHandle >>= \h -> do+  n <- liftIO . gribGetLength h $ key+  liftIO . allocaBytes n $ \bufr -> gribGetString h key bufr n++-- |Get the data values of the GRIB message as floats.+getValues :: GribIO [Double]+getValues = getHandle >>= \h -> do+  n <- liftIO . gribGetSize h $ key+  liftIO . allocaArray n $ \array -> gribGetDoubleArray h key array n+  where key = "values"++-- Helper for the value setters below.+setGeneric :: (GribHandle -> Key -> a -> IO b) -> Key -> a -> GribIO b+setGeneric setter key value = getHandle >>= \h -> liftIO $ setter h key value++-- |Set the value of a key from a float.+setDouble :: Key -> Double -> GribIO ()+setDouble = setGeneric gribSetDouble++-- |Set the value of a key from an integer.+setLong :: Key -> Int -> GribIO ()+setLong = setGeneric gribSetLong++-- |Set the value of a key from a string.+setString :: Key -> String -> GribIO ()+setString key value = void $ setGeneric gribSetString key value++-- |Set the values of the GRIB message from floats.+setValues :: [Double] -> GribIO ()+setValues = setGeneric gribSetDoubleArray "values"

@@ -0,0 +1,55 @@+{- |+Module      : Data.Grib.Exception+Description : Exceptions for HGrib+Copyright   : (c) Mattias Jakobsson 2015+License     : GPL-3++Maintainer  : mjakob422@gmail.com+Stability   : unstable+Portability : portable++Exceptions for HGrib.+-}++{-# LANGUAGE DeriveDataTypeable #-}++module Data.Grib.Exception+       (-- *GRIB Exceptions+         GribException(..)++         -- **Predicates+       , isAnyGribException+       , isGribException+       , isNullPtrReturned++         -- **Error codes+       , ErrorCode(..)+       ) where++import Control.Exception ( Exception )+import Data.Typeable     ( Typeable )++import Data.Grib.Raw.Error+++-- |An exception carrying an 'ErrorCode' or representing a returned+-- null pointer.+data GribException = GribException ErrorCode+                   | NullPtrReturned+                   deriving (Show, Typeable)++instance Exception GribException++-- |True for any 'GribException'.+isAnyGribException :: GribException -> Bool+isAnyGribException = const True++-- |True if a 'GribException' carries the given 'ErrorCode'.+isGribException :: ErrorCode -> GribException -> Bool+isGribException code (GribException code') = code' == code+isGribException _    NullPtrReturned       = False++-- |True for 'NullPtrReturned'.+isNullPtrReturned :: GribException -> Bool+isNullPtrReturned NullPtrReturned = True+isNullPtrReturned _               = False

@@ -16,7 +16,6 @@ module Data.Grib.Raw        ( module Data.Grib.Raw.CFile        , module Data.Grib.Raw.Context-       , module Data.Grib.Raw.Exception        , module Data.Grib.Raw.Handle        , module Data.Grib.Raw.Index        , module Data.Grib.Raw.Iterator@@ -28,7 +27,6 @@  import Data.Grib.Raw.CFile import Data.Grib.Raw.Context-import Data.Grib.Raw.Exception import Data.Grib.Raw.Handle       hiding (withGribHandle, withGribMultiHandle) import Data.Grib.Raw.Index        hiding (withGribIndex) import Data.Grib.Raw.Iterator

@@ -0,0 +1,78 @@+{- |+Module      : Data.Grib.Raw.Error+Copyright   : (c) Mattias Jakobsson 2015+License     : GPL-3++Maintainer  : mjakob422@gmail.com+Stability   : unstable+Portability : portable++Error codes used by GRIB API.+-}++{-# OPTIONS_HADDOCK hide #-}++module Data.Grib.Raw.Error ( ErrorCode(..) ) where+++#include <grib_api.h>++-- |Error codes returned by the grib_api functions.+{#enum define ErrorCode {+      GRIB_SUCCESS                  as GribSuccess+    , GRIB_END_OF_FILE              as GribEndOfFile+    , GRIB_INTERNAL_ERROR           as GribInternalError+    , GRIB_BUFFER_TOO_SMALL         as GribBufferTooSmall+    , GRIB_NOT_IMPLEMENTED          as GribNotImplemented+    , GRIB_7777_NOT_FOUND           as Grib7777NotFound+    , GRIB_ARRAY_TOO_SMALL          as GribArrayTooSmall+    , GRIB_FILE_NOT_FOUND           as GribFileNotFound+    , GRIB_CODE_NOT_FOUND_IN_TABLE  as GribCodeNotFoundInTable+    , GRIB_WRONG_ARRAY_SIZE         as GribWrongArraySize+    , GRIB_NOT_FOUND                as GribNotFound+    , GRIB_IO_PROBLEM               as GribIoProblem+    , GRIB_INVALID_MESSAGE          as GribInvalidMessage+    , GRIB_DECODING_ERROR           as GribDecodingError+    , GRIB_ENCODING_ERROR           as GribEncodingError+    , GRIB_NO_MORE_IN_SET           as GribNoMoreInSet+    , GRIB_GEOCALCULUS_PROBLEM      as GribGeocalculusProblem+    , GRIB_OUT_OF_MEMORY            as GribOutOfMemory+    , GRIB_READ_ONLY                as GribReadOnly+    , GRIB_INVALID_ARGUMENT         as GribInvalidArgument+    , GRIB_NULL_HANDLE              as GribNullHandle+    , GRIB_INVALID_SECTION_NUMBER   as GribInvalidSectionNumber+    , GRIB_VALUE_CANNOT_BE_MISSING  as GribValueCannotBeMissing+    , GRIB_WRONG_LENGTH             as GribWrongLength+    , GRIB_INVALID_TYPE             as GribInvalidType+    , GRIB_WRONG_STEP               as GribWrongStep+    , GRIB_WRONG_STEP_UNIT          as GribWrongStepUnit+    , GRIB_INVALID_FILE             as GribInvalidFile+    , GRIB_INVALID_GRIB             as GribInvalidGrib+    , GRIB_INVALID_INDEX            as GribInvalidIndex+    , GRIB_INVALID_ITERATOR         as GribInvalidIterator+    , GRIB_INVALID_KEYS_ITERATOR    as GribInvalidKeysIterator+    , GRIB_INVALID_NEAREST          as GribInvalidNearest+    , GRIB_INVALID_ORDERBY          as GribInvalidOrderby+    , GRIB_MISSING_KEY              as GribMissingKey+    , GRIB_OUT_OF_AREA              as GribOutOfArea+    , GRIB_CONCEPT_NO_MATCH         as GribConceptNoMatch+    , GRIB_NO_DEFINITIONS           as GribNoDefinitions+    , GRIB_WRONG_TYPE               as GribWrongType+    , GRIB_END                      as GribEnd+    , GRIB_NO_VALUES                as GribNoValues+    , GRIB_WRONG_GRID               as GribWrongGrid+    , GRIB_END_OF_INDEX             as GribEndOfIndex+    , GRIB_NULL_INDEX               as GribNullIndex+    , GRIB_PREMATURE_END_OF_FILE    as GribPrematureEndOfFile+    , GRIB_INTERNAL_ARRAY_TOO_SMALL as GribInternalArrayTooSmall+    , GRIB_MESSAGE_TOO_LARGE        as GribMessageTooLarge+    , GRIB_CONSTANT_FIELD           as GribConstantField+    , GRIB_SWITCH_NO_MATCH          as GribSwitchNoMatch+    , GRIB_UNDERFLOW                as GribUnderflow+    , GRIB_MESSAGE_MALFORMED        as GribMessageMalformed+    , GRIB_CORRUPTED_INDEX          as GribCorruptedIndex+    , GRIB_INVALID_BPV              as GribInvalidBpv+    , GRIB_DIFFERENT_EDITION        as GribDifferentEdition+    , GRIB_VALUE_DIFFERENT          as GribValueDifferent+    , GRIB_INVALID_KEY_VALUE        as GribInvalidKeyValue+    } deriving (Eq, Show) #}

@@ -1,116 +0,0 @@-{- |-Module      : Data.Grib.Raw.Exception-Copyright   : (c) Mattias Jakobsson 2015-License     : GPL-3--Maintainer  : mjakob422@gmail.com-Stability   : unstable-Portability : portable--Exceptions for HGrib.--}--{-# LANGUAGE DeriveDataTypeable #-}--module Data.Grib.Raw.Exception-       ( -- *GRIB Exceptions-         GribException(..)--         -- **Predicates-       , isAnyGribException-       , isGribException-       , isNullPtrReturned--         -- **Error codes-       , ErrorCode(..)-       ) where--import Control.Exception ( Exception )-import Data.Typeable     ( Typeable )---#include <grib_api.h>---- |Error codes returned by the grib_api functions.-{#enum define ErrorCode {-      GRIB_SUCCESS                  as GribSuccess-    , GRIB_END_OF_FILE              as GribEndOfFile-    , GRIB_INTERNAL_ERROR           as GribInternalError-    , GRIB_BUFFER_TOO_SMALL         as GribBufferTooSmall-    , GRIB_NOT_IMPLEMENTED          as GribNotImplemented-    , GRIB_7777_NOT_FOUND           as Grib7777NotFound-    , GRIB_ARRAY_TOO_SMALL          as GribArrayTooSmall-    , GRIB_FILE_NOT_FOUND           as GribFileNotFound-    , GRIB_CODE_NOT_FOUND_IN_TABLE  as GribCodeNotFoundInTable-    , GRIB_WRONG_ARRAY_SIZE         as GribWrongArraySize-    , GRIB_NOT_FOUND                as GribNotFound-    , GRIB_IO_PROBLEM               as GribIoProblem-    , GRIB_INVALID_MESSAGE          as GribInvalidMessage-    , GRIB_DECODING_ERROR           as GribDecodingError-    , GRIB_ENCODING_ERROR           as GribEncodingError-    , GRIB_NO_MORE_IN_SET           as GribNoMoreInSet-    , GRIB_GEOCALCULUS_PROBLEM      as GribGeocalculusProblem-    , GRIB_OUT_OF_MEMORY            as GribOutOfMemory-    , GRIB_READ_ONLY                as GribReadOnly-    , GRIB_INVALID_ARGUMENT         as GribInvalidArgument-    , GRIB_NULL_HANDLE              as GribNullHandle-    , GRIB_INVALID_SECTION_NUMBER   as GribInvalidSectionNumber-    , GRIB_VALUE_CANNOT_BE_MISSING  as GribValueCannotBeMissing-    , GRIB_WRONG_LENGTH             as GribWrongLength-    , GRIB_INVALID_TYPE             as GribInvalidType-    , GRIB_WRONG_STEP               as GribWrongStep-    , GRIB_WRONG_STEP_UNIT          as GribWrongStepUnit-    , GRIB_INVALID_FILE             as GribInvalidFile-    , GRIB_INVALID_GRIB             as GribInvalidGrib-    , GRIB_INVALID_INDEX            as GribInvalidIndex-    , GRIB_INVALID_ITERATOR         as GribInvalidIterator-    , GRIB_INVALID_KEYS_ITERATOR    as GribInvalidKeysIterator-    , GRIB_INVALID_NEAREST          as GribInvalidNearest-    , GRIB_INVALID_ORDERBY          as GribInvalidOrderby-    , GRIB_MISSING_KEY              as GribMissingKey-    , GRIB_OUT_OF_AREA              as GribOutOfArea-    , GRIB_CONCEPT_NO_MATCH         as GribConceptNoMatch-    , GRIB_NO_DEFINITIONS           as GribNoDefinitions-    , GRIB_WRONG_TYPE               as GribWrongType-    , GRIB_END                      as GribEnd-    , GRIB_NO_VALUES                as GribNoValues-    , GRIB_WRONG_GRID               as GribWrongGrid-    , GRIB_END_OF_INDEX             as GribEndOfIndex-    , GRIB_NULL_INDEX               as GribNullIndex-    , GRIB_PREMATURE_END_OF_FILE    as GribPrematureEndOfFile-    , GRIB_INTERNAL_ARRAY_TOO_SMALL as GribInternalArrayTooSmall-    , GRIB_MESSAGE_TOO_LARGE        as GribMessageTooLarge-    , GRIB_CONSTANT_FIELD           as GribConstantField-    , GRIB_SWITCH_NO_MATCH          as GribSwitchNoMatch-    , GRIB_UNDERFLOW                as GribUnderflow-    , GRIB_MESSAGE_MALFORMED        as GribMessageMalformed-    , GRIB_CORRUPTED_INDEX          as GribCorruptedIndex-    , GRIB_INVALID_BPV              as GribInvalidBpv-    , GRIB_DIFFERENT_EDITION        as GribDifferentEdition-    , GRIB_VALUE_DIFFERENT          as GribValueDifferent-    , GRIB_INVALID_KEY_VALUE        as GribInvalidKeyValue-    } deriving (Eq, Show) #}---- This comment is inserted to help Haddock keep all docs.---- |An exception carrying an 'ErrorCode' or representing a returned--- null pointer.-data GribException = GribException ErrorCode-                   | NullPtrReturned-                   deriving (Show, Typeable)--instance Exception GribException---- |True for any 'GribException'.-isAnyGribException :: GribException -> Bool-isAnyGribException = const True---- |True if a 'GribException' carries the given 'ErrorCode'.-isGribException :: ErrorCode -> GribException -> Bool-isGribException code (GribException code') = code' == code-isGribException _    NullPtrReturned       = False---- |True for 'NullPtrReturned'.-isNullPtrReturned :: GribException -> Bool-isNullPtrReturned NullPtrReturned = True-isNullPtrReturned _               = False

@@ -45,7 +45,7 @@        , gribCountInFile        ) where -import Foreign   ( Ptr, alloca, peek, with )+import Foreign   ( Ptr, alloca, newForeignPtr, nullPtr, peek, with ) import Foreign.C ( CSize, withCString )  {#import Data.Grib.Raw.CFile #}@@ -89,12 +89,17 @@ -- |Create a handle from a file resource. -- -- The file is read until a message is found. The message is then--- copied.+-- copied.  If no more messages are found, @Nothing@ is returned. {#fun unsafe grib_handle_new_from_file as ^ {               `GribContext'     ,         `CFilePtr'     , alloca- `CInt'        checkStatusPtr*--    } -> `GribHandle' #}+    } -> `Maybe GribHandle' maybeHandle* #}+  where maybeHandle :: Ptr GribHandle -> IO (Maybe GribHandle)+        maybeHandle p+          | p == nullPtr = return Nothing+          | otherwise    = fmap (Just . GribHandle) fp+          where fp = newForeignPtr gribHandleFinalizer p  -- int grib_write_message(grib_handle* h,const char* file,const char* mode); --

@@ -35,7 +35,7 @@ import Foreign           ( nullPtr ) import Foreign.C         ( peekCString ) -import Data.Grib.Raw.Exception+import Data.Grib.Exception {#import Data.Grib.Raw.Handle #} import Data.Grib.Raw.Marshal 

@@ -10,6 +10,8 @@ Functions to marshal parameters between C and Haskell. -} +{-# OPTIONS_HADDOCK hide #-}+ module Data.Grib.Raw.Marshal        ( module Data.Grib.Raw.Types @@ -28,6 +30,7 @@         , checkForeignPtr        , getArray+       , pack5        ) where  import Control.Exception ( throw, throwIO )@@ -38,7 +41,11 @@                          , peekArray, with, withArrayLen ) import Foreign.C         ( CInt, CString, withCString ) -import Data.Grib.Raw.Exception+-- Hack to have Applicative in base < 4.8 but avoid warning in base >= 4.8:+import Control.Applicative+import Prelude++import Data.Grib.Exception import Data.Grib.Raw.Types  @@ -89,7 +96,7 @@ checkForeignPtr :: (ForeignPtr a -> a) -> FinalizerPtr a -> Ptr a -> IO a checkForeignPtr makeA finalizer p   | p == nullPtr = throw NullPtrReturned-  | otherwise    = fmap makeA $ newForeignPtr finalizer p+  | otherwise    = makeA <$> newForeignPtr finalizer p  getArray :: (Storable a, Integral b, Storable b)          => (CString -> Ptr a -> Ptr b -> IO CInt)@@ -98,3 +105,6 @@   withCString key $ \key' -> with (fromIntegral n) $ \n' -> do     cCall key' xs n' >>= checkStatus     fmap fromIntegral (peek n') >>= flip peekArray xs++pack5 :: a -> b -> c -> d -> e -> (a, b, c, d, e)+pack5 a b c d e = (a, b, c, d, e)

@@ -27,11 +27,15 @@        , GribNearestFlag(..)        ) where -import Control.Exception (bracket)+import Control.Exception ( bracket ) import Foreign           ( Ptr, Storable, alloca, allocaArray, fromBool-                         , peekArray, with, withArray )+                         , peekArray, with, withArray, withMany ) import Foreign.C         ( CSize ) +-- Hack to have Applicative in base < 4.8 but avoid warning in base >= 4.8:+import Control.Applicative+import Prelude+ {#import Data.Grib.Raw.Handle #} import Data.Grib.Raw.Marshal @@ -139,24 +143,20 @@                         -- @(latitudes, longitudes, values, distances,                         -- indices)@ gribNearestFindMultiple h lsm ilats ilons =-  withGribHandle h $ \h' ->-  let lsm' = fromBool lsm in-  withArray (map realToFrac ilats) $ \ilats' ->-  withArray (map realToFrac ilons) $ \ilons' ->-  let n  = min (length ilats) (length ilons)-      n' = fromIntegral n in-  allocaArray n $ \olats ->-  allocaArray n $ \olons ->-  allocaArray n $ \vals ->-  allocaArray n $ \dists ->-  allocaArray n $ \is -> do+  let lsm' = fromBool lsm+      n    = min (length ilats) (length ilons)+      n'   = fromIntegral n in+  withGribHandle h                     $ \h'                          ->+  withArray (map realToFrac ilats)     $ \ilats'                      ->+  withArray (map realToFrac ilons)     $ \ilons'                      ->+  withMany allocaArray (replicate 4 n) $ \[olats, olons, vals, dists] ->+  allocaArray n                        $ \is                          -> do     cCall h' lsm' ilats' ilons' n' olats olons vals dists is >>= checkStatus-    olats' <- fmap (map realToFrac)   (peekArray n olats)-    olons' <- fmap (map realToFrac)   (peekArray n olons)-    vals'  <- fmap (map realToFrac)   (peekArray n vals)-    dists' <- fmap (map realToFrac)   (peekArray n dists)-    is'    <- fmap (map fromIntegral) (peekArray n is)-    return (olats', olons', vals', dists', is')+    pack5 <$> fmap (map realToFrac)   (peekArray n olats)+          <*> fmap (map realToFrac)   (peekArray n olons)+          <*> fmap (map realToFrac)   (peekArray n vals)+          <*> fmap (map realToFrac)   (peekArray n dists)+          <*> fmap (map fromIntegral) (peekArray n is)   where cCall = {#call unsafe grib_nearest_find_multiple #}  -- |Safely create, use and delete a 'GribNearest'.

@@ -378,8 +378,9 @@   withGribHandle h                 $ \h'   ->   withCString key                  $ \key' ->   withCString msg                  $ \msg' ->-  with (fromIntegral $ length msg) $ \n    ->-    cCall h' key' msg' n >>= checkStatus >> fmap fromIntegral (peek n)+  with (fromIntegral $ length msg) $ \n    -> do+    cCall h' key' msg' n >>= checkStatus+    fmap fromIntegral $ peek n   where cCall = {#call unsafe grib_set_string #}  -- int grib_set_bytes(grib_handle* h, const char* key,

@@ -12,10 +12,12 @@  module Data.Grib.Raw.HandleSpec ( main, spec ) where -import Control.Monad ( void )+import Control.Monad ( (>=>), void )+import Data.Maybe    ( isJust ) import Foreign       ( allocaBytes, nullPtr )  import Test.Hspec+import Data.Grib.Exception import Data.Grib.Raw import Data.Grib.Raw.Test @@ -45,8 +47,8 @@       it "should write a message to file" $         withRegular1 $ \h -> do           gribWriteMessage h gribPath "wb" `shouldReturn` ()-          withBinaryCFile gribPath ReadMode $ \f ->-            void $ gribHandleNewFromFile ctx f+          withBinaryCFile gribPath ReadMode $+            gribHandleNewFromFile ctx >=> (`shouldSatisfy` isJust)    describe "gribGetMessage" $     it "should return a message of length 1100" $@@ -86,11 +88,12 @@           len' `shouldBe` 0     in do       context "in multi mode" $ after_ (gribMultiSupportOff ctx) $-        it "should return a message of zero length if given a single message" $-           gribMultiSupportOn ctx >> checkMultiMessageLength+        it "should return a message of zero length if given one message" $ do+           gribMultiSupportOn ctx+           checkMultiMessageLength        context "not in multi mode" $-        it "should return a message of zero length if given a single message"+        it "should return a message of zero length if given one message"            checkMultiMessageLength    describe "gribMultiHandleAppend" $

@@ -16,6 +16,7 @@ import Foreign       ( alloca )  import Test.Hspec+import Data.Grib.Exception import Data.Grib.Raw import Data.Grib.Raw.Test hiding (withRegular1) 

@@ -14,8 +14,10 @@        ( skipIfGribApiVersion        , safeRemoveFile        , withGribFile+       , notAGribPath        , regular1Path        , regular2Path+       , testUuidPath        , withRegular1        , withRegular2        ) where@@ -24,9 +26,11 @@ import Control.Monad     ( (>=>), guard, void ) import System.Directory  ( removeFile ) import System.IO.Error   ( isDoesNotExistError )-import Test.Hspec        ( SpecWith )+import Test.Hspec        ( SpecWith, expectationFailure )  import Data.Grib.Raw+import Data.Grib.Test    ( notAGribPath, regular1Path, regular2Path+                         , testUuidPath )   skipIfGribApiVersion :: (Int -> Bool) -> SpecWith a -> SpecWith a@@ -39,14 +43,11 @@   void $ tryJust (guard . isDoesNotExistError) (removeFile path)  withGribFile :: FilePath -> (GribHandle -> IO ()) -> IO ()-withGribFile name f = withBinaryCFile name ReadMode $-                      gribHandleNewFromFile defaultGribContext >=> f--regular1Path :: FilePath-regular1Path = "test/stage/regular_latlon_surface.grib1"--regular2Path :: FilePath-regular2Path = "test/stage/regular_latlon_surface.grib2"+withGribFile name g = withBinaryCFile name ReadMode $+  gribHandleNewFromFile defaultGribContext >=> \h ->+  case h of+   Just h' -> g h'+   Nothing -> expectationFailure $ "no GRIB message found in '" ++ name ++ "'"  withRegular1 :: (GribHandle -> IO ()) -> IO () withRegular1 = withGribFile regular1Path

@@ -15,6 +15,7 @@ import Foreign ( allocaArray, allocaBytes, nullPtr )  import Test.Hspec+import Data.Grib.Exception import Data.Grib.Raw import Data.Grib.Raw.Test 

@@ -0,0 +1,45 @@+{- |+Module      : Data.Grib.Test+Copyright   : (c) Mattias Jakobsson 2015+License     : GPL-3++Maintainer  : mjakob422@gmail.com+Stability   : unstable+Portability : portable++Utilities for the unit tests of HGrib's high-level interface.+-}++module Data.Grib.Test+       ( gShouldBe+       , gShouldReturn+       , notAGribPath+       , regular1Path+       , regular2Path+       , testUuidPath+       ) where++import Test.Hspec ( shouldBe )++import Data.Grib+++type GExpectation = GribIO ()++gShouldBe :: (Show a, Eq a) => a -> a -> GExpectation+x `gShouldBe` y = liftIO $ x `shouldBe` y++gShouldReturn :: (Show a, Eq a) => GribIO a -> a -> GExpectation+m `gShouldReturn` r = m >>= (`gShouldBe` r)++notAGribPath :: FilePath+notAGribPath = "test/stage/not_a_grib.txt"++regular1Path :: FilePath+regular1Path = "test/stage/regular_latlon_surface.grib1"++regular2Path :: FilePath+regular2Path = "test/stage/regular_latlon_surface.grib2"++testUuidPath :: FilePath+testUuidPath = "test/stage/test_uuid.grib2"

@@ -0,0 +1,130 @@+{- |+Module      : Data.GribSpec+Copyright   : (c) Mattias Jakobsson 2015+License     : GPL-3++Maintainer  : mjakob422@gmail.com+Stability   : unstable+Portability : portable++Unit and regression tests for Data.Grib.+-}++module Data.GribSpec ( main, spec ) where++import Control.Exception ( throwIO )+import System.IO.Error   ( isDoesNotExistError )++import Test.Hspec+import Data.Grib+import Data.Grib.Exception+import Data.Grib.Test+++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "runGribIO" $ do+    it "should return the results of the actions" $+      runGribIO testUuidPath (getLong "topLevel") `shouldReturn` [1, 2]++    it "should fail with DoesNotExistError for a non-existing file" $+      runGribIO "doesnotexist" (return ()) `shouldThrow` isDoesNotExistError++    it "should fail with a GribException for a non-grib file" $+      runGribIO notAGribPath (return ()) `shouldThrow` isAnyGribException++    it "should fail with any exception raised by the action" $+      runGribIO testUuidPath (liftIO $ throwIO NullPtrReturned)+        `shouldThrow` isNullPtrReturned++  describe "runGribIO_" $ do+    it "should return unit" $+      runGribIO_ testUuidPath (getLong "topLevel") `shouldReturn` ()++    it "should fail with DoesNotExistError for a non-existing file" $+      runGribIO_ "doesnotexist" (return ()) `shouldThrow` isDoesNotExistError++    it "should fail with a GribException for a non-grib file" $+      runGribIO_ notAGribPath (return ()) `shouldThrow` isAnyGribException++    it "should fail with any exception raised by the action" $+      runGribIO_ testUuidPath (liftIO $ throwIO NullPtrReturned)+        `shouldThrow` isNullPtrReturned++  describe "getDouble" $+    it "should fail with GribNotFound if the key does not exist" $+      runGribIO_ testUuidPath (getDouble "missingKey")+        `shouldThrow` isGribException GribNotFound++  describe "getLong" $+    it "should fail with GribNotFound if the key does not exist" $+      runGribIO_ testUuidPath (getLong "missingKey")+        `shouldThrow` isGribException GribNotFound++  describe "getString" $+    it "should fail with GribNotFound if the key does not exist" $+      runGribIO_ testUuidPath (getString "missingKey")+        `shouldThrow` isGribException GribNotFound++  describe "setDouble" $ do+    it "should fail with GribNotFound if the key does not exist" $+      runGribIO_ testUuidPath (setDouble "missingKey" 0)+        `shouldThrow` isGribException GribNotFound++    it "should fail with GribReadOnly if the key is read-only" $+      runGribIO_ testUuidPath (setDouble "referenceValue" 0)+        `shouldThrow` isGribException GribReadOnly++  describe "setLong" $ do+    it "should fail with GribNotFound if the key does not exist" $+      runGribIO_ testUuidPath (setLong "missingKey" 0)+        `shouldThrow` isGribException GribNotFound++    it "should fail with GribReadOnly if the key is read-only" $+      runGribIO_ testUuidPath (setLong "getNumberOfValues" 0)+        `shouldThrow` isGribException GribReadOnly++  describe "setString" $ do+    it "should fail with GribNotFound if the key does not exist" $+      runGribIO_ testUuidPath (setString "missingKey" "value")+        `shouldThrow` isGribException GribNotFound++    it "should fail with GribReadOnly if the key is read-only" $+      runGribIO_ testUuidPath (setString "referenceValue" "value")+        `shouldThrow` isGribException GribReadOnly++  describe "getFilename" $+    it "should return the name of the file being read" $+      runGribIO testUuidPath getFilename `shouldReturn` replicate 2 testUuidPath++  describe "getIndex" $+    it "should return the zero-based index of the current message in the file" $+      runGribIO testUuidPath getIndex `shouldReturn` [0, 1]++  describe "get example" $+    it "should produce the same result as the original" $+      runGribIO_ regular1Path $ do+        setString "file" regular1Path++        getLong "Ni" `gShouldReturn` 16+        getLong "Nj" `gShouldReturn` 31++        getDouble "yFirst"      `gShouldReturn` 60+        getDouble "xFirst"      `gShouldReturn`  0+        getDouble "yLast"       `gShouldReturn`  0+        getDouble "xLast"       `gShouldReturn` 30+        getDouble "DyInDegrees" `gShouldReturn`  2+        getDouble "DxInDegrees" `gShouldReturn`  2++        getString "packingType" `gShouldReturn` "grid_simple"++        values <- getValues+        let nvalues = length values+            avg     = sum values / fromIntegral nvalues+        nvalues `gShouldBe` 496+        avg     `gShouldBe` 291.5852483933972++        getString "file" `gShouldReturn` regular1Path

@@ -0,0 +1,1 @@+This is not a GRIB file

binary file changed (absent → 406 bytes)