geos 0.2.2 → 0.3.0

raw patch · 26 files changed

+1617/−1194 lines, 26 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• geos.cabal +7/−5
• src/Data/Geometry/Geos/Buffer.hs +25/−24
• src/Data/Geometry/Geos/Geometry.hs +337/−161
• src/Data/Geometry/Geos/Prepared.hs +16/−33
• src/Data/Geometry/Geos/Raw/Base.hs +113/−21
• src/Data/Geometry/Geos/Raw/Buffer.hs +71/−48
• src/Data/Geometry/Geos/Raw/CoordSeq.hs +109/−87
• src/Data/Geometry/Geos/Raw/Geometry.hs +222/−167
• src/Data/Geometry/Geos/Raw/Internal.hsc +33/−5
• src/Data/Geometry/Geos/Raw/Prepared.hs +45/−39
• src/Data/Geometry/Geos/Raw/STRTree.hs +54/−62
• src/Data/Geometry/Geos/Raw/Serialize.hs +79/−76
• src/Data/Geometry/Geos/Raw/Topology.hs +77/−28
• src/Data/Geometry/Geos/Relatable.hs +26/−10
• src/Data/Geometry/Geos/STRTree.hs +37/−30
• src/Data/Geometry/Geos/Serialize.hs +23/−28
• src/Data/Geometry/Geos/Topology.hs +101/−42
• tests/Data/Geometry/Geos/RelatableSpec.hs +38/−0
• tests/Data/Geometry/Geos/SerializeSpec.hs +54/−0
• tests/Data/Geometry/Geos/TopologySpec.hs +106/−0
• tests/Helpers.hs +38/−0
• tests/Main.hs +6/−16
• tests/ParsingSpec.hs +0/−74
• tests/RawGeometrySpec.hs +0/−98
• tests/SpatialOperationsSpec.hs +0/−87
• tests/SpecSampleData.hs +0/−53

@@ -1,7 +1,7 @@ cabal-version:       2.2 name:                geos -version:             0.2.2+version:             0.3.0  synopsis:  Bindings for GEOS. @@ -93,6 +93,7 @@       base <= 5     , bytestring     , vector+    , transformers     , mtl     , geos     , hspec@@ -114,14 +115,15 @@     , Data.Geometry.Geos.Raw.Serialize     , Data.Geometry.Geos.Raw.Topology     , Data.Geometry.Geos.Raw.STRTree+    , Data.Geometry.Geos.Raw.Prepared     , Data.Geometry.Geos.Relatable     , Data.Geometry.Geos.Serialize     , Data.Geometry.Geos.Topology     , Data.Geometry.Geos.STRTree-    , ParsingSpec-    , RawGeometrySpec-    , SpatialOperationsSpec-    , SpecSampleData+    , Data.Geometry.Geos.TopologySpec+    , Data.Geometry.Geos.RelatableSpec+    , Data.Geometry.Geos.SerializeSpec+    , Helpers  source-repository head   type:     git

@@ -15,19 +15,21 @@ {-# LANGUAGE ScopedTypeVariables #-}  -module Data.Geometry.Geos.Buffer (-    buffer+module Data.Geometry.Geos.Buffer+  ( buffer   , defaultBufferParams-  , BufferParams (..)-  , BufferJoinStyle (..)-  , BufferCapStyle (..)-) where+  , BufferParams(..)+  , BufferJoinStyle(..)+  , BufferCapStyle(..)+  )+where import qualified Data.Geometry.Geos.Raw.Buffer as R-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry-import qualified Data.Geometry.Geos.Raw.Geometry as RG+import           Data.Geometry.Geos.Raw.Base+import           Data.Geometry.Geos.Geometry+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as RG -data BufferCapStyle = +data BufferCapStyle =   -- | the usual round end caps     RoundCap   -- | end caps are truncated flat at the line ends@@ -38,13 +40,13 @@ data BufferJoinStyle =     RoundJoin   | MitreJoin-  | BevelJoin   +  | BevelJoin  convertCapStyle :: BufferCapStyle -> R.BufferCapStyle convertCapStyle = \case-  RoundCap -> R.capRound+  RoundCap  -> R.capRound   SquareCap -> R.capSquare-  FlatCap -> R.capFlat+  FlatCap   -> R.capFlat  convertJoinStyle :: BufferJoinStyle -> R.BufferJoinStyle convertJoinStyle = \case@@ -54,7 +56,7 @@  data BufferParams = BufferParams {     joinStyle :: BufferJoinStyle-  , capStyle :: BufferCapStyle +  , capStyle :: BufferCapStyle {- Sets the limit on the mitre ratio used for very sharp corners. @@ -90,23 +92,22 @@ }  defaultBufferParams :: BufferParams-defaultBufferParams = BufferParams {-    joinStyle = RoundJoin-  , capStyle = RoundCap-  , mitreLimit = 2.0 -  , quadrantSegments = 8-  , singleSided = False-}+defaultBufferParams = BufferParams { joinStyle        = RoundJoin+                                   , capStyle         = RoundCap+                                   , mitreLimit       = 2.0+                                   , quadrantSegments = 8+                                   , singleSided      = False+                                   }  -- | Returns a Geometry that represents all points whose distance from this geometry is less than or equal to the given width. buffer :: Geometry a -> Double -> BufferParams -> Some Geometry buffer g width bp = runGeos $ do   rg :: RG.Geom <- convertGeometryToRaw g-  rbp <- R.createBufferParams -  R.setEndCapStyle rbp (convertCapStyle $ capStyle bp) +  rbp           <- R.createBufferParams+  R.setEndCapStyle rbp (convertCapStyle $ capStyle bp)   R.setJoinStyle rbp (convertJoinStyle $ joinStyle bp)   R.setMitreLimit rbp (mitreLimit bp)   R.setQuadrantSegments rbp (quadrantSegments bp)   R.setSingleSided rbp (singleSided bp)-  rg' <- R.buffer rg rbp width  +  rg' <- R.buffer rg rbp width   convertGeometryFromRaw rg'

@@ -6,17 +6,29 @@ {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.Geometry.Geos.Geometry (-    Geometry(..)-  , Point(..)-  , LinearRing(..)-  , LineString(..)-  , Polygon(..)-  , MultiPoint(..)-  , MultiLineString(..)-  , MultiPolygon(..)+module Data.Geometry.Geos.Geometry+  ( Geometry(..)+  , GeometryConstructionError+  , Point+  , point+  , LinearRing+  , linearRing+  , LineString+  , lineString+  , Polygon+  , polygon+  , MultiPoint+  , multiPoint+  , MultiLineString+  , multiLineString+  , MultiPolygon+  , multiPolygon+  , GeometryCollection+  , geometryCollection   , Some(..)-  , Coordinate(..)+  , Coordinate+  , coordinate2+  , coordinate3   , SRID   , binaryPredicate   , convertGeometryFromRaw@@ -29,6 +41,7 @@   , ensureMultiPoint   , ensureMultiPolygon   , ensureMultiLineString+  , ensureGeometryCollection   , interpolate   , interpolateNormalized   , project@@ -41,32 +54,64 @@   , hausdorffDistance   , nearestPoints   , withSomeGeometry--) where+  , mapSomeGeometry+  )+where -import Data.Data-import Data.Semigroup as Sem-import qualified Data.Vector as V-import qualified Data.Geometry.Geos.Raw.Geometry as R-import qualified Data.Geometry.Geos.Raw.CoordSeq as RC-import Data.Geometry.Geos.Raw.Base-import Control.Monad-import Control.Applicative ((<*>))-import GHC.Generics (Generic)+import           Data.Data+import           Data.List                     (intercalate)+import           Data.Semigroup                as Sem+import qualified Data.Vector                   as V+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as R+import qualified Data.Geometry.Geos.Raw.CoordSeq+                                               as RC+import           Data.Geometry.Geos.Raw.Base+import           Control.Monad+import           Control.Applicative            ( (<*>) )+import           GHC.Generics                   ( Generic )  -- | In all geometry types, SRID is used for compatability and is NOT used in calculations. For example, the `distance` between two PointGeometry with an SRID of `Just 4326` will return a distance between two points in Euclidean space in the units the PointGeometry is initialized with. It will not calculate the distance on a spheroid. type SRID = Maybe Int  data Some :: (* -> *) -> * where-  Some :: f a -> Some f+  Some ::f a -> Some f +instance Eq (Some Geometry) where+  (Some (PointGeometry p s)) == (Some (PointGeometry p2 s2)) = p == p2 && s == s2+  (Some (PointGeometry _ _)) == (Some _) = False+  (Some (LineStringGeometry g s)) == (Some (LineStringGeometry g2 s2)) = g == g2 && s == s2+  (Some (LineStringGeometry _ _)) == (Some _) = False+  (Some (PolygonGeometry g s)) == (Some (PolygonGeometry g2 s2)) = g == g2 && s == s2+  (Some (PolygonGeometry _ _)) == (Some _) = False+  (Some (MultiPointGeometry g s)) == (Some (MultiPointGeometry g2 s2)) = g == g2 && s == s2+  (Some (MultiPointGeometry _ _)) == (Some _) = False+  (Some (MultiLineStringGeometry g s)) == (Some (MultiLineStringGeometry g2 s2)) = g == g2 && s == s2+  (Some (MultiLineStringGeometry _ _)) == (Some _) = False++  (Some (MultiPolygonGeometry g s)) == (Some (MultiPolygonGeometry g2 s2)) = g == g2 && s == s2+  (Some (MultiPolygonGeometry _ _)) == (Some _) = False+  (Some (CollectionGeometry g s)) == (Some (CollectionGeometry g2 s2)) = g == g2 && s == s2+  (Some (CollectionGeometry _ _)) == (Some _) = False+  (Some (LinearRingGeometry g s)) == (Some (LinearRingGeometry g2 s2)) = g == g2 && s == s2+  (Some (LinearRingGeometry _ _)) == (Some _) = False+ withSomeGeometry :: Some Geometry -> (forall a . Geometry a -> b) -> b withSomeGeometry (Some p) f = f p +-- | the same as `withSomeGeometry` with its arguments reversed.+mapSomeGeometry :: (forall a . Geometry a -> b) -> Some Geometry -> b+mapSomeGeometry f (Some p) = f p + instance Show (Some Geometry) where   show (Some a) = "Some (" <> show a <> ")" +data GeometryConstructionError+  = InvalidLinearRing+  | InvalidLineString+  | InvalidPolygon+ data Geometry a where   PointGeometry :: Point -> SRID -> Geometry Point   LineStringGeometry :: LineString -> SRID -> Geometry LineString@@ -75,17 +120,30 @@   MultiPointGeometry :: MultiPoint -> SRID -> Geometry MultiPoint   MultiLineStringGeometry :: MultiLineString -> SRID -> Geometry MultiLineString   MultiPolygonGeometry :: MultiPolygon -> SRID -> Geometry MultiPolygon-  {-CollectionGeometry :: GeometryCollection -> Geometry GeometryCollection-}+  CollectionGeometry :: GeometryCollection -> SRID -> Geometry GeometryCollection  deriving instance Eq (Geometry a) deriving instance Show (Geometry a) +{-| Coordinate is the lightweight class used to store coordinates. Coordinate objects are two-dimensional points, with an additional z-ordinate. +|-} data Coordinate =     Coordinate2 {-# UNPACK #-} !Double {-# UNPACK #-} !Double   | Coordinate3 {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Double-  deriving (Read, Ord, Show, Eq, Data, Typeable, Generic)+  deriving (Read, Ord, Eq, Data, Typeable, Generic) +instance Show Coordinate where+  show (Coordinate2 x y) = "(" ++ show x ++ ", " ++ show y ++ ")"+  show (Coordinate3 x y z) =+    "(" ++ show x ++ ", " ++ show y ++ ", " ++ show z ++ ")" ++coordinate2 :: Double -> Double -> Coordinate+coordinate2  = Coordinate2++coordinate3 :: Double -> Double -> Double -> Coordinate+coordinate3 = Coordinate3+ dimensionsCoordinate :: Coordinate -> Int dimensionsCoordinate = length . gmapQ (const ()) @@ -97,44 +155,94 @@ newtype Point = Point Coordinate  deriving (Read, Ord, Show, Eq, Data, Typeable, Generic) +point :: Coordinate -> Point+point = Point+ -- A LinearRing is a LineString that is closed-newtype LinearRing = LinearRing CoordinateSequence- deriving (Read, Ord, Show, Eq, Data, Typeable, Generic)+newtype LinearRing = LinearRing {+  coordinateSequenceLinearRing :: CoordinateSequence } deriving (Read, Ord, Eq, Data, Typeable, Generic) +instance Show LinearRing where+  show (LinearRing vec) = +    let inner = intercalate ", " $ show <$> V.toList vec+    in "[" ++ inner ++ "]"++linearRing :: CoordinateSequence -> Either GeometryConstructionError LinearRing+linearRing vec+  | 1 <= V.length vec && V.length vec < 4 = Left InvalidLinearRing+  | V.head vec /= V.last vec = Left InvalidLinearRing+  | otherwise = Right $ LinearRing vec+ instance Sem.Semigroup LinearRing where-  (<>) (LinearRing a) (LinearRing b) =  LinearRing (a <> b)+  (<>) (LinearRing a) (LinearRing b) = LinearRing (a <> b)  instance Monoid LinearRing where-  mempty  = LinearRing V.empty+  mempty = LinearRing V.empty -newtype LineString = LineString CoordinateSequence- deriving (Read, Ord, Show, Eq, Data, Typeable, Generic)+newtype LineString = LineString {+  coordinateSequenceLineString :: CoordinateSequence } deriving (Read, Ord, Eq, Data, Typeable, Generic) +instance Show LineString where+  show (LineString vec) = +    let inner = intercalate ", " $ show <$> V.toList vec+    in "[" ++ inner ++ "]"++lineString :: CoordinateSequence -> Either GeometryConstructionError LineString+lineString  vec+  | V.length vec == 1 = Left InvalidLineString+  | V.length vec == 2 && V.last vec == V.head vec = Left InvalidLineString+  | otherwise = Right $ LineString vec+ instance Sem.Semigroup LineString where-  (<>) (LineString a) (LineString b) =  LineString (a <> b)+  (<>) (LineString a) (LineString b) = LineString (a <> b)  instance Monoid LineString where-  mempty  = LineString V.empty+  mempty = LineString V.empty  -- | In a polygon, the fist LinearRing is the shell, and any following are holes. newtype Polygon = Polygon (V.Vector LinearRing)  deriving (Read, Ord, Show, Eq, Data, Typeable, Generic) +polygon :: V.Vector LinearRing -> Either GeometryConstructionError Polygon+polygon vec = +    let shell = maybe V.empty coordinateSequenceLinearRing $ vec V.!? 0+        holes = coordinateSequenceLinearRing <$> if V.null vec then V.empty else V.tail vec+    in +      do+        _ <- if V.null shell && V.any (not . V.null) holes then Left InvalidPolygon else Right ()+        return . Polygon  $ V.cons (LinearRing shell) (fmap LinearRing holes)+  + newtype MultiPoint = MultiPoint (V.Vector Point)  deriving (Read, Ord, Show, Eq, Data, Typeable, Generic) +multiPoint :: V.Vector Point -> MultiPoint+multiPoint = MultiPoint+ instance Sem.Semigroup MultiPoint where-  (<>) (MultiPoint a) (MultiPoint b) =  MultiPoint (a <> b)+  (<>) (MultiPoint a) (MultiPoint b) = MultiPoint (a <> b)  instance Monoid MultiPoint where-  mempty  = MultiPoint V.empty+  mempty = MultiPoint V.empty  newtype MultiLineString = MultiLineString (V.Vector LineString)  deriving (Read, Ord, Show, Eq, Data, Typeable, Generic) +multiLineString :: V.Vector LineString -> MultiLineString+multiLineString = MultiLineString+ newtype MultiPolygon = MultiPolygon (V.Vector Polygon)  deriving (Read, Ord, Show, Eq, Data, Typeable, Generic) +multiPolygon :: V.Vector Polygon -> MultiPolygon+multiPolygon = MultiPolygon++newtype GeometryCollection = GeometryCollection (V.Vector (Some Geometry))+ deriving (Show, Eq, Typeable, Generic)++geometryCollection :: V.Vector (Some Geometry) -> GeometryCollection+geometryCollection  = GeometryCollection+ -- | Returns the distance from the origin of LineString to the point projected on the geometry (that is to a point of the line the closest to the given point). project :: Geometry LineString -> Geometry Point -> Double project g1 g2 = runGeos $ do@@ -152,9 +260,9 @@ -- | Given a distance, returns the point (or closest point) within the geometry LineString that distance. interpolate :: Geometry LineString -> Double -> Geometry Point interpolate g d = runGeos $ do-  g' :: R.Geom <- convertGeometryToRaw  g-  s <- R.getSRID g'-  p <- convertPointFromRaw =<< (R.interpolate g' $ realToFrac d)+  g' :: R.Geom <- convertGeometryToRaw g+  s            <- R.getSRID g'+  p            <- convertPointFromRaw =<< R.interpolate g' ( realToFrac d)   return $ PointGeometry p s  @@ -163,32 +271,46 @@ interpolateNormalized g d = runGeos $ do   g' :: R.Geom <- convertGeometryToRaw g   s <- R.getSRID g'-  p <- convertPointFromRaw =<<  (R.interpolateNormalized g' $ realToFrac d)+  p <- convertPointFromRaw =<< R.interpolateNormalized g' ( realToFrac d)   return $ PointGeometry p s -binaryPredicate :: (R.GeomConst -> R.GeomConst -> Geos Bool)-                  -> Geometry a-                  -> Geometry b-                  -> Bool-binaryPredicate f g1 g2 = runGeos . join $ (f <$> convertGeometryToRaw g1 <*> convertGeometryToRaw g2)+binaryPredicate+  :: (R.GeomConst -> R.GeomConst -> Geos Bool)+  -> Geometry a+  -> Geometry b+  -> Bool+binaryPredicate f g1 g2 =+  runGeos . join $ (f <$> convertGeometryToRaw g1 <*> convertGeometryToRaw g2)  equals :: Geometry a -> Geometry a -> Bool equals = binaryPredicate R.equals  -- | Returns True if the two geometries are exactly equal, up to a specified tolerance. The tolerance value should be a floating point number representing the error tolerance in the comparison, e.g., @equalsExact g1 g2 0.001 @  will compare equality to within one thousandth of a unit. equalsExact :: Geometry a -> Geometry a -> Double -> Bool-equalsExact g1 g2 d = binaryPredicate (\g1' g2' -> R.equalsExact g1' g2' d) g1 g2+equalsExact g1 g2 d =+  binaryPredicate (\g1' g2' -> R.equalsExact g1' g2' d) g1 g2 -convertGeometryToRaw :: (R.Geometry a, R.CoordSeqInput a ~ cb, RC.CoordinateSequence cb) => Geometry b -> Geos a+convertGeometryToRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ cb, RC.CoordinateSequence cb)+  => Geometry b+  -> Geos a convertGeometryToRaw = \case-    PointGeometry pg s -> convertPointToRaw pg s-    LineStringGeometry lsg s -> convertLineStringToRaw lsg s-    LinearRingGeometry lg s -> convertLinearRingToRaw lg s-    PolygonGeometry pg s -> convertPolygonToRaw pg s-    MultiPointGeometry mp s -> convertMultiPointToRaw mp s-    MultiLineStringGeometry ml s -> convertMultiLineStringToRaw ml s-    MultiPolygonGeometry mp s -> convertMultiPolygonToRaw mp s+  PointGeometry           pg  s -> convertPointToRaw pg s+  LineStringGeometry      lsg s -> convertLineStringToRaw lsg s+  LinearRingGeometry      lg  s -> convertLinearRingToRaw lg s+  PolygonGeometry         pg  s -> convertPolygonToRaw pg s+  MultiPointGeometry      mp  s -> convertMultiPointToRaw mp s+  MultiLineStringGeometry ml  s -> convertMultiLineStringToRaw ml s+  MultiPolygonGeometry    mp  s -> convertMultiPolygonToRaw mp s+  CollectionGeometry      gc  s -> convertGeometryCollectionToRaw gc s +convertSomeGeometryToRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ cb, RC.CoordinateSequence cb)+  => Some Geometry+  -> Geos a+convertSomeGeometryToRaw sg = withSomeGeometry sg convertGeometryToRaw++ convertPointToRaw :: R.Geometry b => Point -> Maybe Int -> Geos b convertPointToRaw (Point c) s = do   cs <- RC.createEmptyCoordinateSequence 1 (dimensionsCoordinate c)@@ -197,156 +319,193 @@   convertLinearRingToRaw :: R.Geometry b => LinearRing -> SRID -> Geos b-convertLinearRingToRaw (LinearRing cs) s = do-  csr <- RC.createEmptyCoordinateSequence len (dimensionsCoordinateSequence cs)-  V.zipWithM_ (setCoordinateSequence csr) (V.enumFromN 0 len) cs-  R.createLinearRing csr >>= R.setSRID s-  where-    len = V.length cs+convertLinearRingToRaw =+  convertLineal coordinateSequenceLinearRing R.createLinearRing  convertLineStringToRaw :: R.Geometry b => LineString -> SRID -> Geos b-convertLineStringToRaw (LineString cs) s = do-  csr <- RC.createEmptyCoordinateSequence len (dimensionsCoordinateSequence cs)-  V.zipWithM_ (setCoordinateSequence csr) ( V.enumFromN 0 len) cs-  R.createLineString csr >>=  R.setSRID s-  where-    len = V.length cs+convertLineStringToRaw =+  convertLineal coordinateSequenceLineString R.createLineString+--+convertLineal+  :: R.Geometry b+  => (a -> CoordinateSequence)+  -> (RC.CoordSeqConst -> Geos b)+  -> a+  -> SRID+  -> Geos b+convertLineal getCoordSeq convertGeom geom srid = do+  let coordseq = getCoordSeq geom+      len      = V.length coordseq+  csr <- RC.createEmptyCoordinateSequence+    len+    (dimensionsCoordinateSequence coordseq)+  V.zipWithM_ (setCoordinateSequence csr) (V.enumFromN 0 len) coordseq+  convertGeom csr >>= R.setSRID srid  convertPolygonToRaw :: R.Geometry a => Polygon -> SRID -> Geos a convertPolygonToRaw (Polygon lrs) s = do   ext <- convertLinearRingToRaw (V.head lrs) s-  inn <- (flip convertLinearRingToRaw $ s) `V.mapM` V.tail lrs-  R.createPolygon ext (V.toList inn)  >>= R.setSRID s+  inn <- flip convertLinearRingToRaw s `V.mapM` V.tail lrs+  R.createPolygon ext (V.toList inn) >>= R.setSRID s  convertMultiPointToRaw :: R.Geometry a => MultiPoint -> SRID -> Geos a convertMultiPointToRaw (MultiPoint vp) s = do-  vr <- (flip convertPointToRaw $ s) `V.mapM` vp+  vr <- flip convertPointToRaw s `V.mapM` vp   R.createMultiPoint (V.toList vr) >>= R.setSRID s  convertMultiLineStringToRaw :: R.Geometry a => MultiLineString -> SRID -> Geos a convertMultiLineStringToRaw (MultiLineString vl) s = do-  vr <- (flip convertLineStringToRaw $ s) `V.mapM` vl+  vr <- flip convertLineStringToRaw s `V.mapM` vl   R.createMultiLineString (V.toList vr) >>= R.setSRID s  convertMultiPolygonToRaw :: R.Geometry a => MultiPolygon -> SRID -> Geos a convertMultiPolygonToRaw (MultiPolygon vp) s = do-  vr <- (flip convertPolygonToRaw $ s) `V.mapM` vp+  vr <- flip convertPolygonToRaw s `V.mapM` vp   R.createMultiPolygon (V.toList vr) >>= R.setSRID s -setCoordinateSequence :: RC.CoordinateSequence a => a -> Int -> Coordinate -> Geos ()+convertGeometryCollectionToRaw :: R.Geometry a => GeometryCollection -> SRID -> Geos a+convertGeometryCollectionToRaw (GeometryCollection vp) s = do+  vr <- convertSomeGeometryToRaw `V.mapM` vp+  R.createMultiPolygon (V.toList vr) >>= R.setSRID s+++++setCoordinateSequence+  :: RC.CoordinateSequence a => a -> Int -> Coordinate -> Geos () setCoordinateSequence cs i (Coordinate2 x y) =   RC.setCoordinateSequenceX cs i x >> RC.setCoordinateSequenceY cs i y  setCoordinateSequence cs i (Coordinate3 x y z) =-  RC.setCoordinateSequenceX cs i x >> RC.setCoordinateSequenceY cs i y >> RC.setCoordinateSequenceZ cs i z+  RC.setCoordinateSequenceX cs i x+    >> RC.setCoordinateSequenceY cs i y+    >> RC.setCoordinateSequenceZ cs i z  --- Conversions ---convertGeometryFromRaw :: (R.Geometry a, R.CoordSeqInput a ~ cb, RC.CoordinateSequence cb) => a -> Geos (Some Geometry)+convertGeometryFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ cb, RC.CoordinateSequence cb)+  => a+  -> Geos (Some Geometry) convertGeometryFromRaw rg = do-    s <- R.getSRID rg-    tid <- R.getTypeId rg-    case tid of-        R.PointTypeId -> do-          p <- convertPointFromRaw rg-          return $ Some $ (PointGeometry p s)-        R.LineStringTypeId -> do-          l <- convertLineStringFromRaw rg-          return $ Some (LineStringGeometry l s)-        R.LinearRingTypeId -> do-           l <- convertLinearRingFromRaw rg-           return $ Some (LinearRingGeometry l s)-        R.PolygonTypeId -> do-          p <- convertPolygonFromRaw rg-          return $ Some (PolygonGeometry p s)-        R.MultiPointTypeId -> do-          mp <- convertMultiPointFromRaw rg-          return $ Some (MultiPointGeometry mp s)-        R.MultiLineStringTypeId -> do-          ml <- convertMultiLineStringFromRaw rg-          return $ Some (MultiLineStringGeometry ml s)-        R.MultiPolygonTypeId -> do-          mp <- convertMultiPolygonFromRaw rg-          return $ Some (MultiPolygonGeometry mp s)-        R.GeometryCollectionTypeId -> error "GeometryCollection currently unsupported"+  s   <- R.getSRID rg+  tid <- R.getTypeId rg+  case tid of+    R.PointTypeId -> do+      p <- convertPointFromRaw rg+      return $ Some (PointGeometry p s)+    R.LineStringTypeId -> do+      l <- convertLineStringFromRaw rg+      return $ Some (LineStringGeometry l s)+    R.LinearRingTypeId -> do+      l <- convertLinearRingFromRaw rg+      return $ Some (LinearRingGeometry l s)+    R.PolygonTypeId -> do+      p <- convertPolygonFromRaw rg+      return $ Some (PolygonGeometry p s)+    R.MultiPointTypeId -> do+      mp <- convertMultiPointFromRaw rg+      return $ Some (MultiPointGeometry mp s)+    R.MultiLineStringTypeId -> do+      ml <- convertMultiLineStringFromRaw rg+      return $ Some (MultiLineStringGeometry ml s)+    R.MultiPolygonTypeId -> do+      mp <- convertMultiPolygonFromRaw rg+      return $ Some (MultiPolygonGeometry mp s)+    R.GeometryCollectionTypeId -> do+      gc <- convertGeometryCollectionFromRaw rg+      return $ Some (CollectionGeometry gc s)   -- The following methods are useful when the type of a (Some Geometry) is known a priori -- (i.e. the result of calling centroid is always a point) -ensurePoint :: Some Geometry -> Geometry Point-ensurePoint g = withSomeGeometry g $ \g' -> case g' of-  PointGeometry _ _ -> g'-  _ -> error "This geometry was expected to be a Point"+ensurePoint :: Some Geometry -> Maybe (Geometry Point)+ensurePoint = mapSomeGeometry $ \case+  g@(PointGeometry _ _) -> Just g+  _                     -> Nothing -ensureLineString :: Some Geometry -> Geometry LineString-ensureLineString g = withSomeGeometry g $ \g' -> case g' of-  LineStringGeometry _ _ -> g'-  _ -> error "This geometry was expected to be a LineString"+ensureLineString :: Some Geometry -> Maybe (Geometry LineString)+ensureLineString = mapSomeGeometry $ \case+  g@(LineStringGeometry _ _) -> Just g+  _                          -> Nothing -ensureLinearRing :: Some Geometry -> Geometry LinearRing-ensureLinearRing g = withSomeGeometry g $ \g' -> case g' of-  LinearRingGeometry _ _ -> g'-  _ -> error "This geometry was expected to be a LinearRing"+ensureLinearRing :: Some Geometry -> Maybe (Geometry LinearRing)+ensureLinearRing = mapSomeGeometry $ \case+  g@(LinearRingGeometry _ _) -> Just g+  _                          -> Nothing -ensurePolygon :: Some Geometry -> Geometry Polygon-ensurePolygon g = withSomeGeometry g $ \g' -> case g' of-  PolygonGeometry _ _  -> g'-  _ -> error "This geometry was expected to be a Polygon"+ensurePolygon :: Some Geometry -> Maybe (Geometry Polygon)+ensurePolygon = mapSomeGeometry $ \case+  g@(PolygonGeometry _ _) -> Just g+  _                       -> Nothing -ensureMultiPoint :: Some Geometry -> Geometry MultiPoint-ensureMultiPoint g = withSomeGeometry g $ \p' -> case p' of-  MultiPointGeometry _ _ -> p'-  _ -> error "This geometry was expected to be a MultiPoint"+ensureMultiPoint :: Some Geometry -> Maybe (Geometry MultiPoint)+ensureMultiPoint = mapSomeGeometry $ \case+  g@(MultiPointGeometry _ _) -> Just g+  _                          -> Nothing -ensureMultiLineString :: Some Geometry -> Geometry MultiLineString-ensureMultiLineString g = withSomeGeometry g $ \p' -> case p' of-  MultiLineStringGeometry _ _ -> p'-  _ -> error "This geometry was expected to be a MultiLineString"+ensureMultiLineString :: Some Geometry -> Maybe (Geometry MultiLineString)+ensureMultiLineString = mapSomeGeometry $ \case+  g@(MultiLineStringGeometry _ _) -> Just g+  _                               -> Nothing -ensureMultiPolygon :: Some Geometry -> Geometry MultiPolygon-ensureMultiPolygon g = withSomeGeometry g $ \p' -> case p' of-  MultiPolygonGeometry _ _ -> p'-  _ -> error "This geometry was expected to be a MultiPolygon"+ensureMultiPolygon :: Some Geometry -> Maybe (Geometry MultiPolygon)+ensureMultiPolygon = mapSomeGeometry $ \case+  g@(MultiPolygonGeometry _ _) -> Just g+  _                            -> Nothing +ensureGeometryCollection :: Some Geometry -> Maybe (Geometry GeometryCollection)+ensureGeometryCollection = mapSomeGeometry $ \case+  g@(CollectionGeometry _ _) -> Just g+  _ -> Nothing  getPosition :: RC.CoordinateSequence a => a -> Int -> Geos Coordinate-getPosition cs i =  do-    dim <- RC.getCoordinateSequenceDimensions cs-    x <- RC.getCoordinateSequenceX cs i-    y <- RC.getCoordinateSequenceY cs i-    z <- if dim == 3-              then Just <$> RC.getCoordinateSequenceZ cs i-              else return Nothing-    case z of-      Nothing -> return $ Coordinate2 x y-      Just z' -> return $ Coordinate3 x y z'+getPosition cs i = do+  dim <- RC.getCoordinateSequenceDimensions cs+  x   <- RC.getCoordinateSequenceX cs i+  y   <- RC.getCoordinateSequenceY cs i+  z   <- if dim == 3+    then Just <$> RC.getCoordinateSequenceZ cs i+    else return Nothing+  case z of+    Nothing -> return $ Coordinate2 x y+    Just z' -> return $ Coordinate3 x y z' -convertPointFromRaw :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)  => a -> Geos Point+convertPointFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos Point convertPointFromRaw g = do   cs <- R.getCoordinateSequence g   Point <$> getPosition cs 0  -convertSequenceFromRaw ::  (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)-                        =>  a -> Geos CoordinateSequence+convertSequenceFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos CoordinateSequence convertSequenceFromRaw g = do-  cs  <- R.getCoordinateSequence g+  cs   <- R.getCoordinateSequence g   size <- R.getNumCoordinates g   V.generateM size (getPosition cs) -convertLineStringFromRaw :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)-                          => a -> Geos LineString+convertLineStringFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos LineString convertLineStringFromRaw g = LineString <$> convertSequenceFromRaw g -convertLinearRingFromRaw ::  (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)-                          => a -> Geos LinearRing+convertLinearRingFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos LinearRing convertLinearRingFromRaw g = LinearRing <$> convertSequenceFromRaw g  convertPolygonFromRaw :: R.Geometry a => a -> Geos Polygon convertPolygonFromRaw g = do-  is <- R.getNumInteriorRings g-  ext :: R.GeomConst <- R.getExteriorRing g+  is                          <- R.getNumInteriorRings g+  ext :: R.GeomConst          <- R.getExteriorRing g   ins :: V.Vector R.GeomConst <- V.generateM is (R.getInteriorRingN g)   Polygon <$> convertLinearRingFromRaw `V.mapM` (ext `V.cons` ins) @@ -354,36 +513,53 @@ Enforces using GeomConst for following functions  -}-getGeometryN  :: R.Geometry a => a -> Int -> Geos R.GeomConst+getGeometryN :: R.Geometry a => a -> Int -> Geos R.GeomConst getGeometryN = R.getGeometryN -convertMultiPointFromRaw :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca) => a -> Geos MultiPoint+convertMultiPointFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos MultiPoint convertMultiPointFromRaw g = do   ng <- R.getNumGeometries g-  MultiPoint <$> V.generateM ng (\i -> convertPointFromRaw =<< getGeometryN g i )+  MultiPoint <$> V.generateM ng (convertPointFromRaw <=< getGeometryN g) -convertMultiLineStringFromRaw :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca) => a -> Geos MultiLineString+convertMultiLineStringFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos MultiLineString convertMultiLineStringFromRaw g = do   ng <- R.getNumGeometries g-  MultiLineString <$> V.generateM ng (\i -> convertLineStringFromRaw =<< getGeometryN g i)+  MultiLineString+    <$> V.generateM ng (convertLineStringFromRaw <=< getGeometryN g) -convertMultiPolygonFromRaw :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca) => a -> Geos MultiPolygon+convertMultiPolygonFromRaw+  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos MultiPolygon convertMultiPolygonFromRaw g = do   ng <- R.getNumGeometries g-  MultiPolygon <$> V.generateM ng (\i -> convertPolygonFromRaw =<< getGeometryN g i)+  MultiPolygon <$> V.generateM ng (convertPolygonFromRaw <=< getGeometryN g) -area  :: Geometry a -> Double++convertGeometryCollectionFromRaw +  :: (R.Geometry a, R.CoordSeqInput a ~ ca, RC.CoordinateSequence ca)+  => a+  -> Geos GeometryCollection+convertGeometryCollectionFromRaw g = do+  ng <- R.getNumGeometries g+  GeometryCollection <$> V.generateM ng (convertGeometryFromRaw <=< getGeometryN g)++area :: Geometry a -> Double area g = runGeos $ do   r :: R.Geom <- convertGeometryToRaw g-  d <- R.area r-  return d+  R.area r  -- | Returns the length of this geometry (e.g., 0 for a Point, the length of a LineString, or the circumference of a Polygon). geometryLength :: Geometry a -> Double geometryLength g = runGeos $ do   r :: R.Geom <- convertGeometryToRaw g-  l <- R.geometryLength r-  return l+  R.geometryLength r  -- | NOTE: @distance@ calculations are linear – in other words, @distance@ does not perform a spherical calculation even if the SRID specifies a geographic coordinate system. distance :: Geometry a -> Geometry a -> Double@@ -401,11 +577,11 @@ -- | Returns the closest points of the two geometries. The first point comes from g1 geometry and the second point comes from g2. nearestPoints :: Geometry a -> Geometry a -> (Coordinate, Coordinate) nearestPoints g1 g2 = runGeos $ do-  g1' :: R.Geom <- convertGeometryToRaw g1-  g2' :: R.Geom <- convertGeometryToRaw g2+  g1' :: R.Geom     <- convertGeometryToRaw g1+  g2' :: R.Geom     <- convertGeometryToRaw g2   cs :: RC.CoordSeq <- R.nearestPoints g1' g2'-  p1 <- getPosition cs 0-  p2 <- getPosition cs 1+  p1                <- getPosition cs 0+  p2                <- getPosition cs 1   return (p1, p2)  

@@ -9,48 +9,33 @@  -} -module Data.Geometry.Geos.Prepared (-    prepare-  , contains+module Data.Geometry.Geos.Prepared+  ( prepare   , containsProperly-  , coveredBy-  , covers-  , crosses-  , disjoint-  , intersects-  , overlaps-  , touches-  , within-) where+  , queryPrepared+  , RP.PreparedGeometry+  )+where  import qualified Data.Geometry.Geos.Raw.Prepared as RP import qualified Data.Geometry.Geos.Raw.Geometry as RG-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry (Geometry(..), convertGeometryToRaw)-import Data.Geometry.Geos.Relatable+import           Data.Geometry.Geos.Raw.Base+import           Data.Geometry.Geos.Geometry    ( Geometry(..)+                                                , convertGeometryToRaw+                                                )  prepare :: Geometry a -> RP.PreparedGeometry prepare g = runGeos $ do   r :: RG.Geom <- convertGeometryToRaw g   RP.prepare r --queryPrepared :: (RP.PreparedGeometry -> RG.GeomConst -> Geos Bool)-              -> RP.PreparedGeometry-              -> Geometry b-              -> Bool+queryPrepared+  :: (RP.PreparedGeometry -> RG.GeomConst -> Geos Bool)+  -> RP.PreparedGeometry+  -> Geometry b+  -> Bool queryPrepared f pg g = runGeos $ convertGeometryToRaw g >>= f pg -instance Relatable (RP.PreparedGeometry) where-  contains   = queryPrepared RP.contains-  coveredBy  = queryPrepared RP.coveredBy-  covers     = queryPrepared RP.covers-  crosses    = queryPrepared RP.crosses-  disjoint   = queryPrepared RP.disjoint-  intersects = queryPrepared RP.intersects-  overlaps   = queryPrepared RP.overlaps-  touches    = queryPrepared RP.touches-  within     = queryPrepared RP.within  {-| The containsProperly predicate has the following equivalent definitions:@@ -63,7 +48,5 @@  -} -containsProperly :: RP.PreparedGeometry-                  -> Geometry a-                  -> Bool+containsProperly :: RP.PreparedGeometry -> Geometry a -> Bool containsProperly = queryPrepared RP.containsProperly

@@ -1,39 +1,131 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes, FlexibleContexts, TypeSynonymInstances, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses #-} -module Data.Geometry.Geos.Raw.Base (-    Geos-  , runGeos  +module Data.Geometry.Geos.Raw.Base+  ( Geos+  , runGeos+  , runGeosE+  , runGeosM   , throwIfZero+  , throwIfZero'+  , throwIfNull+  , throwIfNull'+  , throwIf+  , throwIf'   , withGeos+  , withGeos'   , mkErrorMessage-) where+  , marshallInt+  , marshallDouble+  , geosUnit+  )+where -import qualified Data.Geometry.Geos.Raw.Internal as I-import Foreign-import Data.Monoid ((<>))-import System.IO.Unsafe-import qualified Control.Concurrent.MVar as MV-import Control.Monad.Reader+import qualified Data.Geometry.Geos.Raw.Internal+                                               as I+import           Foreign                 hiding ( throwIf+                                                , throwIfNull+                                                )+import           Data.Monoid                    ( (<>) )+import           System.IO.Unsafe+import qualified Control.Concurrent.MVar       as MV+import           Control.Monad.Reader+import           Control.Monad.Trans.Reader+import           Control.Monad.Trans.Except+import           Control.Monad.Error.Class + newtype GEOSHandle = GEOSHandle (MV.MVar (ForeignPtr I.GEOSContextHandle_HS)) -newtype Geos a = Geos { unGeos :: ReaderT GEOSHandle IO a }++-- | Geos is the core context for performing geometric calculations. It handles the foreign function interface as well as error handling. All underlying geos exceptions are represented by a String. +newtype Geos a = Geos {+  unGeos :: ReaderT GEOSHandle (ExceptT String IO) a+}   deriving (MonadReader GEOSHandle, Monad, Functor, Applicative) -- don't derive MonadIO to restrict user from performing arbitrary IO+-- +geosUnit :: Geos ()+geosUnit = pure ()++instance MonadError String Geos where+  throwError = Geos . lift . throwError+  catchError m f = Geos $ liftCatch catchError (unGeos m) (unGeos . f)+ withGeos :: (I.GEOSContextHandle_t -> IO a) -> Geos a-withGeos f = Geos . ReaderT $ \(GEOSHandle mv) -> MV.withMVar mv $ \fp -> withForeignPtr fp f+withGeos f = Geos . ReaderT $ \(GEOSHandle mv) ->+  ExceptT $ MV.withMVar mv $ \fp -> Right <$> withForeignPtr fp f +withGeos' :: (I.GEOSContextHandle_t -> IO (Either String a)) -> Geos a+withGeos' f = Geos . ReaderT $ \(GEOSHandle mv) ->+  ExceptT $ MV.withMVar mv $ \fp -> withForeignPtr fp f+++-- | Unsafe function for performing a geos calculation. Errors will cause runtime exceptions. runGeos :: Geos a -> a-runGeos g = unsafePerformIO $ do+runGeos action = case runGeosE action of+  Right v -> v+  Left  e -> error e++-- | A safe function for performing a geos calculation and returning a Maybe. Exceptions will be represented as Nothing.+runGeosM :: Geos a -> Maybe a+runGeosM action = case runGeosE action of+  Right v -> Just v+  Left  _ -> Nothing++-- | A safe function for performing a geos calculation and returning an Either String a. Exceptions are reprsented as `Left String`+runGeosE :: Geos a -> Either String a+runGeosE g = unsafePerformIO $ do   ptrC <- I.geos_init   fptr <- newForeignPtr I.geos_finish ptrC-  mv <- MV.newMVar fptr-  runReaderT (unGeos g) $ GEOSHandle mv-  +  mv   <- MV.newMVar fptr+  runExceptT $ runReaderT (unGeos g) $ GEOSHandle mv -throwIfZero :: (Eq a, Num a) => (a -> String) -> IO a -> IO a-throwIfZero = throwIf ((==) 0) -mkErrorMessage :: Show a => String -> (a -> String) -mkErrorMessage s = \n -> s  <> " has thrown an error:  " <> show n+throwIf :: (Eq a, MonadError e m) => (a -> Bool) -> (a -> e) -> m a -> m a+throwIf predicate mkError action = do+  val <- action+  if predicate val then throwError $ mkError val else return val++throwIf'+  :: (Eq a, Monad m, MonadError e me)+  => (a -> Bool)+  -> (a -> e)+  -> m a+  -> m (me a)+throwIf' predicate mkError action = do+  val <- action+  if predicate val+    then return $ throwError $ mkError val+    else return $ return val++++throwIfZero :: (Eq a, Num a, MonadError e m) => (a -> e) -> m a -> m a+throwIfZero = throwIf (0 ==)++++throwIfZero' :: (Eq a, Num a, Monad m) => (a -> e) -> m a -> m (Either e a)+throwIfZero' = throwIf' (0 ==)++++throwIfNull :: MonadError String m => String -> m (Ptr a) -> m (Ptr a)+throwIfNull location =+  throwIf (nullPtr ==) (\_ -> "Encountered null pointer at: " <> location)++throwIfNull' :: Monad m => String -> m (Ptr a) -> m (Either String (Ptr a))+throwIfNull' location =+  throwIf' (nullPtr ==) (\_ -> "Encountered null pointer at: " <> location)+++marshallDouble :: (Real r, Storable r) => Ptr r -> IO Double+marshallDouble = fmap realToFrac . peek+++marshallInt :: (Integral i, Storable i) => Ptr i -> IO Int+marshallInt = fmap fromIntegral . peek++mkErrorMessage :: Show a => String -> (a -> String)+mkErrorMessage s n = s <> " has thrown an error:  " <> show n

@@ -1,5 +1,5 @@-module Data.Geometry.Geos.Raw.Buffer (-    BufferParams+module Data.Geometry.Geos.Raw.Buffer+  ( BufferParams   , withBufferParams   , BufferCapStyle   , BufferJoinStyle@@ -18,20 +18,25 @@   , joinRound   , joinMitre   , joinBevel-)  where-import Data.Geometry.Geos.Raw.Internal -import qualified Data.Geometry.Geos.Raw.Geometry as RG-import Data.Geometry.Geos.Raw.Base-import Foreign+  )+where+import           Data.Geometry.Geos.Raw.Internal+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as RG+import           Data.Geometry.Geos.Raw.Base+import           Foreign                 hiding ( throwIfNull+                                                , void+                                                )+import           Control.Monad                  ( void )  newtype BufferParams =  BufferParams (ForeignPtr GEOSBufferParams) deriving (Show, Eq)  -withBufferParams :: BufferParams -> (Ptr GEOSBufferParams -> IO a ) -> IO a-withBufferParams (BufferParams g) f = withForeignPtr g f+withBufferParams :: BufferParams -> (Ptr GEOSBufferParams -> IO a) -> IO a+withBufferParams (BufferParams g) = withForeignPtr g  -createBufferParams :: Geos BufferParams +createBufferParams :: Geos BufferParams createBufferParams = withGeos $ \h -> do   bp <- geos_BufferParamsCreate h   fp <- newForeignPtrEnv geos_BufferParamsDestroy h bp@@ -39,55 +44,73 @@   setEndCapStyle :: BufferParams -> BufferCapStyle -> Geos ()-setEndCapStyle b s = withGeos $ \h -> do-  _ <- throwIfZero (mkErrorMessage "setEndCapStyle") $ withBufferParams b $ \bp -> -      geos_BufferParamsSetEndCapStyle h bp $ unBufferCapStyle s  -  return ()+setEndCapStyle b s =+  void $ throwIfZero (mkErrorMessage "setEndCapStyle") $ withGeos $ \h ->+    withBufferParams b+      $ \bp -> geos_BufferParamsSetEndCapStyle h bp $ unBufferCapStyle s + setJoinStyle :: BufferParams -> BufferJoinStyle -> Geos ()-setJoinStyle b s = withGeos $ \h -> do-  _ <- throwIfZero (mkErrorMessage "setJoinStyle") $ withBufferParams b $ \bp -> -      geos_BufferParamsSetJoinStyle h bp $ unBufferJoinStyle s  -  return ()+setJoinStyle b s =+  void $ throwIfZero (mkErrorMessage "setJoinStyle") $ withGeos $ \h ->+    withBufferParams b+      $ \bp -> geos_BufferParamsSetJoinStyle h bp $ unBufferJoinStyle s   setMitreLimit :: BufferParams -> Double -> Geos ()-setMitreLimit b d = withGeos $ \h -> do-  _ <- throwIfZero (mkErrorMessage "setJoinStyle") $ withBufferParams b $ \bp -> -      geos_BufferParamsSetMitreLimit h bp $ realToFrac d  -  return ()+setMitreLimit b d =+  void $ throwIfZero (mkErrorMessage "setJoinStyle") $ withGeos $ \h ->+    withBufferParams b+      $ \bp -> geos_BufferParamsSetMitreLimit h bp $ realToFrac d  setQuadrantSegments :: BufferParams -> Int -> Geos ()-setQuadrantSegments b i = withGeos $ \h -> do-  _ <- throwIfZero (mkErrorMessage "setJoinStyle") $ withBufferParams b $ \bp -> -      geos_BufferParamsSetQuadrantSegments h bp $ fromIntegral i -  return ()+setQuadrantSegments b i =+  void $ throwIfZero (mkErrorMessage "setJoinStyle") $ withGeos $ \h ->+    withBufferParams b+      $ \bp -> geos_BufferParamsSetQuadrantSegments h bp $ fromIntegral i  setSingleSided :: BufferParams -> Bool -> Geos ()-setSingleSided bp b = withGeos $ \h -> do-  _ <- throwIfZero (mkErrorMessage "setSingleSided") $ withBufferParams bp $ \bpp ->-    geos_BufferParamsSetSingleSided h bpp $ fromBool b-  return ()+setSingleSided bp b =+  void $ throwIfZero (mkErrorMessage "setSingleSided") $ withGeos $ \h ->+    withBufferParams bp+      $ \bpp -> geos_BufferParamsSetSingleSided h bpp $ fromBool b  buffer :: RG.Geometry a => a -> BufferParams -> Double -> Geos a-buffer g b width = -  withGeos $ \h -> do-    RG.withGeometry g $ \gp ->-      withBufferParams b $ \bp ->  do-        g' <- throwIfNull "bufferWithParams" $ geos_BufferWithParams h gp bp $ realToFrac width-        RG.constructGeometry h g'+buffer g b width = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "bufferWithParams" $ RG.withGeometry g $ \gp ->+    withBufferParams b $ flip (geos_BufferWithParams h gp) $ realToFrac width+  traverse (RG.constructGeometry h) eitherPtr -bufferWithStyle :: RG.Geometry a => a -> Double -> Int -> BufferCapStyle -> BufferJoinStyle -> Double -> Geos a-bufferWithStyle g width quadsegs capstyle joinstyle mitrelimit = -  withGeos $ \h -> -    RG.withGeometry g $ \gp -> do-      ptr <- throwIfNull "bufferWithStyle" $ geos_BufferWithStyle h gp (realToFrac width) (fromIntegral quadsegs) (unBufferCapStyle capstyle) (unBufferJoinStyle joinstyle) $ realToFrac mitrelimit-      RG.constructGeometry h ptr+bufferWithStyle+  :: RG.Geometry a+  => a+  -> Double+  -> Int+  -> BufferCapStyle+  -> BufferJoinStyle+  -> Double+  -> Geos a+bufferWithStyle g width quadsegs capstyle joinstyle mitrelimit =+  withGeos' $ \h -> do+    eitherPtr <- throwIfNull' "bufferWithStyle" $ RG.withGeometry g $ \gp ->+      geos_BufferWithStyle h+                           gp+                           (realToFrac width)+                           (fromIntegral quadsegs)+                           (unBufferCapStyle capstyle)+                           (unBufferJoinStyle joinstyle)+        $ realToFrac mitrelimit+    traverse (RG.constructGeometry h) eitherPtr  -- | Will only accept LineString geometries. For the 'width' parameter, negative doubles represent a right-side offset, and positive doubles represent a left-side offset. -offsetCurve :: RG.Geometry a => a -> Double -> Int -> BufferJoinStyle -> Double -> Geos a-offsetCurve g width quadsegs joinstyle mitrelimit = -  withGeos $ \h -> -    RG.withGeometry g $ \gp -> do-      ptr <- throwIfNull "offsetCurve" $ geos_OffsetCurve h gp (realToFrac width) (fromIntegral quadsegs) (unBufferJoinStyle joinstyle) $ realToFrac mitrelimit-      RG.constructGeometry h ptr+offsetCurve+  :: RG.Geometry a => a -> Double -> Int -> BufferJoinStyle -> Double -> Geos a+offsetCurve g width quadsegs joinstyle mitrelimit = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "offsetCurve" $ RG.withGeometry g $ \gp ->+    geos_OffsetCurve h+                     gp+                     (realToFrac width)+                     (fromIntegral quadsegs)+                     (unBufferJoinStyle joinstyle)+      $ realToFrac mitrelimit+  traverse (RG.constructGeometry h) eitherPtr

@@ -1,9 +1,9 @@ {-# LANGUAGE FlexibleInstances #-} -module Data.Geometry.Geos.Raw.CoordSeq (-    CoordinateSequence (..)-  , CoordSeqConst (CoordSeqConst)-  , CoordSeq (CoordSeq)+module Data.Geometry.Geos.Raw.CoordSeq+  ( CoordinateSequence(..)+  , CoordSeqConst(CoordSeqConst)+  , CoordSeq(CoordSeq)   , getCoordinateSequenceX   , getCoordinateSequenceY   , getCoordinateSequenceZ@@ -13,22 +13,26 @@   , setCoordinateSequenceY   , setCoordinateSequenceZ   , setCoordinateSequenceOrd-) where+  )+where -import qualified Data.Geometry.Geos.Raw.Internal as I-import Data.Geometry.Geos.Raw.Base-import Foreign-import Foreign.C.Types-import Control.Monad+import qualified Data.Geometry.Geos.Raw.Internal+                                               as I+import           Data.Geometry.Geos.Raw.Base+import           Foreign                 hiding ( throwIfNull+                                                , void+                                                )+import           Foreign.C.Types+import           Control.Monad  class CoordinateSequence a where   withCoordinateSequence :: a -> (Ptr I.GEOSCoordSequence -> IO b) -> IO b   createEmptyCoordinateSequence :: Int -> Int -> Geos a   createCoordinateSequence :: Ptr I.GEOSCoordSequence -> Geos a -   -newtype CoordSeq = CoordSeq { ++newtype CoordSeq = CoordSeq {   _unCoordSeq :: ForeignPtr I.GEOSCoordSequence } newtype CoordSeqConst = CoordSeqConst {@@ -48,21 +52,21 @@   da <- getCoordinateSequenceDimensions a   db <- getCoordinateSequenceDimensions b   if (sa == sb) && (da == db)-      then foldM (comp (da == 3)) True [0..(sa-1)]-      else return False-  where-    comp zdim acc i = do-      xa <- getCoordinateSequenceX a i-      ya <- getCoordinateSequenceY a i-      xb <- getCoordinateSequenceX b i-      yb <- getCoordinateSequenceY b i-      zd <- if zdim-            then do-              za <- getCoordinateSequenceZ a i-              zb <- getCoordinateSequenceZ b i-              return $ za == zb-             else return True-      return $ (xa == xb)  && (ya == yb) && acc && zd+    then foldM (comp (da == 3)) True [0 .. (sa - 1)]+    else return False+ where+  comp zdim acc i = do+    xa <- getCoordinateSequenceX a i+    ya <- getCoordinateSequenceY a i+    xb <- getCoordinateSequenceX b i+    yb <- getCoordinateSequenceY b i+    zd <- if zdim+      then do+        za <- getCoordinateSequenceZ a i+        zb <- getCoordinateSequenceZ b i+        return $ za == zb+      else return True+    return $ (xa == xb) && (ya == yb) && acc && zd  instance Show CoordSeq where   show = coordSeqShow@@ -73,48 +77,55 @@ coordSeqShow :: CoordinateSequence a => a -> String coordSeqShow a = runGeos $ do   sa <- getCoordinateSequenceSize a-  unlines `fmap` mapM show' [0..(sa-1)]-  where-    show' i = do-      xa <- getCoordinateSequenceX a i-      ya <- getCoordinateSequenceY a i-      return . show $ (xa, ya)-    +  unlines `fmap` mapM show' [0 .. (sa - 1)]+ where+  show' i = do+    xa <- getCoordinateSequenceX a i+    ya <- getCoordinateSequenceY a i+    return . show $ (xa, ya) + instance CoordinateSequence CoordSeq where-  withCoordinateSequence (CoordSeq fp) f = withForeignPtr fp f+  withCoordinateSequence (CoordSeq fp) = withForeignPtr fp   createEmptyCoordinateSequence size dim = do-    ptr <- withGeos $ \h ->-      throwIfNull "createEmptyCoordinateSequence" $ I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)+    ptr <- throwIfNull "createEmptyCoordinateSequence" $ withGeos $ \h ->+      I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)     createCoordinateSequence ptr    createCoordinateSequence ptr = withGeos $ \h -> do-      fptr <- newForeignPtrEnv I.geos_CoordSeqDestroy h ptr-      return $ CoordSeq fptr+    fptr <- newForeignPtrEnv I.geos_CoordSeqDestroy h ptr+    return $ CoordSeq fptr  instance CoordinateSequence CoordSeqConst where   withCoordinateSequence (CoordSeqConst p) f = f p   createEmptyCoordinateSequence size dim = do-    ptr <- withGeos $ \h ->-      throwIfNull "createEmptyCoordinateSequence" $ I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)+    ptr <- throwIfNull "createEmptyCoordinateSequence" $ withGeos $ \h ->+      I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)+     createCoordinateSequence ptr   createCoordinateSequence ptr = return $ CoordSeqConst ptr    -getCoordinateSequenceD_ :: CoordinateSequence a -                          => (I.GEOSContextHandle_t -> Ptr I.GEOSCoordSequence -> CUInt -> Ptr CDouble -> IO CInt) -                          -> a-                          -> Int-                          -> Geos Double -getCoordinateSequenceD_ f cs idx = withGeos $ \h -> -  alloca $ \dptr -> do-    _ <- throwIfZero (mkErrorMessage "getCoordiniateSequenceN") $-          withCoordinateSequence cs $ \pcs -> f h pcs (fromIntegral idx) dptr-    d <- peek dptr-    return $ realToFrac d-  +getCoordinateSequenceD_+  :: CoordinateSequence a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSCoordSequence+     -> CUInt+     -> Ptr CDouble+     -> IO CInt+     )+  -> a+  -> Int+  -> Geos Double+getCoordinateSequenceD_ f cs idx = withGeos' $ \h -> alloca $ \dptr -> do+  eitherRet <-+    throwIfZero' (mkErrorMessage "getCoordiniateSequenceN")+    $ withCoordinateSequence cs+    $ \pcs -> f h pcs (fromIntegral idx) dptr+  traverse (\_ -> marshallDouble dptr) eitherRet+ getCoordinateSequenceX :: CoordinateSequence a => a -> Int -> Geos Double getCoordinateSequenceX = getCoordinateSequenceD_ I.geos_CoordSeqGetX @@ -124,36 +135,41 @@ getCoordinateSequenceZ :: CoordinateSequence a => a -> Int -> Geos Double getCoordinateSequenceZ = getCoordinateSequenceD_ I.geos_CoordSeqGetZ -getCoordinateSequenceSize :: CoordinateSequence a => a -> Geos Int -getCoordinateSequenceSize c =  withGeos $ \h -> -  alloca $ \ptr -> do-    _ <- throwIfZero (mkErrorMessage "getCoordinateSequenceSize") $ -          withCoordinateSequence c $ \pc ->-            I.geos_CoordSeqGetSize h pc ptr-    s <- peek ptr-    return $ fromIntegral s+getCoordinateSequenceSize :: CoordinateSequence a => a -> Geos Int+getCoordinateSequenceSize c = withGeos' $ \h -> alloca $ \ptr -> do+  eitherRet <-+    throwIfZero' (mkErrorMessage "getCoordinateSequenceSize")+    $ withCoordinateSequence c+    $ \pc -> I.geos_CoordSeqGetSize h pc ptr+  traverse (\_ -> marshallInt ptr) eitherRet -getCoordinateSequenceDimensions :: CoordinateSequence a => a -> Geos Int -getCoordinateSequenceDimensions c = withGeos $ \h -> -  alloca $ \ptr -> do-    _ <- throwIfZero (mkErrorMessage "getCoordinateSeqenceDimensions") $ -            withCoordinateSequence c $ \pc ->-              I.geos_CoordSeqGetDimensions h pc ptr-    s <- peek ptr-    return $ fromIntegral s+getCoordinateSequenceDimensions :: CoordinateSequence a => a -> Geos Int+getCoordinateSequenceDimensions c = withGeos' $ \h -> alloca $ \ptr -> do+  eitherRet <-+    throwIfZero' (mkErrorMessage "getCoordinateSeqenceDimensions")+    $ withCoordinateSequence c+    $ \pc -> I.geos_CoordSeqGetDimensions h pc ptr+  traverse (\_ -> marshallInt ptr) eitherRet  ----setCoordinateSequence_ ::  CoordinateSequence a -                        => (I.GEOSContextHandle_t -> Ptr I.GEOSCoordSequence -> CUInt -> CDouble -> IO CInt) -                        -> a -                        -> Int -                        -> Double -                        -> Geos ()-setCoordinateSequence_ f cs idx val = withGeos $ \h -> do-  _ <- throwIfZero (mkErrorMessage "setCoordinateSEquenceN") $ -        withCoordinateSequence cs $ \pcs -> -          f h pcs (fromIntegral idx) (realToFrac val)-  return  ()+setCoordinateSequence_+  :: CoordinateSequence a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSCoordSequence+     -> CUInt+     -> CDouble+     -> IO CInt+     )+  -> a+  -> Int+  -> Double+  -> Geos ()+setCoordinateSequence_ f cs idx val =+  void+    $ throwIfZero (mkErrorMessage "setCoordinateSEquenceN")+    $ withGeos+    $ \h -> withCoordinateSequence cs+        $ \pcs -> f h pcs (fromIntegral idx) (realToFrac val)   setCoordinateSequenceX :: CoordinateSequence a => a -> Int -> Double -> Geos ()@@ -162,12 +178,18 @@ setCoordinateSequenceY :: CoordinateSequence a => a -> Int -> Double -> Geos () setCoordinateSequenceY = setCoordinateSequence_ I.geos_CoordSeqSetY -setCoordinateSequenceZ :: CoordinateSequence a => a -> Int -> Double -> Geos () +setCoordinateSequenceZ :: CoordinateSequence a => a -> Int -> Double -> Geos () setCoordinateSequenceZ = setCoordinateSequence_ I.geos_CoordSeqSetZ -setCoordinateSequenceOrd :: CoordinateSequence a => a -> Int -> Int  -> Double -> Geos Int-setCoordinateSequenceOrd cs idx dim v = withGeos $ \h -> do-  i <- throwIfZero (mkErrorMessage "setCoordinateSequenceN") $ -          withCoordinateSequence cs $ \pcs -> -            I.geos_CoordSeqSetOrdinate h pcs (fromIntegral idx) (fromIntegral dim) (realToFrac v)-  return $ fromIntegral i+setCoordinateSequenceOrd+  :: CoordinateSequence a => a -> Int -> Int -> Double -> Geos ()+setCoordinateSequenceOrd cs idx dim v =+  void+    $ throwIfZero (mkErrorMessage "setCoordinateSequenceN")+    $ withGeos+    $ \h -> withCoordinateSequence cs $ \pcs -> I.geos_CoordSeqSetOrdinate+        h+        pcs+        (fromIntegral idx)+        (fromIntegral dim)+        (realToFrac v)

@@ -7,11 +7,11 @@ Light wrappers around Geos functions. Must be run within the Geos monad.  -}-module Data.Geometry.Geos.Raw.Geometry (-    Geom (..)-  , GeomConst (..)-  , Geometry (..)-  , GeomTypeId (..)+module Data.Geometry.Geos.Raw.Geometry+  ( Geom(..)+  , GeomConst(..)+  , Geometry(..)+  , GeomTypeId(..)   , withMaybeGeometry   , getSRID   , setSRID@@ -32,7 +32,6 @@   , createMultiLineString   , createMultiPolygon   , createCollection-   , project   , projectNormalized   , interpolate@@ -55,72 +54,92 @@   , hausdorffDistance   , nearestPoints   , normalize-) where-import qualified Data.Geometry.Geos.Raw.Internal as I-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Raw.CoordSeq-import Foreign-import Foreign.Ptr (nullPtr)-import Foreign.C.Types-import Foreign.C.String+  )+where+import qualified Data.Geometry.Geos.Raw.Internal+                                               as I+import           Control.Monad+import           Data.Geometry.Geos.Raw.Base+import           Data.Geometry.Geos.Raw.CoordSeq+import           Foreign                 hiding ( throwIfNull+                                                , throwIf+                                                , throwIfNeg+                                                )+import           Foreign.Ptr                    ( nullPtr )+import           Foreign.C.Types+import           Foreign.C.String  {- |  A Geom is a wrapper around the C data structure that has finalizers associated with it. -}-newtype Geom = Geom (ForeignPtr I.GEOSGeometry)+newtype Geom = Geom {+  unGeom :: ForeignPtr I.GEOSGeometry+} + {- | A GeomConst is a wrapper around the C data structure that does *not* have finalizers attached to it. A typical use case for GemoConst is when retrieving a child geometry from a composite geometry. If the parent geometry has finalizers associated with it, we can not separately attempt to deallocate memory occupied by the child geometry. -}-newtype GeomConst = GeomConst ( Ptr I.GEOSGeometry)+newtype GeomConst = GeomConst {+  unGeomConst :: Ptr I.GEOSGeometry+} + class Geometry a where     type CoordSeqInput a -    withGeometry :: a  -                  -> (Ptr I.GEOSGeometry -> IO b ) +    withGeometry :: a+                  -> (Ptr I.GEOSGeometry -> IO b )                   -> IO b     constructGeometry :: I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> IO a  instance Geometry Geom where-    type CoordSeqInput Geom = CoordSeqConst-    withGeometry (Geom g) f = withForeignPtr g f-    constructGeometry h geo =  do-      fptr <- newForeignPtrEnv I.geos_GeomDestroy h geo-      return $ Geom fptr+  type CoordSeqInput Geom = CoordSeqConst+  withGeometry (Geom g) = withForeignPtr g+  constructGeometry h geo = do+    fptr <- newForeignPtrEnv I.geos_GeomDestroy h geo+    return $ Geom fptr  instance Geometry GeomConst where-    type CoordSeqInput GeomConst = CoordSeq-    withGeometry (GeomConst p) f = f p-    constructGeometry _ geo =  return $ GeomConst geo+  type CoordSeqInput GeomConst = CoordSeq+  withGeometry (GeomConst p) f = f p+  constructGeometry _ geo = return $ GeomConst geo -withMaybeGeometry :: Geometry a => Maybe a -> (Ptr I.GEOSGeometry -> IO b) -> IO b+withMaybeGeometry+  :: Geometry a => Maybe a -> (Ptr I.GEOSGeometry -> IO b) -> IO b withMaybeGeometry mg f = case mg of-    Just g -> withGeometry g f-    Nothing -> f nullPtr+  Just g  -> withGeometry g f+  Nothing -> f nullPtr -createGeometryFromCoords :: Geometry b-                          => (I.GEOSContextHandle_t -> Ptr I.GEOSCoordSequence -> IO (Ptr I.GEOSGeometry))-                          -> CoordSeqConst-                          -> Geos b-createGeometryFromCoords f c = -   withGeos $ \h ->-      withCoordinateSequence c $ \pcs -> do-        ptr <- f h pcs-        constructGeometry h ptr+createGeometryFromCoords+  :: Geometry b+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSCoordSequence+     -> IO (Ptr I.GEOSGeometry)+     )+  -> CoordSeqConst+  -> Geos b+createGeometryFromCoords f c = withGeos $ \h ->+  withCoordinateSequence c $ \pcs -> do+    ptr <- f h pcs+    constructGeometry h ptr -geomEq :: (Eq ca, Geometry a, CoordSeqInput a ~ ca, CoordinateSequence ca) => a -> a -> Bool+geomEq+  :: (Eq ca, Geometry a, CoordSeqInput a ~ ca, CoordinateSequence ca)+  => a+  -> a+  -> Bool geomEq a b = runGeos $ do-    sa <- getSRID a-    sb <- getSRID b-    ta <- getTypeId a-    tb <- getTypeId b-    if (sa == sb) && (ta == tb)-      then do-        csa <- getCoordinateSequence a-        csb <- getCoordinateSequence b-        return $ csa == csb-      else return False+  sa <- getSRID a+  sb <- getSRID b+  ta <- getTypeId a+  tb <- getTypeId b+  if (sa == sb) && (ta == tb)+    then do+      csa <- getCoordinateSequence a+      csb <- getCoordinateSequence b+      return $ csa == csb+    else return False   instance Eq Geom where@@ -136,9 +155,9 @@     0 -> return Nothing     i -> return (Just i) -setSRID :: Geometry a => (Maybe Int) -> a -> Geos a-setSRID Nothing g = return g-setSRID (Just i) g = withGeos $ \h ->  do+setSRID :: Geometry a => Maybe Int -> a -> Geos a+setSRID Nothing  g = return g+setSRID (Just i) g = withGeos $ \h -> do   withGeometry g $ \gp -> I.geos_SetSRID h gp $ fromIntegral i   return g @@ -154,36 +173,44 @@ geomTypeId 5 = MultiLineStringTypeId geomTypeId 6 = MultiPolygonTypeId geomTypeId 7 = GeometryCollectionTypeId-geomTypeId i = error $ "Not a valid geometry type " ++ (show i)+geomTypeId i = error $ "Not a valid geometry type " ++ show i  getTypeName :: Geometry a => a -> Geos String-getTypeName g = withGeos $ \h ->  do-  s <- throwIfNull "getType" $-        withGeometry g $ I.geos_GeomType h-  return  =<< peekCString s+getTypeName g = withGeos' $ \h -> do+  eitherCString <- throwIfNull' "getType" $ withGeometry g $ I.geos_GeomType h+  traverse peekCString eitherCString -getTypeId ::Geometry a => a -> Geos GeomTypeId-getTypeId g = withGeos $ \h -> do-  i <- throwIfNeg (mkErrorMessage "getTypeId") $ withGeometry g $ I.geos_GeomTypeId h-  return $ geomTypeId (fromIntegral i)+getTypeId :: Geometry a => a -> Geos GeomTypeId+getTypeId g =+  fmap geomTypeId+    $ throwIf (0 >) (mkErrorMessage "getTypeId")+    $ withGeos+    $ \h -> do+        i <- withGeometry g $ I.geos_GeomTypeId h+        return (fromIntegral i)   getCoordinateSequence :: Geometry a => a -> Geos CoordSeq-getCoordinateSequence g = withGeos $ \h ->-    withGeometry g $ \gptr -> do-        cptr <- throwIfNull "getCoordinateSequence" $ I.geos_GetCoordSeq h gptr-        cptr' <- I.geos_CoordSeqClone h cptr-        fptr <- newForeignPtrEnv I.geos_CoordSeqDestroy h cptr'-        return $ CoordSeq fptr+getCoordinateSequence g = withGeos' $ \h -> do+  eitherCptr <-+    throwIfNull' "getCoordinateSequence" $ withGeometry g $ \gptr ->+      I.geos_GetCoordSeq h gptr+  traverse (create h) eitherCptr+ where+  create h cptr = do+    cptr' <- I.geos_CoordSeqClone h cptr+    fptr  <- newForeignPtrEnv I.geos_CoordSeqDestroy h cptr'+    return $ CoordSeq fptr  -getNum_ :: Geometry a-        => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> IO CInt)-        -> a-        -> Geos Int-getNum_ f g = withGeos $ \h ->-  withGeometry g $ \g' -> do-    i <- throwIfNeg (mkErrorMessage "getNumCoordinates") $ f h g'+getNum_+  :: Geometry a+  => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> IO CInt)+  -> a+  -> Geos Int+getNum_ f g =+  throwIf (0 >) (mkErrorMessage "getNumCoordinates") $ withGeos $ \h -> do+    i <- withGeometry g $ f h     return $ fromIntegral i  @@ -199,15 +226,20 @@ getNumGeometries :: Geometry a => a -> Geos Int getNumGeometries = getNum_ I.geos_GetNumGeometries -getN_ :: Geometry a-      => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> CInt -> IO (Ptr I.GEOSGeometry))-      -> a-      -> Int-      -> Geos GeomConst-getN_ f g i = -  withGeos $ \h ->  withGeometry g $ \gp ->  do-      gp' <- throwIfNull "getN" $ f h gp $ fromIntegral i-      constructGeometry h gp'+getN_+  :: Geometry a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSGeometry+     -> CInt+     -> IO (Ptr I.GEOSGeometry)+     )+  -> a+  -> Int+  -> Geos GeomConst+getN_ f g i = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "getN" $ withGeometry g $ \gp ->+    f h gp $ fromIntegral i+  traverse (constructGeometry h) eitherPtr   getGeometryN :: Geometry a => a -> Int -> Geos GeomConst@@ -215,70 +247,72 @@  -- Returned object is a pointer to internal storage: it must NOT be destroyed directly. getExteriorRing :: Geometry a => a -> Geos GeomConst-getExteriorRing  g = do-  withGeos $ \h -> do-      withGeometry g $ \gp ->  do-        gp' <- throwIfNull "getExteriorRing" $ I.geos_GetExteriorRing h gp -        constructGeometry h gp'-  +getExteriorRing g = withGeos' $ \h -> do+  eitherGeoPtr <- throwIfNull' "getExteriorRing"+    $ withGeometry g (I.geos_GetExteriorRing h)+  traverse (constructGeometry h) eitherGeoPtr + getInteriorRingN :: Geometry a => a -> Int -> Geos GeomConst-getInteriorRingN  = getN_ I.geos_GetInteriorRingN+getInteriorRingN = getN_ I.geos_GetInteriorRingN  normalize :: Geometry a => a -> Geos a normalize g = do   cloned <- cloneGeometry g-  withGeos $ \h -> do-    _ <- throwIfNeg (mkErrorMessage "normalize") $ withGeometry cloned $ I.geos_Normalize h-    return ()+  _      <-+    throwIf (0 >) (mkErrorMessage "normalize")+    $ withGeos+    $ withGeometry cloned+    . I.geos_Normalize   return cloned --  cloneGeometry :: Geometry a => a -> Geos a-cloneGeometry g = do-  withGeos $ \h -> withGeometry g $ \gp -> -    I.geos_GeomClone h gp >>= constructGeometry h+cloneGeometry g =+  withGeos $ \h -> withGeometry g $ I.geos_GeomClone h >=> constructGeometry h  -- Geometry Constructors {-| The following require CoordSeqConst as arguments since coordinate sequences become owned by the Geometry object.  -}-createPoint ::Geometry b => CoordSeqConst -> Geos b+createPoint :: Geometry b => CoordSeqConst -> Geos b createPoint = createGeometryFromCoords I.geos_GeomCreatePoint  createLinearRing :: Geometry a => CoordSeqConst -> Geos a createLinearRing = createGeometryFromCoords I.geos_GeomCreateLinearRing -createLineString ::Geometry b => CoordSeqConst -> Geos b+createLineString :: Geometry b => CoordSeqConst -> Geos b createLineString = createGeometryFromCoords I.geos_GeomCreateLineString  -- | The second argument is a list of geometries, -- | NOTE. geometries become owned by caller. createPolygon :: Geometry a => GeomConst -> [GeomConst] -> Geos a-createPolygon o hs = do-  withGeos $ \h -> do-        ptrs <- mapM (\v -> withGeometry v $ return) hs-        withGeometry o $ \op -> do-          g' <- case ptrs of-                  [] -> I.geos_GeomCreatePolygon h op nullPtr 0-                  xs -> withArray xs $ \ph -> I.geos_GeomCreatePolygon h op ph $ fromIntegral $ length hs-          constructGeometry h g'+createPolygon o hs = withGeos $ \h -> do+  ptrs <- mapM (`withGeometry` return) hs+  withGeometry o $ \op -> do+    g' <- case ptrs of+      [] -> I.geos_GeomCreatePolygon h op nullPtr 0+      xs -> withArray xs+        $ \ph -> I.geos_GeomCreatePolygon h op ph $ fromIntegral $ length hs+    constructGeometry h g'   createMulti_ :: Geometry a => I.GEOSGeomType -> [GeomConst] -> Geos a-createMulti_ t gs = do-  withGeos $ \h -> do-      ptrs <- mapM (\v -> withGeometry v $ return) gs-      withArray ptrs $ \ph -> do-          g' <- I.geos_GeomCreateCollection h (I.unGEOSGeomType t) ph $ fromIntegral $ length gs-          constructGeometry h g'+createMulti_ t gs = withGeos $ \h -> do+  ptrs <- mapM (`withGeometry` return) gs+  withArray ptrs $ \ph -> do+    g' <-+      I.geos_GeomCreateCollection h (I.unGEOSGeomType t) ph+      $ fromIntegral+      $ length gs+    constructGeometry h g' -createMultiPoint :: Geometry a =>  [GeomConst] -> Geos a+createMultiPoint :: Geometry a => [GeomConst] -> Geos a createMultiPoint = createMulti_ I.multiPointId  createMultiLineString :: Geometry a => [GeomConst] -> Geos a-createMultiLineString = createMulti_  I.multiLineStringId+createMultiLineString = createMulti_ I.multiLineStringId  createMultiPolygon :: Geometry a => [GeomConst] -> Geos a createMultiPolygon = createMulti_ I.multiPolygonId@@ -289,15 +323,19 @@  --- Linear Referencing -----------------------geo_2_ :: Geometry a-        => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> Ptr I.GEOSGeometry -> IO CDouble)-        -> a-        -> a-        -> Geos Double+geo_2_+  :: Geometry a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSGeometry+     -> Ptr I.GEOSGeometry+     -> IO CDouble+     )+  -> a+  -> a+  -> Geos Double geo_2_ f g p = withGeos $ \h -> do-   d <- withGeometry g $ \gp ->-          withGeometry p $ f h gp-   return . realToFrac $ d+  d <- withGeometry g $ \gp -> withGeometry p $ f h gp+  return . realToFrac $ d  -- | @project p g@ returns the distance of point @p@ projected on @g@ from origin of @g@. Geometry @g@ must be a lineal geometry --@@ -308,39 +346,47 @@ projectNormalized = geo_2_ I.geos_ProjectNormalized  -geo_1_d :: Geometry a-          => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> CDouble -> IO (Ptr I.GEOSGeometry))-          -> a-          -> Double-          -> Geos Geom-geo_1_d f g d = do-  withGeos $ \h -> withGeometry g $ \gp -> do-    gp' <- f h gp $ realToFrac d-    constructGeometry h gp'+geo_1_d+  :: Geometry a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSGeometry+     -> CDouble+     -> IO (Ptr I.GEOSGeometry)+     )+  -> a+  -> Double+  -> Geos Geom+geo_1_d f g d = withGeos $ \h -> withGeometry g $ \gp -> do+  gp' <- f h gp $ realToFrac d+  constructGeometry h gp'  -- | Return the closest point to given distance within geometry. Geometry must be a LineString -- interpolate :: Geometry a => a -> Double -> Geos Geom-interpolate = geo_1_d  I.geos_Interpolate+interpolate = geo_1_d I.geos_Interpolate  interpolateNormalized :: Geometry a => a -> Double -> Geos Geom interpolateNormalized = geo_1_d I.geos_InterpolateNormalized  --Binary Predicates ---------------------binaryPredicate_ :: Geometry a-                  => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> Ptr I.GEOSGeometry -> IO CChar)-                  -> String-                  -> a-                  -> a-                  -> Geos Bool-binaryPredicate_ f s g1 g2 = withGeos $ \h -> do-  b <- throwIf ((==) 2) (mkErrorMessage s) $-        withGeometry g1 $ \gp1 ->-          withGeometry g2 $ f h gp1-  return . toBool $  b+binaryPredicate_+  :: Geometry a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSGeometry+     -> Ptr I.GEOSGeometry+     -> IO CChar+     )+  -> String+  -> a+  -> a+  -> Geos Bool+binaryPredicate_ f s g1 g2 = do+  b <- throwIf ((==) 2) (mkErrorMessage s) $ withGeos $ \h ->+    withGeometry g1 $ \gp1 -> withGeometry g2 $ f h gp1+  return . toBool $ b -disjoint :: Geometry a => a-> a -> Geos Bool+disjoint :: Geometry a => a -> a -> Geos Bool disjoint = binaryPredicate_ I.geos_Disjoint "disjoint"  touches :: Geometry a => a -> a -> Geos Bool@@ -365,7 +411,11 @@ equals = binaryPredicate_ I.geos_Equals "equals"  equalsExact :: Geometry a => a -> a -> Double -> Geos Bool-equalsExact g1' g2' d = binaryPredicate_ (\h g1 g2 -> I.geos_EqualsExact h g1 g2 (realToFrac d)) "equalsExact" g1' g2'+equalsExact g1' g2' d = binaryPredicate_+  (\h g1 g2 -> I.geos_EqualsExact h g1 g2 (realToFrac d))+  "equalsExact"+  g1'+  g2'  covers :: Geometry a => a -> a -> Geos Bool covers = binaryPredicate_ I.geos_Covers "covers"@@ -375,15 +425,15 @@  -- Misc functions -geo_1 ::  Geometry a-      => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> Ptr CDouble -> IO CInt)-      -> a-      -> Geos Double-geo_1 f g = withGeos $ \h -> alloca $ \dptr -> do-    _ <- throwIfZero (mkErrorMessage "geo_1" ) $ withGeometry g $ \gp ->-        f h gp dptr-    s <- peek dptr-    pure $ realToFrac s+geo_1+  :: Geometry a+  => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> Ptr CDouble -> IO CInt)+  -> a+  -> Geos Double+geo_1 f g = withGeos' $ \h -> alloca $ \dptr -> do+  eitherResult <- throwIfZero' (mkErrorMessage "geo_1")+    $ withGeometry g (flip (f h) dptr)+  traverse (\_ -> marshallDouble dptr) eitherResult  area :: Geometry a => a -> Geos Double area = geo_1 I.geos_Area@@ -391,17 +441,22 @@ geometryLength :: Geometry a => a -> Geos Double geometryLength = geo_1 I.geos_Length -geo_2_d :: Geometry a-          => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> Ptr I.GEOSGeometry -> Ptr CDouble -> IO CInt)-          -> a-          -> a-          -> Geos Double-geo_2_d f g p = withGeos $ \h -> alloca $ \dptr -> do-   _ <- throwIfZero (mkErrorMessage "geo_2") $ withGeometry g $ \gp ->-          withGeometry p $ \pp ->-               f h gp pp dptr-   d <- peek dptr-   pure . realToFrac $ d+geo_2_d+  :: Geometry a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSGeometry+     -> Ptr I.GEOSGeometry+     -> Ptr CDouble+     -> IO CInt+     )+  -> a+  -> a+  -> Geos Double+geo_2_d f geo1 geo2 = withGeos' $ \h -> alloca $ \dptr -> do+  eitherResult <-+    throwIfZero' (mkErrorMessage "geo_2") $ withGeometry geo1 $ \geoPtr1 ->+      withGeometry geo2 $ \geoPtr2 -> f h geoPtr1 geoPtr2 dptr+  traverse (\_ -> marshallDouble dptr) eitherResult  distance :: Geometry a => a -> a -> Geos Double distance = geo_2_d I.geos_Distance@@ -411,6 +466,6 @@  nearestPoints :: (Geometry a, CoordinateSequence b) => a -> a -> Geos b nearestPoints g p = do-  ptr <- withGeos $ \h -> withGeometry g $ \gp ->-            withGeometry p $ I.geos_NearestPoints h gp+  ptr <- withGeos+    $ \h -> withGeometry g $ \gp -> withGeometry p $ I.geos_NearestPoints h gp   createCoordinateSequence ptr

@@ -324,6 +324,24 @@   geos_ConvexHull :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry)  foreign import ccall+  "geos_c.h GEOSMinimumRotatedRectangle_r"+  geos_MinimumRotatedRectangle :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry)++foreign import ccall+  "geos_c.h GEOSMinimumWidth_r"+  geos_MinimumWidth :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry)++foreign import ccall+  "geos_c.h GEOSMinimumClearanceLine_r"+  geos_MinimumClearanceLine :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry)+++foreign import ccall+  "geos_c.h GEOSMinimumClearance_r"+  geos_MinimumClearance :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr CDouble -> IO CInt+++foreign import ccall   "geos_c.h GEOSDifference_r"   geos_Difference :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry) @@ -352,20 +370,32 @@   geos_PointsOnSurface :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry)  foreign import ccall+  "geos_c.h GEOSMinimumBoundingCircle_r"+  geos_MinimumBoundingCircle :: GEOSContextHandle_t +                            -> Ptr GEOSGeometry +                            -> Ptr CDouble +                            -> Ptr (Ptr GEOSGeometry) +                            -> IO (Ptr GEOSGeometry)++foreign import ccall   "geos_c.h GEOSNode_r"   geos_Node :: GEOSContextHandle_t -> Ptr GEOSGeometry -> IO (Ptr GEOSGeometry)   foreign import ccall+  "geos_c.h GEOSPolygonize_valid_r"+  geos_Polygonize_valid :: GEOSContextHandle_t +                        -> Ptr (Ptr GEOSGeometry)+                        -> CUInt+                        -> IO (Ptr GEOSGeometry)++foreign import ccall   "geos_c.h GEOSDelaunayTriangulation_r"   geos_DelaunayTriangulation :: GEOSContextHandle_t -> Ptr GEOSGeometry -> CDouble -> CInt -> IO (Ptr GEOSGeometry) --#if GEOS_VERSION_MAJOR >= 3 && GEOS_VERSION_MINOR > 4 foreign import ccall   "geos_c.h GEOSVoronoiDiagram_r"   geos_VoronoiDiagram :: GEOSContextHandle_t -> Ptr GEOSGeometry -> Ptr GEOSGeometry -> CDouble -> CInt -> IO (Ptr GEOSGeometry)-#endif  ----- --Binary Predicates.@@ -564,7 +594,6 @@  -- STRTREE -#if GEOS_VERSION_MAJOR >= 3 && GEOS_VERSION_MINOR > 4 foreign import ccall   "geos_c.h GEOSSTRtree_create_r"   geos_STRTreeCreate :: GEOSContextHandle_t -> CSize -> IO (Ptr GEOSSTRTree)@@ -591,7 +620,6 @@   "geos_c.h &GEOSSTRtree_destroy_r"   geos_STRTreeDestroy :: FunPtr (GEOSContextHandle_t -> Ptr GEOSSTRTree -> IO ()) -#endif  foreign import ccall   "geos_c.h GEOSisValid_r"

@@ -1,6 +1,6 @@-module Data.Geometry.Geos.Raw.Prepared (-    PreparedGeometry (..)-  , withPreparedGeometry  +module Data.Geometry.Geos.Raw.Prepared+  ( PreparedGeometry(..)+  , withPreparedGeometry   , prepare   , contains   , containsProperly@@ -12,68 +12,74 @@   , overlaps   , touches   , within-) where-import Data.Geometry.Geos.Raw.Internal -import Data.Geometry.Geos.Raw.Base-import qualified Data.Geometry.Geos.Raw.Geometry as RG-import Foreign.Marshal.Utils-import Foreign-import Foreign.C.Types+  )+where+import           Data.Geometry.Geos.Raw.Internal+import           Data.Geometry.Geos.Raw.Base+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as RG+import           Foreign.Marshal.Utils+import           Foreign                 hiding ( throwIf )+import           Foreign.C.Types   newtype PreparedGeometry = PreparedGeometry {-  unPreparedGeometry :: ForeignPtr GEOSPreparedGeometry +  unPreparedGeometry :: ForeignPtr GEOSPreparedGeometry } deriving (Show, Eq) -withPreparedGeometry :: PreparedGeometry -> (Ptr GEOSPreparedGeometry -> IO a ) -> IO a-withPreparedGeometry (PreparedGeometry g) f = withForeignPtr g f+withPreparedGeometry+  :: PreparedGeometry -> (Ptr GEOSPreparedGeometry -> IO a) -> IO a+withPreparedGeometry (PreparedGeometry g) = withForeignPtr g  prepare :: RG.Geometry a => a -> Geos PreparedGeometry prepare g = withGeos $ \h -> do-    g' <- RG.withGeometry g $ \gp -> -        geos_Prepare h gp-    fp <- newForeignPtrEnv geos_PreparedGeomDestroy h g'-    return $ PreparedGeometry fp+  g' <- RG.withGeometry g $ \gp -> geos_Prepare h gp+  fp <- newForeignPtrEnv geos_PreparedGeomDestroy h g'+  return $ PreparedGeometry fp -queryPrepared :: RG.Geometry a-              => (GEOSContextHandle_t -> Ptr GEOSPreparedGeometry -> Ptr GEOSGeometry -> IO CChar)-              -> String-              -> PreparedGeometry-              -> a-              -> Geos Bool-queryPrepared f s pg g = withGeos $ \h -> do-  b <-  throwIf (\v -> v == 2) (mkErrorMessage s) $ -          RG.withGeometry g $ \gp -> -            withPreparedGeometry pg $ \pp ->-              f h pp gp+queryPrepared+  :: RG.Geometry a+  => (  GEOSContextHandle_t+     -> Ptr GEOSPreparedGeometry+     -> Ptr GEOSGeometry+     -> IO CChar+     )+  -> String+  -> PreparedGeometry+  -> a+  -> Geos Bool+queryPrepared f s pg g = do+  b <- throwIf (2 ==) (mkErrorMessage s) $ withGeos $ \h ->+    RG.withGeometry g $ \gp -> withPreparedGeometry pg $ flip (f h) gp   return . toBool $ b -contains :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+contains :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool contains = queryPrepared geos_PreparedContains "contains" -containsProperly :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool-containsProperly = queryPrepared geos_PreparedContainsProperly "containsProperly"+containsProperly :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool+containsProperly =+  queryPrepared geos_PreparedContainsProperly "containsProperly" -coveredBy :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+coveredBy :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool coveredBy = queryPrepared geos_PreparedCoveredBy "coveredBy" -covers :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+covers :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool covers = queryPrepared geos_PreparedCovers "covers" -crosses :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+crosses :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool crosses = queryPrepared geos_PreparedCrosses "crosses" -disjoint :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+disjoint :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool disjoint = queryPrepared geos_PreparedDisjoint "disjoint" -intersects :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+intersects :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool intersects = queryPrepared geos_PreparedIntersects "intersects" -overlaps :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+overlaps :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool overlaps = queryPrepared geos_PreparedOverlaps "overlaps" -touches :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+touches :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool touches = queryPrepared geos_PreparedTouches "touches" -within :: RG.Geometry a => PreparedGeometry -> a-> Geos Bool+within :: RG.Geometry a => PreparedGeometry -> a -> Geos Bool within = queryPrepared geos_PreparedWithin "within"

@@ -1,30 +1,30 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}  -- module Data.Geometry.Geos.Raw.STRTree where -import Prelude hiding (foldr)-import qualified Data.Geometry.Geos.Raw.Internal as I-import qualified Data.Geometry.Geos.Raw.Geometry as RG-import qualified Data.Geometry.Geos.Raw.CoordSeq as RC-import Data.Geometry.Geos.Raw.Base-import Foreign-import qualified Foreign.Concurrent as FC-import Data.IORef-import qualified Data.Vector as V+import           Prelude                 hiding ( foldr )+import qualified Data.Geometry.Geos.Raw.Internal+                                               as I+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as RG+import qualified Data.Geometry.Geos.Raw.CoordSeq+                                               as RC+import           Data.Geometry.Geos.Raw.Base+import           Foreign+import qualified Foreign.Concurrent            as FC+import           Data.IORef+import qualified Data.Vector                   as V   class STRTreeLike t where     withSTRTree :: t a -> (Ptr I.GEOSSTRTree -> IO b ) -> IO b  instance STRTreeLike STRTree where-    withSTRTree (STRTree t) f = withForeignPtr t f-       +  withSTRTree (STRTree t) = withForeignPtr t+ instance STRTreeLike STRTreeBuilder where-    withSTRTree (STRTreeBuilder t) f = withForeignPtr t f+  withSTRTree (STRTreeBuilder t) = withForeignPtr t  {-|   A query-only data structure@@ -44,9 +44,9 @@   wrap2 :: (Ptr a -> Ptr () -> IO ()) -> IO (I.GEOSQueryCallback a)  foreign import ccall "dynamic"-  unwrap :: FunPtr (Finalizer a b) -> Finalizer a b -  +  unwrap :: FunPtr (Finalizer a b) -> Finalizer a b + {- | Create a new R-tree using the Sort-Tile-Recursive algorithm (STRtree) for two-dimensional spatial data. @@ -54,25 +54,25 @@ -} createSTRTreeBuilder :: Int -> Geos (STRTreeBuilder a) createSTRTreeBuilder nodeCapacity = withGeos $ \h -> do-    t <- I.geos_STRTreeCreate h $ fromIntegral nodeCapacity-    let cleanup = unwrap I.geos_STRTreeDestroy h t-    fp <- FC.newForeignPtr t cleanup-    return $ STRTreeBuilder fp+  t <- I.geos_STRTreeCreate h $ fromIntegral nodeCapacity+  let cleanup = unwrap I.geos_STRTreeDestroy h t+  fp <- FC.newForeignPtr t cleanup+  return $ STRTreeBuilder fp   {- |   "Builds" the STRTree by performing a trivial query on it. -} build :: STRTreeBuilder a -> Geos (STRTree a)-build tree@(STRTreeBuilder fp) = do -  cs <- RC.createEmptyCoordinateSequence 1 2-  p ::RG.Geom <- RG.createPoint cs+build tree@(STRTreeBuilder fp) = do+  cs           <- RC.createEmptyCoordinateSequence 1 2+  p :: RG.Geom <- RG.createPoint cs   withGeos $ \h -> do-      callback <- wrap2 $ \_ _ -> return ()-      RG.withGeometry p $ \rg ->-          withSTRTree tree $ \st -> I.geos_STRTreeQuery h st rg callback nullPtr+    callback <- wrap2 $ \_ _ -> return ()+    RG.withGeometry p $ \rg ->+      withSTRTree tree $ \st -> I.geos_STRTreeQuery h st rg callback nullPtr   return $ STRTree fp-  + {-| Insert an item into an STRtree @@ -80,41 +80,33 @@ @param geometry a Geometry whose envelope corresponds to the extent of 'item' @param item the item to insert into the tree -}-insert :: (Storable b, RG.Geometry a)  => STRTreeBuilder b -> a -> b -> Geos ()-insert (STRTreeBuilder tree) geometry item =-  withGeos $ \h -> do-    ptr <- malloc-    poke ptr item-    _ <- withForeignPtr tree $ \st -> do-        RG.withGeometry geometry $ \gr ->-          I.geos_STRTreeInsert h st gr ptr-    let cleanup = free ptr-    FC.addForeignPtrFinalizer tree cleanup-    return ()+insert :: (Storable b, RG.Geometry a) => STRTreeBuilder b -> a -> b -> Geos ()+insert (STRTreeBuilder tree) geometry item = withGeos $ \h -> do+  ptr <- malloc+  poke ptr item+  _ <- withForeignPtr tree $ \st ->+    RG.withGeometry geometry $ \gr -> I.geos_STRTreeInsert h st gr ptr+  let cleanup = free ptr+  FC.addForeignPtrFinalizer tree cleanup+  return ()  foldr :: (STRTreeLike t, Storable a) => (a -> b -> b) -> b -> t a -> Geos b foldr func acc tree = withGeos $ \h -> do-    b <- newIORef acc-    callback <- wrap2 $ \a _ -> do-      i <- peek a-      modifyIORef' b (func i)-    _ <- withSTRTree tree $ \st -> I.geos_STRTreeIterate h st callback nullPtr-    freeHaskellFunPtr callback-    readIORef b--query :: (Storable b, RG.Geometry a) -      => STRTree b -      -> a-      -> Geos (V.Vector b)-query t g  =-  withGeos $ \h -> do-    r <- newIORef V.empty-    callback <- wrap2 $ \a _ -> do-        i <- peek a-        modifyIORef' r (flip V.snoc i)-    _ <- RG.withGeometry g $ \rg ->-          withSTRTree t $ \st -> -            I.geos_STRTreeQuery h st rg callback nullPtr-    freeHaskellFunPtr callback-    readIORef r+  b        <- newIORef acc+  callback <- wrap2 $ \a _ -> do+    i <- peek a+    modifyIORef' b (func i)+  _ <- withSTRTree tree $ \st -> I.geos_STRTreeIterate h st callback nullPtr+  freeHaskellFunPtr callback+  readIORef b +query :: (Storable b, RG.Geometry a) => STRTree b -> a -> Geos (V.Vector b)+query t g = withGeos $ \h -> do+  r        <- newIORef V.empty+  callback <- wrap2 $ \a _ -> do+    i <- peek a+    modifyIORef' r (`V.snoc` i)+  _ <- RG.withGeometry g $ \rg ->+    withSTRTree t $ \st -> I.geos_STRTreeQuery h st rg callback nullPtr+  freeHaskellFunPtr callback+  readIORef r

@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-}-module Data.Geometry.Geos.Raw.Serialize (-    createReader+module Data.Geometry.Geos.Raw.Serialize+  ( createReader   , createWriter   , createWktReader   , createWktWriter@@ -10,15 +10,17 @@   , write   , writeHex   , writeWkt-) where-import Prelude hiding (read)-import qualified Data.Geometry.Geos.Raw.Internal as I-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Raw.Geometry-import Foreign-import Foreign.C.String-import Foreign.C.Types-import qualified Data.ByteString.Char8 as BC+  )+where+import           Prelude                 hiding ( read )+import qualified Data.Geometry.Geos.Raw.Internal+                                               as I+import           Data.Geometry.Geos.Raw.Base+import           Data.Geometry.Geos.Raw.Geometry+import           Foreign                 hiding ( throwIfNull )+import           Foreign.C.String+import           Foreign.C.Types+import qualified Data.ByteString.Char8         as BC   newtype Reader = Reader { _unReader :: ForeignPtr I.GEOSWKBReader }@@ -28,78 +30,82 @@ newtype WktWriter = WktWriter { _unWktWriter :: ForeignPtr I.GEOSWKTWriter }  createReader :: Geos Reader-createReader = withGeos $ \h -> do-    ptr <- throwIfNull "Create Reader" $ I.geos_WKBReaderCreate h-    Reader <$> newForeignPtrEnv I.geos_WKBReaderDestroy h ptr+createReader = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "Create Reader" $ I.geos_WKBReaderCreate h+  traverse (fmap Reader . newForeignPtrEnv I.geos_WKBReaderDestroy h) eitherPtr  createWktReader :: Geos WktReader-createWktReader = withGeos $ \h -> do-    ptr <- throwIfNull "Create WKT Reader" $ I.geos_WKTReaderCreate h-    WktReader <$> newForeignPtrEnv I.geos_WKTReaderDestroy h ptr--read_ :: (I.GEOSContextHandle_t -> Ptr I.GEOSWKBReader -> CString  -> CSize -> IO (Ptr I.GEOSGeometry))-            -> Reader-            -> BC.ByteString-            -> Geos (Maybe Geom)-read_ f (Reader r) bs = withGeos readBlock-    where-      readBlock h =  do-           ptr <- withForeignPtr r $ \rp ->-             BC.useAsCStringLen bs $-               \(cs, l) -> f h rp cs $ fromIntegral l-           g <- wrapUpGeom h ptr-           pure g+createWktReader = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "Create WKT Reader" $ I.geos_WKTReaderCreate h+  traverse (fmap WktReader . newForeignPtrEnv I.geos_WKTReaderDestroy h)+           eitherPtr -wrapUpGeom :: I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> IO (Maybe Geom)-wrapUpGeom h ptr-  | ptr == nullPtr = pure Nothing-  | otherwise = Just . Geom <$> newForeignPtrEnv I.geos_GeomDestroy h ptr+read_+  :: (  I.GEOSContextHandle_t+     -> Ptr I.GEOSWKBReader+     -> CString+     -> CSize+     -> IO (Ptr I.GEOSGeometry)+     )+  -> Reader+  -> BC.ByteString+  -> Geos Geom+read_ f (Reader r) bs = withGeos' $ \h -> do+  eitherPtr <- readBlock h+  traverse (constructGeometry h) eitherPtr+ where+  readBlock h = throwIfNull' "read_" $ withForeignPtr r $ \rp ->+    BC.useAsCStringLen bs $ \(cs, l) -> f h rp cs $ fromIntegral l -read :: Reader -> BC.ByteString -> Geos (Maybe Geom)+read :: Reader -> BC.ByteString -> Geos Geom read = readWkb -readWkb :: Reader -> BC.ByteString -> Geos (Maybe Geom)+readWkb :: Reader -> BC.ByteString -> Geos Geom readWkb = read_ I.geos_WKBReaderRead -readHex :: Reader -> BC.ByteString -> Geos (Maybe Geom)-readHex  = read_ I.geos_WKBReaderReadHex+readHex :: Reader -> BC.ByteString -> Geos Geom+readHex = read_ I.geos_WKBReaderReadHex -readWkt :: WktReader -> BC.ByteString -> Geos (Maybe Geom)-readWkt (WktReader r) bs = do-  withGeos $ \h -> do-    ptr <- withForeignPtr r $ \rp ->-              BC.useAsCString bs $ \cs ->-                I.geos_WKTReaderRead h rp cs-    g <- wrapUpGeom h ptr-    pure g+readWkt :: WktReader -> BC.ByteString -> Geos Geom+readWkt (WktReader r) bs = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "readWKT" $ withForeignPtr r $ \rp ->+    BC.useAsCString bs $ \cs -> I.geos_WKTReaderRead h rp cs+  traverse (constructGeometry h) eitherPtr  createWriter :: Geos Writer-createWriter = withGeos $ \h -> do-  ptr <- throwIfNull "CreateWriter" $ I.geos_WKBWriterCreate h-  I.geos_WKBWriterSetIncludeSRID h ptr $ fromBool True-  fp <- newForeignPtrEnv I.geos_WKBWriterDestroy h ptr-  return $ Writer fp+createWriter = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "CreateWriter" $ I.geos_WKBWriterCreate h+  traverse (create h) eitherPtr+ where+  create h ptr = do+    I.geos_WKBWriterSetIncludeSRID h ptr $ fromBool True+    fp <- newForeignPtrEnv I.geos_WKBWriterDestroy h ptr+    pure $ Writer fp + createWktWriter :: Geos WktWriter-createWktWriter = withGeos $ \h -> do-  ptr <- throwIfNull "CreateWktWriter" $ I.geos_WKTWriterCreate h-  fp <- newForeignPtrEnv I.geos_WKTWriterDestroy h ptr-  return $ WktWriter fp+createWktWriter = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "CreateWktWriter" $ I.geos_WKTWriterCreate h+  traverse (fmap WktWriter . newForeignPtrEnv I.geos_WKTWriterDestroy h)+           eitherPtr -write_ :: Geometry a-        => (I.GEOSContextHandle_t -> Ptr I.GEOSWKBWriter -> Ptr I.GEOSGeometry -> Ptr CSize -> IO CString)-        -> Writer-        -> a-        -> Geos BC.ByteString-write_ f (Writer w) g = withGeos $ \h ->  do-  clen <- withForeignPtr w $ \wp ->-          withGeometry g $ \gp ->-            alloca $ \lp -> do-              cs <- f h wp gp lp-              vl <- fromIntegral `fmap` (peek lp)-              return (cs, vl)-  bs <- BC.packCStringLen clen-  return bs+write_+  :: Geometry a+  => (  I.GEOSContextHandle_t+     -> Ptr I.GEOSWKBWriter+     -> Ptr I.GEOSGeometry+     -> Ptr CSize+     -> IO CString+     )+  -> Writer+  -> a+  -> Geos BC.ByteString+write_ f (Writer w) g = withGeos $ \h -> do+  clen <- withForeignPtr w $ \wp -> withGeometry g $ \gp -> alloca $ \lp -> do+    cs <- f h wp gp lp+    vl <- fromIntegral `fmap` peek lp+    pure (cs, vl)+  BC.packCStringLen clen  write :: Geometry a => Writer -> a -> Geos BC.ByteString write = write_ I.geos_WKBWriterWrite@@ -108,10 +114,7 @@ writeHex = write_ I.geos_WKBWriterWriteHex  writeWkt :: Geometry a => WktWriter -> a -> Geos BC.ByteString-writeWkt (WktWriter w) g = withGeos $ \h ->  do-  wkt <- withForeignPtr w $ \wp ->-          withGeometry g $ \gp -> do-            cs <- I.geos_WKTWriterWrite h wp gp-            return cs-  bs <- BC.packCString wkt-  return bs+writeWkt (WktWriter w) g = withGeos $ \h -> do+  wkt <- withForeignPtr w+    $ \wp -> withGeometry g $ \gp -> I.geos_WKTWriterWrite h wp gp+  BC.packCString wkt

@@ -12,22 +12,27 @@   , centroid   , node   , delaunayTriangulation+  , voronoiDiagram+  , polygonize+  , minimumRotatedRectangle+  , minimumWidth+  , minimumClearanceLine+  , minimumClearance ) where import qualified Data.Geometry.Geos.Raw.Internal as I import Data.Geometry.Geos.Raw.Base import qualified Data.Geometry.Geos.Raw.Geometry as R-import Foreign +import Foreign hiding (throwIfNull, throwIf)+ geo_1 :: R.Geometry a        => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> IO (Ptr I.GEOSGeometry))        -> String        -> a       -> Geos a-geo_1 f s g = -  withGeos $ \h -> -    R.withGeometry g $ \gp -> do-      ptr <- throwIfNull s $ f h gp-      R.constructGeometry h ptr+geo_1 f s g = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' s $ R.withGeometry g $ f h +  traverse (R.constructGeometry h) eitherPtr  geo_2 :: R.Geometry a       => (I.GEOSContextHandle_t -> Ptr I.GEOSGeometry -> Ptr I.GEOSGeometry -> IO (Ptr I.GEOSGeometry))@@ -35,14 +40,13 @@       -> a       -> a       -> Geos a-geo_2 f s g1 g2  = do-  withGeos $ \h -> -    R.withGeometry g1 $ \gp -> -      R.withGeometry g2 $ \gp2 -> do-        ptr <- throwIfNull s $ f h gp gp2-        R.constructGeometry h ptr+geo_2 f s g1 g2  =  withGeos' $ \h -> do+  eitherPtr <- throwIfNull' s $  R.withGeometry g1 $ \gp -> +      R.withGeometry g2 (f h gp)+  traverse (R.constructGeometry h) eitherPtr  + envelope :: R.Geometry a => a -> Geos a envelope = geo_1 I.geos_Envelope "envelope"  @@ -76,22 +80,67 @@ node :: R.Geometry a => a -> Geos a node = geo_1 I.geos_Node "node" +{-+ Polygonizes a set of Geometries which contain linework that+ represents the edges of a planar graph.+ + All types of Geometry are accepted as input; the constituent+ linework is extracted as the edges to be polygonized.+ + The edges must be correctly noded; that is, they must only meet+ at their endpoints.  The set of extracted polygons+ is guaranteed to be edge-disjoint. This is useful when it is known+ that the input lines form a valid polygonal geometry (which may+ include holes or nested polygons).+-}+polygonize :: R.Geometry a => [ a ] -> Geos a+polygonize geoms = withGeos' $ \h -> alloca $ \arrPtr -> do+  _ <- traverse (writeIndexed arrPtr) $ [0 ..] `zip` geoms+  eitherPtr <- throwIfNull' "polygonize" $ I.geos_Polygonize_valid h arrPtr $ fromIntegral (length geoms)+  traverse (R.constructGeometry h) eitherPtr +  where+    writeIndexed arrayPtr (idx, geom) = R.withGeometry geom $ \geoPtr -> pokeElemOff arrayPtr idx geoPtr+++{-+ Returns the minimum rotated rectangular POLYGON which encloses the input geometry. The rectangle has width equal to the minimum diameter, and a longer length. If the convex hull of the input is degenerate (a line or point) a LINESTRING or POINT is returned. The minimum rotated rectangle can be used as an extremely generalized representation for the given geometry.+-}+minimumRotatedRectangle :: R.Geometry a => a -> Geos a+minimumRotatedRectangle = geo_1 I.geos_MinimumRotatedRectangle "minimumRotatedRectangle"++-- | Returns a LINESTRING geometry which represents the minimum diameter of the geometry. The minimum diameter is defined to be the width of the smallest band that contains the geometry, where a band is a strip of the plane defined  by two parallel lines. This can be thought of as the smallest hole that the geometry  can be moved through, with a single rotation.+minimumWidth :: R.Geometry a => a -> Geos a+minimumWidth = geo_1 I.geos_MinimumWidth "minimumWidth"++-- | Returns a LineString whose endpoints define the minimum clearance of a geometry. If the geometry has no minimum clearance, an empty LineString will be returned.++minimumClearanceLine :: R.Geometry a => a -> Geos a+minimumClearanceLine = geo_1 I.geos_MinimumClearanceLine "minimumClearanceLine"++-- | Computes the minimum clearance of a geometry.  The minimum clearance is the smallest amount by which  a vertex could be move to produce an invalid polygon, a non-simple linestring, or a multipoint with  repeated points.  If a geometry has a minimum clearance of 'eps', it can be said that:+-- |  -  No two distinct vertices in the geometry are separated by less than 'eps'+-- |  -  No vertex is closer than 'eps' to a line segment of which it is not an endpoint.+--  If the minimum clearance cannot be defined for a geometry (such as with a single point, or a multipoint whose points are identical, a value of Infinity will be calculated.+minimumClearance :: R.Geometry a => a -> Geos Double+minimumClearance geom = withGeos' $ \h ->+  R.withGeometry geom $ \gptr ->  alloca $ \dptr ->  do+    eitherInt <-  throwIf' (0 /=) (mkErrorMessage "minimumClearance") $ I.geos_MinimumClearance h gptr dptr+    traverse (\_ -> realToFrac <$> peek dptr) eitherInt++ -- | Return a Delaunay triangulation of the vertex of the given geometry @g@, where @tol@ is  the snapping tolerance to use.-delaunayTriangulation :: R.Geometry a => a -> Double -> Geos a-delaunayTriangulation g tol = do-  withGeos $ \h -> do-    R.withGeometry g $ \gp -> do -      ptr <- throwIfNull "delaunayTriangulation" $ I.geos_DelaunayTriangulation h gp (realToFrac tol) $ fromBool True-      R.constructGeometry h ptr+delaunayTriangulation :: R.Geometry a +                      => a +                      -> Double +                      -> Bool+                      -> Geos a+delaunayTriangulation g tol onlyEdges = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "delaunayTriangulation" $ R.withGeometry g $ \gp -> +      I.geos_DelaunayTriangulation h gp (realToFrac tol) $ fromBool onlyEdges+  traverse (R.constructGeometry h) eitherPtr             -#if GEOS_VERSION_MAJOR > 3 && GEOS_VERSION_MINOR > 4--- | --- TODO: make env Maybe Geometry voronoiDiagram :: R.Geometry a => a -> Maybe a -> Double -> Bool -> Geos a-voronoiDiagram g menv tol oe = do-  withGeos $ \h ->-    R.withGeometry g $ \gp -> -      R.withMaybeGeometry env $ \ep -> -        ptr <- throwIfNull "voronoiDiagram" $ I.geos_VoronoiDiagram hp gp ep (realToFrac tol) $ fromBool oe -        R.constructGeometry h ptr-#endif+voronoiDiagram g menv tol oe = withGeos' $ \h -> do+  eitherPtr <- throwIfNull' "voronoiDiagram" $ R.withGeometry g $ \gp -> +    R.withMaybeGeometry menv $ \ep -> I.geos_VoronoiDiagram h gp ep (realToFrac tol) $ fromBool oe +  traverse (R.constructGeometry h) eitherPtr

@@ -1,8 +1,13 @@-module Data.Geometry.Geos.Relatable where+module Data.Geometry.Geos.Relatable (+  Relatable(..)+) where -import Data.Geometry.Geos.Geometry +import           Data.Geometry.Geos.Geometry+import           Data.Geometry.Geos.Prepared import qualified Data.Geometry.Geos.Raw.Geometry as R+import qualified Data.Geometry.Geos.Raw.Prepared as RP + class Relatable a where   contains ::  a -> Geometry b -> Bool   coveredBy :: a -> Geometry b -> Bool@@ -16,14 +21,25 @@   instance Relatable (Geometry a) where-  disjoint = binaryPredicate R.disjoint-  touches = binaryPredicate R.touches+  disjoint   = binaryPredicate R.disjoint+  touches    = binaryPredicate R.touches   intersects = binaryPredicate R.intersects-  contains = binaryPredicate R.contains-  within = binaryPredicate R.within-  crosses = binaryPredicate R.crosses-  overlaps = binaryPredicate R.overlaps-  covers = binaryPredicate R.covers-  coveredBy = binaryPredicate R.coveredBy+  contains   = binaryPredicate R.contains+  within     = binaryPredicate R.within+  crosses    = binaryPredicate R.crosses+  overlaps   = binaryPredicate R.overlaps+  covers     = binaryPredicate R.covers+  coveredBy  = binaryPredicate R.coveredBy ++instance Relatable RP.PreparedGeometry where+  contains   = queryPrepared RP.contains+  coveredBy  = queryPrepared RP.coveredBy+  covers     = queryPrepared RP.covers+  crosses    = queryPrepared RP.crosses+  disjoint   = queryPrepared RP.disjoint+  intersects = queryPrepared RP.intersects+  overlaps   = queryPrepared RP.overlaps+  touches    = queryPrepared RP.touches+  within     = queryPrepared RP.within 

@@ -12,28 +12,33 @@ -}  -module Data.Geometry.Geos.STRTree ( -  foldr, -  toList,-  toVector,-  fromList,-  empty,-  build,-  insert,-  fromFoldable,-  fromFoldable_,-  lookup,-  RT.STRTree,-  RT.STRTreeBuilder-) where+module Data.Geometry.Geos.STRTree+  ( foldr+  , toList+  , toVector+  , fromList+  , empty+  , build+  , insert+  , fromFoldable+  , fromFoldable_+  , lookup+  , RT.STRTree+  , RT.STRTreeBuilder+  )+where -import Prelude hiding (foldr, lookup)-import qualified Data.Geometry.Geos.Raw.STRTree as RT-import qualified Data.Geometry.Geos.Raw.Geometry as RG-import Data.Geometry.Geos.Geometry-import Data.Geometry.Geos.Raw.Base-import Foreign-import qualified Data.Vector as V+import           Prelude                 hiding ( foldr+                                                , lookup+                                                )+import qualified Data.Geometry.Geos.Raw.STRTree+                                               as RT+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as RG+import           Data.Geometry.Geos.Geometry+import           Data.Geometry.Geos.Raw.Base+import           Foreign+import qualified Data.Vector                   as V  -- can't make instance of Foldable because of Storable constraint foldr :: (Storable a) => (a -> b -> b) -> b -> RT.STRTree a -> b@@ -54,28 +59,30 @@ empty = runGeos $ RT.createSTRTreeBuilder 10  build :: RT.STRTreeBuilder a -> RT.STRTree a-build = runGeos . RT.build +build = runGeos . RT.build  insert :: Storable a => Geometry b -> a -> RT.STRTreeBuilder a -> () insert geom item tree = runGeos $ do-    rg :: RG.GeomConst <- convertGeometryToRaw geom-    RT.insert tree rg item-    return ()+  rg :: RG.GeomConst <- convertGeometryToRaw geom+  RT.insert tree rg item+  return ()  {-| `fromFoldable` creates an STRTree with a default node capacity of 10. For finer-grained control over the node capacity, `fromFoldable_` accepts a node-capacity argument. -} fromFoldable :: (Foldable f, Storable b) => f (Geometry a, b) -> RT.STRTree b-fromFoldable  = fromFoldable_ 10+fromFoldable = fromFoldable_ 10 -fromFoldable_ :: (Foldable f, Storable b) => Int -> f (Geometry a, b) -> RT.STRTree b+fromFoldable_+  :: (Foldable f, Storable b) => Int -> f (Geometry a, b) -> RT.STRTree b fromFoldable_ capacity things = runGeos $ do   tree <- RT.createSTRTreeBuilder capacity   mapM_ (ins tree) things   RT.build tree-  where ins tree' (g,b) = do-          rg :: RG.GeomConst <- convertGeometryToRaw g-          RT.insert tree' rg b+ where+  ins tree' (g, b) = do+    rg :: RG.GeomConst <- convertGeometryToRaw g+    RT.insert tree' rg b   {-| 

@@ -4,61 +4,56 @@  Functions to read and write geometries in WKB and WKT formats. -The WKB format is specified in the OGC Simple Features for SQL specification. This implementation supports the extended WKB standard for representing 3-dimensional coordinates. The presence of 3D coordinates is signified by setting the high bit of the wkbType word. Empty Points cannot be represented in WKB; an IllegalArgumentException will be thrown if one is written. The WKB specification does not support representing 'LinearRing', they will be written as 'LineString'++Note the WKT is not able to represent an SRID, so conversions of geometries which contain an SRID into WKT will be lossy. -} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Data.Geometry.Geos.Serialize (-    readHex+module Data.Geometry.Geos.Serialize+  ( readHex   , readLotsOfHex   , writeHex   , readWkt   , writeWkt-) where+  )+where -import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry-import qualified Data.Geometry.Geos.Raw.Serialize as S-import qualified Data.Geometry.Geos.Raw.Geometry as R-import qualified Data.ByteString.Char8 as BC-import Data.Maybe (catMaybes)+import           Data.Geometry.Geos.Raw.Base+import           Data.Geometry.Geos.Geometry+import qualified Data.Geometry.Geos.Raw.Serialize+                                               as S+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as R+import qualified Data.ByteString.Char8         as BC  readHex :: BC.ByteString -> Maybe (Some Geometry)-readHex bs = runGeos $ do+readHex bs = runGeosM $ do   r <- S.createReader   g <- S.readHex r bs-  case g of-    Just g' -> Just <$> convertGeometryFromRaw g'-    Nothing -> return Nothing+  convertGeometryFromRaw g -readLotsOfHex :: [BC.ByteString] -> [Some Geometry]-readLotsOfHex bs = runGeos $ do+readLotsOfHex :: [BC.ByteString] -> Maybe [Some Geometry]+readLotsOfHex bs = runGeosM $ do   r <- S.createReader   x <- traverse (S.readHex r) bs-  traverse convertGeometryFromRaw $ catMaybes x+  traverse convertGeometryFromRaw x  writeHex :: Geometry a -> BC.ByteString writeHex g = runGeos $ do-  w <- S.createWriter+  w           <- S.createWriter   r :: R.Geom <- convertGeometryToRaw g   S.writeHex w r --- Read a string of WKT, optionally adding an SRID to the resulting geometry.-readWkt :: Maybe Int -> BC.ByteString -> Maybe (Some Geometry)-readWkt srid bs = runGeos $ do+readWkt :: BC.ByteString -> Maybe (Some Geometry)+readWkt bs = runGeosM $ do   r <- S.createWktReader   g <- S.readWkt r bs-  case g of-    Just g' -> do-      g'' <- R.setSRID srid g'-      Just <$> convertGeometryFromRaw g''-    Nothing -> return Nothing+  convertGeometryFromRaw g  writeWkt :: Geometry a -> BC.ByteString writeWkt g = runGeos $ do-  w <- S.createWktWriter+  w           <- S.createWktWriter   r :: R.Geom <- convertGeometryToRaw g   S.writeWkt w r

@@ -1,7 +1,6 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}-module Data.Geometry.Geos.Topology (-    envelope+module Data.Geometry.Geos.Topology+  ( envelope   , intersection   , convexHull   , difference@@ -13,51 +12,62 @@   , centroid   , node   , delaunayTriangulation-) where-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry-import qualified Data.Geometry.Geos.Raw.Topology as R-import qualified Data.Geometry.Geos.Raw.Geometry as RG+  , voronoiDiagram+  , polygonize+  , minimumRotatedRectangle+  , minimumClearance+  , minimumClearanceLine+  , minimumWidth+  )+where +import           Control.Monad+import qualified Data.Vector                   as V+import           Data.Geometry.Geos.Raw.Base+import           Data.Geometry.Geos.Geometry+import qualified Data.Geometry.Geos.Raw.Topology+                                               as R+import qualified Data.Geometry.Geos.Raw.Geometry+                                               as RG -geo_1 ::( RG.GeomConst -> Geos RG.GeomConst )-      -> Geometry a-      -> Some Geometry-geo_1 f g = runGeos $ do-    geo <- convertGeometryToRaw g-    convertGeometryFromRaw =<< f geo +geo_1+  :: (RG.GeomConst -> Geos RG.GeomConst) -> Geometry a -> Maybe (Some Geometry)+geo_1 f g = runGeosM $ do+  geo <- convertGeometryToRaw g+  convertGeometryFromRaw =<< f geo -geo_2 :: (RG.GeomConst -> RG.GeomConst -> Geos RG.GeomConst )-      -> Geometry a-      -> Geometry b-      -> Some Geometry-geo_2 f g1 g2 = runGeos $ do+geo_2+  :: (RG.GeomConst -> RG.GeomConst -> Geos RG.GeomConst)+  -> Geometry a+  -> Geometry b+  -> Maybe (Some Geometry)+geo_2 f g1 g2 = runGeosM $ do   g1' <- convertGeometryToRaw g1   g2' <- convertGeometryToRaw g2   convertGeometryFromRaw =<< f g1' g2'  -- | Returns a Polygon that represents the bounding envelope of this geometry. Note that it can also return a Point if the input geometry is a point.-envelope :: Geometry a -> Some Geometry+envelope :: Geometry a -> Maybe (Some Geometry) envelope = geo_1 R.envelope  -- | Returns a Geometry representing the points shared by both geometries.-intersection :: Geometry a -> Geometry b -> Some Geometry+intersection :: Geometry a -> Geometry b -> Maybe (Some Geometry) intersection = geo_2 R.intersection  -- | Returns the smallest Polygon that contains all the points in the geometry.-convexHull :: Geometry a -> Geometry Polygon-convexHull g = ensurePolygon $ geo_1 R.convexHull g+convexHull :: Geometry a -> Maybe (Geometry Polygon)+convexHull g = ensurePolygon =<< geo_1 R.convexHull g  -- | Returns a Geometry representing the points making up this geometry that do not make up other.-difference :: Geometry a -> Geometry b -> Some Geometry+difference :: Geometry a -> Geometry b -> Maybe (Some Geometry) difference = geo_2 R.difference  -- | Returns a Geometry combining the points in this geometry not in other, and the points in other not in this geometry.-symmetricDifference :: Geometry a -> Geometry b -> Some Geometry+symmetricDifference :: Geometry a -> Geometry b -> Maybe (Some Geometry) symmetricDifference = geo_2 R.symmetricDifference -boundary :: Geometry a -> Some Geometry+boundary :: Geometry a -> Maybe (Some Geometry) boundary = geo_1 R.boundary  -- | Returns a Geometry representing all the points in both geometries.@@ -69,33 +79,82 @@ Unioning a set of LineStrings has the effect of fully noding and dissolving the linework. Unioning a set of Polygons will always return a Polygonal geometry (unlike {link #union(Geometry)}, which may return geometrys of lower dimension if a topology collapse occurred. -}-union :: Geometry a -> Geometry b -> Some Geometry+union :: Geometry a -> Geometry b -> Maybe (Some Geometry) union = geo_2 R.union  -unaryUnion :: Geometry a -> Some Geometry+unaryUnion :: Geometry a -> Maybe (Some Geometry) unaryUnion = geo_1 R.unaryUnion  -- | Computes and returns a Point guaranteed to be on the interior of this geometry.-pointOnSurface :: Geometry a -> Geometry Point-pointOnSurface g = ensurePoint $ geo_1 R.pointOnSurface g+pointOnSurface :: Geometry a -> Maybe (Geometry Point)+pointOnSurface = ensurePoint <=< geo_1 R.pointOnSurface  -- | Returns a Point object representing the geometric center of the geometry. The point is not guaranteed to be on the interior of the geometry.-centroid :: Geometry a -> Geometry Point-centroid g = ensurePoint $ geo_1 R.centroid g+centroid :: Geometry a -> Maybe (Geometry Point)+centroid = ensurePoint <=< geo_1 R.centroid -node :: Geometry a -> Some Geometry+node :: Geometry a -> Maybe (Some Geometry) node = geo_1 R.node  -- | Return a Delaunay triangulation of the vertex of the given geometry @g@, where @tol@ is  the snapping tolerance to use.-delaunayTriangulation ::  Geometry a -> Double -> Geometry MultiLineString-delaunayTriangulation g d = ensureMultiLineString (geo_1 (flip R.delaunayTriangulation $ d) g)+delaunayTriangulation :: Geometry a +                      -> Double +                      -> Bool+                      -> Maybe (Some Geometry)+delaunayTriangulation g d onlyEdges =+  geo_1 (\g' -> R.delaunayTriangulation g' d onlyEdges) g -#if GEOS_VERSION_MAJOR > 3 && GEOS_VERSION_MINOR > 4-voronoiDiagram :: Geometry a -> Geometry b -> Double -> Bool -> Some Geometry-voronoiDiagram g env tol onlyEdges = runGeos $ do-  g' <- convertGeometryToRaw g-  env' <- convertGeometryToRaw env-	convertGeometryFromRaw =<< R.voronoiDiagram g' env' tol onlyEndges+-- | Returns the Voronoi polygons of a set of Vertices given as input+voronoiDiagram :: Geometry a          -- ^ the input geometry whose vertex will be used as sites+               -> Maybe (Geometry b)  -- ^ clipping envelope for the returned diagram, automatically determined if Nothing. The diagram will be clipped to the larger of this envelope or an envelope surrounding the sites +               -> Double              -- ^ snapping tolerance to use for improved robustness+               -> Bool                -- ^ whether to return only edges of the Voronoi cells+               -> Some Geometry+voronoiDiagram g menv tol onlyEdges = runGeos $ do+  g' :: RG.GeomConst <- convertGeometryToRaw g+  env'               <- traverse convertGeometryToRaw menv+  convertGeometryFromRaw =<< R.voronoiDiagram g' env' tol onlyEdges -#endif+{-+ Polygonizes a set of Geometries which contain linework that+ represents the edges of a planar graph.+ + All types of Geometry are accepted as input; the constituent+ linework is extracted as the edges to be polygonized.+ + The edges must be correctly noded; that is, they must only meet+ at their endpoints.  The set of extracted polygons+ is guaranteed to be edge-disjoint. This is useful when it is known+ that the input lines form a valid polygonal geometry (which may+ include holes or nested polygons).+-}+polygonize :: V.Vector (Geometry a) -> Maybe (Geometry Polygon)+polygonize vec =+  ensurePolygon+    =<< (runGeosM $ do+          listGeom :: [RG.Geom] <- traverse convertGeometryToRaw $ V.toList vec+          pgon                  <- R.polygonize listGeom+          convertGeometryFromRaw pgon+        )++{-+ Returns the minimum rotated rectangular POLYGON which encloses the input geometry. The rectangle has width equal to the minimum diameter, and a longer length. If the convex hull of the input is degenerate (a line or point) Nothing is returned. The minimum rotated rectangle can be used as an extremely generalized representation for the given geometry.+-}++minimumRotatedRectangle :: Geometry a -> Maybe (Geometry Polygon)+minimumRotatedRectangle = ensurePolygon <=< geo_1 R.minimumRotatedRectangle++-- | Returns a LINESTRING geometry which represents the minimum diameter of the geometry. The minimum diameter is defined to be the width of the smallest band that contains the geometry, where a band is a strip of the plane defined  by two parallel lines. This can be thought of as the smallest hole that the geometry  can be moved through, with a single rotation.+minimumWidth :: Geometry a -> Maybe (Geometry LineString)+minimumWidth = ensureLineString <=< geo_1 R.minimumWidth+++minimumClearance :: Geometry a -> Maybe Double+minimumClearance geom = runGeosM $ do+  raw :: RG.Geom <- convertGeometryToRaw geom+  R.minimumClearance raw+++minimumClearanceLine :: Geometry a -> Maybe (Geometry LineString)+minimumClearanceLine = ensureLineString <=< geo_1 R.minimumClearanceLine

@@ -0,0 +1,38 @@+module Data.Geometry.Geos.RelatableSpec+  ( +    relatableSpec+  )+where++import           Test.Hspec+import           Helpers+import           Data.Geometry.Geos.Relatable++poly1 = fromRight $ makePolygonGeo [[(0, 0), (0, 1), (1, 1), (1.5, 1.5), (1, 0), (0, 0)]]++point1 = makePointGeo (0.5, 0.5)+point2 = makePointGeo (0.5, 1000.4)+point3 = makePointGeo (0, 0.5)+++poly2 = fromRight $ makePolygonGeo+  [ [(0, 0), (0, 1), (1, 1), (1.5, 1.5), (1, 0), (0, 0)]+  , [(0.1, 0.1), (0.1, 0.9), (0.9, 0.1), (0.1, 0.1)]+  ]++poly3 = fromRight $ makePolygonGeo +  [[(38, 40), (39, 40), (40, 42), (40, 44), (38, 44), (38, 40)]]++relatableSpec = describe "Relatable" $ do+  describe "contains" $ do+    it "should relate a polygon containing a point " $ contains poly1 point1 `shouldBe` True+    it "should relate a polygon not containing a point " $ contains poly1 point2 `shouldBe` False+  describe "touches" $ do+    it "should relate a polygon touching a point" $ touches poly1 point3 `shouldBe` True+    it "should relate a polygon not touching a point" $ touches poly1 point1 `shouldBe` False+  describe "intersects" $ do+    it "should relate a polyon intersecting another polygon" $ intersects poly1 poly2 `shouldBe` True+  describe "disjoint" $ do+    it "should relate disjoint polygons" $ disjoint poly1 poly3 `shouldBe` True+    it "should relate NON-disjoint polygons" $ disjoint poly1 poly2 `shouldBe` False+

@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Geometry.Geos.SerializeSpec+  ( +    serializeSpec+  )+where++import qualified Data.ByteString               as BS+import qualified Data.ByteString.Char8         as BS8+import           Data.Maybe                     ( mapMaybe+                                                , catMaybes+                                                )++import           Test.Hspec+import           Helpers+import           Data.Geometry.Geos.Serialize+import           Data.Geometry.Geos.Geometry+import Debug.Trace++multiLineStringWKB = "0105000020C46E000001000000010200000004000000EE2DE25E859A20410829F224364B5A41BD757FB6679A204115C6D8E9304B5A4177111862469A2041A03F04E32C4B5A41BC1D3ADD459A2041793C8CD92C4B5A41" :: BS.ByteString++multiLineStringWKT = "MULTILINESTRING ((544066.6853193619754165 6892760.5772802904248238, 544051.8564411919796839 6892739.6538558201864362, 544035.1915898759616539 6892723.5471343100070953, 544034.9320840160362422 6892723.3991843396797776))" :: BS.ByteString++multiLineString1 = MultiLineStringGeometry (fromRight $ makeMultiLineString  [[(544066.685319362, 6892760.57728029), (544051.856441192, 6892739.65385582), (544035.191589876, 6892723.54713431), (544034.932084016, 6892723.39918434)]]) (Just 28356)++multiLineStringNoSRID = MultiLineStringGeometry (fromRight $ makeMultiLineString  [[(544066.685319362, 6892760.57728029), (544051.856441192, 6892739.65385582), (544035.191589876, 6892723.54713431), (544034.932084016, 6892723.39918434)]]) Nothing+++--loadThingsFromFile :: FilePath -> IO [Some Geometry]+--loadThingsFromFile fp = do+--  rows <- BS8.readFile fp+--  return $ catMaybes $ readHex <$> (BS8.lines rows)+++serializeSpec = describe "Serialize" $ do+  describe "readHex" $ do+    it "should convert a WKB bytestring to a geometry" $ (readHex multiLineStringWKB >>= ensureMultiLineString)  `shouldBe` Just multiLineString1+    it "should read a file with thousands of WKB points" $ do+      rows <- BS8.readFile "tests/sampledata/points.csv"+      let geoms = catMaybes $ readHex <$> BS8.lines rows+      geoms `shouldSatisfy` ((34582 ==) . length . mapMaybe ensurePoint)+    it "should read a file with dozens of WKB polygons" $ do+      rows <- BS8.readFile "tests/sampledata/polygons.csv"+      let geoms = catMaybes $ readHex <$> BS8.lines rows+      geoms `shouldSatisfy` ((98 ==) . length . mapMaybe ensurePolygon)+  describe "writeHex" $ +    it "should convert a geometry to a WKB bytestring" $ writeHex multiLineString1 `shouldBe` multiLineStringWKB ++  describe "writeWkt" $ +    it "should convert a geometry to WKT string" $ writeWkt multiLineString1  `shouldBe` multiLineStringWKT+  describe "readWkt" $ +    it "should convert a WKT string to a geometry" $ readWkt multiLineStringWKT  `shouldBe` (Just $ Some multiLineStringNoSRID)+

@@ -0,0 +1,106 @@++module Data.Geometry.Geos.TopologySpec+  ( topologySpec+  )+where++import           Test.Hspec+import qualified Data.Vector                   as V+import           Data.Either hiding (fromRight)+import           Helpers+import           Data.Geometry.Geos.Geometry+import           Data.Geometry.Geos.Topology++++poly1 = fromRight $ makePolygonGeo [[(0, 0), (0, 1), (1, 1), (1.5, 1.5), (1, 0), (0, 0)]]++cornerOnlyPoly = fromRight $ makePolygonGeo [[(1.0, 1.0), (1.5, 1.5), (1.0, 0.0), (1.0, 1.0)]]++poly2 = fromRight $ makePolygonGeo+  [ [(0, 0), (0, 1), (1, 1), (1.5, 1.5), (1, 0), (0, 0)]+  , [(0.1, 0.1), (0.1, 0.9), (0.9, 0.1), (0.1, 0.1)]+  ]+poly2Hull =+  fromRight $ makePolygonGeo [[(0.0, 0.0), (0.0, 1.0), (1.5, 1.5), (1.0, 0.0), (0.0, 0.0)]]+poly3 =+  fromRight $ makePolygonGeo [[(0.0, 0.0), (1.0, 0.0), (1.0, 1.0), (0.0, 1.0), (0.0, 0.0)]]+poly3Boundary = fromRight $ makeLineStringGeo [(0.0, 0.0), (1.0, 0.0), (1.0, 1.0), (0.0, 1.0), (0.0, 0.0)]+poly4 =+  fromRight $ makePolygonGeo [+    [(1.0, 1.0), (1.0, 2.0), (2.0, 2.0), (2.0, 1.0), (1.0, 1.0)]+  ]+poly5 = +  fromRight $ makePolygonGeo [[(0.0, 0.0),(0.0, 1.0),(1.0, 1.0),(1.0, 2.0),(2.0, 2.0),(2.0, 1.0),(1.3333333333333333, 1.0),(1.0, 0.0),(0.0, 0.0)]]+env1 =+  fromRight $ makePolygonGeo [[(0.0, 0.0), (1.5, 0.0), (1.5, 1.5), (0.0, 1.5), (0.0, 0.0)]]+lineString1 = fromRight $ makeLineStringGeo [(0, 0), (0, 1), (1, 1)]+lineString1Hull = fromRight $ makePolygonGeo [[(0, 0), (0, 1), (1, 1), (0, 0)]]+point1 = makePointGeo (0.5, 1.0)++topologySpec = describe "Topology" $ do+  describe "envelope" $ do+    it "should create an envelope for a plain polygon" $ (envelope poly1 >>= ensurePolygon)  `shouldBe` Just env1+    it "should create an envelope for a polygon with holes" $ (envelope poly2 >>= ensurePolygon)  `shouldBe` Just env1+    it "should create an envelope for a linestring" $ (envelope lineString1 >>= ensurePolygon) `shouldBe` Just poly3+  describe "intersection" $  do+    it "should create a point for polygons with a single-point intersection" $ (intersection poly3 poly4 >>= ensurePoint) `shouldBe` (Just $ makePointGeo (1.0, 1.0))+  describe "convexHull" $ do+    it "should make a convex hull from a polygon" $ convexHull poly2 `shouldBe` Just poly2Hull+    it "should make a convex hull from a linestring" $ convexHull lineString1 `shouldBe` Just lineString1Hull+    it "should not make a convex hull from a point" $ convexHull point1 `shouldBe` Nothing+  describe "difference" $ do+    it "should compute the difference between polygons" $ (difference poly1 poly3  >>= ensurePolygon) `shouldBe` Just cornerOnlyPoly+    it "should compute the difference between a polygon and a linestring" $ do+      (difference poly4 lineString1 >>= ensurePolygon) `shouldBe` Just poly4+  describe "boundary" $ do+    it "should compute the boundary of a polygon" $ do+      (boundary poly3 >>= ensureLineString) `shouldBe` Just poly3Boundary+  describe "union" $ do +      it "should compute the union of two polygons" $ do+        (union poly1 poly4) `shouldBe` (Just $ Some poly5)+  describe "unaryUnion"  $ do +      it "should compute the unary union of a multi polygon" $ +        let pgons = fmap (\case (PolygonGeometry p _)  -> p) [poly1, poly4]+            multiPgon = MultiPolygonGeometry (multiPolygon $ V.fromList pgons) Nothing+        in (unaryUnion multiPgon) `shouldBe` (Just $ Some poly5)+  describe "centroid"  $ do+    it "should compute the centroid of a polygon" $ +      centroid poly1 `shouldBe` (Just $ PointGeometry (point $ coordinate2 0.6333333333333333 0.5666666666666667) Nothing)+  describe "delaunayTriangulation"  $  do+    it "should compute the delaunay triangulation of a simple polygon" $ do+      let ls1 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(0.0, 1.0),(1.5, 1.5) ] )+          ls2 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(0.0, 0.0),(0.0, 1.0) ] )+          ls3 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(0.0, 0.0),(1.0, 0.0) ] )+          ls4 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(1.0, 0.0),(1.5, 1.5) ] )+          ls5 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(1.0, 0.0),(1.0, 1.0) ] )+          ls6 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(1.0, 1.0),(1.5, 1.5) ] )+          ls7 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(0.0, 1.0),(1.0, 1.0) ] )+          ls8 = lineString $  V.map (uncurry coordinate2) ( V.fromList [(0.0, 1.0),(1.0, 0.0) ] )+          lineStrings = multiLineString $ V.fromList $ rights [+            ls1, ls2, ls3, ls4, ls5, ls6, ls7, ls8 ]++       in (delaunayTriangulation poly1 0.1 True >>= ensureMultiLineString) `shouldBe` (Just $ MultiLineStringGeometry lineStrings Nothing)+  describe "voronoiDiagram" $ do+    it "should compute the voronoi diagram of a polygon" $ +      let p1 = makePolygonGeo [[(0.5, 0.5), (0.5, 2.0), (2.0, 0.5), (0.5, 0.5)]]+          p2 = makePolygonGeo [[(-1.5, 0.5), (-1.5, 3.0), (0.16666666666666652, 3.0), (0.5, 2.0), (0.5, 0.5), (-1.5, 0.5)]]+          p3 = makePolygonGeo [[(0.5, -1.5), (-1.5, -1.5), (-1.5, 0.5), (0.5, 0.5), (0.5, -1.5)]]+          p4 = makePolygonGeo [[(3.0, 0.16666666666666663), (3.0, -1.5), (0.5, -1.5), (0.5, 0.5), (2.0, 0.5), (3.0, 0.16666666666666663)]]+          p5 = makePolygonGeo [[(0.16666666666666652, 3.0), (3.0, 3.0), (3.0, 0.16666666666666663), (2.0, 0.5), (0.5, 2.0), (0.16666666666666652, 3.0)]]+          collection = geometryCollection $ V.fromList $ Some <$> rights [p1, p2,  p3, p4, p5 ]++       in ( ensureGeometryCollection $ voronoiDiagram poly1 Nothing 0.1 False) `shouldBe` (Just $ CollectionGeometry collection Nothing)++  describe "polygonize" $ do+    it "should polygonize a set of polygons" $ do+      let result = fromRight $ makePolygonGeo $ [[(0.1, 0.1), (0.1, 0.9), (0.9, 0.1), (0.1, 0.1)]]+      (polygonize $ V.fromList [poly1, poly2]) `shouldBe` Just result++  describe "minimumRotatedRectangle" $ do+    it "should create a minumum rotated rectangle from a polygon" $+      let poly = fromRight $ makePolygonGeo [[(-0.3, 0.9), (9.999999999999999e-2, -0.3), (1.9, 0.3), (1.5, 1.5), (-0.3, 0.9)]]+       in minimumRotatedRectangle poly1 `shouldBe` Just poly+  describe "minimumClearance" $ do +    it "should compute the minimum clearance for a polygon" $ do+      minimumClearance poly1 `shouldBe` Just 0.316227766016838

@@ -0,0 +1,38 @@+module Helpers where+++import qualified Data.Vector as V++import Data.Geometry.Geos.Geometry++makePoint (c1, c2) = point $ coordinate2 c1 c2+makePointGeo c = PointGeometry (makePoint c) Nothing++makeLinearRing :: [(Double, Double)] -> Either GeometryConstructionError LinearRing+makeLinearRing = linearRing . V.map (uncurry coordinate2) . V.fromList++makeLinearRingGeo =  fmap (\lr -> LinearRingGeometry lr Nothing) . makeLinearRing++makeLineString :: [(Double, Double)] -> Either GeometryConstructionError LineString+makeLineString = lineString . V.map (uncurry coordinate2) . V.fromList++makeLineStringGeo cs = fmap (\ls -> LineStringGeometry ls Nothing) $ makeLineString cs +++makePolygon :: [[(Double, Double)]] -> Either GeometryConstructionError Polygon+makePolygon ls = do+  lRings <- traverse makeLinearRing ls+  polygon $ V.fromList lRings++makePolygonGeo cs = fmap (\pg -> PolygonGeometry pg Nothing) $ (makePolygon cs)++makeMultiLineString :: [[(Double, Double)]] -> Either GeometryConstructionError MultiLineString+makeMultiLineString ls = fmap (multiLineString . V.fromList) (traverse makeLineString ls)++makeMultiLineStringGeo lss = fmap (\ls -> MultiLineStringGeometry ls Nothing) $ makeMultiLineString lss++fromRight :: Either a b -> b+fromRight (Right v) = v+fromRight _         = error "Shouldn't happen."++

@@ -1,24 +1,14 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Main where-import qualified Data.ByteString as BS import Test.Hspec-import Control.Exception-import Data.Geometry.Geos.Serialize-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry-import qualified Data.Geometry.Geos.Raw.CoordSeq as RC-import qualified Data.Geometry.Geos.Raw.Serialize as RS-import qualified Data.Geometry.Geos.Raw.Geometry as R-import qualified Data.Vector as V-import Debug.Trace -import ParsingSpec-import RawGeometrySpec-import SpatialOperationsSpec+import Data.Geometry.Geos.TopologySpec+import Data.Geometry.Geos.RelatableSpec+import Data.Geometry.Geos.SerializeSpec  main :: IO () main = hspec $ do-  rawGeometrySpecs-  parsingSpecs-  spatialOpsSpecs+  topologySpec+  relatableSpec+  serializeSpec

@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}--module ParsingSpec where--import Prelude hiding (read)-import qualified Data.ByteString as BS-import Test.Hspec-import Control.Exception-import Data.Geometry.Geos.Relatable-import Data.Geometry.Geos.Serialize-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry-import qualified Data.Geometry.Geos.Raw.CoordSeq as RC-import qualified Data.Geometry.Geos.Raw.Serialize as RS-import qualified Data.Geometry.Geos.Raw.Geometry as R-import qualified Data.Vector as V-import Data.Maybe (fromJust)--import SpecSampleData--parsingSpecs = describe "Tests Serialization" $ do-  it "Parses a bytestring to a linestring" $  do-    ensureLineString <$> readHex linestringBS `shouldBe` Just linestring-  it "Parse a multipolygon" $ do-    ensureMultiPolygon <$> readHex multiPolygonStringBS `shouldBe` Just multiPolygon-  it "Serializes a LineString into a bytestring" $ do-    linestringBS `shouldBe` writeHex linestring-  it "Serializes a LineString to WKT" $ do-    linestringWkt `shouldBe` (writeWkt linestring)-  it "Can parse WKT" $ do-    ensureLineString <$> readWkt (Just 4326) linestringWkt `shouldBe` Just linestring-  it "can parse lots of things" $ do-    polygons <- (fmap ensurePolygon) <$> loadThingsFromFile "tests/sampledata/polygons.csv"-    (length polygons) `shouldBe` 98-    points <- (fmap ensurePoint) <$> loadThingsFromFile "tests/sampledata/points.csv"-    (length points) `shouldBe` 34582-  it "can read a long list" $ do-    points <- (fmap ensurePoint) <$> loadThingsFromFile "tests/sampledata/points.csv"-    (length points) `shouldBe` 34582-    -- Because we're in Australia (below the equator) all the points in this set should have a latitude < 0-    let filteredPoints = filter (\(PointGeometry (Point (Coordinate2 lat long)) _) -> long > 0) points-    -- running this test multiple times will generate a random length list-    length filteredPoints `shouldBe` 0-  it "can read a long list in one op" $ do-    points <- (fmap ensurePoint) <$> loadThingsFromFile' "tests/sampledata/points.csv"-    (length points) `shouldBe` 34582-    -- Because we're in Australia (below the equator) all the points in this set should have a latitude < 0-    let filteredPoints = filter (\(PointGeometry (Point (Coordinate2 lat long)) _) -> long > 0) points-    -- running this test multiple times will generate a random length list-    length filteredPoints `shouldBe` 0-  it "handles nonesense properly" $ do-    let bs = "2D50491A5DC024275C1ED5DE4040" :: BS.ByteString-    Nothing `shouldBe` (fmap ensurePoint $ readHex bs)--  it "can write/read with zero loss of information" $ do-    let bs = "0105000020C46E000001000000010200000004000000EE2DE25E859A20410829F224364B5A41BD757FB6679A204115C6D8E9304B5A4177111862469A2041A03F04E32C4B5A41BC1D3ADD459A2041793C8CD92C4B5A41" :: BS.ByteString-        srid = Just 28356-        points = [[(544066.685319362, 6892760.57728029),-                   (544051.856441192, 6892739.65385582),-                   (544035.191589876, 6892723.54713431),-                   (544034.932084016, 6892723.39918434)]]-        expectedGeo = MultiLineStringGeometry (makeMultiLineString points) srid-        parsedGeo = fromJust (fmap ensureMultiLineString $ readHex bs)-    parsedGeo `shouldBe` expectedGeo-    let encodedHex = writeHex expectedGeo-    encodedHex `shouldBe` bs------searchPoints :: [Geometry Point] -> Geometry Polygon -> [Geometry Point]-searchPoints points polygon = filter f points-  where f point = contains polygon point

@@ -1,98 +0,0 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}-module RawGeometrySpec where--import qualified Data.ByteString as BS-import Test.Hspec-import Control.Exception-import Data.Geometry.Geos.Relatable-import Data.Geometry.Geos.Serialize-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry-import qualified Data.Geometry.Geos.Raw.CoordSeq as RC-import qualified Data.Geometry.Geos.Raw.Serialize as RS-import qualified Data.Geometry.Geos.Raw.Geometry as R-import qualified Data.Vector as V-import Data.Maybe (fromJust)--import SpecSampleData--rawGeometrySpecs = describe "raw geometry" $ do--  it "Creates a Coordinate Sequence" $  do-    let (size, dim) = runGeos $ do-          cs :: RC.CoordSeq <- RC.createEmptyCoordinateSequence 2 2-          size <-  RC.getCoordinateSequenceSize cs-          dim <-  RC.getCoordinateSequenceDimensions cs-          return (size, dim)-    size `shouldBe` (2 :: Int)-    dim `shouldBe` (2 :: Int)-  it "Sets a Coordinate Sequence" $ do-    let (d1, d2) = runGeos $ do-          c :: RC.CoordSeq <- RC.createEmptyCoordinateSequence 2 2-          RC.setCoordinateSequenceX c 0 5.0-          RC.setCoordinateSequenceY c 0 10.0-          d1 <- RC.getCoordinateSequenceX c 0-          d2 <- RC.getCoordinateSequenceY c 0-          return (d1, d2)-    d1 `shouldBe` (5.0 :: Double)-    d2 `shouldBe` (10.0 :: Double)--  it "Creates a LineString " $ do-    let tid = runGeos $ do-          cs :: RC.CoordSeqConst <- RC.createEmptyCoordinateSequence 2 2-          ls :: R.Geom <- R.createLineString cs-          R.getTypeId ls-    tid `shouldBe` R.LineStringTypeId-  it "Creates a Geometry" $ do-    pending--  it "Converts a LineString" $ do-    let (srid, tid, tn) = runGeos $ do-          l :: R.Geom <- convertGeometryToRaw linestring-          t <- R.getTypeId l-          s <- R.getSRID l-          tn <- R.getTypeName l-          return (s, t, tn)-    tid `shouldBe` R.LineStringTypeId-    srid `shouldBe` (Just 4326)-    tn `shouldBe` "LineString"-  it "Converts a Polygon" $ do-    let t = runGeos $ do-          rp :: R.Geom <-  convertGeometryToRaw $ PolygonGeometry polygon1 Nothing-          R.getTypeId rp-    t `shouldBe` R.PolygonTypeId-  it "Converts a MultiPolygon from Raw" $ do-    let (x,y) = runGeos $ do-          r <- RS.createReader-          mpr <- RS.readHex r multiPolygonStringBS-          MultiPolygon vps <- convertMultiPolygonFromRaw $ fromJust mpr-          let (Polygon vlr) = vps V.! 0-              (LinearRing vc) = vlr V.! 0-              (Coordinate2 x y) = vc V.! 0-          return (x, y)--    x `shouldBe` 153.160525-    y `shouldBe` -27.377412-  it "Tests disjoint" $ do-     (disjoint (PolygonGeometry polygon1 Nothing) (PolygonGeometry polygon2 Nothing)) `shouldBe` False-  it "Tests intersects" $ do-     intersects (PolygonGeometry polygon1 Nothing) (PolygonGeometry polygon2 Nothing) `shouldBe` True-  it "Tests raw parsing" $ do-      let (x,y) = runGeos $ do-              r <- RS.createReader-              g <- RS.readHex r multiPolygonStringBS-              gi :: R.GeomConst <- R.getGeometryN (fromJust g) 0-              ir :: R.GeomConst <- R.getExteriorRing gi-              cs <- R.getCoordinateSequence ir-              x <- RC.getCoordinateSequenceX cs 0-              y <- RC.getCoordinateSequenceY cs 0-              return (x,y)-      x `shouldBe` 153.160525-      y `shouldBe` -27.377412-  it "Tests Distance" $ do-    let a = makePointGeo (0,0)-        b = makePointGeo (0,2)-    let d = distance a b-        hd = hausdorffDistance a b-    d   `shouldBe` 2.0-    hd  `shouldBe` 2.0

@@ -1,87 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}--module SpatialOperationsSpec where--import Test.Hspec-import qualified Data.ByteString as BS-import qualified Data.Vector as V-import Data.Geometry.Geos.Raw.Base-import Data.Geometry.Geos.Geometry-import Data.Geometry.Geos.Relatable-import Data.Geometry.Geos.Topology-import qualified Data.Geometry.Geos.STRTree as STR-import Data.Word--import SpecSampleData--spatialOpsSpecs = describe "Tests Contains" $ do-  it "Does polygon to point comparison" $ do-    let polygon         = makePolygonGeo [[(0,0), (0,1), (1,1), (1,0), (0,0)]]-        polygonWithHole = makePolygonGeo [ [(0,0), (0,1), (1,1), (1,0), (0,0)], [(0.1,0.1),(0.1,0.9),(0.9,0.1),(0.1,0.1)] ]-        pointIn         = makePointGeo (0.6, 0.6)-        pointOut        = makePointGeo (1.5, 0.5)-        pointInHole     = makePointGeo (0.4, 0.4)-    (contains polygon pointIn) `shouldBe` True-    (contains polygon pointOut) `shouldBe` False-    (contains polygonWithHole pointIn) `shouldBe` True-    (contains polygonWithHole pointOut) `shouldBe` False-    (contains polygonWithHole pointInHole) `shouldBe` False--  it "Does simple polygon to polygon comparison" $ do-    let polygonBig   = makePolygonGeo [ [(0,0), (0,2), (2,2), (2,0), (0,0)] ]-        polygonSmall = makePolygonGeo [ [(0,0), (0,1), (1,1), (1,0), (0,0)] ]-        polygonIntersect = makePolygonGeo [ [(0,0), (0,2.5), (1,1), (1,0), (0,0)] ]-    (contains polygonBig polygonSmall) `shouldBe` True-    (contains polygonBig polygonBig) `shouldBe` True-    (contains polygonBig polygonIntersect) `shouldBe` False--  it "Does multi polygon to point comparison" $ do-    let polygonBig   = [ [(0,0), (0,2), (2,2), (2,0), (0,0)]]-        polygonSmall = [ [(3,0), (3,1), (4,1), (4,0), (3,0)]]-        multiPoly    = makeMultiPolygonGeo [polygonBig, polygonSmall]-        pointIn      = makePointGeo (0.5, 0.5)-        pointOut     = makePointGeo (2.5, 0.5)-    (contains multiPoly pointIn) `shouldBe` True-    (contains multiPoly pointOut) `shouldBe` False-  it "Projects a point against a linestring" $ do-      let lr = makeLineStringGeo [(0,0), (0, 1), (1, 1)]-          p = makePointGeo (0.5, 1.0)--- The point on this line string nearest (0.5, 1.0) is 1.5 units from the origin. i.e., halfway between the second and third point.-      project lr p `shouldBe` 1.5-      interpolate lr 1.5 `shouldBe` p-      projectNormalized lr p `shouldBe` 0.75-      interpolateNormalized lr 0.75 `shouldBe` p-  it "Tests disjoint geometries" $ do-    let poly = makePolygonGeo [[(0,0), (0,1), (1,1), (1,0), (0,0)]]-        p1 = makePointGeo (2,2)-        p2 = makePointGeo (0.5, 0.5)-    disjoint poly p1 `shouldBe` True-    disjoint poly p2 `shouldBe` False-  it "creates an envelope / boundary of a geometry" $ do-    let poly1 = makePolygonGeo [[(0,0), (0,1), (1,1), (1.5, 1.5), (1,0), (0,0)]]-        env1 = makePolygonGeo [[(0.0, 0.0), (1.5, 0.0), (1.5, 1.5), (0.0, 1.5), (0.0, 0.0)]]-        poly2 = makePolygonGeo [ [(0,0), (0,1), (1,1), (1,0), (0,0)], [(0.1,0.1),(0.1,0.9),(0.9,0.1),(0.1,0.1)] ]-        env2 = makeMultiLineStringGeo [[(0.0, 0.0), (0.0, 1.0), (1.0, 1.0), (1.0, 0.0), (0.0, 0.0)], [(0.1, 0.1), (0.1, 0.9), (0.9, 0.1), (0.1, 0.1)]]-        env3 = makePolygonGeo [ [(0,0), (0,1), (1,1), (1,0), (0,0)] ]-        point = makePointGeo (2.5, 0.5)-    (ensurePolygon $ envelope poly1) `shouldBe` env1-    (ensurePoint $ envelope point) `shouldBe` point-    (ensureMultiLineString $ boundary poly2) `shouldBe` env2-    convexHull poly2 `shouldBe` env3--  it "can use STRTrees" $ do-    let points = makePointGeo <$> [(0.1,0.1), (0.9, 0.9)]-        polygon = makePolygonGeo [[(0,0),(0,1),(1,1),(1,0),(0,0)]]-        tree = STR.fromList $ zip points [(0::Int)..]-        result = STR.lookup polygon tree -    result `shouldBe` V.fromList [0,1]--  it "can run STRTrees on larger data" $ do-    points <- (fmap ensurePoint) <$> loadThingsFromFile "tests/sampledata/points.csv"-    polygons <- (fmap ensurePolygon) <$> loadThingsFromFile "tests/sampledata/polygons.csv"-    let tree = STR.fromList $ zip polygons [(0::Int)..]-    let results = fmap (\p -> STR.lookup p tree) $ take 5000 points-    let total = sum $ fmap sum results-    total `shouldBe` 45

@@ -1,53 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module SpecSampleData where--import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BS8-import qualified Data.Vector as V-import Data.Geometry.Geos.Serialize-import Data.Geometry.Geos.Geometry-import Data.Maybe (catMaybes)--point = PointGeometry (Point $ Coordinate2 36.1 (-119.1)) (Just 4326)-makePoint (c1, c2) = Point $ Coordinate2 c1 c2-makePointGeo c = PointGeometry (makePoint c) Nothing-makeLinearRing = LinearRing . V.map (uncurry Coordinate2) . V.fromList-makeLinearRingGeo cs = LinearRingGeometry (makeLinearRing cs) Nothing-makeLineString = LineString . V.map (uncurry Coordinate2) . V.fromList-makeLineStringGeo cs = LineStringGeometry  (makeLineString cs ) Nothing-makePolygon = Polygon . V.fromList . (fmap makeLinearRing)-makePolygonGeo cs = PolygonGeometry (makePolygon cs) Nothing-makeMultiLineString =  MultiLineString . V.fromList . (fmap  makeLineString)-makeMultiLineStringGeo lss = MultiLineStringGeometry (makeMultiLineString lss) Nothing---- Expects a file containing one geom per line WKB(Hex) encoded-loadThingsFromFile :: FilePath -> IO [Some Geometry]-loadThingsFromFile fp = do-  rows <- BS8.readFile fp-  return $ catMaybes $ readHex <$> (BS8.lines rows)--loadThingsFromFile' :: FilePath -> IO [Some Geometry]-loadThingsFromFile' fp = do-  rows <- BS8.readFile fp-  return $ readLotsOfHex (BS8.lines rows)--makeMultiPolygon = MultiPolygon . V.fromList . (fmap makePolygon)-makeMultiPolygonGeo polygons = MultiPolygonGeometry (makeMultiPolygon polygons) Nothing--polygon1 =  makePolygon [[(0, 0), (0, 1), (1, 1), (1, 0), (0, 0)]]-polygon2 = makePolygon [[(0, 0), (0, 1), (1, 1), (1, 0), (0, 0)]]--polygonBS = "0103000020E6100000010000000C00000073E92D50491A5DC024275C1ED5DE404076E933474C1A5DC02C279CD7DBDE40406EE9A178431A5DC034271059E6DE40406DE9851C431A5DC034271C7AE6DE40406CE9F7AA421A5DC03427A07DE6DE40406CE92B3B421A5DC03427E05BE6DE40406CE955E4411A5DC03427A023E6DE404066E9E9FB3B1A5DC0282718AAD8DE404062E905D4381A5DC02027E877D1DE40406CE95FF8411A5DC014274C4CC6DE40406CE9B5EC421A5DC01427C8A2C6DE404073E92D50491A5DC024275C1ED5DE4040" :: BS.ByteString--linestringBS = "0102000020E610000037000000603A02BC406A5DC020650408151C4140643A94BD436A5DC020659862171C4140693A684D496A5DC01865E0D70E1C4140703AD69C4F6A5DC0146520320B1C4140753A7462556A5DC0146570780B1C41407B3A6CFB5A6A5DC0186534680C1C4140823A5295626A5DC0186500D80C1C4140863AC848666A5DC018659C390F1C4140883A5E29686A5DC01C65985A101C41408A3A6C466A6A5DC0186538520F1C41408E3A0AF06D6A5DC01865A0B00C1C4140923A4619726A5DC01865B4CA0B1C41409A3A30547A6A5DC01065D8E7061C41409D3AEEDE7C6A5DC01065A855051C41409F3AA2FB7E6A5DC010650095041C4140A03A6258806A5DC010656CDD041C4140A23A2EA9816A5DC01065484D041C4140A43AB895836A5DC00C658C83021C4140A63A78A6856A5DC00C6594E4021C4140AC3A24218C6A5DC00C65040C021C4140AE3AAE598D6A5DC00C6594E4021C4140AF3AF6798E6A5DC0106530CD051C4140B03A5CD68F6A5DC01465887F0A1C4140B23A103F916A5DC01865A8980D1C4140B43ACAFB926A5DC0186568A90F1C4140B53A90AC946A5DC01C656432121C4140B63A9060956A5DC02065087C151C4140B63A8A0C956A5DC02465E0DC181C4140B33A9A77926A5DC02865FC161D1C4140B23A76E7916A5DC02C654C00201C4140B23AF856916A5DC0306560D9231C4140B03A5636906A5DC03065383A271C4140AF3A026E8E6A5DC0386514852D1C4140AE3AC6F58D6A5DC03C6504662F1C4140AE3ADEDD8D6A5DC0406538F0341C4140AE3AAE0D8E6A5DC04065F800371C4140B23A76E7916A5DC0546534FF471C4140B83AB0C5976A5DC05C653063511C4140BA3A345E996A5DC06465B84D571C4140BC3A12AB9B6A5DC06C6510D05E1C4140C23A3A41A16A5DC07C6524F76E1C4140C43A5452A36A5DC08065B49F721C4140C63A329FA56A5DC080651C71751C4140CC3A12C9AA6A5DC0846584AA791C4140CF3A7A4EAE6A5DC08865EC7B7C1C4140D43A5424B36A5DC08C658C4E821C4140D53A8AFCB36A5DC09065883F861C4140D63A3811B56A5DC0946538C9881C4140D73AA40DB66A5DC0946580E9891C4140D83A28A6B76A5DC094655C59891C4140DA3A8E02B96A5DC09465E468881C4140DC3AAC00BB6A5DC0946538C9881C4140DE3A027CBC6A5DC09465D828891C4140DF3AB224BE6A5DC09465FC5E891C4140E33ABCBCC16A5DC094659C0A891C4140" :: BS.ByteString--multiPolygonStringBS = "0106000020e6100000020000000103000000010000002e0000001826530523256340321ea5129e603bc0e7e26f7b8223634005a568e55e703bc0cade52ce97216340534145d5af703bc0d38558fd9121634051f4c0c760793bc04eb857e62d21634004711e4e60763bc09a42e735f620634071ab2006ba7a3bc09e616a4b1d206340906ad8ef89793bc0f3e84658d41f63402159c0046e7d3bc0d3d9c9e0a8206340709692e524803bc0226e4e25032063404f57772cb6813bc048c2be9d4420634023a46e675f853bc0994869360f1f6340c6f7c5a52a813bc0e605d847271f6340d28f8653e68a3bc08ac745b5081e634025b1a4dc7d863bc01ec539eae81c6340406ce9d1548b3bc0b84082e2c71c6340ed832c0b269a3bc022aaf067f81b63405c72dc291d943bc07a7077d66e1b63400d1afa27b8983bc035b22b2d231b6340882cd2c43b883bc0c828cfbc9c1a63401616dc0f78883bc03a5cab3dec1a6340ddcd531d728b3bc0378b170b431a634024d5777e518e3bc0cbf6216fb9176340de3d40f7e5903bc050508a56ee1763401cb5c2f4bd863bc0f4311f1068186340772b4b7496853bc09b560a815c17634064ac36ffaf7e3bc0e15e99b7ea17634077f35487dc703bc0fce4284094176340a9177c9a935f3bc0a530ef71a6166340bc9179e40f5a3bc03eca880bc0156340087250c24c5f3bc0f8e0b54b1b166340c4b0c398f4573bc05e2a36e6f5176340af08feb792513bc07a3881e9b41863400a2fc1a90f583bc0dc813ae55118634008e753c72a5d3bc04208c897d0186340ff3d78edd2663bc030849cf7ff196340ed647094bc663bc0d653abaf2e1b6340a69718cbf46b3bc0bb809719b61c63405f46b1dcd26a3bc03eeaaf57581d634000ac8e1ce9643bc0fa5e43705c1e634003eb387ea8683bc0e9edcf45431f6340b073d3669c663bc05f27f565e91f6340211ff46c564d3bc09f909db731226340e3a9471adc463bc0b212f3aca4226340d0b7054b75553bc0f14a92e7fa2463406571ff91e95c3bc01826530523256340321ea5129e603bc00103000000010000000b00000003b16ce610236340779fe3a3c5413bc01b2c9ca479226340dae731ca33433bc0221add416c22634083fa96395d3a3bc0ee5d83be74216340acaa97df693a3bc04b5af10d052163403140a20914353bc062dba2cc86216340dc2a8881ae313bc06953758fec22634078b988efc4343bc0569e40d8a9236340e2afc91af5303bc0478e7406c6236340807d74eaca3b3bc054e4107173236340d7868a71fe423bc003b16ce610236340779fe3a3c5413bc0" :: BS.ByteString--linestringWkt = "LINESTRING (-117.6602010747678833 34.2193918248615319, -117.6603845546283651 34.2194636577717120, -117.6607240217068835 34.2192029805830202, -117.6611091701577152 34.2190916689088738, -117.6614614615480860 34.2191000508120453, -117.6618031079214433 34.2191286331018887, -117.6622670462620874 34.2191419603279314, -117.6624929385526173 34.2192146314284287, -117.6626075191690006 34.2192490810504921, -117.6627365166588390 34.2192175650945387, -117.6629600620164808 34.2191372664621554, -117.6632140336826353 34.2191098576387844, -117.6637163611398194 34.2189607435813059, -117.6638715101675672 34.2189127990951647, -117.6640004238383739 34.2188898326804747, -117.6640835723178498 34.2188984660407414, -117.6641638709502615 34.2188812831392397, -117.6642813014137232 34.2188267169495646, -117.6644073652374516 34.2188382839759413, -117.6648028234291701 34.2188124677141730, -117.6648773385483935 34.2188382839759413, -117.6649460701544143 34.2189270483305563, -117.6650291348148585 34.2190703788748181, -117.6651151331414269 34.2191649267426214, -117.6652211642165753 34.2192279586544714, -117.6653243454446311 34.2193053236207732, -117.6653672607888836 34.2194056550017649, -117.6653472280403037 34.2195087524108033, -117.6651896482606361 34.2196377499006417, -117.6651552824576186 34.2197265980742884, -117.6651208328355835 34.2198440285377501, -117.6650520174105168 34.2199471259467600, -117.6649432203073360 34.2201391553484768, -117.6649145541984751 34.2201964875661986, -117.6649088545043185 34.2203655505531970, -117.6649202538926318 34.2204285824650469, -117.6651552824576186 34.2209471708144122, -117.6655134411802237 34.2212337480839039, -117.6656108388951054 34.2214142942782757, -117.6657512357732571 34.2216434555110425, -117.6660922115943606 34.2221363952366744, -117.6662183592371207 34.2222480421869477, -117.6663587561152724 34.2223340405134877, -117.6666739156746075 34.2224629541842944, -117.6668888276719684 34.2225489525108628, -117.6671839544827094 34.2227266488581279, -117.6672355031872286 34.2228469291686679, -117.6673014687652028 34.2229243779540013, -117.6673616508299887 34.2229587437570046, -117.6674590485448562 34.2229415608555030, -117.6675421132053145 34.2229128947466563, -117.6676637346203620 34.2229243779540013, -117.6677541753556113 34.2229357773423146, -117.6678554287459377 34.2229422314077567, -117.6680747831519938 34.2229321731239509)" :: BS.ByteString--multiPolygonWkt = "MULTIPOLYGON(((153.160525 -27.377412,153.109678 -27.438948,153.049781 -27.440183,153.049071 -27.474133,153.036853 -27.462407,153.030055 -27.479401,153.003576 -27.474761,152.994671 -27.48996,153.020615 -27.500563,153.000384 -27.506686,153.008376 -27.520987,152.970607 -27.504557,152.973545 -27.542577,152.938563 -27.525358,152.903432 -27.544263,152.8994 -27.602143,152.874073 -27.57857,152.85728 -27.59656,152.848044 -27.532162,152.831633 -27.533082,152.841338 -27.54471,152.820684 -27.555931,152.741386 -27.566009,152.747844 -27.526336,152.762703 -27.521827,152.730042 -27.494873,152.747402 -27.440865,152.736847 -27.373346,152.707818 -27.351805,152.679693 -27.372265,152.690832 -27.343576,152.748767 -27.318645,152.772084 -27.343989,152.759997 -27.363934,152.775463 -27.401656,152.812496 -27.401315,152.849449 -27.421704,152.897229 -27.41728,152.917034 -27.394182,152.948784 -27.408821,152.976962 -27.400824,152.997241 -27.3021,153.068569 -27.276796,153.082602 -27.333821,153.155628 -27.362939,153.160525 -27.377412)),((153.095813 -27.256922,153.077349 -27.262509,153.075715 -27.227985,153.045501 -27.228178,153.031867 -27.207337,153.047705 -27.194069,153.091377 -27.20613,153.114483 -27.19124,153.117923 -27.233565,153.107842 -27.261695,153.095813 -27.256922)))" :: BS.ByteString--linestring = LineStringGeometry (LineString $ V.fromList [Coordinate2 (-117.66020107476788) 34.21939182486153,Coordinate2 (-117.66038455462837) 34.21946365777171,Coordinate2 (-117.66072402170688) 34.21920298058302,Coordinate2 (-117.66110917015772) 34.219091668908874,Coordinate2 (-117.66146146154809) 34.219100050812045,Coordinate2 (-117.66180310792144) 34.21912863310189,Coordinate2 (-117.66226704626209) 34.21914196032793,Coordinate2 (-117.66249293855262) 34.21921463142843,Coordinate2 (-117.662607519169) 34.21924908105049,Coordinate2 (-117.66273651665884) 34.21921756509454,Coordinate2 (-117.66296006201648) 34.219137266462155,Coordinate2 (-117.66321403368264) 34.219109857638784,Coordinate2 (-117.66371636113982) 34.218960743581306,Coordinate2 (-117.66387151016757) 34.218912799095165,Coordinate2 (-117.66400042383837) 34.218889832680475,Coordinate2 (-117.66408357231785) 34.21889846604074,Coordinate2 (-117.66416387095026) 34.21888128313924,Coordinate2 (-117.66428130141372) 34.218826716949565,Coordinate2 (-117.66440736523745) 34.21883828397594,Coordinate2 (-117.66480282342917) 34.21881246771417,Coordinate2 (-117.6648773385484) 34.21883828397594,Coordinate2 (-117.66494607015441) 34.218927048330556,Coordinate2 (-117.66502913481486) 34.21907037887482,Coordinate2 (-117.66511513314143) 34.21916492674262,Coordinate2 (-117.66522116421658) 34.21922795865447,Coordinate2 (-117.66532434544463) 34.21930532362077,Coordinate2 (-117.66536726078888) 34.219405655001765,Coordinate2 (-117.6653472280403) 34.2195087524108,Coordinate2 (-117.66518964826064) 34.21963774990064,Coordinate2 (-117.66515528245762) 34.21972659807429,Coordinate2 (-117.66512083283558) 34.21984402853775,Coordinate2 (-117.66505201741052) 34.21994712594676,Coordinate2 (-117.66494322030734) 34.22013915534848,Coordinate2 (-117.66491455419848) 34.2201964875662,Coordinate2 (-117.66490885450432) 34.2203655505532,Coordinate2 (-117.66492025389263) 34.22042858246505,Coordinate2 (-117.66515528245762) 34.22094717081441,Coordinate2 (-117.66551344118022) 34.221233748083904,Coordinate2 (-117.6656108388951) 34.221414294278276,Coordinate2 (-117.66575123577326) 34.22164345551104,Coordinate2 (-117.66609221159436) 34.222136395236674,Coordinate2 (-117.66621835923712) 34.22224804218695,Coordinate2 (-117.66635875611527) 34.22233404051349,Coordinate2 (-117.66667391567461) 34.222462954184294,Coordinate2 (-117.66688882767197) 34.22254895251086,Coordinate2 (-117.66718395448271) 34.22272664885813,Coordinate2 (-117.66723550318723) 34.22284692916867,Coordinate2 (-117.6673014687652) 34.222924377954,Coordinate2 (-117.66736165082999) 34.222958743757005,Coordinate2 (-117.66745904854486) 34.2229415608555,Coordinate2 (-117.66754211320531) 34.222912894746656,Coordinate2 (-117.66766373462036) 34.222924377954,Coordinate2 (-117.66775417535561) 34.222935777342315,Coordinate2 (-117.66785542874594) 34.22294223140776,Coordinate2 (-117.668074783152) 34.22293217312395]) (Just 4326)--multiPolygon = MultiPolygonGeometry (MultiPolygon $ V.fromList [Polygon $ V.fromList [LinearRing $ V.fromList [Coordinate2 153.160525 (-27.377412),Coordinate2 153.109678 (-27.438948),Coordinate2 153.049781 (-27.440183),Coordinate2 153.049071 (-27.474133),Coordinate2 153.036853 (-27.462407),Coordinate2 153.030055 (-27.479401),Coordinate2 153.003576 (-27.474761),Coordinate2 152.994671 (-27.48996),Coordinate2 153.020615 (-27.500563),Coordinate2 153.000384 (-27.506686),Coordinate2 153.008376 (-27.520987),Coordinate2 152.970607 (-27.504557),Coordinate2 152.973545 (-27.542577),Coordinate2 152.938563 (-27.525358),Coordinate2 152.903432 (-27.544263),Coordinate2 152.8994 (-27.602143),Coordinate2 152.874073 (-27.57857),Coordinate2 152.85728 (-27.59656),Coordinate2 152.848044 (-27.532162),Coordinate2 152.831633 (-27.533082),Coordinate2 152.841338 (-27.54471),Coordinate2 152.820684 (-27.555931),Coordinate2 152.741386 (-27.566009),Coordinate2 152.747844 (-27.526336),Coordinate2 152.762703 (-27.521827),Coordinate2 152.730042 (-27.494873),Coordinate2 152.747402 (-27.440865),Coordinate2 152.736847 (-27.373346),Coordinate2 152.707818 (-27.351805),Coordinate2 152.679693 (-27.372265),Coordinate2 152.690832 (-27.343576),Coordinate2 152.748767 (-27.318645),Coordinate2 152.772084 (-27.343989),Coordinate2 152.759997 (-27.363934),Coordinate2 152.775463 (-27.401656),Coordinate2 152.812496 (-27.401315),Coordinate2 152.849449 (-27.421704),Coordinate2 152.897229 (-27.41728),Coordinate2 152.917034 (-27.394182),Coordinate2 152.948784 (-27.408821),Coordinate2 152.976962 (-27.400824),Coordinate2 152.997241 (-27.3021),Coordinate2 153.068569 (-27.276796),Coordinate2 153.082602 (-27.333821),Coordinate2 153.155628 (-27.362939),Coordinate2 153.160525 (-27.377412)]],Polygon $ V.fromList [LinearRing $ V.fromList [Coordinate2 153.095813 (-27.256922),Coordinate2 153.077349 (-27.262509),Coordinate2 153.075715 (-27.227985),Coordinate2 153.045501 (-27.228178),Coordinate2 153.031867 (-27.207337),Coordinate2 153.047705 (-27.194069),Coordinate2 153.091377 (-27.20613),Coordinate2 153.114483 (-27.19124),Coordinate2 153.117923 (-27.233565),Coordinate2 153.107842 (-27.261695),Coordinate2 153.095813 (-27.256922)]]]) (Just 4326)