hgeos 0.1.6.0 → 0.1.7.0

raw patch · 6 files changed

+137/−31 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hgeos.cabal +1/−1
• src/lib/Data/Geolocation/GEOS.hs +58/−22
• src/lib/Data/Geolocation/GEOS/Imports.hs +19/−1
• src/lib/Data/Geolocation/GEOS/Trans.hs +17/−0
• src/lib/Data/Geolocation/GEOS/helpers.c +14/−1
• src/test/GEOSTest/TransAPI.hs +28/−6

@@ -1,5 +1,5 @@ name:                 hgeos-version:              0.1.6.0+version:              0.1.7.0 synopsis:             Simple Haskell bindings to GEOS C API description:   Simple Haskell bindings to the <https://trac.osgeo.org/geos/ GEOS>

@@ -31,6 +31,7 @@     , area     , createCoordSeq     , createLinearRing+    , createPolygon     , envelope     , geomTypeId     , getCoordSeq@@ -38,6 +39,7 @@     , getExteriorRing     , getGeometry     , getNumGeometries+    , getOrdinate     , getSize     , getX     , getY@@ -47,6 +49,7 @@     , mkReader     , mkWriter     , readGeometry+    , setOrdinate     , setX     , setY     , setZ@@ -62,6 +65,7 @@ import Data.Word import Foreign.C import Foreign.Marshal.Alloc+import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable @@ -154,10 +158,20 @@ -- |Returns a linear ring 'Geometry' instance from the given coordinate -- sequence createLinearRing :: CoordinateSequence -> IO (Maybe Geometry)-createLinearRing (CoordinateSequence sr (DeleteAction rawPtr _) h) = do-    modifyIORef' sr $ \p@ContextState{..} -> p { deleteActions = filter (\(DeleteAction r _) -> r /= rawPtr) deleteActions }+createLinearRing (CoordinateSequence sr deleteAction h) = do+    untrack sr deleteAction     checkAndTrackGeometry sr (\hCtx -> c_GEOSGeom_createLinearRing_r hCtx h) +-- |Returns a polygon 'Geometry' instance from the given shell and optional+-- array of holes+createPolygon :: Geometry -> [Geometry] -> IO (Maybe Geometry)+createPolygon (Geometry sr deleteAction h) holes = do+    untrack sr deleteAction+    withArrayLen (map (\(Geometry _ _ h') -> h') holes) $ \count array ->+        checkAndTrackGeometry+            sr+            (\hCtx -> c_GEOSGeom_createPolygon_r hCtx h array (fromIntegral count))+ -- |Returns a 'Geometry' instance representing the envelope of the supplied -- 'Geometry' envelope :: Geometry -> IO (Maybe Geometry)@@ -194,8 +208,8 @@  -- |Returns child 'Geometry' at given index getGeometry :: Geometry -> Int -> IO (Maybe Geometry)-getGeometry (Geometry sr _ h) index =-    checkAndDoNotTrack sr (\hCtx -> c_GEOSGetGeometryN_r hCtx h (fromIntegral index))+getGeometry (Geometry sr _ h) n =+    checkAndDoNotTrack sr (\hCtx -> c_GEOSGetGeometryN_r hCtx h (fromIntegral n))  -- |Gets the number of geometries in a 'Geometry' instance getNumGeometries :: Geometry -> IO (Maybe Int)@@ -206,12 +220,22 @@                 then Nothing                 else Just $ fromIntegral value -getOrdinate :: (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) ->-    CoordinateSequence -> Word -> IO (Maybe Double)-getOrdinate f (CoordinateSequence sr _ h) index = do+-- |Gets an ordinate value from a coordinate sequence+getOrdinate :: CoordinateSequence -> Word -> Word -> IO (Maybe Double)+getOrdinate coords idx dim =+    getOrdinateHelper+        (\hCtx h idx' -> c_GEOSCoordSeq_getOrdinate_r hCtx h idx' (fromIntegral dim))+        coords+        idx++getOrdinateHelper :: (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) ->+    CoordinateSequence ->+    Word ->+    IO (Maybe Double)+getOrdinateHelper f (CoordinateSequence sr _ h) idx = do     ContextState{..} <- readIORef sr     alloca $ \valuePtr -> do-        status <- f hCtx h (fromIntegral index) valuePtr+        status <- f hCtx h (fromIntegral idx) valuePtr         case status of              0 -> return Nothing              _ -> do@@ -230,17 +254,17 @@                  size <- peek sizePtr                  return $ Just (fromIntegral size) --- |Gets an "x" ordinate value from a coordinate sequence+-- |Gets an x-ordinate value from a coordinate sequence getX :: CoordinateSequence -> Word -> IO (Maybe Double)-getX = getOrdinate c_GEOSCoordSeq_getX_r+getX = getOrdinateHelper c_GEOSCoordSeq_getX_r --- |Gets a "y" ordinate value from a coordinate sequence+-- |Gets a y-ordinate value from a coordinate sequence getY :: CoordinateSequence -> Word -> IO (Maybe Double)-getY = getOrdinate c_GEOSCoordSeq_getY_r+getY = getOrdinateHelper c_GEOSCoordSeq_getY_r --- |Gets a "z" ordinate value from a coordinate sequence+-- |Gets a z-ordinate value from a coordinate sequence getZ :: CoordinateSequence -> Word -> IO (Maybe Double)-getZ = getOrdinate c_GEOSCoordSeq_getZ_r+getZ = getOrdinateHelper c_GEOSCoordSeq_getZ_r  -- |Returns a 'Geometry' instance representing the intersection of the two -- supplied 'Geometry' instances:@@ -286,25 +310,37 @@     mapM_ (\(DeleteAction _ f) -> f) deleteActions     c_finishGEOS_r hCtx -setOrdinate :: (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CDouble -> IO CInt ) -> CoordinateSequence -> Word -> Double -> IO (Maybe ())-setOrdinate f (CoordinateSequence sr _ h) idx val = do+-- |Sets an x-ordinate value within a coordinate sequence+setOrdinate :: CoordinateSequence -> Word -> Word -> Double -> IO (Maybe ())+setOrdinate coords idx dim =+    setOrdinateHelper+        (\hCtx h idx' -> c_GEOSCoordSeq_setOrdinate_r hCtx h idx' (fromIntegral dim))+        coords+        idx++setOrdinateHelper :: (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CDouble -> IO CInt ) -> CoordinateSequence -> Word -> Double -> IO (Maybe ())+setOrdinateHelper f (CoordinateSequence sr _ h) idx val = do     ContextState{..} <- readIORef sr     status <- f hCtx h (fromIntegral idx) (realToFrac val)     return $ case status of                   0 -> Nothing                   _ -> Just () --- |Sets an "x" ordinate value within a coordinate sequence+-- |Sets an x-ordinate value within a coordinate sequence setX :: CoordinateSequence -> Word -> Double -> IO (Maybe ())-setX = setOrdinate c_GEOSCoordSeq_setX_r+setX = setOrdinateHelper c_GEOSCoordSeq_setX_r --- |Sets an "y" ordinate value within a coordinate sequence+-- |Sets a y-ordinate value within a coordinate sequence setY :: CoordinateSequence -> Word -> Double -> IO (Maybe ())-setY = setOrdinate c_GEOSCoordSeq_setY_r+setY = setOrdinateHelper c_GEOSCoordSeq_setY_r --- |Sets an "z" ordinate value within a coordinate sequence+-- |Sets a z-ordinate value within a coordinate sequence setZ :: CoordinateSequence -> Word -> Double -> IO (Maybe ())-setZ = setOrdinate c_GEOSCoordSeq_setZ_r+setZ = setOrdinateHelper c_GEOSCoordSeq_setZ_r++untrack :: ContextStateRef -> DeleteAction -> IO ()+untrack sr (DeleteAction rawPtr _) =+    modifyIORef' sr $ \p@ContextState{..} -> p { deleteActions = filter (\(DeleteAction r _) -> r /= rawPtr) deleteActions }  -- |Reports version of GEOS API version :: IO String

@@ -19,6 +19,8 @@ <https://github.com/rcook/hgeos/blob/master/src/test/GEOSTest/LowLevelAPI.hs View sample> -} +{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Data.Geolocation.GEOS.Imports     ( GEOSContextHandle ()     , GEOSCoordSequencePtr ()@@ -29,10 +31,12 @@     , c_GEOSArea_r     , c_GEOSCoordSeq_create_r     , c_GEOSCoordSeq_destroy_r+    , c_GEOSCoordSeq_getOrdinate_r     , c_GEOSCoordSeq_getSize_r     , c_GEOSCoordSeq_getX_r     , c_GEOSCoordSeq_getY_r     , c_GEOSCoordSeq_getZ_r+    , c_GEOSCoordSeq_setOrdinate_r     , c_GEOSCoordSeq_setX_r     , c_GEOSCoordSeq_setY_r     , c_GEOSCoordSeq_setZ_r@@ -40,6 +44,7 @@     , c_GEOSFree_r_CString     , c_GEOSGeomTypeId_r     , c_GEOSGeom_createLinearRing_r+    , c_GEOSGeom_createPolygon_r     , c_GEOSGeom_destroy_r     , c_GEOSGeom_getCoordSeq_r     , c_GEOSGetExteriorRing_r@@ -61,6 +66,7 @@  import Foreign.C import Foreign.Ptr+import Foreign.Storable  -- |Determines if given pointer is null class NullablePtr a where@@ -78,7 +84,7 @@     rawIntPtr (GEOSCoordSequencePtr p) = ptrToIntPtr p  -- |Wraps @GEOSGeometry*@-newtype GEOSGeometryPtr = GEOSGeometryPtr (Ptr GEOSGeometryPtr)+newtype GEOSGeometryPtr = GEOSGeometryPtr (Ptr GEOSGeometryPtr) deriving Storable instance NullablePtr GEOSGeometryPtr where     isNullPtr (GEOSGeometryPtr p) = p == nullPtr     rawIntPtr (GEOSGeometryPtr p) = ptrToIntPtr p@@ -107,6 +113,10 @@ foreign import ccall "GEOSCoordSeq_destroy_r"     c_GEOSCoordSeq_destroy_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> IO () +-- |Wraps @GEOSCoordSeq_getOrdinate_r@+foreign import ccall "GEOSCoordSeq_getOrdinate_r"+    c_GEOSCoordSeq_getOrdinate_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CUInt -> Ptr CDouble -> IO CInt+ -- |Wraps @GEOSCoordSeq_getSize_r@ foreign import ccall "GEOSCoordSeq_getSize_r"     c_GEOSCoordSeq_getSize_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> Ptr CUInt -> IO CInt@@ -123,6 +133,10 @@ foreign import ccall "GEOSCoordSeq_getZ_r"     c_GEOSCoordSeq_getZ_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt +-- |Wraps @GEOSCoordSeq_setOrdinate_r@+foreign import ccall "GEOSCoordSeq_setOrdinate_r"+    c_GEOSCoordSeq_setOrdinate_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CUInt -> CDouble -> IO CInt+ -- |Wraps @GEOSCoordSeq_setX_r@ foreign import ccall "GEOSCoordSeq_setX_r"     c_GEOSCoordSeq_setX_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CDouble -> IO CInt@@ -150,6 +164,10 @@ -- |Wraps @GEOSGeom_createLinearRing_r@ foreign import ccall "GEOSGeom_createLinearRing_r"     c_GEOSGeom_createLinearRing_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> IO GEOSGeometryPtr++-- |Wraps @GEOSGeom_createPolygon_r@+foreign import ccall "GEOSGeom_createPolygon_r"+    c_GEOSGeom_createPolygon_r :: GEOSContextHandle -> GEOSGeometryPtr -> Ptr GEOSGeometryPtr -> CUInt -> IO GEOSGeometryPtr  -- |Wraps @GEOSGeom_destroy_r@ foreign import ccall "GEOSGeom_destroy_r"

@@ -21,12 +21,14 @@     ( areaM     , createCoordSeqM     , createLinearRingM+    , createPolygonM     , envelopeM     , geomTypeIdM     , getCoordSeqM     , getExteriorRingM     , getGeometryM     , getNumGeometriesM+    , getOrdinateM     , getSizeM     , getXM     , getYM@@ -38,6 +40,7 @@     , readGeometryM     , runGEOS     , runGEOSEither+    , setOrdinateM     , setXM     , setYM     , setZM@@ -56,6 +59,9 @@ ternaryGEOSFunc :: (a -> b -> c -> IO (Maybe d)) -> a -> b -> c -> MaybeT IO d ternaryGEOSFunc f a b c = MaybeT (f a b c) +quaternaryGEOSFunc :: (a -> b -> c -> d -> IO (Maybe e)) -> a -> b -> c -> d -> MaybeT IO e+quaternaryGEOSFunc f a b c d = MaybeT (f a b c d)+ -- |@MaybeT@-wrapped version of 'area' areaM :: Geometry -> MaybeT IO Double areaM = unaryGEOSFunc area@@ -68,6 +74,10 @@ createLinearRingM :: CoordinateSequence -> MaybeT IO Geometry createLinearRingM = unaryGEOSFunc createLinearRing +-- |@MaybeT@-wrapped version of 'createPolygon'+createPolygonM :: Geometry -> [Geometry] -> MaybeT IO Geometry+createPolygonM = binaryGEOSFunc createPolygon+ -- |@MaybeT@-wrapped version of 'envelope' envelopeM :: Geometry -> MaybeT IO Geometry envelopeM = unaryGEOSFunc envelope@@ -92,6 +102,10 @@ getNumGeometriesM :: Geometry -> MaybeT IO Int getNumGeometriesM = unaryGEOSFunc getNumGeometries +-- |@MaybeT@-wrapped version of 'getOrdinate'+getOrdinateM :: CoordinateSequence -> Word -> Word -> MaybeT IO Double+getOrdinateM = ternaryGEOSFunc getOrdinate+ -- |@MaybeT@-wrapped version of 'getSize' getSizeM :: CoordinateSequence -> MaybeT IO Word getSizeM = unaryGEOSFunc getSize@@ -163,6 +177,9 @@     case result of          Nothing -> Left <$> getErrorMessage          Just r -> return $ Right r++-- |@MaybeT@-wrapped version of 'setOrdinate'+setOrdinateM = quaternaryGEOSFunc setOrdinate  -- |@MaybeT@-wrapped version of 'setX' setXM = ternaryGEOSFunc setX

@@ -3,8 +3,11 @@ #include <stdarg.h> #include <stdio.h> -//#define TRACE(message) printf(message "\n")+#ifdef ENABLE_TRACE+#define TRACE(message) printf(message "\n")+#else #define TRACE(message) do {} while (0)+#endif  __thread char g_noticeMessage[256]; static const size_t s_noticeMessageLen = sizeof(g_noticeMessage) / sizeof(g_noticeMessage[0]);@@ -13,6 +16,8 @@  static void noticeHandler(const char* format, ...) {+    TRACE("noticeHandler");+     va_list args;     va_start(args, format);     vsnprintf(g_noticeMessage, s_noticeMessageLen, format, args);@@ -21,6 +26,8 @@  static void errorHandler(const char* format, ...) {+    TRACE("errorHandler");+     va_list args;     va_start(args, format);     vsnprintf(g_errorMessage, s_errorMessageLen, format, args);@@ -29,15 +36,21 @@  GEOSContextHandle_t initializeGEOSWithHandlers() {+    TRACE("initializeGEOSWithHandlers");+     return initGEOS_r(noticeHandler, errorHandler); }  const char* getNoticeMessage() {+    TRACE("getNoticeMessage");+     return g_noticeMessage; }  const char* getErrorMessage() {+    TRACE("getErrorMessage");+     return g_errorMessage; }

@@ -6,6 +6,10 @@ import Data.Geolocation.GEOS.Trans import Data.Maybe +check :: Bool -> MaybeT IO ()+check True = return ()+check False = error "Check failed"+ -- Demonstrates use of monad transformer API -- Lifetimes of GEOS objects are automatically managed by the context objects -- which guarantees that they are released when the context goes out of scope@@ -24,15 +28,33 @@         coords <- createCoordSeqM ctx 10 3         size <- getSizeM coords         forM_ [0..size - 2] $ \i -> do-            setXM coords i (fromIntegral i * 10.0)-            setYM coords i (fromIntegral i * 20.0)-            setZM coords i (fromIntegral i * 30.0)-        setXM coords (size - 1) 0.0-        setYM coords (size - 1) 0.0-        setZM coords (size - 1) 0.0+            setXM coords i (fromIntegral (i + 1) * 10.0)+            setYM coords i (fromIntegral (i + 1) * 20.0)+            setZM coords i (fromIntegral (i + 1) * 30.0)+        setOrdinateM coords (size - 1) 0 10.0+        setOrdinateM coords (size - 1) 1 20.0+        setOrdinateM coords (size - 1) 2 30.0         g3 <- createLinearRingM coords         str1 <- writeGeometryM writer g3         lift $ putStrLn str1++        x0 <- getXM coords 0+        check $ x0 == 10.0+        y0 <- getYM coords 0+        check $ y0 == 20.0+        z0 <- getZM coords 0+        check $ z0 == 30.0++        x1 <- getOrdinateM coords 1 0+        check $ x1 == 20.0+        y1 <- getOrdinateM coords 1 1+        check $ y1 == 40.0+        z1 <- getOrdinateM coords 1 2+        check $ z1 == 60.0++        p <- createPolygonM g3 []+        str2 <- writeGeometryM writer p+        lift $ putStrLn str2      case result of          Left m -> error $ "TransAPI.demo failed: " ++ m