diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,190 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + Copyright 2017-2018 wkt-geom Project + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +# wkt-geom + +![CircleCI](https://circleci.com/gh/sitewisely/wkt-geom/tree/master.svg?style=svg&circle-token=234d1b3bda2ff80367f7c38dc7ff7a3a051eea42) + +http://www.opengeospatial.org/standards/sfa (Section 7) +http://edndoc.esri.com/arcsde/9.0/general_topics/wkt_representation.htm diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/Ewkb.hs b/src/Data/Ewkb.hs new file mode 100644 --- /dev/null +++ b/src/Data/Ewkb.hs @@ -0,0 +1,23 @@ +-- Refer to the eWKB Postgis Documentation +-- +-- Allows parsing of ByteString into a Geospatial Object. +-- +------------------------------------------------------------------- +module Data.Ewkb + ( parseByteString + ) where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Geospatial as Geospatial + +import qualified Data.Internal.Ewkb.Geometry as EwkbGeometry +import qualified Data.Internal.Wkb.Geospatial as WkbGeospatial + +parseByteString :: LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry +parseByteString byteString = + case BinaryGet.runGetOrFail + (WkbGeospatial.geospatialGeometry EwkbGeometry.wkbGeometryType) + byteString of + Left (_, _, err) -> Left $ "Could not parse ewkb: " ++ err + Right (_, _, geoSpatialGeometry) -> Right geoSpatialGeometry diff --git a/src/Data/Internal/Ewkb/Geometry.hs b/src/Data/Internal/Ewkb/Geometry.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Ewkb/Geometry.hs @@ -0,0 +1,80 @@ +module Data.Internal.Ewkb.Geometry + ( EwkbGeometryType (..) + , SridType (..) + , ewkbGeometryType + , wkbGeometryType + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import Data.Bits ((.&.)) +import qualified Data.Word as Word + +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry + +data SridType = Srid Word.Word32 | NoSrid deriving (Show, Eq) + +data EwkbGeometryType = EwkbGeom Geometry.WkbGeometryType SridType deriving (Show, Eq) + +ewkbGeometryType :: Endian.EndianType -> BinaryGet.Get EwkbGeometryType +ewkbGeometryType endianType = do + rawGeometryType <- Endian.fourBytes endianType + ewkbSrid <- getEwkbSrid endianType rawGeometryType + geomType <- rawtoWkbGeometryType rawGeometryType + pure $ EwkbGeom geomType ewkbSrid + +wkbGeometryType :: Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType +wkbGeometryType endianType = do + rawGeometryType <- Endian.fourBytes endianType + _ <- getEwkbSrid endianType rawGeometryType + rawtoWkbGeometryType rawGeometryType + +rawtoWkbGeometryType :: Word.Word32 -> BinaryGet.Get Geometry.WkbGeometryType +rawtoWkbGeometryType rawGeometryType = do + let geomType = intToGeometryType rawGeometryType + coordType = intToCoordinateType rawGeometryType + case geomType of + Just g -> pure $ Geometry.WkbGeom g coordType + _ -> Monad.fail $ "Invalid EwkbGeometry: " ++ show rawGeometryType + +getEwkbSrid :: Endian.EndianType -> Word.Word32 -> BinaryGet.Get SridType +getEwkbSrid endianType int = + if int .&. 0x20000000 /= 0 then do + srid <- Endian.fourBytes endianType + if srid == 4326 then + pure $ Srid srid + else + Monad.fail $ "Invalid SRID only 4326 supported: " ++ show srid + else + pure NoSrid + +intToGeometryType :: Word.Word32 -> Maybe Geometry.GeometryType +intToGeometryType int = + case int .&. 0x0fffffff of + 0 -> Just Geometry.Geometry + 1 -> Just Geometry.Point + 2 -> Just Geometry.LineString + 3 -> Just Geometry.Polygon + 4 -> Just Geometry.MultiPoint + 5 -> Just Geometry.MultiLineString + 6 -> Just Geometry.MultiPolygon + 7 -> Just Geometry.GeometryCollection + _ -> Nothing + +intToCoordinateType :: Word.Word32 -> Geometry.CoordinateType +intToCoordinateType int = + case (hasZ int, hasM int) of + (False, False) -> Geometry.TwoD + (False, True) -> Geometry.M + (True, False) -> Geometry.Z + (True, True) -> Geometry.ZM + +hasZ :: Word.Word32 -> Bool +hasZ int = + int .&. 0x80000000 /= 0 + +hasM :: Word.Word32 -> Bool +hasM int = + int .&. 0x40000000 /= 0 + diff --git a/src/Data/Internal/Wkb/Endian.hs b/src/Data/Internal/Wkb/Endian.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkb/Endian.hs @@ -0,0 +1,39 @@ +module Data.Internal.Wkb.Endian + ( EndianType (..) + , endianType + , fourBytes + , doubleBytes + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.Word as Word + +data EndianType = LittleEndian | BigEndian deriving (Show, Eq) + +endianType :: BinaryGet.Get EndianType +endianType = do + byte <- BinaryGet.getWord8 + case byte of + 0 -> + pure BigEndian + 1 -> + pure LittleEndian + _ -> + Monad.fail "Invalid EndianType" + +fourBytes :: EndianType -> BinaryGet.Get Word.Word32 +fourBytes et = + case et of + LittleEndian -> + BinaryGet.getWord32le + BigEndian -> + BinaryGet.getWord32be + +doubleBytes :: EndianType -> BinaryGet.Get Double +doubleBytes et = + case et of + LittleEndian -> + BinaryGet.getDoublele + BigEndian -> + BinaryGet.getDoublebe diff --git a/src/Data/Internal/Wkb/Geometry.hs b/src/Data/Internal/Wkb/Geometry.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkb/Geometry.hs @@ -0,0 +1,58 @@ +module Data.Internal.Wkb.Geometry + ( GeometryType (..) + , CoordinateType (..) + , WkbGeometryType (..) + , geometryTypeWithCoords + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.Word as Word + +import qualified Data.Internal.Wkb.Endian as Endian + +data GeometryType + = Geometry + | Point + | LineString + | Polygon + | MultiPoint + | MultiLineString + | MultiPolygon + | GeometryCollection deriving (Show, Eq) + +data CoordinateType = TwoD | Z | M | ZM deriving (Show, Eq) + +data WkbGeometryType = WkbGeom GeometryType CoordinateType deriving (Show, Eq) + +geometryTypeWithCoords :: Endian.EndianType -> BinaryGet.Get WkbGeometryType +geometryTypeWithCoords endianType = do + fullGeometryType <- Endian.fourBytes endianType + let geomType = intToGeometryType $ fullGeometryType `rem` 1000 + coordType = intToCoordinateType $ fullGeometryType `div` 1000 + case (geomType, coordType) of + (Just g, Just c) -> pure $ WkbGeom g c + _ -> + Monad.fail $ "Invalid WkbGeometryType: " ++ show fullGeometryType + +intToGeometryType :: Word.Word32 -> Maybe GeometryType +intToGeometryType int = + case int of + 0 -> Just Geometry + 1 -> Just Point + 2 -> Just LineString + 3 -> Just Polygon + 4 -> Just MultiPoint + 5 -> Just MultiLineString + 6 -> Just MultiPolygon + 7 -> Just GeometryCollection + _ -> Nothing + +intToCoordinateType :: Word.Word32 -> Maybe CoordinateType +intToCoordinateType int = + case int of + 0 -> Just TwoD + 1 -> Just Z + 2 -> Just M + 3 -> Just ZM + _ -> Nothing diff --git a/src/Data/Internal/Wkb/GeometryCollection.hs b/src/Data/Internal/Wkb/GeometryCollection.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkb/GeometryCollection.hs @@ -0,0 +1,34 @@ +module Data.Internal.Wkb.GeometryCollection + ( geometryCollection + , enclosedFeature + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.Geospatial as Geospatial +import qualified Data.Vector as Vector + +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry + +geometryCollection :: BinaryGet.Get Geospatial.GeospatialGeometry + -> Endian.EndianType + -> Geometry.CoordinateType + -> BinaryGet.Get Geospatial.GeospatialGeometry +geometryCollection getGeospatialGeometry endianType _ = do + numberOfGeometries <- Endian.fourBytes endianType + geoSpatialGeometries <- Vector.generateM (fromIntegral numberOfGeometries) (const getGeospatialGeometry) + pure $ Geospatial.Collection geoSpatialGeometries + +enclosedFeature :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) + -> Geometry.GeometryType + -> (Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get feature) + -> BinaryGet.Get feature +enclosedFeature getWkbGeom expectedGeometryType getFeature = do + endianType <- Endian.endianType + geometryTypeWithCoords <- getWkbGeom endianType + let (Geometry.WkbGeom geoType coordType) = geometryTypeWithCoords + if geoType == expectedGeometryType then + getFeature endianType coordType + else + Monad.fail "Wrong geometry type of enclosed feature" diff --git a/src/Data/Internal/Wkb/Geospatial.hs b/src/Data/Internal/Wkb/Geospatial.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkb/Geospatial.hs @@ -0,0 +1,42 @@ +module Data.Internal.Wkb.Geospatial + ( geospatialGeometry + ) where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.Geospatial as Geospatial + +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry +import qualified Data.Internal.Wkb.GeometryCollection as GeometryCollection +import qualified Data.Internal.Wkb.Line as Line +import qualified Data.Internal.Wkb.Point as Point +import qualified Data.Internal.Wkb.Polygon as Polygon + +geospatialGeometry :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) + -> BinaryGet.Get Geospatial.GeospatialGeometry +geospatialGeometry getWkbGeom = do + endianType <- Endian.endianType + geometryTypeWithCoords <- getWkbGeom endianType + let (Geometry.WkbGeom geomType coordType) = geometryTypeWithCoords + getFeature geomType getWkbGeom endianType coordType + +getFeature :: Geometry.GeometryType + -> (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) + -> Endian.EndianType + -> Geometry.CoordinateType + -> BinaryGet.Get Geospatial.GeospatialGeometry +getFeature geomType getWkbGeom = + case geomType of + Geometry.Geometry -> getNoGeometry + Geometry.Point -> Point.point + Geometry.LineString -> Line.line + Geometry.Polygon -> Polygon.polygon + Geometry.MultiPoint -> Point.multiPoint getWkbGeom + Geometry.MultiLineString -> Line.multiLine getWkbGeom + Geometry.MultiPolygon -> Polygon.multiPolygon getWkbGeom + Geometry.GeometryCollection -> GeometryCollection.geometryCollection (geospatialGeometry getWkbGeom) + +getNoGeometry :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getNoGeometry _ _ = + pure Geospatial.NoGeometry + diff --git a/src/Data/Internal/Wkb/Line.hs b/src/Data/Internal/Wkb/Line.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkb/Line.hs @@ -0,0 +1,37 @@ +module Data.Internal.Wkb.Line + ( Data.Internal.Wkb.Line.line + , multiLine + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.Geospatial as Geospatial +import qualified Data.LineString as LineString +import qualified Data.Vector as Vector + +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry +import qualified Data.Internal.Wkb.GeometryCollection as GeometryCollection +import qualified Data.Internal.Wkb.Point as Point + +line :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +line endianType coordType = do + gl <- geoLine endianType coordType + pure $ Geospatial.Line gl + +multiLine :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +multiLine getWkbGeom endianType _ = do + numberOfLines <- Endian.fourBytes endianType + geoLines <- Vector.generateM (fromIntegral numberOfLines) (const $ GeometryCollection.enclosedFeature getWkbGeom Geometry.LineString geoLine) + pure $ Geospatial.MultiLine $ Geospatial.mergeGeoLines geoLines + +geoLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoLine +geoLine endianType coordType = do + numberOfPoints <- Endian.fourBytes endianType + if numberOfPoints >= 2 then do + p1 <- Point.coordPoint endianType coordType + p2 <- Point.coordPoint endianType coordType + pts <- Point.coordPoints endianType coordType (numberOfPoints - 2) + pure $ Geospatial.GeoLine $ LineString.makeLineString p1 p2 pts + else + Monad.fail "Must have at least two points for a line" diff --git a/src/Data/Internal/Wkb/Point.hs b/src/Data/Internal/Wkb/Point.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkb/Point.hs @@ -0,0 +1,60 @@ +module Data.Internal.Wkb.Point + ( point + , multiPoint + , coordPoint + , coordPoints + ) where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.Geospatial as Geospatial +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VectorStorable +import qualified Data.Word as Word + +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry +import qualified Data.Internal.Wkb.GeometryCollection as GeometryCollection + +point :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +point endianType coordType = do + gp <- geoPoint endianType coordType + pure $ Geospatial.Point gp + +multiPoint :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +multiPoint getWkbGeom endianType _ = do + numberOfPoints <- Endian.fourBytes endianType + geoPoints <- Vector.generateM (fromIntegral numberOfPoints) (const $ GeometryCollection.enclosedFeature getWkbGeom Geometry.Point geoPoint) + pure $ Geospatial.MultiPoint $ Geospatial.mergeGeoPoints geoPoints + +geoPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPoint +geoPoint endianType coordType = do + p <- coordPoint endianType coordType + pure $ Geospatial.GeoPoint p + +coordPoints :: Endian.EndianType -> Geometry.CoordinateType -> Word.Word32 -> BinaryGet.Get (VectorStorable.Vector Geospatial.GeoPositionWithoutCRS) +coordPoints endianType coordType numberOfPoints = + VectorStorable.generateM (fromIntegral numberOfPoints) (const $ coordPoint endianType coordType) + +coordPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPositionWithoutCRS +coordPoint endianType coordType = + case coordType of + Geometry.TwoD -> do + x <- Endian.doubleBytes endianType + y <- Endian.doubleBytes endianType + pure $ Geospatial.GeoPointXY (Geospatial.PointXY x y) + Geometry.Z -> do + x <- Endian.doubleBytes endianType + y <- Endian.doubleBytes endianType + z <- Endian.doubleBytes endianType + pure $ Geospatial.GeoPointXYZ (Geospatial.PointXYZ x y z) + Geometry.M -> do + x <- Endian.doubleBytes endianType + y <- Endian.doubleBytes endianType + m <- Endian.doubleBytes endianType + pure $ Geospatial.GeoPointXYZ (Geospatial.PointXYZ x y m) + Geometry.ZM -> do + x <- Endian.doubleBytes endianType + y <- Endian.doubleBytes endianType + z <- Endian.doubleBytes endianType + m <- Endian.doubleBytes endianType + pure $ Geospatial.GeoPointXYZM (Geospatial.PointXYZM x y z m) diff --git a/src/Data/Internal/Wkb/Polygon.hs b/src/Data/Internal/Wkb/Polygon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkb/Polygon.hs @@ -0,0 +1,56 @@ +module Data.Internal.Wkb.Polygon + ( polygon + , multiPolygon + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VectorStorable + +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry +import qualified Data.Internal.Wkb.GeometryCollection as GeometryCollection +import qualified Data.Internal.Wkb.Point as Point + +polygon :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +polygon endianType coordType = do + geoPolygon <- getGeoPolygon endianType coordType + pure $ Geospatial.Polygon geoPolygon + +multiPolygon :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +multiPolygon getWkbGeom endianType _ = do + numberOfPolygons <- Endian.fourBytes endianType + geoPolygons <- Vector.generateM (fromIntegral numberOfPolygons) (const $ GeometryCollection.enclosedFeature getWkbGeom Geometry.Polygon getGeoPolygon) + pure $ Geospatial.MultiPolygon $ Geospatial.mergeGeoPolygons geoPolygons + +getGeoPolygon :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPolygon +getGeoPolygon endianType coordType = do + linearRings <- getLinearRings endianType coordType + pure $ Geospatial.GeoPolygon linearRings + +getLinearRings :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get (Vector.Vector (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) +getLinearRings endianType coordType = do + numberOfRings <- Endian.fourBytes endianType + Vector.generateM (fromIntegral numberOfRings) (const $ getLinearRing endianType coordType) + +getLinearRing :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) +getLinearRing endianType coordType = do + numberOfPoints <- Endian.fourBytes endianType + if numberOfPoints >= 4 then do + p1 <- Point.coordPoint endianType coordType + p2 <- Point.coordPoint endianType coordType + p3 <- Point.coordPoint endianType coordType + pts <- Point.coordPoints endianType coordType (numberOfPoints - 3) + if VectorStorable.last pts == p1 then + pure $ LinearRing.makeLinearRing p1 p2 p3 (VectorStorable.init pts) + else + Monad.fail $ + "First and last points of linear ring are different: first=" + ++ show p1 ++ " last=" ++ show (VectorStorable.last pts) + else + Monad.fail $ + "Must have at least four points for a linear ring: " + ++ show numberOfPoints diff --git a/src/Data/Internal/Wkt/Common.hs b/src/Data/Internal/Wkt/Common.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkt/Common.hs @@ -0,0 +1,26 @@ +module Data.Internal.Wkt.Common + ( emptySet + , emptySets + , number + ) where + +import Control.Applicative ((<|>)) +import qualified Data.Scientific as Scientific +import qualified Data.Vector as Vector +import qualified Text.Trifecta as Trifecta + +emptySet :: Trifecta.Parser (Vector.Vector a) +emptySet = do + _ <- Trifecta.string "empty" + pure Vector.empty + +emptySets :: Trifecta.Parser ([a], [[a]]) +emptySets = do + _ <- Trifecta.string "empty" + pure ([], []) + +number :: Trifecta.Parser Scientific.Scientific +number = do + sign <- (Trifecta.char '+' >> pure id) <|> (Trifecta.char '-' >> pure negate) <|> pure id + sign . either fromInteger id <$> Trifecta.integerOrScientific + diff --git a/src/Data/Internal/Wkt/GeometryCollection.hs b/src/Data/Internal/Wkt/GeometryCollection.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkt/GeometryCollection.hs @@ -0,0 +1,39 @@ +module Data.Internal.Wkt.GeometryCollection + ( geometryCollection + , emptyGeometryCollection + ) where + +import Control.Applicative ((<|>)) +import qualified Data.Geospatial as Geospatial +import qualified Data.Vector as Vector +import qualified Text.Trifecta as Trifecta + +import qualified Data.Internal.Wkt.Common as Wkt +import qualified Data.Internal.Wkt.Line as Line +import qualified Data.Internal.Wkt.Point as Point +import qualified Data.Internal.Wkt.Polygon as Polygon + +geometryCollection :: Trifecta.Parser (Vector.Vector Geospatial.GeospatialGeometry) +geometryCollection = do + _ <- Trifecta.string "geometrycollection" + _ <- Trifecta.spaces + Wkt.emptySet <|> bracketedAll + +bracketedAll :: Trifecta.Parser (Vector.Vector Geospatial.GeospatialGeometry) +bracketedAll = do + _ <- Trifecta.char '(' >> Trifecta.spaces + x <- parseAll + _ <- Trifecta.spaces >> Trifecta.char ')' + pure x + +parseAll :: Trifecta.Parser (Vector.Vector Geospatial.GeospatialGeometry) +parseAll = do + let + single = Geospatial.Point <$> Point.point <|> Geospatial.Line <$> Line.lineString <|> Geospatial.Polygon <$> Polygon.polygon + multi = Geospatial.MultiPoint <$> Point.multiPoint <|> Geospatial.MultiLine <$> Line.multiLineString <|> Geospatial.MultiPolygon <$> Polygon.multiPolygon + x <- single <|> multi + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> (single <|> multi)) + pure $ Vector.cons x (Vector.fromList xs) + +emptyGeometryCollection :: Vector.Vector Geospatial.GeospatialGeometry +emptyGeometryCollection = Vector.empty diff --git a/src/Data/Internal/Wkt/Line.hs b/src/Data/Internal/Wkt/Line.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkt/Line.hs @@ -0,0 +1,60 @@ +module Data.Internal.Wkt.Line + ( line + , lineString + , multiLineString + , emptyLine + , emptyMultiLine + , commandPoint + ) where + +import Control.Applicative ((<|>)) +import qualified Data.Geospatial as Geospatial +import qualified Data.LineString as LineString +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VectorStorable +import qualified Text.Trifecta as Trifecta + +import qualified Data.Internal.Wkt.Common as Wkt +import qualified Data.Internal.Wkt.Point as Point + +lineString :: Trifecta.Parser Geospatial.GeoLine +lineString = do + _ <- Trifecta.string "linestring" + _ <- Trifecta.spaces + (Trifecta.string "empty" >> pure emptyLine) <|> Geospatial.GeoLine <$> line + +multiLineString :: Trifecta.Parser Geospatial.GeoMultiLine +multiLineString = do + _ <- Trifecta.string "multilinestring" + _ <- Trifecta.spaces + x <- Wkt.emptySet <|> manyLines + pure $ Geospatial.GeoMultiLine x + +manyLines :: Trifecta.Parser (Vector.Vector (LineString.LineString Geospatial.GeoPositionWithoutCRS)) +manyLines = do + _ <- Trifecta.spaces >> Trifecta.char '(' + x <- line + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> line) + _ <- Trifecta.char ')' >> Trifecta.spaces + pure $ Vector.cons x (Vector.fromList xs) + +line :: Trifecta.Parser (LineString.LineString Geospatial.GeoPositionWithoutCRS) +line = do + _ <- Trifecta.spaces >> Trifecta.char '(' >> Trifecta.spaces + first <- Point.justPoints + second <- commandPoint + rest <- Trifecta.many commandPoint + _ <- Trifecta.char ')' >> Trifecta.spaces + pure $ LineString.makeLineString first second (VectorStorable.fromList rest) + +commandPoint :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS +commandPoint = do + _ <- Trifecta.char ',' + _ <- Trifecta.spaces + Point.justPoints + +emptyLine :: Geospatial.GeoLine +emptyLine = Geospatial.GeoLine $ LineString.makeLineString Geospatial.GeoEmpty Geospatial.GeoEmpty VectorStorable.empty + +emptyMultiLine :: Geospatial.GeoMultiLine +emptyMultiLine = Geospatial.mergeGeoLines Vector.empty diff --git a/src/Data/Internal/Wkt/Point.hs b/src/Data/Internal/Wkt/Point.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkt/Point.hs @@ -0,0 +1,67 @@ +module Data.Internal.Wkt.Point + ( point + , multiPoint + , justPoints + , emptyPoint + , emptyMultiPoint + ) where + +import Control.Applicative ((<|>)) +import qualified Data.Geospatial as Geospatial +import qualified Data.Scientific as Scientific +import qualified Data.Vector as Vector +import qualified Text.Trifecta as Trifecta + +import qualified Data.Internal.Wkt.Common as Wkt + +point :: Trifecta.Parser Geospatial.GeoPoint +point = do + _ <- Trifecta.string "point" + _ <- Trifecta.spaces + (Trifecta.string "empty" >> pure emptyPoint) <|> fmap Geospatial.GeoPoint bracketedPoint + +multiPoint :: Trifecta.Parser Geospatial.GeoMultiPoint +multiPoint = do + _ <- Trifecta.string "multipoint" + _ <- Trifecta.spaces + xl <- Wkt.emptySet <|> manyPoints + pure $ Geospatial.GeoMultiPoint xl + +manyPoints :: Trifecta.Parser (Vector.Vector Geospatial.GeoPositionWithoutCRS) +manyPoints = do + _ <- Trifecta.char '(' >> Trifecta.spaces + xl <- unbracketedPoints <|> bracketedPoints + _ <- Trifecta.spaces >> Trifecta.char ')' >> Trifecta.spaces + pure xl + +unbracketedPoints :: Trifecta.Parser (Vector.Vector Geospatial.GeoPositionWithoutCRS) +unbracketedPoints = do + x <- justPoints + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> justPoints) + pure $ Vector.cons x (Vector.fromList xs) + +bracketedPoints :: Trifecta.Parser (Vector.Vector Geospatial.GeoPositionWithoutCRS) +bracketedPoints = do + x <- bracketedPoint + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> bracketedPoint) + pure $ Vector.cons x (Vector.fromList xs) + +bracketedPoint :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS +bracketedPoint = do + _ <- Trifecta.spaces >> Trifecta.char '(' >> Trifecta.spaces + x <- justPoints + _ <- Trifecta.spaces >> Trifecta.char ')' >> Trifecta.spaces + pure x + +justPoints :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS +justPoints = do + x <- Wkt.number + _ <- Trifecta.spaces + y <- Wkt.number + pure $ Geospatial.GeoPointXY (Geospatial.PointXY (Scientific.toRealFloat x) (Scientific.toRealFloat y)) + +emptyPoint :: Geospatial.GeoPoint +emptyPoint = Geospatial.GeoPoint Geospatial.GeoEmpty + +emptyMultiPoint :: Geospatial.GeoMultiPoint +emptyMultiPoint = Geospatial.GeoMultiPoint Vector.empty diff --git a/src/Data/Internal/Wkt/Polygon.hs b/src/Data/Internal/Wkt/Polygon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Internal/Wkt/Polygon.hs @@ -0,0 +1,63 @@ +module Data.Internal.Wkt.Polygon + ( polygon + , multiPolygon + , emptyPolygon + , emptyMultiPolygon + ) where + +import Control.Applicative ((<|>)) +import qualified Data.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VectorStorable +import qualified Text.Trifecta as Trifecta + +import qualified Data.Internal.Wkt.Common as Wkt +import qualified Data.Internal.Wkt.Line as Line +import qualified Data.Internal.Wkt.Point as Point + +polygon :: Trifecta.Parser Geospatial.GeoPolygon +polygon = do + _ <- Trifecta.string "polygon" + _ <- Trifecta.spaces + x <- Wkt.emptySet <|> polygon' + pure $ Geospatial.GeoPolygon x + +multiPolygon :: Trifecta.Parser Geospatial.GeoMultiPolygon +multiPolygon = do + _ <- Trifecta.string "multipolygon" + _ <- Trifecta.spaces + xs <- Wkt.emptySet <|> multiPolygon' + pure $ Geospatial.GeoMultiPolygon xs + +polygon' :: Trifecta.Parser (Vector.Vector (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) +polygon' = do + _ <- Trifecta.spaces >> Trifecta.char '(' + x <- linearRing + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> linearRing) + _ <- Trifecta.char ')' >> Trifecta.spaces + pure $ Vector.cons x (Vector.fromList xs) + +multiPolygon' :: Trifecta.Parser (Vector.Vector (Vector.Vector (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS))) +multiPolygon' = do + _ <- Trifecta.spaces >> Trifecta.char '(' + x <- polygon' + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> polygon') + _ <- Trifecta.char ')' >> Trifecta.spaces + pure $ Vector.cons x (Vector.fromList xs) + +linearRing :: Trifecta.Parser (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) +linearRing = do + _ <- Trifecta.spaces >> Trifecta.char '(' >> Trifecta.spaces + first <- Point.justPoints + second <- Line.commandPoint + third <- Line.commandPoint + rest <- Trifecta.many Line.commandPoint + _ <- Trifecta.char ')' >> Trifecta.spaces + pure $ LinearRing.makeLinearRing first second third (VectorStorable.init $ VectorStorable.fromList rest) + +emptyPolygon :: Geospatial.GeoPolygon +emptyPolygon = Geospatial.GeoPolygon Vector.empty + +emptyMultiPolygon :: Geospatial.GeoMultiPolygon +emptyMultiPolygon = Geospatial.mergeGeoPolygons Vector.empty diff --git a/src/Data/Wkb.hs b/src/Data/Wkb.hs new file mode 100644 --- /dev/null +++ b/src/Data/Wkb.hs @@ -0,0 +1,23 @@ +-- Refer to the WKB Wikipedia page +-- +-- Allows parsing of ByteString into a Geospatial Object. +-- +------------------------------------------------------------------- +module Data.Wkb + ( parseByteString + ) where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Geospatial as Geospatial + +import qualified Data.Internal.Wkb.Geometry as Geometry +import qualified Data.Internal.Wkb.Geospatial as WkbGeospatial + +parseByteString :: LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry +parseByteString byteString = + case BinaryGet.runGetOrFail + (WkbGeospatial.geospatialGeometry Geometry.geometryTypeWithCoords) + byteString of + Left (_, _, err) -> Left $ "Could not parse wkb: " ++ err + Right (_, _, geoSpatialGeometry) -> Right geoSpatialGeometry diff --git a/src/Data/Wkt.hs b/src/Data/Wkt.hs new file mode 100644 --- /dev/null +++ b/src/Data/Wkt.hs @@ -0,0 +1,55 @@ +-- Refer to the WKT Spec +-- +-- Allows parsing of String or ByteString into a Wkt object. +-- +------------------------------------------------------------------- +module Data.Wkt + ( parseByteString + , parseString + , WktGeometryCollection.geometryCollection + , WktGeometryCollection.emptyGeometryCollection + , WktLine.emptyLine + , WktLine.emptyMultiLine + , WktLine.lineString + , WktLine.multiLineString + , WktPoint.emptyPoint + , WktPoint.emptyMultiPoint + , WktPoint.point + , WktPoint.multiPoint + , WktPolygon.emptyPolygon + , WktPolygon.emptyMultiPolygon + , WktPolygon.polygon + , WktPolygon.multiPolygon + ) where + +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.Char as Char +import qualified Text.Trifecta as Trifecta +import qualified Text.Trifecta.Delta as TrifectaDelta + +import qualified Data.Internal.Wkt.GeometryCollection as WktGeometryCollection +import qualified Data.Internal.Wkt.Line as WktLine +import qualified Data.Internal.Wkt.Point as WktPoint +import qualified Data.Internal.Wkt.Polygon as WktPolygon + +delta :: String -> TrifectaDelta.Delta +delta str = TrifectaDelta.Directed (UTF8.fromString str) 0 0 0 0 + +parseByteString :: Trifecta.Parser a -> ByteString.ByteString -> Trifecta.Result a +parseByteString p bs = Trifecta.parseByteString p (TrifectaDelta.Directed lowerBs 0 0 0 0) lowerBs + where + lowerBs = d8ToLower bs + d8ToLower = ByteString.map f + where + f w | w >= 65 && w <= 90 = w + 32 + | otherwise = w + +parseString :: Trifecta.Parser a -> String -> Trifecta.Result a +parseString p s = Trifecta.parseString p (Data.Wkt.delta lowerS) lowerS + where + lowerS = asciiToLower s + asciiToLower = fmap f + where + f c | Char.isAsciiUpper c = Char.chr (Char.ord c + 32) + | otherwise = c diff --git a/test/Data/Internal/Ewkb/GeometrySpec.hs b/test/Data/Internal/Ewkb/GeometrySpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Ewkb/GeometrySpec.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Ewkb.GeometrySpec where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.ByteString.Lazy as LazyByteString +import Data.Monoid ((<>)) +import qualified Data.Word as Word +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.Internal.Ewkb.Geometry as Ewkb +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Wkb + +spec :: Spec +spec = + testValidGetEwkbGeometryType + +testValidGetEwkbGeometryType :: Spec +testValidGetEwkbGeometryType = + describe "get extended wkb geometry type for valid data" $ + mapM_ testGetEwkbGeometryType expectations + +testGetEwkbGeometryType :: (Word.Word32, Maybe Word.Word32, Ewkb.EwkbGeometryType) -> Spec +testGetEwkbGeometryType (rawGeomType, maybeSrid, expected) = + it ("Parse " ++ show expected) $ + mapM_ test [Endian.BigEndian, Endian.LittleEndian] + where test endianType = + BinaryGet.runGet (Ewkb.ewkbGeometryType endianType) (getByteString endianType rawGeomType maybeSrid) `shouldBe` expected + +getByteString :: Endian.EndianType -> Word.Word32 -> Maybe Word.Word32 -> LazyByteString.ByteString +getByteString endianType rawGeomType maybeSrid = + ByteStringBuilder.toLazyByteString $ + case maybeSrid of + Just srid' -> + case endianType of + Endian.LittleEndian -> + ByteStringBuilder.word32LE rawGeomType <> ByteStringBuilder.word32LE srid' + Endian.BigEndian -> + ByteStringBuilder.word32BE rawGeomType <> ByteStringBuilder.word32BE srid' + Nothing -> + case endianType of + Endian.LittleEndian -> + ByteStringBuilder.word32LE rawGeomType + Endian.BigEndian -> + ByteStringBuilder.word32BE rawGeomType + +expectations :: [(Word.Word32, Maybe Word.Word32, Ewkb.EwkbGeometryType)] +expectations = + [ (0x00000000, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.TwoD) Ewkb.NoSrid) + , (0x00000001, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.TwoD) Ewkb.NoSrid) + , (0x00000002, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.TwoD) Ewkb.NoSrid) + , (0x00000003, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.TwoD) Ewkb.NoSrid) + , (0x00000004, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.TwoD) Ewkb.NoSrid) + , (0x00000005, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.TwoD) Ewkb.NoSrid) + , (0x00000006, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.TwoD) Ewkb.NoSrid) + , (0x00000007, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.TwoD) Ewkb.NoSrid) + , (0x80000000, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.Z) Ewkb.NoSrid) + , (0x80000001, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.Z) Ewkb.NoSrid) + , (0x80000002, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.Z) Ewkb.NoSrid) + , (0x80000003, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.Z) Ewkb.NoSrid) + , (0x80000004, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.Z) Ewkb.NoSrid) + , (0x80000005, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.Z) Ewkb.NoSrid) + , (0x80000006, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.Z) Ewkb.NoSrid) + , (0x80000007, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.Z) Ewkb.NoSrid) + , (0x40000000, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.M) Ewkb.NoSrid) + , (0x40000001, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.M) Ewkb.NoSrid) + , (0x40000002, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.M) Ewkb.NoSrid) + , (0x40000003, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.M) Ewkb.NoSrid) + , (0x40000004, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.M) Ewkb.NoSrid) + , (0x40000005, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.M) Ewkb.NoSrid) + , (0x40000006, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.M) Ewkb.NoSrid) + , (0x40000007, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.M) Ewkb.NoSrid) + , (0xC0000000, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.ZM) Ewkb.NoSrid) + , (0xC0000001, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.ZM) Ewkb.NoSrid) + , (0xC0000002, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.ZM) Ewkb.NoSrid) + , (0xC0000003, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.ZM) Ewkb.NoSrid) + , (0xC0000004, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.ZM) Ewkb.NoSrid) + , (0xC0000005, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.ZM) Ewkb.NoSrid) + , (0xC0000006, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.ZM) Ewkb.NoSrid) + , (0xC0000007, Nothing, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.ZM) Ewkb.NoSrid) + , (0x20000000, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.TwoD) (Ewkb.Srid srid)) + , (0x20000001, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.TwoD) (Ewkb.Srid srid)) + , (0x20000002, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.TwoD) (Ewkb.Srid srid)) + , (0x20000003, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.TwoD) (Ewkb.Srid srid)) + , (0x20000004, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.TwoD) (Ewkb.Srid srid)) + , (0x20000005, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.TwoD) (Ewkb.Srid srid)) + , (0x20000006, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.TwoD) (Ewkb.Srid srid)) + , (0x20000007, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.TwoD) (Ewkb.Srid srid)) + , (0xA0000000, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.Z) (Ewkb.Srid srid)) + , (0xA0000001, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.Z) (Ewkb.Srid srid)) + , (0xA0000002, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.Z) (Ewkb.Srid srid)) + , (0xA0000003, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.Z) (Ewkb.Srid srid)) + , (0xA0000004, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.Z) (Ewkb.Srid srid)) + , (0xA0000005, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.Z) (Ewkb.Srid srid)) + , (0xA0000006, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.Z) (Ewkb.Srid srid)) + , (0xA0000007, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.Z) (Ewkb.Srid srid)) + , (0x60000000, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.M) (Ewkb.Srid srid)) + , (0x60000001, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.M) (Ewkb.Srid srid)) + , (0x60000002, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.M) (Ewkb.Srid srid)) + , (0x60000003, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.M) (Ewkb.Srid srid)) + , (0x60000004, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.M) (Ewkb.Srid srid)) + , (0x60000005, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.M) (Ewkb.Srid srid)) + , (0x60000006, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.M) (Ewkb.Srid srid)) + , (0x60000007, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.M) (Ewkb.Srid srid)) + , (0xE0000000, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.ZM) (Ewkb.Srid srid)) + , (0xE0000001, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.ZM) (Ewkb.Srid srid)) + , (0xE0000002, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.ZM) (Ewkb.Srid srid)) + , (0xE0000003, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.ZM) (Ewkb.Srid srid)) + , (0xE0000004, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.ZM) (Ewkb.Srid srid)) + , (0xE0000005, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.ZM) (Ewkb.Srid srid)) + , (0xE0000006, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.ZM) (Ewkb.Srid srid)) + , (0xE0000007, Just srid, Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.ZM) (Ewkb.Srid srid)) + ] + +srid :: Word.Word32 +srid = 4326 diff --git a/test/Data/Internal/Wkb/EndianSpec.hs b/test/Data/Internal/Wkb/EndianSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkb/EndianSpec.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkb.EndianSpec where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.ByteString.Lazy as LazyByteString +import qualified GHC.Word as Word +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.Internal.Wkb.Endian as Endian + +spec :: Spec +spec = + testGetEndian + +testGetEndian :: Spec +testGetEndian = + describe "get endian" $ do + it "Returns BigEndian for 0" $ + BinaryGet.runGet Endian.endianType (getByteString 0) `shouldBe` Endian.BigEndian + it "Returns LittleEndian for 1" $ + BinaryGet.runGet Endian.endianType (getByteString 1) `shouldBe` Endian.LittleEndian + it "Returns fail for other" $ + BinaryGet.runGetOrFail Endian.endianType (getByteString 5) `shouldBe` Left ("", 1, "Invalid EndianType") + +getByteString :: Word.Word8 -> LazyByteString.ByteString +getByteString int = + ByteStringBuilder.toLazyByteString $ ByteStringBuilder.word8 int diff --git a/test/Data/Internal/Wkb/GeometrySpec.hs b/test/Data/Internal/Wkb/GeometrySpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkb/GeometrySpec.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkb.GeometrySpec where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Word as Word +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry + +spec :: Spec +spec = + testValidGetGeometryTypeWithCoords + +testValidGetGeometryTypeWithCoords :: Spec +testValidGetGeometryTypeWithCoords = + describe "get geometry type with coords type for valid data" $ + mapM_ testGetGeometryTypeWithCoords expectations + +testGetGeometryTypeWithCoords :: (Word.Word32, Geometry.WkbGeometryType) -> Spec +testGetGeometryTypeWithCoords (int, expected) = + it ("Parse " ++ show expected) $ + mapM_ test [Endian.BigEndian, Endian.LittleEndian] + where test endianType = + BinaryGet.runGet (Geometry.geometryTypeWithCoords endianType) (getByteString endianType int) `shouldBe` expected + +getByteString :: Endian.EndianType -> Word.Word32 -> LazyByteString.ByteString +getByteString endianType int = + ByteStringBuilder.toLazyByteString $ + case endianType of + Endian.LittleEndian -> + ByteStringBuilder.word32LE int + Endian.BigEndian -> + ByteStringBuilder.word32BE int + +expectations :: [(Word.Word32, Geometry.WkbGeometryType)] +expectations = + [ (0000, Geometry.WkbGeom Geometry.Geometry Geometry.TwoD) + , (0001, Geometry.WkbGeom Geometry.Point Geometry.TwoD) + , (0002, Geometry.WkbGeom Geometry.LineString Geometry.TwoD) + , (0003, Geometry.WkbGeom Geometry.Polygon Geometry.TwoD) + , (0004, Geometry.WkbGeom Geometry.MultiPoint Geometry.TwoD) + , (0005, Geometry.WkbGeom Geometry.MultiLineString Geometry.TwoD) + , (0006, Geometry.WkbGeom Geometry.MultiPolygon Geometry.TwoD) + , (0007, Geometry.WkbGeom Geometry.GeometryCollection Geometry.TwoD) + , (1000, Geometry.WkbGeom Geometry.Geometry Geometry.Z) + , (1001, Geometry.WkbGeom Geometry.Point Geometry.Z) + , (1002, Geometry.WkbGeom Geometry.LineString Geometry.Z) + , (1003, Geometry.WkbGeom Geometry.Polygon Geometry.Z) + , (1004, Geometry.WkbGeom Geometry.MultiPoint Geometry.Z) + , (1005, Geometry.WkbGeom Geometry.MultiLineString Geometry.Z) + , (1006, Geometry.WkbGeom Geometry.MultiPolygon Geometry.Z) + , (1007, Geometry.WkbGeom Geometry.GeometryCollection Geometry.Z) + , (2000, Geometry.WkbGeom Geometry.Geometry Geometry.M) + , (2001, Geometry.WkbGeom Geometry.Point Geometry.M) + , (2002, Geometry.WkbGeom Geometry.LineString Geometry.M) + , (2003, Geometry.WkbGeom Geometry.Polygon Geometry.M) + , (2004, Geometry.WkbGeom Geometry.MultiPoint Geometry.M) + , (2005, Geometry.WkbGeom Geometry.MultiLineString Geometry.M) + , (2006, Geometry.WkbGeom Geometry.MultiPolygon Geometry.M) + , (2007, Geometry.WkbGeom Geometry.GeometryCollection Geometry.M) + , (3000, Geometry.WkbGeom Geometry.Geometry Geometry.ZM) + , (3001, Geometry.WkbGeom Geometry.Point Geometry.ZM) + , (3002, Geometry.WkbGeom Geometry.LineString Geometry.ZM) + , (3003, Geometry.WkbGeom Geometry.Polygon Geometry.ZM) + , (3004, Geometry.WkbGeom Geometry.MultiPoint Geometry.ZM) + , (3005, Geometry.WkbGeom Geometry.MultiLineString Geometry.ZM) + , (3006, Geometry.WkbGeom Geometry.MultiPolygon Geometry.ZM) + , (3007, Geometry.WkbGeom Geometry.GeometryCollection Geometry.ZM) + ] diff --git a/test/Data/SpecHelper.hs b/test/Data/SpecHelper.hs new file mode 100644 --- /dev/null +++ b/test/Data/SpecHelper.hs @@ -0,0 +1,30 @@ +module Data.SpecHelper where + +import qualified Data.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.LineString as LineString +import qualified Data.Vector.Storable as VectorStorable + +point1 :: Geospatial.GeoPositionWithoutCRS +point1 = Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0) + +point2 :: Geospatial.GeoPositionWithoutCRS +point2 = Geospatial.GeoPointXY (Geospatial.PointXY 3.0 4.0) + +lineString1 :: LineString.LineString Geospatial.GeoPositionWithoutCRS +lineString1 = LineString.makeLineString (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0)) (Geospatial.GeoPointXY (Geospatial.PointXY 3.0 4.0)) VectorStorable.empty + +lineString2 :: LineString.LineString Geospatial.GeoPositionWithoutCRS +lineString2 = LineString.makeLineString (Geospatial.GeoPointXY (Geospatial.PointXY 1.5 2.5)) (Geospatial.GeoPointXY (Geospatial.PointXY 3.5 4.5)) VectorStorable.empty + +lineString3 :: LineString.LineString Geospatial.GeoPositionWithoutCRS +lineString3 = LineString.makeLineString (Geospatial.GeoPointXY (Geospatial.PointXY 15 15)) (Geospatial.GeoPointXY (Geospatial.PointXY 20 20)) (VectorStorable.singleton (Geospatial.GeoPointXY (Geospatial.PointXY 20 20))) + +lineString4 :: LineString.LineString Geospatial.GeoPositionWithoutCRS +lineString4 = LineString.makeLineString (Geospatial.GeoPointXY (Geospatial.PointXY 15 15)) (Geospatial.GeoPointXY (Geospatial.PointXY 20 20)) (VectorStorable.singleton (Geospatial.GeoPointXY (Geospatial.PointXY 25 25))) + +linearRing1 :: LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS +linearRing1 = LinearRing.makeLinearRing (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0)) (Geospatial.GeoPointXY (Geospatial.PointXY 3.0 4.0)) (Geospatial.GeoPointXY (Geospatial.PointXY 5.0 6.0)) VectorStorable.empty + +linearRing2 :: LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS +linearRing2 = LinearRing.makeLinearRing (Geospatial.GeoPointXY (Geospatial.PointXY 1.5 2.5)) (Geospatial.GeoPointXY (Geospatial.PointXY 3.5 4.5)) (Geospatial.GeoPointXY (Geospatial.PointXY 5.5 6.5)) VectorStorable.empty diff --git a/test/Data/WkbGeometryCollectionSpec.hs b/test/Data/WkbGeometryCollectionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WkbGeometryCollectionSpec.hs @@ -0,0 +1,54 @@ + +{-# LANGUAGE OverloadedStrings #-} + +module Data.WkbGeometryCollectionSpec where + +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Geospatial as Geospatial +import Data.Monoid ((<>)) +import qualified Data.Vector as Vector +import qualified Data.Wkb as Wkb +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = + testWkbGeometryCollectionParsing + +testWkbGeometryCollectionParsing :: Spec +testWkbGeometryCollectionParsing = + describe "Test wkb geometry collection" $ + it "Parse valid wkb geometry collection" $ + Wkb.parseByteString exampleWkbGeometryCollection `shouldBe` (Right . Geospatial.Collection $ + Vector.fromList + [ Geospatial.Point $ Geospatial.GeoPoint SpecHelper.point1 + , Geospatial.Point $ Geospatial.GeoPoint SpecHelper.point2 + , Geospatial.Line $ Geospatial.GeoLine SpecHelper.lineString3 + ] + ) + +exampleWkbGeometryCollection :: LazyByteString.ByteString +exampleWkbGeometryCollection = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 7 + <> ByteStringBuilder.int32BE 3 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.doubleBE 1 + <> ByteStringBuilder.doubleBE 2 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.doubleBE 3 + <> ByteStringBuilder.doubleBE 4 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.int32BE 3 + <> ByteStringBuilder.doubleBE 15 + <> ByteStringBuilder.doubleBE 15 + <> ByteStringBuilder.doubleBE 20 + <> ByteStringBuilder.doubleBE 20 + <> ByteStringBuilder.doubleBE 20 + <> ByteStringBuilder.doubleBE 20 diff --git a/test/Data/WkbLineSpec.hs b/test/Data/WkbLineSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WkbLineSpec.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.WkbLineSpec where + +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Geospatial as Geospatial +import Data.Monoid ((<>)) +import qualified Data.Vector as Vector +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.Wkb as Wkb + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = do + testWkbLineParsing + testWkbMultiLineParsing + +testWkbLineParsing :: Spec +testWkbLineParsing = + describe "Test wkb line" $ + it "Parse valid wkb line" $ + Wkb.parseByteString exampleWkbLine `shouldBe` (Right $ Geospatial.Line $ Geospatial.GeoLine SpecHelper.lineString1) + +exampleWkbLine :: LazyByteString.ByteString +exampleWkbLine = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + <> ByteStringBuilder.doubleBE 3.0 + <> ByteStringBuilder.doubleBE 4.0 + +testWkbMultiLineParsing :: Spec +testWkbMultiLineParsing = + describe "Test wkb multi line" $ + it "Parse valid wkb multi line" $ + Wkb.parseByteString exampleWkbMultiLine `shouldBe` (Right $ Geospatial.MultiLine $ Geospatial.GeoMultiLine (Vector.fromList [SpecHelper.lineString1, SpecHelper.lineString2])) + +exampleWkbMultiLine :: LazyByteString.ByteString +exampleWkbMultiLine = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 5 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + <> ByteStringBuilder.doubleBE 3.0 + <> ByteStringBuilder.doubleBE 4.0 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.doubleBE 1.5 + <> ByteStringBuilder.doubleBE 2.5 + <> ByteStringBuilder.doubleBE 3.5 + <> ByteStringBuilder.doubleBE 4.5 diff --git a/test/Data/WkbPointSpec.hs b/test/Data/WkbPointSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WkbPointSpec.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.WkbPointSpec where + +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Geospatial as Geospatial +import Data.Monoid ((<>)) +import qualified Data.Vector as Vector +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.Wkb as Wkb + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = do + testWkbPointParsing + testWkbMultiPointParsing + +testWkbPointParsing :: Spec +testWkbPointParsing = + describe "Test wkb point" $ + it "Parse valid wkb point" $ + Wkb.parseByteString exampleWkbPoint `shouldBe` (Right . Geospatial.Point $ Geospatial.GeoPoint SpecHelper.point1) + +exampleWkbPoint :: LazyByteString.ByteString +exampleWkbPoint = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + +testWkbMultiPointParsing :: Spec +testWkbMultiPointParsing = + describe "Test wkb multi point" $ + it "Parse valid wkb multi point" $ + Wkb.parseByteString exampleWkbMultiPoint `shouldBe` (Right $ Geospatial.MultiPoint (Geospatial.GeoMultiPoint (Vector.fromList [SpecHelper.point1, SpecHelper.point2]))) + +exampleWkbMultiPoint :: LazyByteString.ByteString +exampleWkbMultiPoint = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 4 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.doubleBE 3.0 + <> ByteStringBuilder.doubleBE 4.0 + diff --git a/test/Data/WkbPolygonSpec.hs b/test/Data/WkbPolygonSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WkbPolygonSpec.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.WkbPolygonSpec where + +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Geospatial as Geospatial +import Data.Monoid ((<>)) +import qualified Data.Vector as Vector +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.Wkb as Wkb + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = do + testWkbPolygonParsing + testWkbMultiPolygonParsing + +testWkbPolygonParsing :: Spec +testWkbPolygonParsing = + describe "Test wkb polygon" $ do + it "Parse valid wkb polygon" $ + Wkb.parseByteString exampleWkbPolygon `shouldBe` (Right $ Geospatial.Polygon $ Geospatial.GeoPolygon (Vector.singleton SpecHelper.linearRing1)) + it "Not parse bad wkb polygon" $ + Wkb.parseByteString exampleBadWkbPolygon `shouldBe` Left "Could not parse wkb: First and last points of linear ring are different: first=GeoPointXY (PointXY {_xyX = 1.0, _xyY = 2.0}) last=GeoPointXY (PointXY {_xyX = 7.0, _xyY = 8.0})" + +exampleWkbPolygon :: LazyByteString.ByteString +exampleWkbPolygon = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 3 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.int32BE 4 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + <> ByteStringBuilder.doubleBE 3.0 + <> ByteStringBuilder.doubleBE 4.0 + <> ByteStringBuilder.doubleBE 5.0 + <> ByteStringBuilder.doubleBE 6.0 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + +exampleBadWkbPolygon :: LazyByteString.ByteString +exampleBadWkbPolygon = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 3 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.int32BE 4 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + <> ByteStringBuilder.doubleBE 3.0 + <> ByteStringBuilder.doubleBE 4.0 + <> ByteStringBuilder.doubleBE 5.0 + <> ByteStringBuilder.doubleBE 6.0 + <> ByteStringBuilder.doubleBE 7.0 + <> ByteStringBuilder.doubleBE 8.0 + +testWkbMultiPolygonParsing :: Spec +testWkbMultiPolygonParsing = + describe "Test wkb multi polygon" $ + it "Parse valid wkb multi polygon" $ + Wkb.parseByteString exampleWkbMultiPolygon `shouldBe` (Right $ Geospatial.MultiPolygon $ Geospatial.GeoMultiPolygon + (Vector.fromList + [ Vector.singleton SpecHelper.linearRing1 + , Vector.singleton SpecHelper.linearRing2 + ])) + +exampleWkbMultiPolygon :: LazyByteString.ByteString +exampleWkbMultiPolygon = + ByteStringBuilder.toLazyByteString $ + ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 6 + <> ByteStringBuilder.int32BE 2 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 3 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.int32BE 4 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + <> ByteStringBuilder.doubleBE 3.0 + <> ByteStringBuilder.doubleBE 4.0 + <> ByteStringBuilder.doubleBE 5.0 + <> ByteStringBuilder.doubleBE 6.0 + <> ByteStringBuilder.doubleBE 1.0 + <> ByteStringBuilder.doubleBE 2.0 + <> ByteStringBuilder.word8 0 + <> ByteStringBuilder.int32BE 3 + <> ByteStringBuilder.int32BE 1 + <> ByteStringBuilder.int32BE 4 + <> ByteStringBuilder.doubleBE 1.5 + <> ByteStringBuilder.doubleBE 2.5 + <> ByteStringBuilder.doubleBE 3.5 + <> ByteStringBuilder.doubleBE 4.5 + <> ByteStringBuilder.doubleBE 5.5 + <> ByteStringBuilder.doubleBE 6.5 + <> ByteStringBuilder.doubleBE 1.5 + <> ByteStringBuilder.doubleBE 2.5 diff --git a/test/Data/WktGeometryCollectionSpec.hs b/test/Data/WktGeometryCollectionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WktGeometryCollectionSpec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.WktGeometryCollectionSpec where + +import Control.Lens ((^?!)) +import qualified Data.Geospatial as Geospatial +import qualified Data.Vector as Vector +import Test.Hspec (Spec, describe, it, shouldBe) +import qualified Text.Trifecta as Trifecta + +import qualified Data.Wkt as Wkt + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = testGeometryCollection + +testGeometryCollection :: Spec +testGeometryCollection = + describe "simple geometry collections" $ do + it "Parse empty" $ + Wkt.parseString Wkt.geometryCollection "geometrycollection empty" ^?! Trifecta._Success `shouldBe` Wkt.emptyGeometryCollection + it "Parse something" $ + Wkt.parseString Wkt.geometryCollection "GeometryCollection(POINT (1 2),POINT (3 4),LINESTRING (15 15, 20 20, 25 25))" ^?! Trifecta._Success `shouldBe` exampleGeometryCollection + it "Parse something with spaces" $ + Wkt.parseString Wkt.geometryCollection "GeometryCollection ( POINT ( 1 2) , POINT (3 4) , LINESTRING (15 15 , 20 20, 25 25 ) ) " ^?! Trifecta._Success `shouldBe` exampleGeometryCollection + +exampleGeometryCollection :: Vector.Vector Geospatial.GeospatialGeometry +exampleGeometryCollection = + Vector.fromList + [ Geospatial.Point $ Geospatial.GeoPoint SpecHelper.point1 + , Geospatial.Point $ Geospatial.GeoPoint SpecHelper.point2 + , Geospatial.Line $ Geospatial.GeoLine SpecHelper.lineString4 + ] diff --git a/test/Data/WktLineSpec.hs b/test/Data/WktLineSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WktLineSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.WktLineSpec where + +import Control.Lens ((^?), (^?!)) +import qualified Data.Geospatial as Geospatial +import qualified Data.LineString as LineString +import qualified Data.Maybe as Maybe +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VectorStorable +import Test.Hspec (Spec, describe, it, shouldBe, + shouldSatisfy) +import qualified Text.Trifecta as Trifecta + +import qualified Data.Wkt as Wkt + +spec :: Spec +spec = do + testLines + testMultiLines + +testLines :: Spec +testLines = + describe "simple lines" $ do + it "Parse incomplete" $ + Wkt.parseString Wkt.lineString "linestring" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse empty" $ + Wkt.parseString Wkt.lineString "linestring empty" ^?! Trifecta._Success `shouldBe` Wkt.emptyLine + it "Parse not points" $ + Wkt.parseString Wkt.lineString "linestring (abc)" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse something" $ + Wkt.parseString Wkt.lineString "linestring (1.0 2.0, 1.0 2.5, 1.0 3.0)" ^?! Trifecta._Success `shouldBe` exampleLine + it "Parse spaces" $ + Wkt.parseString Wkt.lineString "linestring ( 1.0 2.0,1.0 2.5, 1.0 3.0)" ^?! Trifecta._Success `shouldBe` exampleLine + +testMultiLines :: Spec +testMultiLines = + describe "simple multilines" $ do + it "Parse incomplete" $ + Wkt.parseString Wkt.multiLineString "multilinestring" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse empty" $ + Wkt.parseString Wkt.multiLineString "multilinestring empty" ^?! Trifecta._Success `shouldBe` Wkt.emptyMultiLine + it "Parse not points" $ + Wkt.parseString Wkt.multiLineString "multilinestring (abc)" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse something" $ + Wkt.parseString Wkt.multiLineString "multilinestring ((1.0 2.0, 1.0 2.5, 1.0 3.0))" ^?! Trifecta._Success `shouldBe` exampleMultiLine + it "Parse spaces" $ + Wkt.parseString Wkt.multiLineString "multilinestring ( ( 1.0 2.0,1.0 2.5, 1.0 3.0) )" ^?! Trifecta._Success `shouldBe` exampleMultiLine + +exampleLine :: Geospatial.GeoLine +exampleLine = Geospatial.GeoLine exampleLineString + +exampleMultiLine :: Geospatial.GeoMultiLine +exampleMultiLine = Geospatial.GeoMultiLine (Vector.singleton exampleLineString) + +exampleLineString :: LineString.LineString Geospatial.GeoPositionWithoutCRS +exampleLineString = LineString.makeLineString (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0)) (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.5)) (VectorStorable.singleton (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 3.0))) diff --git a/test/Data/WktPointSpec.hs b/test/Data/WktPointSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WktPointSpec.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.WktPointSpec where + +import Control.Lens ((^?), (^?!)) +import qualified Data.Geospatial as Geospatial +import qualified Data.Maybe as Maybe +import qualified Data.Vector as Vector +import Test.Hspec (Spec, describe, expectationFailure, it, + shouldBe, shouldSatisfy) +import qualified Text.Trifecta as Trifecta + +import qualified Data.Wkt as Wkt + +spec :: Spec +spec = do + testPoints + testMultiPoints + +testPoints :: Spec +testPoints = + describe "simple points" $ do + it "Parse incomplete" $ + Wkt.parseString Wkt.point "point" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse empty" $ + Wkt.parseString Wkt.point "point empty" ^?! Trifecta._Success `shouldBe` Wkt.emptyPoint + it "Parse not points" $ + Wkt.parseString Wkt.point "point (abc)" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse something" $ do + --Wkt.parseString Wkt.point "point (1.0 2.0)" ^?! Trifecta._Success `shouldBe` examplePoint + let x = Wkt.parseString Wkt.point "point (1.0 2.0)" + case x of + Trifecta.Success a -> a `shouldBe` examplePoint + Trifecta.Failure f -> expectationFailure (show f) + it "Parse spaces" $ + Wkt.parseString Wkt.point "point( 1.0 2.0 )" ^?! Trifecta._Success `shouldBe` examplePoint + +testMultiPoints :: Spec +testMultiPoints = + describe "simple multipoints" $ do + it "Parse incomplete" $ + Wkt.parseString Wkt.multiPoint "multipoint" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse empty" $ + Wkt.parseString Wkt.multiPoint "multipoint empty" ^?! Trifecta._Success `shouldBe` Wkt.emptyMultiPoint + it "Parse not points" $ + Wkt.parseString Wkt.multiPoint "multipoint (abc)" `shouldSatisfy` (Maybe.isJust . flip (^?) Trifecta._Failure) + it "Parse unbracketed" $ + Wkt.parseString Wkt.multiPoint "multipoint (1.0 2.0, 2.0 2.0)" ^?! Trifecta._Success `shouldBe` exampleMultiPoint + it "Parse unbracketed spaces" $ + Wkt.parseString Wkt.multiPoint "multipoint( 1.0 2.0,2.0 2.0 )" ^?! Trifecta._Success `shouldBe` exampleMultiPoint + it "Parse bracketed" $ + Wkt.parseString Wkt.multiPoint "multipoint ((1.0 2.0), (2.0 2.0))" ^?! Trifecta._Success `shouldBe` exampleMultiPoint + it "Parse bracketed spaces" $ + Wkt.parseString Wkt.multiPoint "multipoint( ( 1.0 2.0) ,( 2.0 2.0) )" ^?! Trifecta._Success `shouldBe` exampleMultiPoint + +examplePoint :: Geospatial.GeoPoint +examplePoint = Geospatial.GeoPoint (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0)) + +exampleMultiPoint :: Geospatial.GeoMultiPoint +exampleMultiPoint = Geospatial.GeoMultiPoint (Vector.fromList [Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0), Geospatial.GeoPointXY (Geospatial.PointXY 2.0 2.0)]) diff --git a/test/Data/WktPolygonSpec.hs b/test/Data/WktPolygonSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/WktPolygonSpec.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.WktPolygonSpec where + +import Control.Lens ((^?!)) +import qualified Data.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VectorStorable +import Test.Hspec (Spec, describe, it, shouldBe) +import qualified Text.Trifecta as Trifecta + +import qualified Data.Wkt as Wkt + +spec :: Spec +spec = do + testPolygons + testMultiPolygons + +testPolygons :: Spec +testPolygons = + describe "simple polygons" $ do + it "Parse empty" $ + Wkt.parseString Wkt.polygon "polygon empty" ^?! Trifecta._Success `shouldBe` Wkt.emptyPolygon + it "Parse something" $ + Wkt.parseString Wkt.polygon "polygon ((4.0 0.0, 0.0 4.0, -4.0 0.0, 0.0 -4.0, 4.0 0.0))" ^?! Trifecta._Success `shouldBe` examplePolygon + it "Parse spaces" $ + Wkt.parseString Wkt.polygon "polygon ( (4.0 0.0, 0.0 4.0, -4.0 0.0 , 0.0 -4.0 , 4.0 0.0))" ^?! Trifecta._Success `shouldBe` examplePolygon + it "Parse something with hole" $ + Wkt.parseString Wkt.polygon "polygon ((4.0 0.0, 0.0 4.0, -4.0 0.0, 0.0 -4.0, 4.0 0.0),(2.0 0.0, 0.0 2.0, -2.0 0.0, 0.0 -2.0, 2.0 0.0))" ^?! Trifecta._Success `shouldBe` examplePolygonWithHole + it "Parse something with hole spaces" $ + Wkt.parseString Wkt.polygon "polygon ( (4.0 0.0, 0.0 4.0, -4.0 0.0 , 0.0 -4.0 , 4.0 0.0),( 2.0 0.0, 0.0 2.0 , -2.0 0.0, 0.0 -2.0, 2.0 0.0))" ^?! Trifecta._Success `shouldBe` examplePolygonWithHole + +testMultiPolygons :: Spec +testMultiPolygons = + describe "simple multipolygons" $ do + it "Parse empty" $ + Wkt.parseString Wkt.multiPolygon "multipolygon empty" ^?! Trifecta._Success `shouldBe` Wkt.emptyMultiPolygon + it "Parse something" $ + Wkt.parseString Wkt.multiPolygon "multipolygon (((4.0 0.0, 0.0 4.0, -4.0 0.0, 0.0 -4.0, 4.0 0.0)))" ^?! Trifecta._Success `shouldBe` exampleMultiPolygon + it "Parse something with hole" $ + Wkt.parseString Wkt.multiPolygon "multipolygon (( (4.0 0.0, 0.0 4.0, -4.0 0.0 , 0.0 -4.0 , 4.0 0.0),( 2.0 0.0, 0.0 2.0 , -2.0 0.0, 0.0 -2.0, 2.0 0.0)))" ^?! Trifecta._Success `shouldBe` exampleMultiPolygonWithHole + +examplePolygon :: Geospatial.GeoPolygon +examplePolygon = + Geospatial.GeoPolygon (Vector.singleton linearRingSingle) + +examplePolygonWithHole :: Geospatial.GeoPolygon +examplePolygonWithHole = Geospatial.GeoPolygon linearRingDouble + +linearRingSingle :: LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS +linearRingSingle = LinearRing.makeLinearRing (Geospatial.GeoPointXY (Geospatial.PointXY 4.0 0.0)) (Geospatial.GeoPointXY (Geospatial.PointXY 0.0 4.0)) (Geospatial.GeoPointXY (Geospatial.PointXY (-4.0) 0.0)) (VectorStorable.fromList [Geospatial.GeoPointXY (Geospatial.PointXY 0.0 (-4.0))]) + +linearRingDouble :: Vector.Vector (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) +linearRingDouble = Vector.fromList + [ linearRingSingle + , LinearRing.makeLinearRing (Geospatial.GeoPointXY (Geospatial.PointXY 2.0 0.0)) (Geospatial.GeoPointXY (Geospatial.PointXY 0.0 2.0)) (Geospatial.GeoPointXY (Geospatial.PointXY (-2.0) 0.0)) (VectorStorable.fromList [ Geospatial.GeoPointXY (Geospatial.PointXY 0.0 (-2.0))]) + ] + +exampleMultiPolygon :: Geospatial.GeoMultiPolygon +exampleMultiPolygon = Geospatial.GeoMultiPolygon (Vector.singleton (Vector.singleton linearRingSingle)) + +exampleMultiPolygonWithHole :: Geospatial.GeoMultiPolygon +exampleMultiPolygonWithHole = Geospatial.GeoMultiPolygon (Vector.singleton linearRingDouble) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/wkt-geom.cabal b/wkt-geom.cabal new file mode 100644 --- /dev/null +++ b/wkt-geom.cabal @@ -0,0 +1,84 @@ +name: wkt-geom +version: 0.0.1 +synopsis: A parser of WKT, WKB and eWKB. +description: Well Known Text (WKT), Well Known Binary and the Postgresql extension Extended Well Know Binary (eWKB) are vector geometry representations. + . + The text or binary representations are parsed and turned into their GeoJSON representations. The binary representations use vectors throughout + whereas the text representation still uses a list and then is converted to a vector representation. +homepage: https://github.com/indicatrix/wkt-geom#readme +license: Apache-2.0 +license-file: LICENSE +author: Andrew Newmnan, Dominic Endrei +maintainer: andrewfnewman@gmail.com +copyright: 2017-2018 Wkt-Geom Project +category: Data +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.Ewkb + , Data.Wkb + , Data.Wkt + , Data.Internal.Ewkb.Geometry + , Data.Internal.Wkb.Endian + , Data.Internal.Wkb.Geometry + , Data.Internal.Wkb.GeometryCollection + , Data.Internal.Wkb.Geospatial + , Data.Internal.Wkb.Line + , Data.Internal.Wkb.Point + , Data.Internal.Wkb.Polygon + , Data.Internal.Wkt.Common + , Data.Internal.Wkt.Line + , Data.Internal.Wkt.Point + , Data.Internal.Wkt.Polygon + , Data.Internal.Wkt.GeometryCollection + + + build-depends: base < 5 && >= 4.8 + , binary >= 0.8 + , bytestring >= 0.10 + , geojson >= 2.0.0 + , scientific >= 0.3.6 + , trifecta >= 1.7 + , utf8-string >= 1 + , vector >= 0.10 + + ghc-options: -Wall + default-language: Haskell2010 + +test-suite wkt-geom-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + other-modules: Data.Internal.Ewkb.GeometrySpec + , Data.Internal.Wkb.EndianSpec + , Data.Internal.Wkb.GeometrySpec + , Data.WkbGeometryCollectionSpec + , Data.WkbLineSpec + , Data.WkbPointSpec + , Data.WkbPolygonSpec + , Data.WktGeometryCollectionSpec + , Data.WktLineSpec + , Data.WktPointSpec + , Data.WktPolygonSpec + , Data.SpecHelper + main-is: Spec.hs + build-depends: base + , binary >= 0.8 + , ansi-wl-pprint >= 0.6 + , bytestring >= 0.10 + , geojson >= 2.0.0 + , hspec + , lens + , QuickCheck + , scientific >= 0.3.6 + , trifecta >= 1.7 + , vector >= 0.10 + , wkt-geom + ghc-options: -Wall + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/githubuser/wkt-geom