diff --git a/hgeos.cabal b/hgeos.cabal --- a/hgeos.cabal +++ b/hgeos.cabal @@ -1,5 +1,5 @@ name: hgeos -version: 0.1.5.1 +version: 0.1.6.0 synopsis: Simple Haskell bindings to GEOS C API description: Simple Haskell bindings to the diff --git a/src/lib/Data/Geolocation/GEOS.hs b/src/lib/Data/Geolocation/GEOS.hs --- a/src/lib/Data/Geolocation/GEOS.hs +++ b/src/lib/Data/Geolocation/GEOS.hs @@ -29,6 +29,8 @@ , Reader () , Writer () , area + , createCoordSeq + , createLinearRing , envelope , geomTypeId , getCoordSeq @@ -45,12 +47,16 @@ , mkReader , mkWriter , readGeometry + , setX + , setY + , setZ , version , withGEOS , writeGeometry ) where import Control.Exception +import Control.Monad import Data.Geolocation.GEOS.Imports import Data.IORef import Data.Word @@ -64,17 +70,16 @@ data ContextState = ContextState { hCtx :: GEOSContextHandle - , hReaders :: [GEOSWKTReaderPtr] - , hWriters :: [GEOSWKTWriterPtr] - , hGeometries :: [GEOSGeometryPtr] - , hCoordinateSequences :: [GEOSCoordSequencePtr] + , deleteActions :: [DeleteAction] } type ContextStateRef = IORef ContextState -- |References a coordinate sequence -data CoordinateSequence = CoordinateSequence ContextStateRef GEOSCoordSequencePtr +data CoordinateSequence = CoordinateSequence ContextStateRef DeleteAction GEOSCoordSequencePtr +data DeleteAction = DeleteAction IntPtr (IO ()) + -- |Represents a geometry type ID data GeometryType = Point | @@ -87,17 +92,17 @@ GeometryCollection deriving (Enum, Show) -- |References a reader -data Reader = Reader ContextStateRef GEOSWKTReaderPtr +data Reader = Reader ContextStateRef DeleteAction GEOSWKTReaderPtr -- |References a writer -data Writer = Writer ContextStateRef GEOSWKTWriterPtr +data Writer = Writer ContextStateRef DeleteAction GEOSWKTWriterPtr -- |References a geometry -data Geometry = Geometry ContextStateRef GEOSGeometryPtr +data Geometry = Geometry ContextStateRef DeleteAction GEOSGeometryPtr -- |Returns area of a 'Geometry' instance area :: Geometry -> IO (Maybe Double) -area (Geometry sr h) = do +area (Geometry sr _ h) = do ContextState{..} <- readIORef sr alloca $ \valuePtr -> do status <- c_GEOSArea_r hCtx h valuePtr @@ -113,27 +118,55 @@ h <- f hCtx return $ if isNullPtr h then Nothing - else Just $ Geometry sr h + else Just $ Geometry sr emptyDeleteAction h -checkAndTrack :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry) -checkAndTrack sr f = do +checkAndTrack :: NullablePtr a => + ContextStateRef -> + (GEOSContextHandle -> IO a) -> + (GEOSContextHandle -> a -> IO ()) -> + (ContextStateRef -> DeleteAction -> a -> b) -> + IO (Maybe b) +checkAndTrack sr create destroy wrap = do ContextState{..} <- readIORef sr - h <- f hCtx + h <- create hCtx if isNullPtr h then return Nothing else do - modifyIORef' sr $ (\p@ContextState{..} -> p { hGeometries = h : hGeometries }) - return $ Just (Geometry sr h) + let deleteAction = DeleteAction (rawIntPtr h) (destroy hCtx h) + modifyIORef' sr (\p@ContextState{..} -> p { deleteActions = deleteAction : deleteActions }) + return $ Just (wrap sr deleteAction h) +checkAndTrackGeometry :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry) +checkAndTrackGeometry sr create = checkAndTrack sr create c_GEOSGeom_destroy_r Geometry + +emptyDeleteAction :: DeleteAction +emptyDeleteAction = DeleteAction (ptrToIntPtr nullPtr) (return ()) + +-- |Creates an empty 'CoordinateSequence' instance +createCoordSeq :: Context -> Word -> Word -> IO (Maybe CoordinateSequence) +createCoordSeq (Context sr) size dims = + checkAndTrack + sr + (\hCtx -> c_GEOSCoordSeq_create_r hCtx (fromIntegral size) (fromIntegral dims)) + c_GEOSCoordSeq_destroy_r + CoordinateSequence + +-- |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 } + checkAndTrackGeometry sr (\hCtx -> c_GEOSGeom_createLinearRing_r hCtx h) + -- |Returns a 'Geometry' instance representing the envelope of the supplied -- 'Geometry' envelope :: Geometry -> IO (Maybe Geometry) -envelope (Geometry sr h) = - checkAndTrack sr (\hCtx -> c_GEOSEnvelope_r hCtx h) +envelope (Geometry sr _ h) = + checkAndTrackGeometry sr (\hCtx -> c_GEOSEnvelope_r hCtx h) -- |Returns type of a 'Geometry' instance geomTypeId :: Geometry -> IO (Maybe GeometryType) -geomTypeId (Geometry sr h) = do +geomTypeId (Geometry sr _ h) = do ContextState{..} <- readIORef sr value <- c_GEOSGeomTypeId_r hCtx h return $ if value == -1 @@ -142,12 +175,12 @@ -- |Returns a 'CoordinateSequence' from the supplied 'Geometry' getCoordSeq :: Geometry -> IO (Maybe CoordinateSequence) -getCoordSeq (Geometry sr hGeometry) = do +getCoordSeq (Geometry sr _ hGeometry) = do ContextState{..} <- readIORef sr h <- c_GEOSGeom_getCoordSeq_r hCtx hGeometry return $ if isNullPtr h then Nothing - else Just $ CoordinateSequence sr h + else Just $ CoordinateSequence sr emptyDeleteAction h -- |Returns message in case of error getErrorMessage :: IO String @@ -156,17 +189,17 @@ -- |Returns a 'Geometry' instance representing the exterior ring of the -- supplied 'Geometry' getExteriorRing :: Geometry -> IO (Maybe Geometry) -getExteriorRing (Geometry sr h) = +getExteriorRing (Geometry sr _ h) = checkAndDoNotTrack sr (\hCtx -> c_GEOSGetExteriorRing_r hCtx h) -- |Returns child 'Geometry' at given index getGeometry :: Geometry -> Int -> IO (Maybe Geometry) -getGeometry (Geometry sr h) index = +getGeometry (Geometry sr _ h) index = checkAndDoNotTrack sr (\hCtx -> c_GEOSGetGeometryN_r hCtx h (fromIntegral index)) -- |Gets the number of geometries in a 'Geometry' instance getNumGeometries :: Geometry -> IO (Maybe Int) -getNumGeometries (Geometry sr h) = do +getNumGeometries (Geometry sr _ h) = do ContextState{..} <- readIORef sr value <- c_GEOSGetNumGeometries_r hCtx h return $ if value == -1 @@ -175,7 +208,7 @@ getOrdinate :: (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) -> CoordinateSequence -> Word -> IO (Maybe Double) -getOrdinate f (CoordinateSequence sr h) index = do +getOrdinate f (CoordinateSequence sr _ h) index = do ContextState{..} <- readIORef sr alloca $ \valuePtr -> do status <- f hCtx h (fromIntegral index) valuePtr @@ -187,7 +220,7 @@ -- |Gets the size from a coordinate sequence getSize :: CoordinateSequence -> IO (Maybe Word) -getSize (CoordinateSequence sr h) = do +getSize (CoordinateSequence sr _ h) = do ContextState{..} <- readIORef sr alloca $ \sizePtr -> do status <- c_GEOSCoordSeq_getSize_r hCtx h sizePtr @@ -212,12 +245,12 @@ -- |Returns a 'Geometry' instance representing the intersection of the two -- supplied 'Geometry' instances: intersection :: Geometry -> Geometry -> IO (Maybe Geometry) -intersection (Geometry sr0 h0) (Geometry sr1 h1) = - checkAndTrack sr0 (\hCtx -> c_GEOSIntersection_r hCtx h0 h1) +intersection (Geometry sr0 _ h0) (Geometry sr1 _ h1) = + checkAndTrackGeometry sr0 (\hCtx -> c_GEOSIntersection_r hCtx h0 h1) -- |Returns value indicating if specified 'Geometry' instance is empty isEmpty :: Geometry -> IO (Maybe Bool) -isEmpty (Geometry sr h) = do +isEmpty (Geometry sr _ h) = do ContextState{..} <- readIORef sr value <- c_GEOSisEmpty_r hCtx h return $ case value of @@ -228,48 +261,51 @@ mkContext :: IO Context mkContext = do hCtx <- c_initializeGEOSWithHandlers - sr <- newIORef $ ContextState hCtx [] [] [] [] + sr <- newIORef $ ContextState hCtx [] return $ Context sr -- |Creates a reader used to deserialize 'Geometry' instances from -- -format text: mkReader :: Context -> IO (Maybe Reader) -mkReader (Context sr) = do - ContextState{..} <- readIORef sr - h <- c_GEOSWKTReader_create_r hCtx - if isNullPtr h - then return Nothing - else do - modifyIORef' sr (\p@ContextState{..} -> p { hReaders = h : hReaders }) - return $ Just (Reader sr h) +mkReader (Context sr) = checkAndTrack sr c_GEOSWKTReader_create_r c_GEOSWKTReader_destroy_r Reader -- |Creates a writer used to serialize 'Geometry' instances to -- -format text: mkWriter :: Context -> IO (Maybe Writer) -mkWriter (Context sr) = do - ContextState{..} <- readIORef sr - h <- c_GEOSWKTWriter_create_r hCtx - if isNullPtr h - then return Nothing - else do - modifyIORef' sr (\p@ContextState{..} -> p { hWriters = h : hWriters }) - return $ Just (Writer sr h) +mkWriter (Context sr) = checkAndTrack sr c_GEOSWKTWriter_create_r c_GEOSWKTWriter_destroy_r Writer -- |Deserializes a 'Geometry' instance from the given 'String' using the -- supplied 'Reader': readGeometry :: Reader -> String -> IO (Maybe Geometry) -readGeometry (Reader sr h) str = withCString str $ \cs -> do - checkAndTrack sr (\hCtx -> c_GEOSWKTReader_read_r hCtx h cs) +readGeometry (Reader sr _ h) str = withCString str $ \cs -> do + checkAndTrackGeometry sr (\hCtx -> c_GEOSWKTReader_read_r hCtx h cs) releaseContext :: Context -> IO () releaseContext (Context sr) = do ContextState{..} <- readIORef sr - mapM_ (c_GEOSCoordSeq_destroy_r hCtx) hCoordinateSequences - mapM_ (c_GEOSGeom_destroy_r hCtx) hGeometries - mapM_ (c_GEOSWKTWriter_destroy_r hCtx) hWriters - mapM_ (c_GEOSWKTReader_destroy_r hCtx) hReaders + 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 + 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 +setX :: CoordinateSequence -> Word -> Double -> IO (Maybe ()) +setX = setOrdinate c_GEOSCoordSeq_setX_r + +-- |Sets an "y" ordinate value within a coordinate sequence +setY :: CoordinateSequence -> Word -> Double -> IO (Maybe ()) +setY = setOrdinate c_GEOSCoordSeq_setY_r + +-- |Sets an "z" ordinate value within a coordinate sequence +setZ :: CoordinateSequence -> Word -> Double -> IO (Maybe ()) +setZ = setOrdinate c_GEOSCoordSeq_setZ_r + -- |Reports version of GEOS API version :: IO String version = c_GEOSversion >>= peekCString @@ -290,7 +326,7 @@ -- |Serializes a 'Geometry' instance to a 'String' using the supplied 'Writer': writeGeometry :: Writer -> Geometry -> IO (Maybe String) -writeGeometry (Writer sr hWriter) (Geometry _ hGeometry) = do +writeGeometry (Writer sr _ hWriter) (Geometry _ _ hGeometry) = do ContextState{..} <- readIORef sr bracket (c_GEOSWKTWriter_write_r hCtx hWriter hGeometry) diff --git a/src/lib/Data/Geolocation/GEOS/Imports.hs b/src/lib/Data/Geolocation/GEOS/Imports.hs --- a/src/lib/Data/Geolocation/GEOS/Imports.hs +++ b/src/lib/Data/Geolocation/GEOS/Imports.hs @@ -25,16 +25,21 @@ , GEOSGeometryPtr () , GEOSWKTReaderPtr () , GEOSWKTWriterPtr () - , NullablePtr (isNullPtr) + , NullablePtr (isNullPtr, rawIntPtr) , c_GEOSArea_r + , c_GEOSCoordSeq_create_r , c_GEOSCoordSeq_destroy_r , c_GEOSCoordSeq_getSize_r , c_GEOSCoordSeq_getX_r , c_GEOSCoordSeq_getY_r , c_GEOSCoordSeq_getZ_r + , c_GEOSCoordSeq_setX_r + , c_GEOSCoordSeq_setY_r + , c_GEOSCoordSeq_setZ_r , c_GEOSEnvelope_r , c_GEOSFree_r_CString , c_GEOSGeomTypeId_r + , c_GEOSGeom_createLinearRing_r , c_GEOSGeom_destroy_r , c_GEOSGeom_getCoordSeq_r , c_GEOSGetExteriorRing_r @@ -61,6 +66,7 @@ class NullablePtr a where -- |Evaluates to @True@ if pointer is null, @False@ otherwise isNullPtr :: a -> Bool + rawIntPtr :: a -> IntPtr -- |Wraps @GEOSContextHandle@ newtype GEOSContextHandle = GEOSContextHandle (Ptr GEOSContextHandle) @@ -69,26 +75,34 @@ newtype GEOSCoordSequencePtr = GEOSCoordSequencePtr (Ptr GEOSCoordSequencePtr) instance NullablePtr GEOSCoordSequencePtr where isNullPtr (GEOSCoordSequencePtr p) = p == nullPtr + rawIntPtr (GEOSCoordSequencePtr p) = ptrToIntPtr p -- |Wraps @GEOSGeometry*@ newtype GEOSGeometryPtr = GEOSGeometryPtr (Ptr GEOSGeometryPtr) instance NullablePtr GEOSGeometryPtr where isNullPtr (GEOSGeometryPtr p) = p == nullPtr + rawIntPtr (GEOSGeometryPtr p) = ptrToIntPtr p -- |Wraps @GEOSWKTReader*@ newtype GEOSWKTReaderPtr = GEOSWKTReaderPtr (Ptr GEOSWKTReaderPtr) instance NullablePtr GEOSWKTReaderPtr where isNullPtr (GEOSWKTReaderPtr p) = p == nullPtr + rawIntPtr (GEOSWKTReaderPtr p) = ptrToIntPtr p -- |Wraps @GEOSWKTWriter*@ newtype GEOSWKTWriterPtr = GEOSWKTWriterPtr (Ptr GEOSWKTWriterPtr) instance NullablePtr GEOSWKTWriterPtr where isNullPtr (GEOSWKTWriterPtr p) = p == nullPtr + rawIntPtr (GEOSWKTWriterPtr p) = ptrToIntPtr p -- |Wraps @GEOSArea_r@ foreign import ccall "GEOSArea_r" c_GEOSArea_r :: GEOSContextHandle -> GEOSGeometryPtr -> Ptr CDouble -> IO CInt +-- |Wraps @GEOSCoordSeq_create_r@ +foreign import ccall "GEOSCoordSeq_create_r" + c_GEOSCoordSeq_create_r :: GEOSContextHandle -> CUInt -> CUInt -> IO GEOSCoordSequencePtr + -- |Wraps @GEOSCoordSeq_destroy_r@ foreign import ccall "GEOSCoordSeq_destroy_r" c_GEOSCoordSeq_destroy_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> IO () @@ -109,6 +123,18 @@ foreign import ccall "GEOSCoordSeq_getZ_r" c_GEOSCoordSeq_getZ_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt +-- |Wraps @GEOSCoordSeq_setX_r@ +foreign import ccall "GEOSCoordSeq_setX_r" + c_GEOSCoordSeq_setX_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CDouble -> IO CInt + +-- |Wraps @GEOSCoordSeq_setY_r@ +foreign import ccall "GEOSCoordSeq_setY_r" + c_GEOSCoordSeq_setY_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CDouble -> IO CInt + +-- |Wraps @GEOSCoordSeq_setZ_r@ +foreign import ccall "GEOSCoordSeq_setZ_r" + c_GEOSCoordSeq_setZ_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CDouble -> IO CInt + -- |Wraps @GEOSEnvelope_r@ foreign import ccall "GEOSEnvelope_r" c_GEOSEnvelope_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO GEOSGeometryPtr @@ -120,6 +146,10 @@ -- |Wraps @GEOSGeomTypeId_r@ foreign import ccall "GEOSGeomTypeId_r" c_GEOSGeomTypeId_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO CInt + +-- |Wraps @GEOSGeom_createLinearRing_r@ +foreign import ccall "GEOSGeom_createLinearRing_r" + c_GEOSGeom_createLinearRing_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> IO GEOSGeometryPtr -- |Wraps @GEOSGeom_destroy_r@ foreign import ccall "GEOSGeom_destroy_r" diff --git a/src/lib/Data/Geolocation/GEOS/Trans.hs b/src/lib/Data/Geolocation/GEOS/Trans.hs --- a/src/lib/Data/Geolocation/GEOS/Trans.hs +++ b/src/lib/Data/Geolocation/GEOS/Trans.hs @@ -19,6 +19,8 @@ module Data.Geolocation.GEOS.Trans ( areaM + , createCoordSeqM + , createLinearRingM , envelopeM , geomTypeIdM , getCoordSeqM @@ -36,6 +38,9 @@ , readGeometryM , runGEOS , runGEOSEither + , setXM + , setYM + , setZM , writeGeometryM ) where @@ -48,67 +53,78 @@ binaryGEOSFunc :: (a -> b -> IO (Maybe c)) -> a -> b -> MaybeT IO c binaryGEOSFunc f a b = MaybeT (f a b) --- | @MaybeT@-wrapped version of 'area' +ternaryGEOSFunc :: (a -> b -> c -> IO (Maybe d)) -> a -> b -> c -> MaybeT IO d +ternaryGEOSFunc f a b c = MaybeT (f a b c) + +-- |@MaybeT@-wrapped version of 'area' areaM :: Geometry -> MaybeT IO Double areaM = unaryGEOSFunc area --- | @MaybeT@-wrapped version of 'envelope' +-- |@MaybeT@-wrapped version of 'createCoordSeq' +createCoordSeqM :: Context -> Word -> Word -> MaybeT IO CoordinateSequence +createCoordSeqM = ternaryGEOSFunc createCoordSeq + +-- |@MaybeT@-wrapped version of 'createLinearRing' +createLinearRingM :: CoordinateSequence -> MaybeT IO Geometry +createLinearRingM = unaryGEOSFunc createLinearRing + +-- |@MaybeT@-wrapped version of 'envelope' envelopeM :: Geometry -> MaybeT IO Geometry envelopeM = unaryGEOSFunc envelope --- | @MaybeT@-wrapped version of 'geomTypeId' +-- |@MaybeT@-wrapped version of 'geomTypeId' geomTypeIdM :: Geometry -> MaybeT IO GeometryType geomTypeIdM = unaryGEOSFunc geomTypeId --- | @MaybeT@-wrapped version of 'getCoordSeq' +-- |@MaybeT@-wrapped version of 'getCoordSeq' getCoordSeqM :: Geometry -> MaybeT IO CoordinateSequence getCoordSeqM = unaryGEOSFunc getCoordSeq --- | @MaybeT@-wrapped version of 'getExteriorRing' +-- |@MaybeT@-wrapped version of 'getExteriorRing' getExteriorRingM :: Geometry -> MaybeT IO Geometry getExteriorRingM = unaryGEOSFunc getExteriorRing --- | @MaybeT@-wrapped version of 'getGeometry' +-- |@MaybeT@-wrapped version of 'getGeometry' getGeometryM :: Geometry -> Int -> MaybeT IO Geometry getGeometryM = binaryGEOSFunc getGeometry --- | @MaybeT@-wrapped version of 'getNumGeometries' +-- |@MaybeT@-wrapped version of 'getNumGeometries' getNumGeometriesM :: Geometry -> MaybeT IO Int getNumGeometriesM = unaryGEOSFunc getNumGeometries --- | @MaybeT@-wrapped version of 'getSize' +-- |@MaybeT@-wrapped version of 'getSize' getSizeM :: CoordinateSequence -> MaybeT IO Word getSizeM = unaryGEOSFunc getSize --- | @MaybeT@-wrapped version of 'getX' +-- |@MaybeT@-wrapped version of 'getX' getXM :: CoordinateSequence -> Word -> MaybeT IO Double getXM = binaryGEOSFunc getX --- | @MaybeT@-wrapped version of 'getY' +-- |@MaybeT@-wrapped version of 'getY' getYM :: CoordinateSequence -> Word -> MaybeT IO Double getYM = binaryGEOSFunc getY --- | @MaybeT@-wrapped version of 'getZ' +-- |@MaybeT@-wrapped version of 'getZ' getZM :: CoordinateSequence -> Word -> MaybeT IO Double getZM = binaryGEOSFunc getZ --- | @MaybeT@-wrapped version of 'intersection' +-- |@MaybeT@-wrapped version of 'intersection' intersectionM :: Geometry -> Geometry -> MaybeT IO Geometry intersectionM = binaryGEOSFunc intersection --- | @MaybeT@-wrapped version of 'isEmpty' +-- |@MaybeT@-wrapped version of 'isEmpty' isEmptyM :: Geometry -> MaybeT IO Bool isEmptyM = unaryGEOSFunc isEmpty --- | @MaybeT@-wrapped version of 'mkReader' +-- |@MaybeT@-wrapped version of 'mkReader' mkReaderM :: Context -> MaybeT IO Reader mkReaderM = unaryGEOSFunc mkReader --- | @MaybeT@-wrapped version of 'mkWriter' +-- |@MaybeT@-wrapped version of 'mkWriter' mkWriterM :: Context -> MaybeT IO Writer mkWriterM = unaryGEOSFunc mkWriter --- | @MaybeT@-wrapped version of 'readGeometry' +-- |@MaybeT@-wrapped version of 'readGeometry' readGeometryM :: Reader -> String -> MaybeT IO Geometry readGeometryM = binaryGEOSFunc readGeometry @@ -148,6 +164,15 @@ Nothing -> Left <$> getErrorMessage Just r -> return $ Right r --- | @MaybeT@-wrapped version of 'area' +-- |@MaybeT@-wrapped version of 'setX' +setXM = ternaryGEOSFunc setX + +-- |@MaybeT@-wrapped version of 'setY' +setYM = ternaryGEOSFunc setY + +-- |@MaybeT@-wrapped version of 'setZ' +setZM = ternaryGEOSFunc setZ + +-- |@MaybeT@-wrapped version of 'area' writeGeometryM :: Writer -> Geometry -> MaybeT IO String writeGeometryM = binaryGEOSFunc writeGeometry diff --git a/src/test/GEOSTest/HighLevelAPI.hs b/src/test/GEOSTest/HighLevelAPI.hs --- a/src/test/GEOSTest/HighLevelAPI.hs +++ b/src/test/GEOSTest/HighLevelAPI.hs @@ -18,4 +18,5 @@ writer <- MaybeT $ mkWriter ctx str <- MaybeT $ writeGeometry writer g2 lift $ putStrLn str - putStrLn $ "HighLevelAPI.demo: " ++ (if isJust result then "succeeded" else "failed") + + putStrLn $ "HighLevelAPI.demo: " ++ (if isJust result then "succeeded" else error "HighLevelAPI.demo failed") diff --git a/src/test/GEOSTest/Sample.hs b/src/test/GEOSTest/Sample.hs --- a/src/test/GEOSTest/Sample.hs +++ b/src/test/GEOSTest/Sample.hs @@ -137,4 +137,5 @@ fileName <- getDataFileName "data/namibia.wkt" wkt <- readFile fileName result <- withGEOS $ \ctx -> runMaybeT (generatePolygonMeshSQL ctx wkt 1.0) - putStrLn $ "Sample.demo: " ++ (if isJust result then "succeeded" else "failed") + + putStrLn $ "Sample.demo: " ++ (if isJust result then "succeeded" else error "Sample.demo failed") diff --git a/src/test/GEOSTest/TransAPI.hs b/src/test/GEOSTest/TransAPI.hs --- a/src/test/GEOSTest/TransAPI.hs +++ b/src/test/GEOSTest/TransAPI.hs @@ -1,5 +1,6 @@ module GEOSTest.TransAPI (demo) where +import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Maybe import Data.Geolocation.GEOS.Trans @@ -10,12 +11,29 @@ -- which guarantees that they are released when the context goes out of scope demo :: IO () demo = do - result <- runGEOS $ \ctx -> do + result <- runGEOSEither $ \ctx -> do reader <- mkReaderM ctx + writer <- mkWriterM ctx + g0 <- readGeometryM reader "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))" g1 <- readGeometryM reader "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))" g2 <- intersectionM g0 g1 - writer <- mkWriterM ctx - str <- writeGeometryM writer g2 - lift $ putStrLn str - putStrLn $ "TransAPI.demo: " ++ (if isJust result then "succeeded" else "failed") + str0 <- writeGeometryM writer g2 + lift $ putStrLn str0 + + 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 + g3 <- createLinearRingM coords + str1 <- writeGeometryM writer g3 + lift $ putStrLn str1 + + case result of + Left m -> error $ "TransAPI.demo failed: " ++ m + Right _ -> putStrLn "TransAPI.demo succeeded"