geos 0.3.0 → 0.4.0

raw patch · 5 files changed

+79/−23 lines, 5 files

Files

• geos.cabal +7/−3
• src/Data/Geometry/Geos/STRTree.hs +18/−14
• tests/Data/Geometry/Geos/STRTreeSpec.hs +52/−0
• tests/Data/Geometry/Geos/SerializeSpec.hs +0/−6
• tests/Main.hs +2/−0

@@ -1,7 +1,7 @@ cabal-version:       2.2 name:                geos -version:             0.3.0+version:             0.4.0  synopsis:  Bindings for GEOS. @@ -40,7 +40,8 @@     , vector     , transformers     , mtl-  build-tools: hsc2hs+  build-tool-depends:+    hsc2hs:hsc2hs   exposed-modules:       Data.Geometry.Geos.Topology     , Data.Geometry.Geos.Geometry@@ -86,7 +87,8 @@     exitcode-stdio-1.0   default-language:    Haskell2010   hs-source-dirs: tests src-  build-tools: hsc2hs+  build-tool-depends:+    hsc2hs:hsc2hs   main-is: Main.hs    build-depends:@@ -116,6 +118,7 @@     , Data.Geometry.Geos.Raw.Topology     , Data.Geometry.Geos.Raw.STRTree     , Data.Geometry.Geos.Raw.Prepared+    , Data.Geometry.Geos.Prepared     , Data.Geometry.Geos.Relatable     , Data.Geometry.Geos.Serialize     , Data.Geometry.Geos.Topology@@ -123,6 +126,7 @@     , Data.Geometry.Geos.TopologySpec     , Data.Geometry.Geos.RelatableSpec     , Data.Geometry.Geos.SerializeSpec+    , Data.Geometry.Geos.STRTreeSpec     , Helpers  source-repository head

@@ -17,14 +17,12 @@   , toList   , toVector   , fromList-  , empty-  , build-  , insert+  , unfoldr_+  , unfoldr   , fromFoldable   , fromFoldable_   , lookup   , RT.STRTree-  , RT.STRTreeBuilder   ) where @@ -55,17 +53,23 @@ fromList :: Storable b => [(Geometry a, b)] -> RT.STRTree b fromList = fromFoldable -empty :: RT.STRTreeBuilder a-empty = runGeos $ RT.createSTRTreeBuilder 10--build :: RT.STRTreeBuilder a -> RT.STRTree a-build = runGeos . RT.build+unfoldr :: Storable a => (b -> Maybe ((Geometry g, a), b)) -> b -> RT.STRTree a+unfoldr = unfoldr_ 10 -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 ()+unfoldr_ :: Storable a => Int -> (b -> Maybe ((Geometry g, a), b)) -> b -> RT.STRTree a+unfoldr_ capacity func initial = runGeos $ do+  builder' <- RT.createSTRTreeBuilder capacity+  go builder' func initial+  where+    go builder f init' =+      case f init' of+        Just ((geom, item), next) -> do+          rg :: RG.GeomConst <- convertGeometryToRaw geom+          RT.insert builder rg item+          go builder f next+        Nothing -> do+          tree <- RT.build builder+          pure tree  {-| `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.

@@ -0,0 +1,52 @@+module Data.Geometry.Geos.STRTreeSpec where++import Data.Either+import qualified Data.Vector as V+import qualified Data.Geometry.Geos.STRTree as STR+import Data.Geometry.Geos.Geometry+import           Test.Hspec++strSpec = describe "STRTree" $ do+  describe "fromList" $ do+    it "should correctly build an STRTree" $ do+      let points = fmap (flip PointGeometry Nothing . point . uncurry coordinate2)+            [ (0.1, 0.2)+            , (0.2, 0.3)+            , (0.3, 0.4)+            ]+          mapping :: [(Geometry Point, Int)]+          mapping = zip points [1..]+          strtree = STR.fromList mapping+          env = V.fromList $ fmap (uncurry coordinate2)+            [ (0, 0)+            , (1, 0)+            , (1, 1)+            , (0, 1)+            , (0, 0)+            ]+          eitherQuery = linearRing  env >>=  polygon . V.singleton+          query = PolygonGeometry (fromRight (error "shouldn't happen") eitherQuery) Nothing+          results = STR.lookup query strtree+      results `shouldBe` (V.fromList [1..3])++  describe "unfoldr" $ do+    it "should correctly build an STRTree" $ do++      let buildFunc i =+            if i < 1+               then Just ((flip PointGeometry Nothing . point $ coordinate2 i i, 100 + i), i+0.1 )+               else Nothing+          init :: Double+          init = 0.1+          strtree = STR.unfoldr buildFunc init+          env = V.fromList $ fmap (uncurry coordinate2)+            [ (0, 0)+            , (1, 0)+            , (1, 1)+            , (0, 1)+            , (0, 0)+            ]+          eitherQuery = linearRing  env >>=  polygon . V.singleton+          query = PolygonGeometry (fromRight (error "shouldn't happen") eitherQuery) Nothing+          results = STR.lookup query strtree+      V.length results `shouldBe` 10

@@ -27,12 +27,6 @@ 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

@@ -6,9 +6,11 @@ import Data.Geometry.Geos.TopologySpec import Data.Geometry.Geos.RelatableSpec import Data.Geometry.Geos.SerializeSpec+import Data.Geometry.Geos.STRTreeSpec  main :: IO () main = hspec $ do   topologySpec   relatableSpec   serializeSpec+  strSpec