hgeos 0.1.3.0 → 0.1.4.0

raw patch · 9 files changed

+290/−134 lines, 9 filesdep +mtldep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mtl, transformers

API changes (from Hackage documentation)

Files

• hgeos.cabal +6/−1
• src/lib/Data/Geolocation/GEOS.hs +6/−4
• src/lib/Data/Geolocation/GEOS/Imports.hs +31/−29
• src/lib/Data/Geolocation/GEOS/Trans.hs +130/−0
• src/test/GEOSTest/HighLevelAPI.hs +12/−9
• src/test/GEOSTest/LowLevelAPI.hs +4/−4
• src/test/GEOSTest/Sample.hs +78/−87
• src/test/GEOSTest/TransAPI.hs +21/−0
• src/test/Main.hs +2/−0

@@ -1,5 +1,5 @@ name:                 hgeos-version:              0.1.3.0+version:              0.1.4.0 synopsis:             Simple Haskell bindings to GEOS C API description:   Simple Haskell bindings to the <https://trac.osgeo.org/geos/ GEOS>@@ -25,12 +25,14 @@   hs-source-dirs:     src/lib   default-language:   Haskell2010   build-depends:      base >= 4.7 && < 5+                    , transformers   extra-libraries:    geos_c   c-sources:          src/lib/Data/Geolocation/GEOS/helpers.c                     , src/lib/Data/Geolocation/GEOS/helpers.h   cc-options:         -std=c99 -pthread   exposed-modules:    Data.Geolocation.GEOS                     , Data.Geolocation.GEOS.Imports+                    , Data.Geolocation.GEOS.Trans   if os(windows)     include-dirs:     C:/OSGeo4W64/include     extra-lib-dirs:   C:/OSGeo4W64/lib@@ -43,7 +45,10 @@   build-depends:      MissingH                     , base >= 4.7 && < 5                     , hgeos+                    , mtl+                    , transformers   other-modules:      GEOSTest.Arith                     , GEOSTest.HighLevelAPI                     , GEOSTest.LowLevelAPI                     , GEOSTest.Sample+                    , GEOSTest.TransAPI

@@ -12,6 +12,8 @@  For the low-level FFI bindings, see "Data.Geolocation.GEOS.Imports". +For the monad transformer wrappers, see "Data.Geolocation.GEOS.Trans".+ <https://github.com/rcook/hgeos/blob/master/src/test/GEOSTest/HighLevelAPI.hs View sample 1>  <https://github.com/rcook/hgeos/blob/master/src/test/GEOSTest/Sample.hs View sample 2>@@ -60,7 +62,7 @@ data Context = Context ContextStateRef  data ContextState = ContextState-    { hCtx :: GEOSContextHandle_t+    { hCtx :: GEOSContextHandle     , hReaders :: [GEOSWKTReaderPtr]     , hWriters :: [GEOSWKTWriterPtr]     , hGeometries :: [GEOSGeometryPtr]@@ -104,7 +106,7 @@                 value <- peek valuePtr                 return $ Just (realToFrac value) -checkAndDoNotTrack :: ContextStateRef -> (GEOSContextHandle_t -> IO GEOSGeometryPtr) -> IO (Maybe Geometry)+checkAndDoNotTrack :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry) checkAndDoNotTrack sr f = do     ContextState{..} <- readIORef sr     h <- f hCtx@@ -112,7 +114,7 @@                 then Nothing                 else Just $ Geometry sr h -checkAndTrack :: ContextStateRef -> (GEOSContextHandle_t -> IO GEOSGeometryPtr) -> IO (Maybe Geometry)+checkAndTrack :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry) checkAndTrack sr f = do     ContextState{..} <- readIORef sr     h <- f hCtx@@ -166,7 +168,7 @@                 then Nothing                 else Just $ fromIntegral value -getOrdinate :: (GEOSContextHandle_t -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) ->+getOrdinate :: (GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) ->     CoordinateSequence -> Word -> IO (Maybe Double) getOrdinate f (CoordinateSequence sr h) index = do     ContextState{..} <- readIORef sr

@@ -14,11 +14,13 @@  For the high-level API, see "Data.Geolocation.GEOS". +For the monad transformer wrappers, see "Data.Geolocation.GEOS.Trans".+ <https://github.com/rcook/hgeos/blob/master/src/test/GEOSTest/LowLevelAPI.hs View sample> -}  module Data.Geolocation.GEOS.Imports-    ( GEOSContextHandle_t ()+    ( GEOSContextHandle ()     , GEOSCoordSequencePtr ()     , GEOSGeometryPtr ()     , GEOSWKTReaderPtr ()@@ -56,11 +58,11 @@  -- |Determines if given pointer is null class NullablePtr a where-    -- |Returns @True@ if pointer is null, @False@ otherwise+    -- |Evaluates to @True@ if pointer is null, @False@ otherwise     isNullPtr :: a -> Bool --- |Wraps @GEOSContextHandle_t@-newtype GEOSContextHandle_t = GEOSContextHandle_t (Ptr GEOSContextHandle_t)+-- |Wraps @GEOSContextHandle@+newtype GEOSContextHandle = GEOSContextHandle (Ptr GEOSContextHandle)  -- |Wraps @GEOSCoordSequence*@ newtype GEOSCoordSequencePtr = GEOSCoordSequencePtr (Ptr GEOSCoordSequencePtr)@@ -84,99 +86,99 @@  -- |Wraps @GEOSArea_r@ foreign import ccall "GEOSArea_r"-    c_GEOSArea_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> Ptr CDouble -> IO CInt+    c_GEOSArea_r :: GEOSContextHandle -> GEOSGeometryPtr -> Ptr CDouble -> IO CInt  -- |Wraps @GEOSCoordSeq_destroy_r@ foreign import ccall "GEOSCoordSeq_destroy_r"-    c_GEOSCoordSeq_destroy_r :: GEOSContextHandle_t -> GEOSCoordSequencePtr -> IO ()+    c_GEOSCoordSeq_destroy_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> IO ()  -- |Wraps @GEOSCoordSeq_getSize_r@ foreign import ccall "GEOSCoordSeq_getSize_r"-    c_GEOSCoordSeq_getSize_r :: GEOSContextHandle_t -> GEOSCoordSequencePtr -> Ptr CUInt -> IO CInt+    c_GEOSCoordSeq_getSize_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> Ptr CUInt -> IO CInt  -- |Wraps @GEOSCoordSeq_getX_r@ foreign import ccall "GEOSCoordSeq_getX_r"-    c_GEOSCoordSeq_getX_r :: GEOSContextHandle_t -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt+    c_GEOSCoordSeq_getX_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt  -- |Wraps @GEOSCoordSeq_getY_r@ foreign import ccall "GEOSCoordSeq_getY_r"-    c_GEOSCoordSeq_getY_r :: GEOSContextHandle_t -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt+    c_GEOSCoordSeq_getY_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt  -- |Wraps @GEOSCoordSeq_getZ_r@ foreign import ccall "GEOSCoordSeq_getZ_r"-    c_GEOSCoordSeq_getZ_r :: GEOSContextHandle_t -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt+    c_GEOSCoordSeq_getZ_r :: GEOSContextHandle -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt  -- |Wraps @GEOSEnvelope_r@ foreign import ccall "GEOSEnvelope_r"-    c_GEOSEnvelope_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO GEOSGeometryPtr+    c_GEOSEnvelope_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO GEOSGeometryPtr  -- |Wraps @GEOSFree_r@ specialized to @const char*@ foreign import ccall "GEOSFree_r"-    c_GEOSFree_r_CString :: GEOSContextHandle_t -> CString -> IO ()+    c_GEOSFree_r_CString :: GEOSContextHandle -> CString -> IO ()  -- |Wraps @GEOSGeomTypeId_r@ foreign import ccall "GEOSGeomTypeId_r"-    c_GEOSGeomTypeId_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO CInt+    c_GEOSGeomTypeId_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO CInt  -- |Wraps @GEOSGeom_destroy_r@ foreign import ccall "GEOSGeom_destroy_r"-    c_GEOSGeom_destroy_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO ()+    c_GEOSGeom_destroy_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO ()  -- |Wraps @GEOSGeom_getCoordSeq_r@ foreign import ccall "GEOSGeom_getCoordSeq_r"-    c_GEOSGeom_getCoordSeq_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO GEOSCoordSequencePtr+    c_GEOSGeom_getCoordSeq_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO GEOSCoordSequencePtr  -- |Wraps @GEOSGetExteriorRing_r@ foreign import ccall "GEOSGetExteriorRing_r"-    c_GEOSGetExteriorRing_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO GEOSGeometryPtr+    c_GEOSGetExteriorRing_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO GEOSGeometryPtr  -- |Wraps @GEOSGetGeometryN_r@ foreign import ccall "GEOSGetGeometryN_r"-    c_GEOSGetGeometryN_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> CInt -> IO GEOSGeometryPtr+    c_GEOSGetGeometryN_r :: GEOSContextHandle -> GEOSGeometryPtr -> CInt -> IO GEOSGeometryPtr  -- |Wraps @GEOSGetNumGeometries_r@ foreign import ccall "GEOSGetNumGeometries_r"-    c_GEOSGetNumGeometries_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO CInt+    c_GEOSGetNumGeometries_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO CInt  -- |Wraps @GEOSIntersection_r@ foreign import ccall "GEOSIntersection_r"-    c_GEOSIntersection_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> GEOSGeometryPtr -> IO GEOSGeometryPtr+    c_GEOSIntersection_r :: GEOSContextHandle -> GEOSGeometryPtr -> GEOSGeometryPtr -> IO GEOSGeometryPtr  -- |Wraps @GEOSWKTReader_create_r@ foreign import ccall "GEOSWKTReader_create_r"-    c_GEOSWKTReader_create_r :: GEOSContextHandle_t -> IO GEOSWKTReaderPtr+    c_GEOSWKTReader_create_r :: GEOSContextHandle -> IO GEOSWKTReaderPtr  -- |Wraps @GEOSWKTReader_destroy_r@ foreign import ccall "GEOSWKTReader_destroy_r"-    c_GEOSWKTReader_destroy_r :: GEOSContextHandle_t -> GEOSWKTReaderPtr -> IO ()+    c_GEOSWKTReader_destroy_r :: GEOSContextHandle -> GEOSWKTReaderPtr -> IO ()  -- |Wraps @GEOSWKTReader_read_r@ foreign import ccall "GEOSWKTReader_read_r"-    c_GEOSWKTReader_read_r :: GEOSContextHandle_t -> GEOSWKTReaderPtr -> CString -> IO GEOSGeometryPtr+    c_GEOSWKTReader_read_r :: GEOSContextHandle -> GEOSWKTReaderPtr -> CString -> IO GEOSGeometryPtr  -- |Wraps @GEOSWKTWriter_create_r@ foreign import ccall "GEOSWKTWriter_create_r"-    c_GEOSWKTWriter_create_r :: GEOSContextHandle_t -> IO GEOSWKTWriterPtr+    c_GEOSWKTWriter_create_r :: GEOSContextHandle -> IO GEOSWKTWriterPtr  -- |Wraps @GEOSWKTWriter_destroy_r@ foreign import ccall "GEOSWKTWriter_destroy_r"-    c_GEOSWKTWriter_destroy_r :: GEOSContextHandle_t -> GEOSWKTWriterPtr -> IO ()+    c_GEOSWKTWriter_destroy_r :: GEOSContextHandle -> GEOSWKTWriterPtr -> IO ()  -- |Wraps @GEOSWKTWriter_write_r@ foreign import ccall "GEOSWKTWriter_write_r"-    c_GEOSWKTWriter_write_r :: GEOSContextHandle_t -> GEOSWKTWriterPtr -> GEOSGeometryPtr -> IO CString+    c_GEOSWKTWriter_write_r :: GEOSContextHandle -> GEOSWKTWriterPtr -> GEOSGeometryPtr -> IO CString  -- |Wraps @GEOSisEmpty_r@ foreign import ccall "GEOSisEmpty_r"-    c_GEOSisEmpty_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO CChar+    c_GEOSisEmpty_r :: GEOSContextHandle -> GEOSGeometryPtr -> IO CChar  -- |Wraps @GEOSversion@ foreign import ccall "GEOSversion"     c_GEOSversion :: IO CString --- |Wraps @finishGEOS_r@ helper function+-- |Wraps @finishGEOS_r@ foreign import ccall "finishGEOS_r"-    c_finishGEOS_r :: GEOSContextHandle_t -> IO ()+    c_finishGEOS_r :: GEOSContextHandle -> IO ()  -- |Wraps @getErrorMessage@ helper function foreign import ccall "helpers.h getErrorMessage"@@ -188,4 +190,4 @@  -- |Wraps @initializeGEOSWithHandlers@ helper function foreign import ccall "helpers.h initializeGEOSWithHandlers"-    c_initializeGEOSWithHandlers :: IO GEOSContextHandle_t+    c_initializeGEOSWithHandlers :: IO GEOSContextHandle

@@ -0,0 +1,130 @@+{-|+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 : POSIX++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+    , envelopeM+    , geomTypeIdM+    , getCoordSeqM+    , getExteriorRingM+    , getGeometryM+    , getNumGeometriesM+    , getSizeM+    , getXM+    , getYM+    , getZM+    , intersectionM+    , isEmptyM+    , mkReaderM+    , mkWriterM+    , readGeometryM+    , runGEOS+    , writeGeometryM+    ) where++import Control.Monad.Trans.Maybe+import Data.Geolocation.GEOS++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)++-- | @MaybeT@-wrapped version of 'area'+areaM :: Geometry -> MaybeT IO Double+areaM = unaryGEOSFunc area++-- | @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 '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 .)++-- | @MaybeT@-wrapped version of 'area'+writeGeometryM :: Writer -> Geometry -> MaybeT IO String+writeGeometryM = binaryGEOSFunc writeGeometry

@@ -1,18 +1,21 @@ module GEOSTest.HighLevelAPI (demo) where +import Control.Monad.Trans+import Control.Monad.Trans.Maybe import Data.Geolocation.GEOS+import Data.Maybe  -- 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-    withGEOS $ \ctx -> do-        (Just reader) <- mkReader ctx-        (Just g0) <- readGeometry reader "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"-        (Just g1) <- readGeometry reader "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))"-        (Just g2) <- intersection g0 g1-        (Just writer) <- mkWriter ctx-        (Just str) <- writeGeometry writer g2-        putStrLn str-        putStrLn "HighLevelAPI.demo done"+    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+    putStrLn $ "HighLevelAPI.demo: " ++ (if isJust result then "succeeded" else "failed")

@@ -26,13 +26,13 @@                             putStrLn str                             putStrLn "LowLevelAPI.demo done"     where-        withGEOS :: (GEOSContextHandle_t -> IO a) -> IO a+        withGEOS :: (GEOSContextHandle -> IO a) -> IO a         withGEOS = bracket c_initializeGEOSWithHandlers c_finishGEOS_r-        withWKTReader :: GEOSContextHandle_t -> (GEOSWKTReaderPtr -> IO a) -> IO a+        withWKTReader :: GEOSContextHandle -> (GEOSWKTReaderPtr -> IO a) -> IO a         withWKTReader ctx = bracket (c_GEOSWKTReader_create_r ctx) (c_GEOSWKTReader_destroy_r ctx)-        withWKTWriter :: GEOSContextHandle_t -> (GEOSWKTWriterPtr -> IO a) -> IO a+        withWKTWriter :: GEOSContextHandle -> (GEOSWKTWriterPtr -> IO a) -> IO a         withWKTWriter ctx = bracket (c_GEOSWKTWriter_create_r ctx) (c_GEOSWKTWriter_destroy_r ctx)-        withGeometry :: GEOSContextHandle_t -> GEOSWKTReaderPtr -> CString -> (GEOSGeometryPtr -> IO a) -> IO a+        withGeometry :: GEOSContextHandle -> GEOSWKTReaderPtr -> CString -> (GEOSGeometryPtr -> IO a) -> IO a         withGeometry ctx reader wkt =             bracket                 (c_GEOSWKTReader_read_r ctx reader wkt)

@@ -3,8 +3,11 @@ 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 import Data.String.Utils import GEOSTest.Arith import Paths_hgeos@@ -15,26 +18,6 @@ type Longitude = Double type Resolution = Double -printGeometry :: Writer -> Geometry -> IO ()-printGeometry r g = do-    maybeStr <- writeGeometry r g-    case maybeStr of-         Nothing -> putStrLn "(invalid)"-         (Just str) -> putStrLn str--getXYZs :: CoordinateSequence -> IO (Maybe [Coordinate])-getXYZs coordSeq = do-    maybeSize <- getSize coordSeq-    case maybeSize of-         Nothing -> return Nothing-         Just size -> do-             xyzs <- forM [0..(size - 1)] $ \i -> do-                 (Just x) <- getX coordSeq i-                 (Just y) <- getY coordSeq i-                 (Just z) <- getZ coordSeq i-                 return (x, y, z)-             return $ Just xyzs- data Extent = Extent     { minX :: Double     , maxX :: Double@@ -44,6 +27,15 @@     , maxZ :: Double     } deriving Show +getXYZs :: CoordinateSequence -> MaybeT IO [Coordinate]+getXYZs coordSeq = do+    size <- MaybeT $ getSize coordSeq+    forM [0..(size - 1)] $ \i -> do+        x <- MaybeT $ getX coordSeq i+        y <- MaybeT $ getY coordSeq i+        z <- MaybeT $ getZ coordSeq i+        return (x, y, z)+ extent :: [Coordinate] -> Extent extent ((x, y, z) : cs) =     let (minX, maxX, minY, maxY, minZ, maxZ) =@@ -56,8 +48,9 @@                     if z' > maxX then z' else maxZ)) (x, x, y, y, z, z) cs     in Extent minX maxX minY maxY minZ maxZ -mkSquare :: Reader -> Longitude -> Latitude -> Resolution -> IO Geometry-mkSquare reader longitude latitude resolution = do+-- TODO: Build polygon using API instead of string parsing+mkSquare :: Reader -> Longitude -> Latitude -> Resolution -> MaybeT IO Geometry+mkSquare reader longitude latitude resolution =     let points = [             (longitude, latitude),             (longitude + resolution, latitude),@@ -66,41 +59,32 @@             (longitude, latitude)             ]         wkt = printf "POLYGON ((%s))" (intercalate "," (map (\(a, b) -> printf "%f %f" a b) points))-    (Just g) <- readGeometry reader wkt-    return g--getGeometries :: Geometry -> IO [Geometry]-getGeometries geometry = do-    (Just count) <- getNumGeometries geometry-    forM [0..(count - 1)] $ \i -> do-        (Just g) <- getGeometry geometry i-        return g+    in MaybeT $ readGeometry reader wkt -findBiggestPolygon :: Geometry -> IO Geometry-findBiggestPolygon geometry = do-    geometries@(g : gs) <- getGeometries geometry-    a : as <- sequence $ map area geometries-    let (g', _) = foldr (\p@(_, a') biggest@(_, aBiggest) -> if a' > aBiggest then p else biggest) (g, a) (zip gs as)-    return g'+getGeometries :: Geometry -> IO (Maybe [Geometry])+getGeometries geometry = runMaybeT $ do+    count <- MaybeT $ getNumGeometries geometry+    mapM (MaybeT . getGeometry geometry) [0..(count - 1)] -resolution :: Double-resolution = 1.0+findBiggestPolygon :: Geometry -> IO (Maybe Geometry)+findBiggestPolygon geometry = runMaybeT $ do+    gs@(gHead : gTail) <- MaybeT (getGeometries geometry)+    as@(aHead : aTail) <- mapM (MaybeT . 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 -> IO ()+processPolygon :: String -> Resolution -> Longitude -> Latitude -> Geometry -> MaybeT IO () processPolygon tableName resolution longitude latitude p = do+    shell <- MaybeT $ getExteriorRing p+    coordSeq <- MaybeT $ getCoordSeq shell+    xyzs <- getXYZs coordSeq     let pId = polygonId resolution longitude latitude-    (Just shell) <- getExteriorRing p-    (Just coordSeq) <- getCoordSeq shell-    (Just xyzs) <- getXYZs coordSeq-    forM_ (zip [0..] xyzs) $ \(pointId, (x, y, _)) -> do-        let s = printf-                    "INSERT INTO %s (polygon_id, point_id, longitude, latitude) VALUES ('%s', %d, %f, %f);\n"-                    tableName-                    pId-                    (pointId :: Int)-                    x-                    y-        putStr s+        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  polygonId :: Resolution -> Longitude -> Latitude -> String polygonId resolution longitude latitude = "id_" ++ formatValue longitude ++ "_" ++ formatValue latitude@@ -108,42 +92,49 @@         formatValue :: Double -> String         formatValue = replace "-" "m" . replace "." "_" . (printf "%.2f") . mfloor resolution --- A more involved example of use of API+generatePolygonMeshSQL :: Context -> String -> Resolution -> MaybeT 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+    xyzs <- getXYZs coordSeq++    lift $ do+        putStrLn "Shell:"+        mapM_ print xyzs++    let Extent{..} = extent xyzs+        mfloorRes = mfloor resolution+        longitudeBegin = mfloorRes minX+        longitudeEnd = mfloorRes maxX + resolution+        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++    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+        unless isOverlapEmpty $ do+            typeId <- MaybeT $ geomTypeId overlap+            polygon <- case typeId of+                            MultiPolygon -> MaybeT $ findBiggestPolygon overlap+                            Polygon -> return overlap+            processPolygon "TABLE_NAME" resolution longitude latitude polygon+    return ()+ demo :: IO () demo = do     fileName <- getDataFileName "data/namibia.wkt"     wkt <- readFile fileName-    withGEOS $ \ctx -> do-        (Just reader) <- mkReader ctx-        (Just writer) <- mkWriter ctx-        let p = printGeometry writer--        (Just country) <- readGeometry reader wkt-        (Just env) <- envelope country-        (Just shell) <- getExteriorRing env-        (Just coordSeq) <- getCoordSeq shell-        (Just xyzs) <- getXYZs coordSeq-        forM_ xyzs $ \(x, y, z) -> print (x, y, z)-        let Extent{..} = extent xyzs-            mfloorRes = mfloor resolution-            longitudeBegin = mfloorRes minX-            longitudeEnd = mfloorRes maxX + resolution-            latitudeBegin = mfloorRes minY-            latitudeEnd = mfloorRes maxY + resolution-        print longitudeBegin-        print longitudeEnd-        print latitudeBegin-        print 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-            (Just overlap) <- intersection square country-            (Just x) <- isEmpty overlap-            unless x $ do-                (Just t) <- geomTypeId overlap-                polygon <- case t of-                                MultiPolygon -> findBiggestPolygon overlap-                                Polygon -> return overlap-                processPolygon "foo" resolution longitude latitude polygon-    putStrLn "Sample.demo done"+    result <- withGEOS $ \ctx -> runMaybeT (generatePolygonMeshSQL ctx wkt 1.0)+    putStrLn $ "Sample.demo: " ++ (if isJust result then "succeeded" else "failed")

@@ -0,0 +1,21 @@+module GEOSTest.TransAPI (demo) where++import Control.Monad.Trans+import Control.Monad.Trans.Maybe+import Data.Geolocation.GEOS.Trans+import Data.Maybe++-- 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 <- runGEOS $ \ctx -> do+        reader <- mkReaderM 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")

@@ -6,6 +6,7 @@ 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@@ -13,4 +14,5 @@     putStrLn v     LowLevelAPI.demo     HighLevelAPI.demo+    TransAPI.demo     Sample.demo