hgeos 0.1.5.1 → 0.1.6.0

raw patch · 7 files changed

+189/−78 lines, 7 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 +88/−52
• src/lib/Data/Geolocation/GEOS/Imports.hs +31/−1
• src/lib/Data/Geolocation/GEOS/Trans.hs +42/−17
• src/test/GEOSTest/HighLevelAPI.hs +2/−1
• src/test/GEOSTest/Sample.hs +2/−1
• src/test/GEOSTest/TransAPI.hs +23/−5

@@ -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 <https://trac.osgeo.org/geos/ GEOS>

@@ -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 <https://trac.osgeo.org/geos/ GEOS> coordinate sequence-data CoordinateSequence = CoordinateSequence ContextStateRef GEOSCoordSequencePtr+data CoordinateSequence = CoordinateSequence ContextStateRef DeleteAction GEOSCoordSequencePtr +data DeleteAction = DeleteAction IntPtr (IO ())+ -- |Represents a <https://trac.osgeo.org/geos/ GEOS> geometry type ID data GeometryType =     Point |@@ -87,17 +92,17 @@     GeometryCollection deriving (Enum, Show)  -- |References a <https://en.wikipedia.org/wiki/Well-known_text WKT> reader-data Reader = Reader ContextStateRef GEOSWKTReaderPtr+data Reader = Reader ContextStateRef DeleteAction GEOSWKTReaderPtr  -- |References a <https://en.wikipedia.org/wiki/Well-known_text WKT> writer-data Writer = Writer ContextStateRef GEOSWKTWriterPtr+data Writer = Writer ContextStateRef DeleteAction GEOSWKTWriterPtr  -- |References a <https://trac.osgeo.org/geos/ GEOS> 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 -- <https://en.wikipedia.org/wiki/Well-known_text WKT>-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 -- <https://en.wikipedia.org/wiki/Well-known_text WKT>-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)

@@ -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"

@@ -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

@@ -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")

@@ -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")

@@ -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"