diff --git a/geos.cabal b/geos.cabal --- a/geos.cabal +++ b/geos.cabal @@ -1,8 +1,8 @@ name: geos -version: 0.1.0.1 +version: 0.1.1.0 -synopsis: Bindings for GEOS. +synopsis: Bindings for GEOS. description: This is a Haskell binding to Geos, the open-source geometry library, which includes geometry types, predicate functions and other operations, spatially indexed geometries, and parsers for WKB and WKT formats. @@ -45,6 +45,7 @@ , Data.Geometry.Geos.Serialize , Data.Geometry.Geos.Buffer , Data.Geometry.Geos.Prepared + , Data.Geometry.Geos.STRTree other-modules: Data.Geometry.Geos.Raw.Base @@ -57,11 +58,10 @@ , Data.Geometry.Geos.Raw.Internal hs-source-dirs: src - frameworks: GEOS default-extensions: LambdaCase , GADTs - , ExistentialQuantification + , ExistentialQuantification , DeriveDataTypeable , RankNTypes , DataKinds @@ -82,7 +82,6 @@ exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: tests src - frameworks: GEOS build-tools: hsc2hs main-is: Main.hs @@ -97,11 +96,11 @@ default-extensions: LambdaCase , GADTs - , ExistentialQuantification + , ExistentialQuantification , DeriveDataTypeable , RankNTypes , DataKinds - , KindSignatures + , KindSignatures other-modules: Data.Geometry.Geos.Geometry , Data.Geometry.Geos.Raw.Internal @@ -120,4 +119,4 @@ source-repository head type: git - location: https://github.com/ewestern/geos + location: https://github.com/ewestern/geos diff --git a/src/Data/Geometry/Geos/Raw/Geometry.hs b/src/Data/Geometry/Geos/Raw/Geometry.hs --- a/src/Data/Geometry/Geos/Raw/Geometry.hs +++ b/src/Data/Geometry/Geos/Raw/Geometry.hs @@ -66,11 +66,16 @@ import Foreign.C.Types import Foreign.C.String +{- | +A Geom is a wrapper around the C data structure that has finalizers associated with it. +-} newtype Geom = Geom (ForeignPtr I.GEOSGeometry) +{- | +A GeomConst is a wrapper around the C data structure that does *not* have finalizers attached to it. A typical use case for GemoConst is when retrieving a child geometry from a composite geometry. If the parent geometry has finalizers associated with it, we can not separately attempt to deallocate memory occupied by the child geometry. +-} newtype GeomConst = GeomConst ( Ptr I.GEOSGeometry) - class Geometry a where type CoordSeqInput a @@ -178,11 +183,12 @@ => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> IO CInt) -> a -> Geos Int -getNum_ f g = withGeos $ \h -> do - i <- throwIfNeg (mkErrorMessage "getNumCoordinates") $ - withGeometry g $ f h - return $ fromIntegral i +getNum_ f g = withGeos $ \h -> + withGeometry g $ \g' -> do + i <- throwIfNeg (mkErrorMessage "getNumCoordinates") $ f h g' + return $ fromIntegral i + getNumCoordinates :: Geometry a => a -> Geos Int getNumCoordinates = getNum_ I.geos_GetNumCoordinates @@ -191,24 +197,26 @@ getNumInteriorRings = getNum_ I.geos_GetNumInteriorRings --- multi geometries +-- Returned object is a pointer to internal storage: it must NOT be destroyed directly. getNumGeometries :: Geometry a => a -> Geos Int getNumGeometries = getNum_ I.geos_GetNumGeometries -getN_ :: (Geometry a , Geometry b) +getN_ :: Geometry a => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> CInt -> IO (Ptr I.GEOSGeometry)) -> a -> Int - -> Geos b + -> Geos GeomConst getN_ f g i = withGeos $ \h -> withGeometry g $ \gp -> do gp' <- throwIfNull "getN" $ f h gp $ fromIntegral i constructGeometry h gp' -getGeometryN :: (Geometry a, Geometry b) => a -> Int -> Geos b +getGeometryN :: Geometry a => a -> Int -> Geos GeomConst getGeometryN = getN_ I.geos_GetGeometryN -getExteriorRing :: (Geometry a, Geometry b) => a -> Geos b +-- Returned object is a pointer to internal storage: it must NOT be destroyed directly. +getExteriorRing :: Geometry a => a -> Geos GeomConst getExteriorRing g = do withGeos $ \h -> do withGeometry g $ \gp -> do @@ -216,7 +224,7 @@ constructGeometry h gp' -getInteriorRingN :: (Geometry a, Geometry b) => a -> Int -> Geos b +getInteriorRingN :: Geometry a => a -> Int -> Geos GeomConst getInteriorRingN = getN_ I.geos_GetInteriorRingN normalize :: Geometry a => a -> Geos a @@ -233,11 +241,6 @@ withGeos $ \h -> withGeometry g $ \gp -> I.geos_GeomClone h gp >>= constructGeometry h - {-Geometry Constructors.-} - {-GEOSCoordSequence* arguments will become ownership of the returned object.-} - {-All functions return NULL on exception.-} - - -- Geometry Constructors {-| The following require CoordSeqConst as arguments since coordinate sequences become owned by the Geometry object. @@ -252,18 +255,17 @@ createLineString ::Geometry b => CoordSeqConst -> Geos b createLineString = createGeometryFromCoords I.geos_GeomCreateLineString --- TODO: Make this take a vector argument - -- | The second argument is a list of geometries, -- | NOTE. geometries become owned by caller. createPolygon :: Geometry a => GeomConst -> [GeomConst] -> Geos a createPolygon o hs = do withGeos $ \h -> do ptrs <- mapM (\v -> withGeometry v $ return) hs - withGeometry o $ \op -> - withArray ptrs $ \ph -> do - g' <- I.geos_GeomCreatePolygon h op ph $ fromIntegral $ length hs - constructGeometry h g' + withGeometry o $ \op -> do + g' <- case ptrs of + [] -> I.geos_GeomCreatePolygon h op nullPtr 0 + xs -> withArray xs $ \ph -> I.geos_GeomCreatePolygon h op ph $ fromIntegral $ length hs + constructGeometry h g' createMulti_ :: Geometry a => I.GEOSGeomType -> [GeomConst] -> Geos a diff --git a/src/Data/Geometry/Geos/Raw/Internal.hs b/src/Data/Geometry/Geos/Raw/Internal.hs deleted file mode 100644 --- a/src/Data/Geometry/Geos/Raw/Internal.hs +++ /dev/null @@ -1,613 +0,0 @@ -{-# LINE 1 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} -{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} -{-# LINE 2 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} -module Data.Geometry.Geos.Raw.Internal where - -import Foreign -import Foreign.C - - -{-# LINE 8 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} - -{-# LINE 9 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} - -newtype GEOSGeomType = GEOSGeomType { unGEOSGeomType :: CInt } - deriving (Eq,Show) - -pointId :: GEOSGeomType -pointId = GEOSGeomType 0 -lineStringId :: GEOSGeomType -lineStringId = GEOSGeomType 1 -polygonId :: GEOSGeomType -polygonId = GEOSGeomType 3 -multiPointId :: GEOSGeomType -multiPointId = GEOSGeomType 4 -multiLineStringId :: GEOSGeomType -multiLineStringId = GEOSGeomType 4 -multiPolygonId :: GEOSGeomType -multiPolygonId = GEOSGeomType 6 -geometryCollectionId :: GEOSGeomType -geometryCollectionId = GEOSGeomType 7 - -{-# LINE 22 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} - -newtype GEOSByteOrder = GEOSByteOrder { unGEOSByteOrder :: CInt} - deriving (Eq, Show) - -bigEndian :: GEOSByteOrder -bigEndian = GEOSByteOrder 0 -littleEndian :: GEOSByteOrder -littleEndian = GEOSByteOrder 1 - -{-# LINE 30 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} - -data GEOSContextHandle_HS -type GEOSContextHandle_t = Ptr GEOSContextHandle_HS -data GEOSGeometry -data GEOSCoordSequence -data GEOSSTRTree -data GEOSBufferParams -data GEOSPreparedGeometry -type GEOSMessageHandler = FunPtr (CString -> (Ptr ()) -> IO ()) -type GEOSMessageHandler_r = FunPtr (CString -> (Ptr ()) -> IO ()) -type GEOSQueryCallback = FunPtr (Ptr () -> Ptr () -> IO ()) - --- read/write -data GEOSWKBWriter -data GEOSWKBReader -data GEOSWKTWriter -data GEOSWKTReader - -foreign import ccall - "stdlib.h &free" - p_free :: FunPtr (Ptr a -> IO ()) - -foreign import ccall - "notice_handlers.h init_GEOS" - geos_init :: IO GEOSContextHandle_t - -foreign import ccall - "notice_handlers.h &finalise_GEOS" - geos_finish :: FunPtr (GEOSContextHandle_t -> IO ()) - -foreign import ccall - "geos_c.h GEOSContext_setNoticeHandler_r" - geos_setNoticeHandler :: GEOSContextHandle_t -> GEOSMessageHandler -> IO GEOSMessageHandler - -foreign import ccall - "geos_c.h GEOSContext_setErrorHandler_r" - geos_setErrorHandler :: GEOSContextHandle_t -> GEOSMessageHandler -> IO GEOSMessageHandler - --- Info - -foreign import ccall - "geos_c.h GEOSGetSRID_r" - geos_GetSRID :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO CInt - -foreign import ccall - - "geos_c.h GEOSSetSRID_r" - geos_SetSRID :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CInt -> IO () - -foreign import ccall - "geos_c.h GEOSGeom_getCoordSeq_r" - geos_GetCoordSeq :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSCoordSequence) - -foreign import ccall - "geos_c.h GEOSGeomTypeId_r" - geos_GeomTypeId :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO CInt - -foreign import ccall - "geos_c.h GEOSGeomType_r" - geos_GeomType :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr CChar) - -foreign import ccall - "geos_c.h GEOSNormalize_r" - geos_Normalize :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO CInt - - -- polygons -foreign import ccall - "geos_c.h GEOSGetInteriorRingN_r" - geos_GetInteriorRingN :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CInt -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGetExteriorRing_r" - geos_GetExteriorRing :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGetNumInteriorRings_r" - geos_GetNumInteriorRings :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO CInt --- multigeometries -foreign import ccall - "geos_c.h GEOSGetNumGeometries_r" - geos_GetNumGeometries :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO CInt - -foreign import ccall - "geos_c.h GEOSGetGeometryN_r" - geos_GetGeometryN :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CInt -> IO (Ptr GEOSGeometry) - - --- Linear Referencing -foreign import ccall - "geos_c.h GEOSProject_r" - geos_Project :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CDouble ---- -foreign import ccall - "geos_c.h GEOSInterpolate_r" - geos_Interpolate :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CDouble -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSProjectNormalized_r" - geos_ProjectNormalized :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CDouble - -foreign import ccall - "geos_c.h GEOSInterpolateNormalized_r" - geos_InterpolateNormalized :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CDouble -> IO (Ptr GEOSGeometry) - - -- Coord Sequence -- return 0 on exception - -- -foreign import ccall - "geos_c.h GEOSCoordSeq_create_r" - geos_CoordSeqCreate :: GEOSContextHandle_t -> CUInt -> CUInt -> IO (Ptr GEOSCoordSequence) - - -foreign import ccall - "geos_c.h GEOSCoordSeq_clone_r" - geos_CoordSeqClone :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> IO (Ptr GEOSCoordSequence ) - -foreign import ccall - "geos_c.h &GEOSCoordSeq_destroy_r" - geos_CoordSeqDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSCoordSequence -> IO ()) - -foreign import ccall - "geos_c.h GEOSCoordSeq_setX_r" - geos_CoordSeqSetX :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_setY_r" - geos_CoordSeqSetY :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_setZ_r" - geos_CoordSeqSetZ :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_setOrdinate_r" - geos_CoordSeqSetOrdinate :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> CUInt -> CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_getX_r" - geos_CoordSeqGetX :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_getY_r" - geos_CoordSeqGetY :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_getZ_r" - geos_CoordSeqGetZ :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_getOrdinate_r" - geos_CoordSeqGetOrdinate :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> CUInt -> CUInt -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_getSize_r" - geos_CoordSeqGetSize :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> Ptr CUInt -> IO CInt - -foreign import ccall - "geos_c.h GEOSGetNumCoordinates_r" - geos_GetNumCoordinates :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO CInt - -foreign import ccall - "geos_c.h GEOSCoordSeq_getDimensions_r" - geos_CoordSeqGetDimensions :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> Ptr CUInt -> IO CInt - -foreign import ccall - "geos_c.h &GEOSGeom_destroy_r" - geos_GeomDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSGeometry -> IO ()) - -foreign import ccall - "geos_c.h GEOSGeom_clone_r" - geos_GeomClone :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - --- Geometry Constructors. --- * GEOSCoordSequence* arguments will become ownership of the returned object. --- * All functions return NULL on exception. - -foreign import ccall - "geos_c.h GEOSGeom_createPoint_r" - geos_GeomCreatePoint :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGeom_createEmptyPoint_r" - geos_GeomCreateEmptyPoint :: GEOSContextHandle_t -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGeom_createLinearRing_r" - geos_GeomCreateLinearRing :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGeom_createLineString_r" - geos_GeomCreateLineString :: GEOSContextHandle_t -> Ptr GEOSCoordSequence -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGeom_createEmptyLineString_r" - geos_GeomCreateEmptyLineString :: GEOSContextHandle_t -> IO (Ptr GEOSGeometry) - ---Second argument is an array of GEOSGeometry* objects. ---The caller remains owner of the array, but pointed-to ---objects become ownership of the returned GEOSGeometry. - -foreign import ccall - "geos_c.h GEOSGeom_createEmptyPolygon_r" - geos_GeomCreateEmptyPolygon :: GEOSContextHandle_t -> IO (Ptr GEOSGeometry) - - -- todo: this might not work as a plain pointer -foreign import ccall - "geos_c.h GEOSGeom_createPolygon_r" - geos_GeomCreatePolygon :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr (Ptr GEOSGeometry) -> CUInt -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGeom_createCollection_r" - geos_GeomCreateCollection :: GEOSContextHandle_t -> CInt -> Ptr (Ptr GEOSGeometry) -> CUInt -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGeom_createEmptyCollection_r" - geos_GeomCreateEmptyCollection :: GEOSContextHandle_t -> CInt -> IO (Ptr GEOSGeometry) - ----------- ---- Buffer ---------- - -newtype BufferCapStyle = BufferCapStyle { unBufferCapStyle :: CInt } - deriving (Eq,Show) - -capRound :: BufferCapStyle -capRound = BufferCapStyle 1 -capFlat :: BufferCapStyle -capFlat = BufferCapStyle 2 -capSquare :: BufferCapStyle -capSquare = BufferCapStyle 3 - -{-# LINE 258 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} - -newtype BufferJoinStyle = BufferJoinStyle { unBufferJoinStyle :: CInt } - deriving (Eq, Show) - -joinRound :: BufferJoinStyle -joinRound = BufferJoinStyle 1 -joinMitre :: BufferJoinStyle -joinMitre = BufferJoinStyle 2 -joinBevel :: BufferJoinStyle -joinBevel = BufferJoinStyle 3 - -{-# LINE 267 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} -foreign import ccall - "geos_c.h GEOSBuffer_r" - geos_Buffer :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CDouble -> CInt -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSBufferParams_create_r" - geos_BufferParamsCreate :: GEOSContextHandle_t -> IO (Ptr GEOSBufferParams) - -foreign import ccall - "geos_c.h &GEOSBufferParams_destroy_r" - geos_BufferParamsDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSBufferParams -> IO ()) - -foreign import ccall - "geos_c.h GEOSBufferParams_setEndCapStyle_r" - geos_BufferParamsSetEndCapStyle :: GEOSContextHandle_t -> Ptr GEOSBufferParams -> CInt -> IO CInt - -foreign import ccall - "geos_c.h GEOSBufferParams_setJoinStyle_r" - geos_BufferParamsSetJoinStyle :: GEOSContextHandle_t -> Ptr GEOSBufferParams -> CInt -> IO CInt - -foreign import ccall - "geos_c.h GEOSBufferParams_setMitreLimit_r" - geos_BufferParamsSetMitreLimit :: GEOSContextHandle_t -> Ptr GEOSBufferParams -> CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSBufferParams_setQuadrantSegments_r" - geos_BufferParamsSetQuadrantSegments :: GEOSContextHandle_t -> Ptr GEOSBufferParams -> CInt -> IO CInt - -foreign import ccall - "geos_c.h GEOSBufferParams_setSingleSided_r" - geos_BufferParamsSetSingleSided :: GEOSContextHandle_t -> Ptr GEOSBufferParams -> CInt -> IO CInt - -foreign import ccall - "geos_c.h GEOSBufferWithParams_r" - geos_BufferWithParams :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSBufferParams -> CDouble -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSBufferWithStyle_r" - geos_BufferWithStyle :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CDouble -> CInt -> CInt -> CInt -> CDouble -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSOffsetCurve_r" - geos_OffsetCurve :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CDouble -> CInt -> CInt -> CDouble -> IO (Ptr GEOSGeometry) - ------------ ---- Topology ----------- -foreign import ccall - "geos_c.h GEOSEnvelope_r" - geos_Envelope :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSIntersection_r" - geos_Intersection :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSConvexHull_r" - geos_ConvexHull :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSDifference_r" - geos_Difference :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSSymDifference_r" - geos_SymDifference :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSBoundary_r" - geos_Boundary :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSUnion_r" - geos_Union :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSUnaryUnion_r" - geos_UnaryUnion :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSGetCentroid_r" - geos_GetCentroid :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSPointOnSurface_r" - geos_PointsOnSurface :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSNode_r" - geos_Node :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) - - -foreign import ccall - "geos_c.h GEOSDelaunayTriangulation_r" - geos_DelaunayTriangulation :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CDouble -> CInt -> IO (Ptr GEOSGeometry) - - - -{-# LINE 365 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} -foreign import ccall - "geos_c.h GEOSVoronoiDiagram_r" - geos_VoronoiDiagram :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> CDouble -> CInt -> IO (Ptr GEOSGeometry) - -{-# LINE 369 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} - ------ ---Binary Predicates. ------ - -foreign import ccall - "geos_c.h GEOSDisjoint_r" - geos_Disjoint :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSTouches_r" - geos_Touches :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSCrosses_r" - geos_Crosses :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSIntersects_r" - geos_Intersects :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSWithin_r" - geos_Within :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSContains_r" - geos_Contains :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSOverlaps_r" - geos_Overlaps :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSEquals_r" - geos_Equals :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSEqualsExact_r" - geos_EqualsExact :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> CDouble -> IO CChar - -foreign import ccall - "geos_c.h GEOSCovers_r" - geos_Covers :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSCoveredBy_r" - geos_CoveredBy :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO CChar - ---- prepared Geometries - ---- Readers / Writers -foreign import ccall - "geos_c.h GEOSWKBReader_create_r" - geos_WKBReaderCreate :: GEOSContextHandle_t -> IO (Ptr GEOSWKBReader) - -foreign import ccall - "geos_c.h &GEOSWKBReader_destroy_r" - geos_WKBReaderDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSWKBReader -> IO ()) - -foreign import ccall - "geos_c.h GEOSWKBReader_read_r" - geos_WKBReaderRead :: GEOSContextHandle_t -> Ptr GEOSWKBReader -> CString -> CSize -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSWKBReader_readHEX_r" - geos_WKBReaderReadHex :: GEOSContextHandle_t -> Ptr GEOSWKBReader -> CString -> CSize -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSWKBWriter_create_r" - geos_WKBWriterCreate :: GEOSContextHandle_t -> IO (Ptr GEOSWKBWriter) - -foreign import ccall - "geos_c.h &GEOSWKBWriter_destroy_r" - geos_WKBWriterDestroy :: FunPtr ( GEOSContextHandle_t -> Ptr GEOSWKBWriter -> IO ()) - - -- caller owns results -foreign import ccall - "geos_c.h GEOSWKBWriter_write_r" - geos_WKBWriterWrite :: GEOSContextHandle_t -> Ptr GEOSWKBWriter -> Ptr GEOSGeometry -> Ptr CSize -> IO CString - - -- caller owns results -foreign import ccall - "geos_c.h GEOSWKBWriter_writeHEX_r" - geos_WKBWriterWriteHex :: GEOSContextHandle_t -> Ptr GEOSWKBWriter -> Ptr GEOSGeometry -> Ptr CSize -> IO CString - -foreign import ccall - "geos_c.h GEOSWKBWriter_setIncludeSRID_r" - geos_WKBWriterSetIncludeSRID :: GEOSContextHandle_t -> Ptr GEOSWKBWriter -> CChar -> IO () - -foreign import ccall - "geos_c.h GEOSWKTReader_create_r" - geos_WKTReaderCreate :: GEOSContextHandle_t -> IO (Ptr GEOSWKTReader) - -foreign import ccall - "geos_c.h &GEOSWKTReader_destroy_r" - geos_WKTReaderDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSWKTReader -> IO ()) - -foreign import ccall - "geos_c.h GEOSWKTReader_read_r" - geos_WKTReaderRead :: GEOSContextHandle_t -> Ptr GEOSWKTReader -> CString -> IO (Ptr GEOSGeometry) - -foreign import ccall - "geos_c.h GEOSWKTWriter_create_r" - geos_WKTWriterCreate :: GEOSContextHandle_t -> IO (Ptr GEOSWKTWriter) - -foreign import ccall - "geos_c.h &GEOSWKTWriter_destroy_r" - geos_WKTWriterDestroy :: FunPtr ( GEOSContextHandle_t -> Ptr GEOSWKTWriter -> IO ()) - - -- caller owns results -foreign import ccall - "geos_c.h GEOSWKTWriter_write_r" - geos_WKTWriterWrite :: GEOSContextHandle_t -> Ptr GEOSWKTWriter -> Ptr GEOSGeometry -> IO CString - - ---TODO: 1085 finish writer methods - --- following return 0 on exception, 1 otherwise -foreign import ccall - "geos_c.h GEOSArea_r" - geos_Area :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSLength_r" - geos_Length :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSDistance_r" - geos_Distance :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSHausdorffDistance_r" - geos_HausdorffDistance :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSHausdorffDistanceDensify_r" - geos_HausdorffDistanceDensify :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> CDouble -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSGeomGetLength_r" - geos_GeomGetLength :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr CDouble -> IO CInt - -foreign import ccall - "geos_c.h GEOSNearestPoints_r" - geos_NearestPoints :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO (Ptr GEOSCoordSequence) - --- | Prepared Geometries -foreign import ccall - "geos_c.h GEOSPrepare_r" - geos_Prepare :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSPreparedGeometry) - -foreign import ccall - "geos_c.h &GEOSPreparedGeom_destroy_r" - geos_PreparedGeomDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> IO ()) - -foreign import ccall - "geos_c.h GEOSPreparedContains_r" - geos_PreparedContains :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedContainsProperly_r" - geos_PreparedContainsProperly :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedCoveredBy_r" - geos_PreparedCoveredBy :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedCovers_r" - geos_PreparedCovers :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedCrosses_r" - geos_PreparedCrosses :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedDisjoint_r" - geos_PreparedDisjoint :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedIntersects_r" - geos_PreparedIntersects :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedOverlaps_r" - geos_PreparedOverlaps :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedTouches_r" - geos_PreparedTouches :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - -foreign import ccall - "geos_c.h GEOSPreparedWithin_r" - geos_PreparedWithin :: GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar - --- STRTREE - - -{-# LINE 568 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} -foreign import ccall - "geos_c.h GEOSSTRtree_create_r" - geos_STRTreeCreate :: GEOSContextHandle_t -> CSize -> IO (Ptr GEOSSTRTree) - - -foreign import ccall - "geos_c.h GEOSSTRtree_insert_r" - geos_STRTreeInsert :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> Ptr GEOSGeometry -> Ptr () -> IO () - -foreign import ccall - "geos_c.h GEOSSTRtree_query_r" - geos_STRTreeQuery :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> Ptr GEOSGeometry -> GEOSQueryCallback -> Ptr () -> IO () - -foreign import ccall - "geos_c.h GEOSSTRtree_iterate_r" - geos_STRTreeIterate :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> GEOSQueryCallback -> Ptr () -> IO () - -foreign import ccall - "geos_c.h &GEOSSTRtree_destroy_r" - geos_STRTreeDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSSTRTree -> IO ()) - - -{-# LINE 590 "src/Data/Geometry/Geos/Raw/Internal.hsc" #-} - diff --git a/src/Data/Geometry/Geos/Raw/Internal.hsc b/src/Data/Geometry/Geos/Raw/Internal.hsc --- a/src/Data/Geometry/Geos/Raw/Internal.hsc +++ b/src/Data/Geometry/Geos/Raw/Internal.hsc @@ -14,6 +14,7 @@ #{ enum GEOSGeomType, GEOSGeomType, pointId = GEOS_POINT , lineStringId = GEOS_LINESTRING + , linearRingId = GEOS_LINEARRING , polygonId = GEOS_POLYGON , multiPointId = GEOS_MULTIPOINT , multiLineStringId = GEOS_MULTILINESTRING @@ -38,7 +39,8 @@ data GEOSPreparedGeometry type GEOSMessageHandler = FunPtr (CString -> (Ptr ()) -> IO ()) type GEOSMessageHandler_r = FunPtr (CString -> (Ptr ()) -> IO ()) -type GEOSQueryCallback = FunPtr (Ptr () -> Ptr () -> IO ()) +type GEOSQueryCallback a = FunPtr (Ptr a -> Ptr () -> IO ()) +type GEOSDistanceCallback = FunPtr (Ptr () -> Ptr () -> CDouble -> Ptr () -> IO ()) -- read/write data GEOSWKBWriter @@ -570,15 +572,20 @@ foreign import ccall "geos_c.h GEOSSTRtree_insert_r" - geos_STRTreeInsert :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> Ptr GEOSGeometry -> Ptr () -> IO () + geos_STRTreeInsert :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> Ptr GEOSGeometry -> Ptr a -> IO () foreign import ccall "geos_c.h GEOSSTRtree_query_r" - geos_STRTreeQuery :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> Ptr GEOSGeometry -> GEOSQueryCallback -> Ptr () -> IO () + geos_STRTreeQuery :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> Ptr GEOSGeometry -> GEOSQueryCallback a -> Ptr () -> IO () foreign import ccall "geos_c.h GEOSSTRtree_iterate_r" - geos_STRTreeIterate :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> GEOSQueryCallback -> Ptr () -> IO () + geos_STRTreeIterate :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> GEOSQueryCallback a -> Ptr () -> IO () + +foreign import ccall + "geos_c.h GEOSSTRtree_nearest_generic_r" + geos_STRTreNearestGeneric :: GEOSContextHandle_t -> Ptr GEOSSTRTree -> Ptr GEOSGeometry -> GEOSDistanceCallback -> IO () + foreign import ccall "geos_c.h &GEOSSTRtree_destroy_r" diff --git a/src/Data/Geometry/Geos/STRTree.hs b/src/Data/Geometry/Geos/STRTree.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geometry/Geos/STRTree.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE ScopedTypeVariables #-} + + +module Data.Geometry.Geos.STRTree where + +import Prelude hiding (foldr) +import qualified Data.Geometry.Geos.Raw.STRTree as RT +import qualified Data.Geometry.Geos.Raw.Geometry as RG +import Data.Geometry.Geos.Types +import Data.Geometry.Geos.Geometry +import Data.Geometry.Geos.Raw.Base +import Foreign +import qualified Data.Vector as V + +-- can't make instance of Foldable because of Storable constraint +foldr :: (RT.STRTreeLike t, Storable a) => (a -> b -> b) -> b -> t a -> b +foldr f a = runGeos . RT.foldr f a + + +-- unfortunately, the api exposed by geos does not allow retrieval of original geometries +toList :: Storable a => RT.STRTree a -> [a] +toList = foldr (:) [] + +toVector :: Storable a => RT.STRTree a -> V.Vector a +toVector = foldr V.cons V.empty + +-- would like to expose 'empty' as is common for haskell collections, but when initializing an STRTree we have to know the node size before hand + +fromList :: Storable b => [(Geometry a, b)] -> RT.STRTree b +fromList = fromFoldable + +empty :: RT.STRTreeBuilder a +empty = runGeos $ RT.createSTRTreeBuilder 10 + +build :: RT.STRTreeBuilder a -> RT.STRTree a +build = runGeos . RT.build + +insert :: Storable a => Geometry b -> a -> RT.STRTreeBuilder a -> () +insert geom item tree = runGeos $ do + rg :: RG.GeomConst <- convertGeometryToRaw geom + RT.insert tree rg item + return () + +{-| +`fromFoldable` creates an STRTree with a default node capacity of 10. For finer-grained control over the node capacity, `fromFoldable_` accepts a node-capacity argument. +-} +fromFoldable :: (Foldable f, Storable b) => f (Geometry a, b) -> RT.STRTree b +fromFoldable = fromFoldable_ 10 + +fromFoldable_ :: (Foldable f, Storable b) => Int -> f (Geometry a, b) -> RT.STRTree b +fromFoldable_ capacity things = runGeos $ do + tree <- RT.createSTRTreeBuilder capacity + mapM_ (ins tree) things + RT.build tree + where ins tree' (g,b) = do + rg :: RG.GeomConst <- convertGeometryToRaw g + RT.insert tree' rg b + + +lookup :: Storable b => Geometry a -> RT.STRTree b -> V.Vector b +lookup g tree = runGeos $ do + rg :: RG.GeomConst <- convertGeometryToRaw g + RT.query tree rg diff --git a/tests/SpatialOperationsSpec.hs b/tests/SpatialOperationsSpec.hs --- a/tests/SpatialOperationsSpec.hs +++ b/tests/SpatialOperationsSpec.hs @@ -1,14 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} module SpatialOperationsSpec where import Test.Hspec import qualified Data.ByteString as BS import qualified Data.Vector as V +import Data.Geometry.Geos.Raw.Base import Data.Geometry.Geos.Types import Data.Geometry.Geos.Geometry import Data.Geometry.Geos.Topology +import qualified Data.Geometry.Geos.STRTree as STR +import Data.Word import SpecSampleData @@ -66,3 +70,18 @@ (ensurePoint $ envelope point) `shouldBe` point (ensureMultiLineString $ boundary poly2) `shouldBe` env2 convexHull poly2 `shouldBe` env3 + + it "can use STRTrees" $ do + let points = makePointGeo <$> [(0.1,0.1), (0.9, 0.9)] + polygon = makePolygonGeo [[(0,0),(0,1),(1,1),(1,0),(0,0)]] + tree = STR.fromList $ zip points [(0::Int)..] + result = STR.lookup polygon tree + result `shouldBe` V.fromList [0,1] + + it "can run STRTrees on larger data" $ do + points <- (fmap ensurePoint) <$> loadThingsFromFile "tests/sampledata/points.csv" + polygons <- (fmap ensurePolygon) <$> loadThingsFromFile "tests/sampledata/polygons.csv" + let tree = STR.fromList $ zip polygons [(0::Int)..] + let results = fmap (\p -> STR.lookup p tree) $ take 5000 points + let total = sum $ fmap sum results + total `shouldBe` 45