hgeos 0.1.7.4 → 0.1.8.0

raw patch · 7 files changed

+270/−428 lines, 7 filesdep −mtldep −transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: mtl, transformers

API changes (from Hackage documentation)

Files

• hgeos.cabal +1/−6
• src/lib/Data/Geolocation/GEOS.hs +155/−73
• src/lib/Data/Geolocation/GEOS/Trans.hs +0/−207
• src/test/GEOSTest/HighLevelAPI.hs +77/−11
• src/test/GEOSTest/Sample.hs +37/−42
• src/test/GEOSTest/TransAPI.hs +0/−87
• src/test/Main.hs +0/−2

@@ -1,5 +1,5 @@ name:                 hgeos-version:              0.1.7.4+version:              0.1.8.0 synopsis:             Simple Haskell bindings to GEOS C API description:   Simple Haskell bindings to the <https://trac.osgeo.org/geos/ GEOS>@@ -25,13 +25,11 @@   hs-source-dirs:     src/lib   default-language:   Haskell2010   build-depends:      base >= 4.6 && < 5-                    , transformers   extra-libraries:    geos_c   c-sources:          src/lib/Data/Geolocation/GEOS/helpers.c   cc-options:         -std=c99 -pthread   exposed-modules:    Data.Geolocation.GEOS                     , Data.Geolocation.GEOS.Imports-                    , Data.Geolocation.GEOS.Trans  test-suite hgeos-app   type:               exitcode-stdio-1.0@@ -41,10 +39,7 @@   build-depends:      MissingH                     , base >= 4.6 && < 5                     , hgeos-                    , mtl-                    , transformers   other-modules:      GEOSTest.Arith                     , GEOSTest.HighLevelAPI                     , GEOSTest.LowLevelAPI                     , GEOSTest.Sample-                    , GEOSTest.TransAPI

@@ -20,11 +20,13 @@ <https://github.com/rcook/hgeos/blob/master/src/test/GEOSTest/Sample.hs View sample 2> -} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-}  module Data.Geolocation.GEOS     ( Context ()     , CoordinateSequence ()+    , GEOSError ()     , Geometry ()     , GeometryType (..)     , Reader ()@@ -66,6 +68,7 @@ import Control.Monad import Data.Geolocation.GEOS.Imports import Data.IORef+import Data.Typeable import Data.Word import Foreign.C import Foreign.Marshal.Alloc@@ -105,6 +108,13 @@ -- |References a <https://en.wikipedia.org/wiki/Well-known_text WKT> writer data Writer = Writer ContextStateRef DeleteAction GEOSWKTWriterPtr +-- |Encapsulates an exception thrown by GEOS library+data GEOSError = GEOSError+    { context :: String+    , message :: String+    } deriving (Show, Typeable)+instance Exception GEOSError+ -- |References a <https://trac.osgeo.org/geos/ GEOS> geometry data Geometry = Geometry     { geometryStateRef :: ContextStateRef@@ -112,17 +122,23 @@     , geometryRawPtr :: GEOSGeometryPtr     } +throwGEOSError :: String -> IO a+throwGEOSError context = do+    m <- c_getErrorMessage+    message <- peekCString m+    throw $ GEOSError context message+ -- |Returns area of a 'Geometry' instance-area :: Geometry -> IO (Maybe Double)+area :: Geometry -> IO Double area (Geometry sr _ h) = do     ContextState{..} <- readIORef sr     alloca $ \valuePtr -> do         status <- c_GEOSArea_r hCtx h valuePtr         case status of-             0 -> return Nothing+             0 -> throwGEOSError "GEOSArea_r"              _ -> do                 value <- peek valuePtr-                return $ Just (realToFrac value)+                return $ realToFrac value  checkAndDoNotTrack :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry) checkAndDoNotTrack sr f = do@@ -132,6 +148,14 @@                 then Nothing                 else Just $ Geometry sr emptyDeleteAction h +checkAndDoNotTrack2 :: String -> ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO Geometry+checkAndDoNotTrack2 context sr f = do+    ContextState{..} <- readIORef sr+    h <- f hCtx+    if isNullPtr h+       then throwGEOSError context+       else return $ Geometry sr emptyDeleteAction h+ checkAndTrack :: NullablePtr a =>     ContextStateRef ->     (GEOSContextHandle -> IO a) ->@@ -148,76 +172,108 @@         modifyIORef' sr (\p@ContextState{..} -> p { deleteActions = deleteAction : deleteActions })         return $ Just (wrap sr deleteAction h) +checkAndTrack2 :: NullablePtr a =>+    String ->+    ContextStateRef ->+    (GEOSContextHandle -> IO a) ->+    (GEOSContextHandle -> a -> IO ()) ->+    (ContextStateRef -> DeleteAction -> a -> b) ->+    IO b+checkAndTrack2 context sr create destroy wrap = do+    ContextState{..} <- readIORef sr+    h <- create hCtx+    if isNullPtr h+    then throwGEOSError context+    else do+        let deleteAction = DeleteAction (rawIntPtr h) (destroy hCtx h)+        modifyIORef' sr (\p@ContextState{..} -> p { deleteActions = deleteAction : deleteActions })+        return $ wrap sr deleteAction h+ checkAndTrackGeometry :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry) checkAndTrackGeometry sr create = checkAndTrack sr create c_GEOSGeom_destroy_r Geometry +checkAndTrackGeometry2 :: String -> ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO Geometry+checkAndTrackGeometry2 context sr create = checkAndTrack2 context sr create c_GEOSGeom_destroy_r Geometry+ emptyDeleteAction :: DeleteAction emptyDeleteAction = DeleteAction (ptrToIntPtr nullPtr) (return ())  -- |Creates a 'Geometry' collection-createCollection :: GeometryType -> [Geometry] -> IO (Maybe Geometry)+createCollection :: GeometryType -> [Geometry] -> IO Geometry createCollection geometryType gs@((Geometry sr _ _) : _) = do     untrack sr (map geometryDeleteAction gs)     withArrayLen (map geometryRawPtr gs) $ \count array ->-        checkAndTrackGeometry+        checkAndTrackGeometry2+            "GEOSGeom_createCollection_r"             sr             (\hCtx -> c_GEOSGeom_createCollection_r hCtx (fromIntegral $ fromEnum geometryType) array (fromIntegral count))  -- |Creates an empty 'CoordinateSequence' instance-createCoordSeq :: Context -> Word -> Word -> IO (Maybe CoordinateSequence)+createCoordSeq :: Context -> Word -> Word -> IO CoordinateSequence createCoordSeq (Context sr) size dims =-    checkAndTrack+    checkAndTrack2+        "GEOSCoordSeq_create_r"         sr         (\hCtx -> c_GEOSCoordSeq_create_r hCtx (fromIntegral size) (fromIntegral dims))         c_GEOSCoordSeq_destroy_r         CoordinateSequence  -- |Returns an empty polygon 'Geometry' instance-createEmptyPolygon :: Context -> IO (Maybe Geometry)+createEmptyPolygon :: Context -> IO Geometry createEmptyPolygon (Context sr) = do     ContextState{..} <- readIORef sr-    checkAndTrackGeometry sr c_GEOSGeom_createEmptyPolygon_r+    checkAndTrackGeometry2+        "GEOSGeom_createEmptyPolygon_r"+        sr+        c_GEOSGeom_createEmptyPolygon_r  -- |Returns a linear ring 'Geometry' instance from the given coordinate -- sequence-createLinearRing :: CoordinateSequence -> IO (Maybe Geometry)+createLinearRing :: CoordinateSequence -> IO Geometry createLinearRing (CoordinateSequence sr deleteAction h) = do     untrack sr [deleteAction]-    checkAndTrackGeometry sr (\hCtx -> c_GEOSGeom_createLinearRing_r hCtx h)+    checkAndTrackGeometry2+        "GEOSGeom_createLinearRing_r"+        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 -> [Geometry] -> IO Geometry createPolygon (Geometry sr deleteAction h) holes = do     untrack sr (deleteAction : map geometryDeleteAction holes)     withArrayLen (map geometryRawPtr holes) $ \count array ->-        checkAndTrackGeometry+        checkAndTrackGeometry2+            "GEOSGeom_createPolygon_r"             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)+envelope :: Geometry -> IO Geometry envelope (Geometry sr _ h) =-    checkAndTrackGeometry sr (\hCtx -> c_GEOSEnvelope_r hCtx h)+    checkAndTrackGeometry2+        "GEOSEnvelope_r"+        sr+        (\hCtx -> c_GEOSEnvelope_r hCtx h)  -- |Returns type of a 'Geometry' instance-geomTypeId :: Geometry -> IO (Maybe GeometryType)+geomTypeId :: Geometry -> IO GeometryType geomTypeId (Geometry sr _ h) = do     ContextState{..} <- readIORef sr     value <- c_GEOSGeomTypeId_r hCtx h-    return $ if value == -1-                then Nothing-                else Just $ toEnum (fromIntegral value)+    if value == -1+       then throwGEOSError "GEOSGeomTypeId_r"+       else return $ toEnum (fromIntegral value)  -- |Returns a 'CoordinateSequence' from the supplied 'Geometry'-getCoordSeq :: Geometry -> IO (Maybe CoordinateSequence)+getCoordSeq :: Geometry -> IO CoordinateSequence 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 emptyDeleteAction h+    if isNullPtr h+       then throwGEOSError "GEOSGeom_getCoordSeq_r"+       else return $ CoordinateSequence sr emptyDeleteAction h  -- |Returns message in case of error getErrorMessage :: IO String@@ -225,85 +281,95 @@  -- |Returns a 'Geometry' instance representing the exterior ring of the -- supplied 'Geometry'-getExteriorRing :: Geometry -> IO (Maybe Geometry)+getExteriorRing :: Geometry -> IO Geometry getExteriorRing (Geometry sr _ h) =-    checkAndDoNotTrack sr (\hCtx -> c_GEOSGetExteriorRing_r hCtx h)+    checkAndDoNotTrack2+        "GEOSGetExteriorRing_r"+        sr+        (\hCtx -> c_GEOSGetExteriorRing_r hCtx h)  -- |Returns child 'Geometry' at given index-getGeometry :: Geometry -> Int -> IO (Maybe Geometry)+getGeometry :: Geometry -> Int -> IO Geometry getGeometry (Geometry sr _ h) n =-    checkAndDoNotTrack sr (\hCtx -> c_GEOSGetGeometryN_r hCtx h (fromIntegral n))+    checkAndDoNotTrack2+        "GEOSGetGeometryN_r"+        sr+        (\hCtx -> c_GEOSGetGeometryN_r hCtx h (fromIntegral n))  -- |Gets the number of geometries in a 'Geometry' instance-getNumGeometries :: Geometry -> IO (Maybe Int)+getNumGeometries :: Geometry -> IO Int getNumGeometries (Geometry sr _ h) = do     ContextState{..} <- readIORef sr     value <- c_GEOSGetNumGeometries_r hCtx h-    return $ if value == -1-                then Nothing-                else Just $ fromIntegral value+    if value == -1+       then throwGEOSError "GEOSGetNumGeometries_r"+       else return $ fromIntegral value  -- |Gets an ordinate value from a coordinate sequence-getOrdinate :: CoordinateSequence -> Word -> Word -> IO (Maybe Double)+getOrdinate :: CoordinateSequence -> Word -> Word -> IO Double getOrdinate coords idx dim =     getOrdinateHelper+        "GEOSCoordSeq_getOrdinate_r"         (\hCtx h idx' -> c_GEOSCoordSeq_getOrdinate_r hCtx h idx' (fromIntegral dim))         coords         idx -getOrdinateHelper :: (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) ->+getOrdinateHelper :: String -> (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) ->     CoordinateSequence ->     Word ->-    IO (Maybe Double)-getOrdinateHelper f (CoordinateSequence sr _ h) idx = do+    IO Double+getOrdinateHelper context f (CoordinateSequence sr _ h) idx = do     ContextState{..} <- readIORef sr     alloca $ \valuePtr -> do         status <- f hCtx h (fromIntegral idx) valuePtr         case status of-             0 -> return Nothing+             0 -> throwGEOSError context              _ -> do                 value <- peek valuePtr-                return $ Just (realToFrac value)+                return $ realToFrac value  -- |Gets the size from a coordinate sequence-getSize :: CoordinateSequence -> IO (Maybe Word)+getSize :: CoordinateSequence -> IO Word getSize (CoordinateSequence sr _ h) = do     ContextState{..} <- readIORef sr     alloca $ \sizePtr -> do         status <- c_GEOSCoordSeq_getSize_r hCtx h sizePtr         case status of-             0 -> return Nothing+             0 -> throwGEOSError "GEOSCoordSeq_getSize_r"              _ -> do                  size <- peek sizePtr-                 return $ Just (fromIntegral size)+                 return $ fromIntegral size  -- |Gets an x-ordinate value from a coordinate sequence-getX :: CoordinateSequence -> Word -> IO (Maybe Double)-getX = getOrdinateHelper c_GEOSCoordSeq_getX_r+getX :: CoordinateSequence -> Word -> IO Double+getX = getOrdinateHelper "GEOSCoordSeq_getX_r" c_GEOSCoordSeq_getX_r  -- |Gets a y-ordinate value from a coordinate sequence-getY :: CoordinateSequence -> Word -> IO (Maybe Double)-getY = getOrdinateHelper c_GEOSCoordSeq_getY_r+getY :: CoordinateSequence -> Word -> IO Double+getY = getOrdinateHelper "GEOSCoordSeq_getY_r" c_GEOSCoordSeq_getY_r  -- |Gets a z-ordinate value from a coordinate sequence-getZ :: CoordinateSequence -> Word -> IO (Maybe Double)-getZ = getOrdinateHelper c_GEOSCoordSeq_getZ_r+getZ :: CoordinateSequence -> Word -> IO Double+getZ = getOrdinateHelper "GEOSCoordSeq_getZ_r" c_GEOSCoordSeq_getZ_r  -- |Returns a 'Geometry' instance representing the intersection of the two -- supplied 'Geometry' instances:-intersection :: Geometry -> Geometry -> IO (Maybe Geometry)+intersection :: Geometry -> Geometry -> IO Geometry intersection (Geometry sr0 _ h0) (Geometry sr1 _ h1) =-    checkAndTrackGeometry sr0 (\hCtx -> c_GEOSIntersection_r hCtx h0 h1)+    checkAndTrackGeometry2+        "GEOSIntersection_r"+        sr0+        (\hCtx -> c_GEOSIntersection_r hCtx h0 h1)  -- |Returns value indicating if specified 'Geometry' instance is empty-isEmpty :: Geometry -> IO (Maybe Bool)+isEmpty :: Geometry -> IO Bool isEmpty (Geometry sr _ h) = do     ContextState{..} <- readIORef sr     value <- c_GEOSisEmpty_r hCtx h-    return $ case value of-                  0 -> Just False-                  1 -> Just True-                  _ -> Nothing+    case value of+         0 -> return False+         1 -> return True+         _ -> throwGEOSError "GEOSisEmpty_r"  mkContext :: IO Context mkContext = do@@ -313,19 +379,34 @@  -- |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) = checkAndTrack sr c_GEOSWKTReader_create_r c_GEOSWKTReader_destroy_r Reader+mkReader :: Context -> IO Reader+mkReader (Context sr) =+    checkAndTrack2+        "GEOSWKTReader_create_r"+        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) = checkAndTrack sr c_GEOSWKTWriter_create_r c_GEOSWKTWriter_destroy_r Writer+mkWriter :: Context -> IO Writer+mkWriter (Context sr) =+    checkAndTrack2+        "GEOSWKTWriter_destroy_r"+        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 -> String -> IO Geometry readGeometry (Reader sr _ h) str = withCString str $ \cs -> do-    checkAndTrackGeometry sr (\hCtx -> c_GEOSWKTReader_read_r hCtx h cs)+    checkAndTrackGeometry2+        "GEOSWKTReader_read_r"+        sr+        (\hCtx -> c_GEOSWKTReader_read_r hCtx h cs)  releaseContext :: Context -> IO () releaseContext (Context sr) = do@@ -334,32 +415,33 @@     c_finishGEOS_r hCtx  -- |Sets an x-ordinate value within a coordinate sequence-setOrdinate :: CoordinateSequence -> Word -> Word -> Double -> IO (Maybe ())+setOrdinate :: CoordinateSequence -> Word -> Word -> Double -> IO () setOrdinate coords idx dim =     setOrdinateHelper+        "GEOSCoordSeq_setOrdinate_r"         (\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+setOrdinateHelper :: String -> (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> CDouble -> IO CInt ) -> CoordinateSequence -> Word -> Double -> IO ()+setOrdinateHelper context 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 ()+    if status == 0+       then throwGEOSError context+       else return ()  -- |Sets an x-ordinate value within a coordinate sequence-setX :: CoordinateSequence -> Word -> Double -> IO (Maybe ())-setX = setOrdinateHelper c_GEOSCoordSeq_setX_r+setX :: CoordinateSequence -> Word -> Double -> IO ()+setX = setOrdinateHelper "GEOSCoordSeq_setX_r" c_GEOSCoordSeq_setX_r  -- |Sets a y-ordinate value within a coordinate sequence-setY :: CoordinateSequence -> Word -> Double -> IO (Maybe ())-setY = setOrdinateHelper c_GEOSCoordSeq_setY_r+setY :: CoordinateSequence -> Word -> Double -> IO ()+setY = setOrdinateHelper "GEOSCoordSeq_setY_r" c_GEOSCoordSeq_setY_r  -- |Sets a z-ordinate value within a coordinate sequence-setZ :: CoordinateSequence -> Word -> Double -> IO (Maybe ())-setZ = setOrdinateHelper c_GEOSCoordSeq_setZ_r+setZ :: CoordinateSequence -> Word -> Double -> IO ()+setZ = setOrdinateHelper "GEOSCoordSeq_setZ_r" c_GEOSCoordSeq_setZ_r  untrack :: ContextStateRef -> [DeleteAction] -> IO () untrack sr deleteActions = do@@ -385,10 +467,10 @@ withGEOS = bracket mkContext releaseContext  -- |Serializes a 'Geometry' instance to a 'String' using the supplied 'Writer':-writeGeometry :: Writer -> Geometry -> IO (Maybe String)+writeGeometry :: Writer -> Geometry -> IO String writeGeometry (Writer sr _ hWriter) (Geometry _ _ hGeometry) = do     ContextState{..} <- readIORef sr     bracket         (c_GEOSWKTWriter_write_r hCtx hWriter hGeometry)         (c_GEOSFree_r_CString hCtx)-        (\cs -> if cs == nullPtr then return Nothing else Just <$> peekCString cs)+        (\cs -> if cs == nullPtr then throwGEOSError "GEOSWKTWriter_write_r" else peekCString cs)

@@ -1,207 +0,0 @@-{-|-Module      : Data.Geolocation.GEOS.Trans-Description : @MaybeT@ wrappers for high-level GEOS API-Copyright   : (C) Richard Cook, 2016-Licence     : MIT-Maintainer  : rcook@rcook.org-Stability   : experimental-Portability : portable--These are @MaybeT@ monad transformer wrapper functions for the high-level API-to simplify error handling in client code.--For the low-level FFI bindings, see "Data.Geolocation.GEOS.Imports".--For the high-level API, see "Data.Geolocation.GEOS".--<https://github.com/rcook/hgeos/blob/master/src/test/GEOSTest/TransAPI.hs View sample>--}--module Data.Geolocation.GEOS.Trans-    ( areaM-    , createCollectionM-    , createCoordSeqM-    , createEmptyPolygonM-    , createLinearRingM-    , createPolygonM-    , envelopeM-    , geomTypeIdM-    , getCoordSeqM-    , getExteriorRingM-    , getGeometryM-    , getNumGeometriesM-    , getOrdinateM-    , getSizeM-    , getXM-    , getYM-    , getZM-    , intersectionM-    , isEmptyM-    , mkReaderM-    , mkWriterM-    , readGeometryM-    , runGEOS-    , runGEOSEither-    , setOrdinateM-    , setXM-    , setYM-    , setZM-    , writeGeometryM-    ) where--import Control.Applicative-import Control.Monad.Trans.Maybe-import Data.Geolocation.GEOS-import Data.Word--unaryGEOSFunc :: (a -> IO (Maybe b)) -> a -> MaybeT IO b-unaryGEOSFunc = (MaybeT .)--binaryGEOSFunc :: (a -> b -> IO (Maybe c)) -> a -> b -> MaybeT IO c-binaryGEOSFunc f a b = MaybeT (f a b)--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---- |@MaybeT@-wrapped version of 'createCollection'-createCollectionM :: GeometryType -> [Geometry] -> MaybeT IO Geometry-createCollectionM = binaryGEOSFunc createCollection---- |@MaybeT@-wrapped version of 'createCoordSeq'-createCoordSeqM :: Context -> Word -> Word -> MaybeT IO CoordinateSequence-createCoordSeqM = ternaryGEOSFunc createCoordSeq---- |@MaybeT@-wrapped version of 'createEmptyPolygon'-createEmptyPolygonM :: Context -> MaybeT IO Geometry-createEmptyPolygonM = unaryGEOSFunc createEmptyPolygon---- |@MaybeT@-wrapped version of 'createLinearRing'-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---- |@MaybeT@-wrapped version of 'geomTypeId'-geomTypeIdM :: Geometry -> MaybeT IO GeometryType-geomTypeIdM = unaryGEOSFunc geomTypeId---- |@MaybeT@-wrapped version of 'getCoordSeq'-getCoordSeqM :: Geometry -> MaybeT IO CoordinateSequence-getCoordSeqM = unaryGEOSFunc getCoordSeq---- |@MaybeT@-wrapped version of 'getExteriorRing'-getExteriorRingM :: Geometry -> MaybeT IO Geometry-getExteriorRingM = unaryGEOSFunc getExteriorRing---- |@MaybeT@-wrapped version of 'getGeometry'-getGeometryM :: Geometry -> Int -> MaybeT IO Geometry-getGeometryM = binaryGEOSFunc getGeometry---- |@MaybeT@-wrapped version of 'getNumGeometries'-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---- |@MaybeT@-wrapped version of 'getX'-getXM :: CoordinateSequence -> Word -> MaybeT IO Double-getXM = binaryGEOSFunc getX---- |@MaybeT@-wrapped version of 'getY'-getYM :: CoordinateSequence -> Word -> MaybeT IO Double-getYM = binaryGEOSFunc getY---- |@MaybeT@-wrapped version of 'getZ'-getZM :: CoordinateSequence -> Word -> MaybeT IO Double-getZM = binaryGEOSFunc getZ---- |@MaybeT@-wrapped version of 'intersection'-intersectionM :: Geometry -> Geometry -> MaybeT IO Geometry-intersectionM = binaryGEOSFunc intersection---- |@MaybeT@-wrapped version of 'isEmpty'-isEmptyM :: Geometry -> MaybeT IO Bool-isEmptyM = unaryGEOSFunc isEmpty---- |@MaybeT@-wrapped version of 'mkReader'-mkReaderM :: Context -> MaybeT IO Reader-mkReaderM = unaryGEOSFunc mkReader---- |@MaybeT@-wrapped version of 'mkWriter'-mkWriterM :: Context -> MaybeT IO Writer-mkWriterM = unaryGEOSFunc mkWriter---- |@MaybeT@-wrapped version of 'readGeometry'-readGeometryM :: Reader -> String -> MaybeT IO Geometry-readGeometryM = binaryGEOSFunc readGeometry---- |Creates a <https://trac.osgeo.org/geos/ GEOS> context, passes it to a block--- and releases the context and all associated objects such as readers, writers--- and geometries at the end inside a @MaybeT IO@ monad:------ @---    runGEOS $ \ctx -> do------        -- Use context------        return ()--- @-runGEOS :: (Context -> MaybeT IO a) -> IO (Maybe a)-runGEOS = withGEOS . (runMaybeT .)---- |Creates a <https://trac.osgeo.org/geos/ GEOS> context, passes it to a block--- and releases the context and all associated objects such as readers, writers--- and geometries at the end inside a @MaybeT IO@ monad returning a message in--- case of error:------ @---    result <- runGEOSEither $ \ctx -> do------        -- Use context------        return ()---    case result of---          Left m -> putStrLn $ "Failed: " ++ m---          Right r -> putStrLn $ "Succeeded: " ++ show r--- @-runGEOSEither :: (Context -> MaybeT IO a) -> IO (Either String a)-runGEOSEither action = do-    result <- runGEOS action-    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---- |@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

@@ -1,22 +1,88 @@ module GEOSTest.HighLevelAPI (demo) where -import Control.Monad.Trans-import Control.Monad.Trans.Maybe+import Control.Monad import Data.Geolocation.GEOS import Data.Maybe +check :: Bool -> IO ()+check True = return ()+check False = error "Check failed"++type Coordinate = (Double, Double)++createLinearRingHelper :: Context -> [Coordinate] -> IO Geometry+createLinearRingHelper ctx cs = do+    let count = length cs+    coords <- createCoordSeq ctx (fromIntegral count) 2+    forM_ (zip [0..] cs) $ \(i, (x, y)) -> do+        setX coords i x+        setY coords i y+    createLinearRing coords+ -- Demonstrates use of high-level 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 demo :: IO () demo = do-    result <- withGEOS $ \ctx -> runMaybeT $ do-        reader <- MaybeT $ mkReader ctx-        g0 <- MaybeT $ readGeometry reader "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"-        g1 <- MaybeT $ readGeometry reader "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))"-        g2 <- MaybeT $ intersection g0 g1-        writer <- MaybeT $ mkWriter ctx-        str <- MaybeT $ writeGeometry writer g2-        lift $ putStrLn str+    withGEOS $ \ctx -> do+        reader <- mkReader ctx+        writer <- mkWriter ctx -    putStrLn $ "HighLevelAPI.demo: " ++ (if isJust result then "succeeded" else error "HighLevelAPI.demo failed")+        g0 <- readGeometry reader "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"+        a0 <- area g0+        putStrLn $ show a0++        g1 <- readGeometry reader "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))"+        a1 <- area g1+        putStrLn $ show a1++        g2 <- intersection g0 g1+        str0 <- writeGeometry writer g2+        putStrLn str0++        coords <- createCoordSeq ctx 10 3+        size <- getSize coords+        forM_ [0..size - 2] $ \i -> do+            setX coords i (fromIntegral (i + 1) * 10.0)+            setY coords i (fromIntegral (i + 1) * 20.0)+            setZ coords i (fromIntegral (i + 1) * 30.0)+        setOrdinate coords (size - 1) 0 10.0+        setOrdinate coords (size - 1) 1 20.0+        setOrdinate coords (size - 1) 2 30.0+        g3 <- createLinearRing coords+        str1 <- writeGeometry writer g3+        putStrLn str1++        x0 <- getX coords 0+        check $ x0 == 10.0+        y0 <- getY coords 0+        check $ y0 == 20.0+        z0 <- getZ coords 0+        check $ z0 == 30.0++        x1 <- getOrdinate coords 1 0+        check $ x1 == 20.0+        y1 <- getOrdinate coords 1 1+        check $ y1 == 40.0+        z1 <- getOrdinate coords 1 2+        check $ z1 == 60.0++        p <- createPolygon g3 []+        str2 <- writeGeometry writer p+        putStrLn str2++        shell <- createLinearRingHelper ctx [(-10.0, -10.0), (-10.0, 10.0), (10.0, 10.0), (10.0, -10.0), (-10.0, -10.0)]+        hole <- createLinearRingHelper ctx [(-5.0, -5.0), (-5.0, 5.0), (5.0, 5.0), (5.0, -5.0), (-5.0, -5.0)]+        polygon <- createPolygon shell [hole]+        str3 <- writeGeometry writer polygon+        putStrLn str3++        coll <- createCollection MultiPolygon [polygon]+        str4 <- writeGeometry writer coll+        putStrLn str4++        p <- createEmptyPolygon ctx+        str5 <- writeGeometry writer p+        putStrLn str5++    putStrLn "HighLevelAPI2.demo succeeded"

@@ -3,8 +3,6 @@ module GEOSTest.Sample (demo) where  import Control.Monad-import Control.Monad.Trans-import Control.Monad.Trans.Maybe import Data.Geolocation.GEOS import Data.List import Data.Maybe@@ -27,13 +25,13 @@     , maxZ :: Double     } deriving Show -getXYZs :: CoordinateSequence -> MaybeT IO [Coordinate]+getXYZs :: CoordinateSequence -> IO [Coordinate] getXYZs coordSeq = do-    size <- MaybeT $ getSize coordSeq+    size <- getSize coordSeq     forM [0..(size - 1)] $ \i -> do-        x <- MaybeT $ getX coordSeq i-        y <- MaybeT $ getY coordSeq i-        z <- MaybeT $ getZ coordSeq i+        x <- getX coordSeq i+        y <- getY coordSeq i+        z <- getZ coordSeq i         return (x, y, z)  extent :: [Coordinate] -> Extent@@ -49,7 +47,7 @@     in Extent minX maxX minY maxY minZ maxZ  -- TODO: Build polygon using API instead of string parsing-mkSquare :: Reader -> Longitude -> Latitude -> Resolution -> MaybeT IO Geometry+mkSquare :: Reader -> Longitude -> Latitude -> Resolution -> IO Geometry mkSquare reader longitude latitude resolution =     let points = [             (longitude, latitude),@@ -59,32 +57,32 @@             (longitude, latitude)             ]         wkt = printf "POLYGON ((%s))" (intercalate "," (map (\(a, b) -> printf "%f %f" a b) points))-    in MaybeT $ readGeometry reader wkt+    in readGeometry reader wkt -getGeometries :: Geometry -> IO (Maybe [Geometry])-getGeometries geometry = runMaybeT $ do-    count <- MaybeT $ getNumGeometries geometry-    mapM (MaybeT . getGeometry geometry) [0..(count - 1)]+getGeometries :: Geometry -> IO [Geometry]+getGeometries geometry = do+    count <- getNumGeometries geometry+    mapM (getGeometry geometry) [0..(count - 1)] -findBiggestPolygon :: Geometry -> IO (Maybe Geometry)-findBiggestPolygon geometry = runMaybeT $ do-    gs@(gHead : gTail) <- MaybeT (getGeometries geometry)-    as@(aHead : aTail) <- mapM (MaybeT . area) gs+findBiggestPolygon :: Geometry -> IO Geometry+findBiggestPolygon geometry = do+    gs@(gHead : gTail) <- getGeometries geometry+    as@(aHead : aTail) <- mapM area gs     return $ fst $ foldr         (\p'@(_, a') p@(_, a) -> if a' > a then p' else p)         (gHead, aHead)         (zip gTail aTail) -processPolygon :: String -> Resolution -> Longitude -> Latitude -> Geometry -> MaybeT IO ()+processPolygon :: String -> Resolution -> Longitude -> Latitude -> Geometry -> IO () processPolygon tableName resolution longitude latitude p = do-    shell <- MaybeT $ getExteriorRing p-    coordSeq <- MaybeT $ getCoordSeq shell+    shell <- getExteriorRing p+    coordSeq <- getCoordSeq shell     xyzs <- getXYZs coordSeq     let pId = polygonId resolution longitude latitude         format :: Int -> Double -> Double -> String         format = printf "INSERT INTO %s (polygon_id, point_id, longitude, latitude) VALUES ('%s', %d, %f, %f);\n" tableName pId         strs = map (\(pointId, (x, y, _)) -> format pointId x y) (zip [0..] xyzs)-    lift $ forM_ strs putStr+    forM_ strs putStr  polygonId :: Resolution -> Longitude -> Latitude -> String polygonId resolution longitude latitude = "id_" ++ formatValue longitude ++ "_" ++ formatValue latitude@@ -92,19 +90,18 @@         formatValue :: Double -> String         formatValue = replace "-" "m" . replace "." "_" . (printf "%.2f") . mfloor resolution -generatePolygonMeshSQL :: Context -> String -> Resolution -> MaybeT IO ()+generatePolygonMeshSQL :: Context -> String -> Resolution -> IO () generatePolygonMeshSQL ctx wkt resolution = do-    reader <- MaybeT $ mkReader ctx-    writer <- MaybeT $ mkWriter ctx-    country <- MaybeT $ readGeometry reader wkt-    env <- MaybeT $ envelope country-    shell <- MaybeT $ getExteriorRing env-    coordSeq <- MaybeT $ getCoordSeq shell+    reader <- mkReader ctx+    writer <- mkWriter ctx+    country <- readGeometry reader wkt+    env <- envelope country+    shell <- getExteriorRing env+    coordSeq <- getCoordSeq shell     xyzs <- getXYZs coordSeq -    lift $ do-        putStrLn "Shell:"-        mapM_ print xyzs+    putStrLn "Shell:"+    mapM_ print xyzs      let Extent{..} = extent xyzs         mfloorRes = mfloor resolution@@ -113,21 +110,20 @@         latitudeBegin = mfloorRes minY         latitudeEnd = mfloorRes maxY + resolution -    lift $ do-        putStrLn "Longitude and latitude ranges:"-        putStrLn $ printf "  longitude %f to %f" longitudeBegin longitudeEnd-        putStrLn $ printf "  latitude %f to %f" latitudeBegin latitudeEnd+    putStrLn "Longitude and latitude ranges:"+    putStrLn $ printf "  longitude %f to %f" longitudeBegin longitudeEnd+    putStrLn $ printf "  latitude %f to %f" latitudeBegin latitudeEnd      let longitudes = frange longitudeBegin longitudeEnd 1.0         latitudes = frange latitudeBegin latitudeEnd 1.0     forM_ [(i, j) | i <- longitudes, j <- latitudes] $ \(longitude, latitude) -> do         square <- mkSquare reader longitude latitude resolution-        overlap <- MaybeT $ intersection square country-        isOverlapEmpty <- MaybeT $ isEmpty overlap+        overlap <- intersection square country+        isOverlapEmpty <- isEmpty overlap         unless isOverlapEmpty $ do-            typeId <- MaybeT $ geomTypeId overlap+            typeId <- geomTypeId overlap             polygon <- case typeId of-                            MultiPolygon -> MaybeT $ findBiggestPolygon overlap+                            MultiPolygon -> findBiggestPolygon overlap                             Polygon -> return overlap             processPolygon "TABLE_NAME" resolution longitude latitude polygon     return ()@@ -136,6 +132,5 @@ demo = do     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 error "Sample.demo failed")+    withGEOS $ \ctx -> generatePolygonMeshSQL ctx wkt 1.0+    putStrLn "Sample.demo: succeeded"

@@ -1,87 +0,0 @@-module GEOSTest.TransAPI (demo) where--import Control.Monad-import Control.Monad.Trans-import Control.Monad.Trans.Maybe-import Data.Geolocation.GEOS (Context, Geometry, GeometryType (..))-import Data.Geolocation.GEOS.Trans-import Data.Maybe--check :: Bool -> MaybeT IO ()-check True = return ()-check False = error "Check failed"--type Coordinate = (Double, Double)--createLinearRing :: Context -> [Coordinate] -> MaybeT IO Geometry-createLinearRing ctx cs = do-    let count = length cs-    coords <- createCoordSeqM ctx (fromIntegral count) 2-    forM_ (zip [0..] cs) $ \(i, (x, y)) -> do-        setXM coords i x-        setYM coords i y-    createLinearRingM coords---- 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-demo :: IO ()-demo = 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-        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 + 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--        shell <- createLinearRing ctx [(-10.0, -10.0), (-10.0, 10.0), (10.0, 10.0), (10.0, -10.0), (-10.0, -10.0)]-        hole <- createLinearRing ctx [(-5.0, -5.0), (-5.0, 5.0), (5.0, 5.0), (5.0, -5.0), (-5.0, -5.0)]-        polygon <- createPolygonM shell [hole]-        str3 <- writeGeometryM writer polygon-        lift $ putStrLn str3--        coll <- createCollectionM MultiPolygon [polygon]-        str4 <- writeGeometryM writer coll-        lift $ putStrLn str4--        p <- createEmptyPolygonM ctx-        str5 <- writeGeometryM writer p-        lift $ putStrLn str5--    case result of-         Left m -> error $ "TransAPI.demo failed: " ++ m-         Right _ -> putStrLn "TransAPI.demo succeeded"

@@ -6,7 +6,6 @@ import qualified GEOSTest.HighLevelAPI as HighLevelAPI import qualified GEOSTest.LowLevelAPI as LowLevelAPI import qualified GEOSTest.Sample as Sample-import qualified GEOSTest.TransAPI as TransAPI  main :: IO () main = do@@ -14,5 +13,4 @@     putStrLn v     LowLevelAPI.demo     HighLevelAPI.demo-    TransAPI.demo     Sample.demo