packages feed

hgeos (empty) → 0.1.0.0

raw patch · 8 files changed

+482/−0 lines, 8 filesdep +Globdep +basedep +doctestsetup-changed

Dependencies added: Glob, base, doctest, hgeos

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Richard Cook++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main :: IO ()+main = defaultMain
+ hgeos.cabal view
@@ -0,0 +1,48 @@+name:                 hgeos+version:              0.1.0.0+synopsis:             Haskell bindings to GEOS C API+description:          Please see README.md+homepage:             https://github.com/rcook/hgeos#readme+license:              MIT+license-file:         LICENSE+author:               Richard Cook+maintainer:           rcook@rcook.org+copyright:            2016 Richard Cook+category:             Web+build-type:           Simple+cabal-version:        >= 1.10++source-repository head+  type:               git+  location:           https://github.com/rcook/hgeos.git++library+  hs-source-dirs:     src/lib+  default-language:   Haskell2010+  build-depends:      base >= 4.7 && < 5+  extra-libraries:    geos_c+  c-sources:          src/lib/helpers.c+  includes:           src/lib/helpers.h+  cc-options:         -std=c99 -pthread+  exposed-modules:    Data.Geolocation.GEOS+                    , Data.Geolocation.GEOS.Imports+  if os(windows)+    include-dirs:     C:/OSGeo4W64/include+    extra-lib-dirs:   C:/OSGeo4W64/lib++executable hgeos+  hs-source-dirs:     src/app+  main-is:            Main.hs+  default-language:   Haskell2010+  build-depends:      base >= 4.7 && < 5+                    , hgeos+  other-modules:      Main++test-suite doctests+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            Main.hs+  default-language:   Haskell2010+  build-depends:      Glob+                    , base >= 4.7 && < 5+                    , doctest
+ src/app/Main.hs view
@@ -0,0 +1,63 @@+module Main (main) where++import Control.Exception+import Data.Geolocation.GEOS+import Data.Geolocation.GEOS.Imports+import Foreign.C+import Foreign.Ptr++-- Demonstrates direct use of imports+-- Lifetimes of various GEOS objects, including readers, writers and+-- geometries, must be managed explicitly by clients using explicit calls to+-- various destroy/free functions+lowLevelAPIDemo :: IO ()+lowLevelAPIDemo = do+    wkt0 <- newCString "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"+    wkt1 <- newCString "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))"++    withGEOS $ \ctx -> do+        withWKTReader ctx $ \reader -> do+            withGeometry ctx reader wkt0 $ \g0 -> do+                withGeometry ctx reader wkt1 $ \g1 -> do+                    bracket (c_GEOSIntersection_r ctx g0 g1) (c_GEOSGeom_destroy_r ctx) $ \g2 -> do+                        withWKTWriter ctx $ \writer -> do+                            str <- bracket+                                (c_GEOSWKTWriter_write_r ctx writer g2)+                                (c_GEOSFree_r_CChar ctx)+                                peekCString+                            putStrLn str+                            putStrLn "lowLevelAPIDemo done"+    where+        withGEOS :: (GEOSContextHandle_t -> IO a) -> IO a+        withGEOS = bracket c_initializeGEOSWithHandlers c_uninitializeGEOS+        withWKTReader :: GEOSContextHandle_t -> (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 ctx = bracket (c_GEOSWKTWriter_create_r ctx) (c_GEOSWKTWriter_destroy_r ctx)+        withGeometry :: GEOSContextHandle_t -> GEOSWKTReaderPtr -> CString -> (GEOSGeometryPtr -> IO a) -> IO a+        withGeometry ctx reader wkt =+            bracket+                (c_GEOSWKTReader_read_r ctx reader wkt)+                (c_GEOSGeom_destroy_r ctx)++-- 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+highLevelAPIDemo :: IO ()+highLevelAPIDemo = do+    withContext $ \ctx -> do+        reader <- mkReader ctx+        g0 <- readGeometry reader "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"+        g1 <- readGeometry reader "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))"+        g2 <- intersection g0 g1+        writer <- mkWriter ctx+        str <- writeGeometry writer g2+        putStrLn str+        putStrLn "highLevelAPIDemo done"++main :: IO ()+main = do+    s <- peekCString c_GEOSversion+    putStrLn s+    lowLevelAPIDemo+    highLevelAPIDemo
+ src/lib/Data/Geolocation/GEOS.hs view
@@ -0,0 +1,197 @@+{-|+Module      : Data.Geolocation.GEOS+Description : High-level API for interoperating with GEOS C API+Copyright   : (C) Richard Cook, 2016+Licence     : MIT+Maintainer  : rcook@rcook.org+Stability   : experimental+Portability : POSIX++A high-level API for interoperating with GEOS C API which includes automatic+management of lifetimes of objects such as readers, writers and geometries.++For the low-level FFI bindings, see "Data.Geolocation.GEOS.Imports".+-}++{-# LANGUAGE RecordWildCards #-}++module Data.Geolocation.GEOS+    ( Context()+    , Geometry()+    , Reader()+    , Writer()+    , intersection+    , mkReader+    , mkWriter+    , readGeometry+    , withContext+    , writeGeometry+    ) where++import Control.Exception+import Data.Geolocation.GEOS.Imports+import Data.IORef+import Foreign.C++data ContextState = ContextState+    { hCtx :: GEOSContextHandle_t+    , hReaders :: [GEOSWKTReaderPtr]+    , hWriters :: [GEOSWKTWriterPtr]+    , hGeometries :: [GEOSGeometryPtr]+    }++type ContextStateRef = IORef ContextState++-- |Represents a <https://trac.osgeo.org/geos/ GEOS> context+data Context = Context ContextStateRef++-- |Represents a <https://en.wikipedia.org/wiki/Well-known_text WKT> reader+data Reader = Reader ContextStateRef GEOSWKTReaderPtr++-- |Represents a <https://en.wikipedia.org/wiki/Well-known_text WKT> writer+data Writer = Writer ContextStateRef GEOSWKTWriterPtr++-- |Represents a <https://trac.osgeo.org/geos/ GEOS> geometry+data Geometry = Geometry ContextStateRef GEOSGeometryPtr++mkContext :: IO Context+mkContext = do+    hCtx <- c_initializeGEOSWithHandlers+    sr <- newIORef $ ContextState hCtx [] [] []+    return $ Context sr++releaseContext :: Context -> IO ()+releaseContext (Context sr) = do+    ContextState{..} <- readIORef sr+    mapM_ (c_GEOSGeom_destroy_r hCtx) hGeometries+    mapM_ (c_GEOSWKTWriter_destroy_r hCtx) hWriters+    mapM_ (c_GEOSWKTReader_destroy_r hCtx) hReaders+    c_uninitializeGEOS hCtx++-- |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:+--+-- @+--    withContext $ \ctx -> do+--+--        -- Use context+--+--        return ()+-- @+withContext :: (Context -> IO a) -> IO a+withContext = bracket mkContext releaseContext++-- |Creates a reader used to deserialize 'Geometry' instances from+-- <https://en.wikipedia.org/wiki/Well-known_text WKT>-format text:+--+-- @+--    withContext $ \ctx -> do+--        reader <- mkReader ctx+--+--        -- Use reader+--+--        return ()+-- @+--+-- The reader is associated with the 'Context' and released when the 'Context'+-- is released.+mkReader :: Context -> IO Reader+mkReader (Context sr) = do+    ContextState{..} <- readIORef sr+    hReader <- c_GEOSWKTReader_create_r hCtx+    modifyIORef' sr (\p@ContextState{..} -> p { hReaders = hReader : hReaders })+    return $ Reader sr hReader++-- |Creates a writer used to serialize 'Geometry' instances to+-- <https://en.wikipedia.org/wiki/Well-known_text WKT>-format text:+--+-- @+--    withContext $ \ctx -> do+--        writer <- mkWriter ctx+--+--        -- Use writer+--+--        return ()+-- @+--+-- The writer is associated with the 'Context' and released when the 'Context'+-- is released.+mkWriter :: Context -> IO Writer+mkWriter (Context sr) = do+    ContextState{..} <- readIORef sr+    hWriter <- c_GEOSWKTWriter_create_r hCtx+    modifyIORef' sr (\p@ContextState{..} -> p { hWriters = hWriter : hWriters })+    return $ Writer sr hWriter++-- |Deserializes a 'Geometry' instance from the given 'String' using the+-- supplied 'Reader':+--+-- @+--    withContext $ \ctx -> do+--        reader <- mkReader ctx+--        geometry <- readGeometry read "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"+--+--        -- Use geometry+--+--        return ()+-- @+--+-- The geometry is associated with the 'Context' and released when the 'Context'+-- is released.+readGeometry :: Reader -> String -> IO Geometry+readGeometry (Reader sr hReader) str = withCString str $ \cs -> do+    ContextState{..} <- readIORef sr+    hGeometry <- c_GEOSWKTReader_read_r hCtx hReader cs+    modifyIORef' sr (\p@ContextState{..} -> p { hGeometries = hGeometry : hGeometries })+    return $ Geometry sr hGeometry++-- |Serializes a 'Geometry' instance to a 'String' using the supplied 'Writer':+--+-- @+--    withContext $ \ctx -> do+--        reader <- mkReader ctx+--        geometry <- readGeometry read "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"+--+--        writer <- mkWriter ctx+--        str <- writeGeometry writer geometry+--+--        -- Use string+--+--        return ()+-- @+--+-- The geometry is associated with the 'Context' and released when the 'Context'+-- is released.+writeGeometry :: Writer -> Geometry -> IO String+writeGeometry (Writer sr hWriter) (Geometry _ hGeometry) = do+    ContextState{..} <- readIORef sr+    str <- bracket+        (c_GEOSWKTWriter_write_r hCtx hWriter hGeometry)+        (c_GEOSFree_r_CChar hCtx)+        peekCString+    return str++-- |Returns the 'Geometry' instance representing the intersection of the two+-- supplied 'Geometry' instances:+--+-- @+--    withContext $ \ctx -> do+--        reader <- mkReader ctx+--        g0 <- readGeometry reader "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))"+--        g1 <- readGeometry reader "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))"+--+--        g2 <- intersection g0 g1+--+--        -- Use geometry+--+--        putStrLn str+-- @+--+-- The geometry is associated with the 'Context' and released when the 'Context'+-- is released.+intersection :: Geometry -> Geometry -> IO Geometry+intersection (Geometry sr0 hGeometry0) (Geometry sr1 hGeometry1) = do+    ContextState{..} <- readIORef sr0+    hGeometry <- c_GEOSIntersection_r hCtx hGeometry0 hGeometry1+    return $ Geometry sr0 hGeometry
+ src/lib/Data/Geolocation/GEOS/Imports.hs view
@@ -0,0 +1,89 @@+{-|+Module      : Data.Geolocation.GEOS.Imports+Description : FFI bindings for GEOS C API+Copyright   : (C) Richard Cook, 2016+Licence     : MIT+Maintainer  : rcook@rcook.org+Stability   : experimental+Portability : POSIX++These are low-level FFI bindings for the GEOS C API derived from+<http://geos.osgeo.org/doxygen/geos__c_8h_source.html geos_c.h>. These enable+low-level access to the native functions for parts of the C API for which+high-level wrappers do not yet exist.++For the high-level API, see "Data.Geolocation.GEOS".+-}++module Data.Geolocation.GEOS.Imports where++import Foreign.C+import Foreign.Ptr++-- |Wraps @GEOSContextHandle_t@+newtype GEOSContextHandle_t = GEOSContextHandle_t (Ptr GEOSContextHandle_t)++-- |Wraps @GEOSGeometry*@+newtype GEOSGeometryPtr = GEOSGeometryPtr (Ptr GEOSGeometryPtr)++-- |Wraps @GEOSWKTReader*@+newtype GEOSWKTReaderPtr = GEOSWKTReaderPtr (Ptr GEOSWKTReaderPtr)++-- |Wraps @GEOSWKTWriter*@+newtype GEOSWKTWriterPtr = GEOSWKTWriterPtr (Ptr GEOSWKTWriterPtr)++-- |Wraps @GEOSversion@+foreign import ccall "GEOSversion"+    c_GEOSversion :: CString++-- |Wraps @GEOSFree_r@ specialized to @const char*@+foreign import ccall "GEOSFree_r"+    c_GEOSFree_r_CChar :: GEOSContextHandle_t -> Ptr CChar -> IO ()++-- |Wraps @initializeGEOSWithHandlers@ helper function+foreign import ccall "helpers.h initializeGEOSWithHandlers"+    c_initializeGEOSWithHandlers :: IO GEOSContextHandle_t++-- |Wraps @uninitializeGEOS@ helper function+foreign import ccall "helpers.h uninitializeGEOS"+    c_uninitializeGEOS :: GEOSContextHandle_t -> IO ()++-- |Wraps @getNoticeMessage@ helper function+foreign import ccall "helpers.h getNoticeMessage"+    c_getNoticeMessage :: IO CString++-- |Wraps @getErrorMessage@ helper function+foreign import ccall "helpers.h getErrorMessage"+    c_getErrorMessage :: IO CString++-- |Wraps @GEOSGeom_destroy_r@+foreign import ccall "GEOSGeom_destroy_r"+    c_GEOSGeom_destroy_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> IO ()++-- |Wraps @GEOSWKTReader_create_r@+foreign import ccall "GEOSWKTReader_create_r"+    c_GEOSWKTReader_create_r :: GEOSContextHandle_t -> IO GEOSWKTReaderPtr++-- |Wraps @GEOSWKTReader_destroy_r@+foreign import ccall "GEOSWKTReader_destroy_r"+    c_GEOSWKTReader_destroy_r :: GEOSContextHandle_t -> GEOSWKTReaderPtr -> IO ()++-- |Wraps @GEOSWKTReader_read_r@+foreign import ccall "GEOSWKTReader_read_r"+    c_GEOSWKTReader_read_r :: GEOSContextHandle_t -> GEOSWKTReaderPtr -> CString -> IO GEOSGeometryPtr++-- |Wraps @GEOSWKTWriter_create_r@+foreign import ccall "GEOSWKTWriter_create_r"+    c_GEOSWKTWriter_create_r :: GEOSContextHandle_t -> IO GEOSWKTWriterPtr++-- |Wraps @GEOSWKTWriter_destroy_r@+foreign import ccall "GEOSWKTWriter_destroy_r"+    c_GEOSWKTWriter_destroy_r :: GEOSContextHandle_t -> GEOSWKTWriterPtr -> IO ()++-- |Wraps @GEOSWKTWriter_write_r@+foreign import ccall "GEOSWKTWriter_write_r"+    c_GEOSWKTWriter_write_r :: GEOSContextHandle_t -> GEOSWKTWriterPtr -> GEOSGeometryPtr -> IO CString++-- |Wraps @GEOSIntersection_r@+foreign import ccall "GEOSIntersection_r"+    c_GEOSIntersection_r :: GEOSContextHandle_t -> GEOSGeometryPtr -> GEOSGeometryPtr -> IO GEOSGeometryPtr
+ src/lib/helpers.c view
@@ -0,0 +1,48 @@+#include "helpers.h"+#include <geos_c.h>+#include <stdarg.h>+#include <stdio.h>++//#define TRACE(message) printf(message "\n")+#define TRACE(message) do {} while (0)++__thread char g_noticeMessage[256];+static const size_t s_noticeMessageLen = sizeof(g_noticeMessage) / sizeof(g_noticeMessage[0]);+__thread char g_errorMessage[256];+static const size_t s_errorMessageLen = sizeof(g_errorMessage) / sizeof(g_errorMessage[0]);++static void noticeHandler(const char* format, ...)+{+    va_list args;+    va_start(args, format);+    vsnprintf(g_noticeMessage, s_noticeMessageLen, format, args);+    va_end(args);+}++static void errorHandler(const char* format, ...)+{+    va_list args;+    va_start(args, format);+    vsnprintf(g_errorMessage, s_errorMessageLen, format, args);+    va_end(args);+}++GEOSContextHandle_t initializeGEOSWithHandlers()+{+    return initGEOS_r(noticeHandler, errorHandler);+}++void uninitializeGEOS(GEOSContextHandle_t handle)+{+    finishGEOS_r(handle);+}++const char* getNoticeMessage()+{+    return g_noticeMessage;+}++const char* getErrorMessage()+{+    return g_errorMessage;+}
+ test/Main.hs view
@@ -0,0 +1,13 @@+module Main (main) where++import qualified System.FilePath.Glob as Glob+import qualified Test.DocTest as DocTest++includeDirs :: [String]+includeDirs = []++doctestWithIncludeDirs :: [String] -> IO ()+doctestWithIncludeDirs fs = DocTest.doctest (map ("-I" ++) includeDirs ++ fs)++main :: IO ()+main = Glob.glob "src/**/*.hs" >>= doctestWithIncludeDirs