diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,5 +1,19 @@ # Change log for esqueleto-postgis project +## Version 1.2.0 ++ re-export point, less annoying to use. ++ adopt wkt-geom package and put it in as a submodule, + original library doesn't appear to be maintained. + this way we're a step closer to stackage. + + got rid of the internal convention, + it goes against pvp. If we want some specialized + usage package I should split off a core package instead. + For now I don't care I don't think I'm not changing those + functions anyway. + + also ported over the test suite ++ swap out bytestring-base16 for base16, which appears maintained. + + ## Version 1.1.0 + Add st_union + add getPoitns to escape the postgis geometry more easily. diff --git a/esqueleto-postgis.cabal b/esqueleto-postgis.cabal --- a/esqueleto-postgis.cabal +++ b/esqueleto-postgis.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: esqueleto-postgis -version: 1.1.0 +version: 1.2.0 homepage: https://github.com/jappeace/esqueleto-postgis#readme bug-reports: https://github.com/jappeace/esqueleto-postgis/issues author: Jappie Klooster @@ -64,8 +64,10 @@ esqueleto >= 3.5.10 && < 3.7, text >= 1.2.5 && < 2.2, persistent >= 2.13.3 && < 2.19, - geojson >= 4.1.1 && < 4.2, - wkt-geom >= 0.0.12 && < 0.1, + geojson >= 4.1.0 && < 4.2, + bytestring < 2, + base16 >= 1.0 && < 1.1, + binary < 1, default-language: Haskell2010 @@ -74,6 +76,18 @@ import: common-options exposed-modules: Database.Esqueleto.Postgis + Database.Esqueleto.Postgis.Ewkb + Database.Esqueleto.Postgis.Hex + Database.Esqueleto.Postgis.Ewkb.Geometry + Database.Esqueleto.Postgis.Wkb.Endian + Database.Esqueleto.Postgis.Wkb.Geometry + Database.Esqueleto.Postgis.Wkb.GeometryCollection + Database.Esqueleto.Postgis.Wkb.Geospatial + Database.Esqueleto.Postgis.Wkb.Line + Database.Esqueleto.Postgis.Wkb.Point + Database.Esqueleto.Postgis.Wkb.Polygon + Database.Esqueleto.Postgis.Wkb + hs-source-dirs: src @@ -82,6 +96,19 @@ type: exitcode-stdio-1.0 main-is: Test.hs ghc-options: -Wno-unused-packages + other-modules: + Data.SpecHelper + Ewkb.GeometrySpec + Ewkb.LineSpec + Ewkb.PointSpec + Wkb.EndianSpec + Wkb.GeometryCollectionSpec + Wkb.GeometrySpec + Wkb.HexParsingSpec + Wkb.LineSpec + Wkb.PointSpec + Wkb.PolygonSpec + hs-source-dirs: test build-depends: @@ -93,3 +120,6 @@ resourcet, monad-logger, hedgehog, + hspec, + tasty-hspec, + hw-hspec-hedgehog < 0.2 && >= 0.1.0.4 diff --git a/src/Database/Esqueleto/Postgis.hs b/src/Database/Esqueleto/Postgis.hs --- a/src/Database/Esqueleto/Postgis.hs +++ b/src/Database/Esqueleto/Postgis.hs @@ -19,15 +19,20 @@ st_point, st_point_xyz, st_point_xyzm, + + -- * re-exports + PointXY(..), + PointXYZ(..), + PointXYZM(..), ) where import Data.Bifunctor (first) -import Data.Ewkb (parseHexByteString) +import Database.Esqueleto.Postgis.Ewkb (parseHexByteString) import Data.Foldable (Foldable (toList), fold) import Data.Geospatial (GeoPoint (..), GeoPositionWithoutCRS (..), GeospatialGeometry, PointXY (..), PointXYZ (..), PointXYZM (..)) import Data.Geospatial qualified as Geospatial -import Data.Hex (Hex (..)) +import Database.Esqueleto.Postgis.Hex (Hex (..)) import Data.LineString (LineString, fromLineString, lineStringHead) import Data.LinearRing (LinearRing, fromLinearRing, makeLinearRing, ringHead, toSeq) import Data.List qualified as List diff --git a/src/Database/Esqueleto/Postgis/Ewkb.hs b/src/Database/Esqueleto/Postgis/Ewkb.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Ewkb.hs @@ -0,0 +1,52 @@ +-- | I copied these because the original libraryy doesn't +-- appear to be maintained. +-- I'm only interested in this parseHexBytestring function. +-- +-- friendly copied from github.com/zellige/wkt-geom.git +-- Copyright 2017-2018 wkt-geom Project +-- Apache license +-- +-- +-- Refer to the eWKB Postgis Documentation +-- +-- Allows parsing of ByteString into a Geospatial Object. +-- +------------------------------------------------------------------- +module Database.Esqueleto.Postgis.Ewkb + ( parseByteString + , parseHexByteString + , toByteString + ) 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.Geospatial as Geospatial +import qualified Database.Esqueleto.Postgis.Hex as Hex + +import qualified Database.Esqueleto.Postgis.Ewkb.Geometry as EwkbGeometry +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geospatial as WkbGeospatial + +-- | +-- Representation of EWKB as Binary +parseByteString :: LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry +parseByteString byteString = + case BinaryGet.runGetOrFail + (WkbGeospatial.getGeospatialGeometry EwkbGeometry.getWkbGeom) + byteString of + Left (_, _, err) -> Left $ "Could not parse ewkb: " ++ err + Right (_, _, geoSpatialGeometry) -> Right geoSpatialGeometry + +-- | +-- Representation of EWKB as a String in Base16/Hex form i.e. "0101000000000000000000f03f0000000000000040" is POINT 1.0 2.0 +parseHexByteString :: Hex.Hex -> Either String Geospatial.GeospatialGeometry +parseHexByteString = Hex.safeConvert parseByteString + +-- | +-- Produce the binary representation of EWKB given its EndianType (Little or Big - Intel is Little) and SRID (4326 for example). +toByteString :: Endian.EndianType -> EwkbGeometry.SridType -> Geospatial.GeospatialGeometry -> LazyByteString.ByteString +toByteString endianType sridType = + ByteStringBuilder.toLazyByteString . WkbGeospatial.builderGeospatialGeometry + mkBuilder endianType + where mkBuilder eType gType = EwkbGeometry.builderEwkbGeom eType (EwkbGeometry.EwkbGeom gType sridType) diff --git a/src/Database/Esqueleto/Postgis/Ewkb/Geometry.hs b/src/Database/Esqueleto/Postgis/Ewkb/Geometry.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Ewkb/Geometry.hs @@ -0,0 +1,148 @@ +module Database.Esqueleto.Postgis.Ewkb.Geometry + ( EwkbGeometryType (..) + , SridType (..) + , getEwkbGeom + , getWkbGeom + , builderWkbGeom + , builderEwkbGeom + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import Data.Bits ((.&.), (.|.)) +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Word as Word + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry + +-- Types + +data SridType = Srid Word.Word32 | NoSrid deriving (Show, Eq) + +data EwkbGeometryType = EwkbGeom Geometry.WkbGeometryType SridType deriving (Show, Eq) + + +-- Binary parsers + +getEwkbGeom :: Endian.EndianType -> BinaryGet.Get EwkbGeometryType +getEwkbGeom endianType = do + rawGeometryType <- Endian.getFourBytes endianType + ewkbSrid <- getEwkbSrid endianType rawGeometryType + geomType <- rawtoWkbGeometryType rawGeometryType + pure $ EwkbGeom geomType ewkbSrid + +getWkbGeom :: Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType +getWkbGeom endianType = do + rawGeometryType <- Endian.getFourBytes endianType + _ <- getEwkbSrid endianType rawGeometryType + rawtoWkbGeometryType rawGeometryType + +getEwkbSrid :: Endian.EndianType -> Word.Word32 -> BinaryGet.Get SridType +getEwkbSrid endianType int = + if int .&. sridMask /= 0 then do + srid <- Endian.getFourBytes endianType + if srid == supportedSrid then + pure $ Srid srid + else + Monad.fail $ "Invalid SRID only " <> show supportedSrid <> " supported: " ++ show srid + else + pure NoSrid + + +-- Binary builders + +builderEwkbGeom :: Endian.EndianType -> EwkbGeometryType -> ByteStringBuilder.Builder +builderEwkbGeom endianType (EwkbGeom wkbGeometryType NoSrid) = + builderWkbGeom endianType wkbGeometryType +builderEwkbGeom endianType (EwkbGeom wkbGeometryType (Srid srid)) = do + let int = wkbGeometryTypeToInt wkbGeometryType .|. sridMask + Endian.builderFourBytes endianType int + <> Endian.builderFourBytes endianType srid + +builderWkbGeom :: Endian.EndianType -> Geometry.WkbGeometryType -> ByteStringBuilder.Builder +builderWkbGeom endianType wkbGeometryType = + Endian.builderFourBytes endianType $ wkbGeometryTypeToInt wkbGeometryType + + +-- Helpers + +wkbGeometryTypeToInt :: Geometry.WkbGeometryType -> Word.Word32 +wkbGeometryTypeToInt (Geometry.WkbGeom geometryType coordinateType) = + coordinateTypeToInt coordinateType .|. geometryTypeToInt geometryType + +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 + + +intToGeometryType :: Word.Word32 -> Maybe Geometry.GeometryType +intToGeometryType int = + case int .&. geometryMask 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 + +geometryTypeToInt :: Geometry.GeometryType -> Word.Word32 +geometryTypeToInt geometryType = + case geometryType of + Geometry.Geometry -> 0 + Geometry.Point -> 1 + Geometry.LineString -> 2 + Geometry.Polygon -> 3 + Geometry.MultiPoint -> 4 + Geometry.MultiLineString -> 5 + Geometry.MultiPolygon -> 6 + Geometry.GeometryCollection -> 7 + +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 + +coordinateTypeToInt :: Geometry.CoordinateType -> Word.Word32 +coordinateTypeToInt coordinateType = + case coordinateType of + Geometry.TwoD -> 0 + Geometry.Z -> zMask + Geometry.M -> mMask + Geometry.ZM -> zMask .|. mMask + +hasZ :: Word.Word32 -> Bool +hasZ int = + int .&. zMask /= 0 + +hasM :: Word.Word32 -> Bool +hasM int = + int .&. 0x40000000 /= 0 + + +-- Constants + +zMask :: Word.Word32 +zMask = 0x80000000 + +mMask :: Word.Word32 +mMask = 0x40000000 + +sridMask :: Word.Word32 +sridMask = 0x20000000 + +geometryMask :: Word.Word32 +geometryMask = 0x0fffffff + +supportedSrid :: Word.Word32 +supportedSrid = 4326 diff --git a/src/Database/Esqueleto/Postgis/Hex.hs b/src/Database/Esqueleto/Postgis/Hex.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Hex.hs @@ -0,0 +1,23 @@ + +-- | friendly copied from github.com/zellige/wkt-geom.git +-- Copyright 2017-2018 wkt-geom Project +-- Apache license +module Database.Esqueleto.Postgis.Hex + ( safeConvert + , Hex(..) + ) where + +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Base16 as ByteStringBase16 +import qualified Data.ByteString.Char8 as ByteStringChar8 +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Geospatial as Geospatial + +newtype Hex = Hex ByteString.ByteString + +safeConvert :: (LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry) -> Hex -> Either String Geospatial.GeospatialGeometry +safeConvert f (Hex byteString) = + case ByteStringBase16.decodeBase16Untyped byteString of + Left _ -> Left $ "Invalid hex representation: " <> ByteStringChar8.unpack byteString + Right decoded -> f $ LazyByteString.fromStrict decoded + diff --git a/src/Database/Esqueleto/Postgis/Wkb.hs b/src/Database/Esqueleto/Postgis/Wkb.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb.hs @@ -0,0 +1,41 @@ +-- Refer to the WKB Wikipedia page +-- +-- Allows parsing of ByteString into a Geospatial Object. +-- +------------------------------------------------------------------- +module Database.Esqueleto.Postgis.Wkb + ( parseByteString + , parseHexByteString + , toByteString + ) 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.Geospatial as Geospatial +import qualified Database.Esqueleto.Postgis.Hex as Hex + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry +import qualified Database.Esqueleto.Postgis.Wkb.Geospatial as WkbGeospatial + +-- | +-- Representation of WKB as Binary +parseByteString :: LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry +parseByteString byteString = + case BinaryGet.runGetOrFail + (WkbGeospatial.getGeospatialGeometry Geometry.getWkbGeom) + byteString of + Left (_, _, err) -> Left $ "Could not parse wkb: " ++ err + Right (_, _, geoSpatialGeometry) -> Right geoSpatialGeometry + +-- | +-- Representation of WKB as a String in Base16/Hex form i.e. "0101000000000000000000f03f0000000000000040" is POINT 1.0 2.0 +parseHexByteString :: Hex.Hex -> Either String Geospatial.GeospatialGeometry +parseHexByteString = Hex.safeConvert parseByteString + +-- | +-- Produce the binary representation of WKB given its EndianType (Little or Big - Intel is Little). Use EWKB when you know the SRID. +toByteString :: Endian.EndianType -> Geospatial.GeospatialGeometry -> LazyByteString.ByteString +toByteString endianType = + ByteStringBuilder.toLazyByteString . WkbGeospatial.builderGeospatialGeometry Geometry.builderWkbGeom endianType diff --git a/src/Database/Esqueleto/Postgis/Wkb/Endian.hs b/src/Database/Esqueleto/Postgis/Wkb/Endian.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb/Endian.hs @@ -0,0 +1,63 @@ +module Database.Esqueleto.Postgis.Wkb.Endian + ( EndianType (..) + , getEndianType + , getFourBytes + , getDouble + , builderEndianType + , builderFourBytes + , builderDouble + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Word as Word + +data EndianType = LittleEndian | BigEndian deriving (Show, Eq) + +getEndianType :: BinaryGet.Get EndianType +getEndianType = do + byte <- BinaryGet.getWord8 + case byte of + 0 -> + pure BigEndian + 1 -> + pure LittleEndian + _ -> + Monad.fail "Invalid EndianType" + +getFourBytes :: EndianType -> BinaryGet.Get Word.Word32 +getFourBytes endianType = + case endianType of + LittleEndian -> + BinaryGet.getWord32le + BigEndian -> + BinaryGet.getWord32be + +getDouble :: EndianType -> BinaryGet.Get Double +getDouble endianType = + case endianType of + LittleEndian -> + BinaryGet.getDoublele + BigEndian -> + BinaryGet.getDoublebe + +builderEndianType :: EndianType -> ByteStringBuilder.Builder +builderEndianType BigEndian = ByteStringBuilder.word8 0 +builderEndianType LittleEndian = ByteStringBuilder.word8 1 + +builderFourBytes :: EndianType -> Word.Word32 -> ByteStringBuilder.Builder +builderFourBytes endianType = + case endianType of + LittleEndian -> + ByteStringBuilder.word32LE + BigEndian -> + ByteStringBuilder.word32BE + +builderDouble :: EndianType -> Double -> ByteStringBuilder.Builder +builderDouble endianType = + case endianType of + LittleEndian -> + ByteStringBuilder.doubleLE + BigEndian -> + ByteStringBuilder.doubleBE diff --git a/src/Database/Esqueleto/Postgis/Wkb/Geometry.hs b/src/Database/Esqueleto/Postgis/Wkb/Geometry.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb/Geometry.hs @@ -0,0 +1,123 @@ +module Database.Esqueleto.Postgis.Wkb.Geometry + ( GeometryType (..) + , CoordinateType (..) + , WkbGeometryType (..) + , BuilderWkbGeometryType + , getWkbGeom + , builderWkbGeom + , geoPositionWithoutCRSToCoordinateType + , coordTypeOfSequence + , coordTypeOfLinearRings + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.Maybe as Maybe +import qualified Data.Sequence as Sequence +import qualified Data.Word as Word + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian + +-- Types + +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) + + +-- Binary parsers + +getWkbGeom :: Endian.EndianType -> BinaryGet.Get WkbGeometryType +getWkbGeom endianType = do + fullGeometryType <- Endian.getFourBytes 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 + + +-- Binary builders + +type BuilderWkbGeometryType = Endian.EndianType -> WkbGeometryType -> ByteStringBuilder.Builder + +builderWkbGeom :: Endian.EndianType -> WkbGeometryType -> ByteStringBuilder.Builder +builderWkbGeom endianType (WkbGeom geometryType coordinateType) = do + let int = coordinateTypeToInt coordinateType * 1000 + geometryTypeToInt geometryType + Endian.builderFourBytes endianType int + + +-- Helpers + +geoPositionWithoutCRSToCoordinateType :: Geospatial.GeoPositionWithoutCRS -> Maybe CoordinateType +geoPositionWithoutCRSToCoordinateType geoPosition = + case geoPosition of + Geospatial.GeoEmpty -> Nothing + Geospatial.GeoPointXY _ -> Just TwoD + Geospatial.GeoPointXYZ _ -> Just Z + Geospatial.GeoPointXYZM _ -> Just ZM + +coordTypeOfSequence :: Sequence.Seq Geospatial.GeoPositionWithoutCRS -> CoordinateType +coordTypeOfSequence (first Sequence.:<| _) = + Maybe.fromMaybe TwoD (geoPositionWithoutCRSToCoordinateType first) +coordTypeOfSequence _ = TwoD + +coordTypeOfLinearRings :: Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) -> CoordinateType +coordTypeOfLinearRings (first Sequence.:<| _) = coordTypeOfSequence $ LinearRing.toSeq first +coordTypeOfLinearRings _ = TwoD + +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 + +geometryTypeToInt :: GeometryType -> Word.Word32 +geometryTypeToInt geometryType = + case geometryType of + Geometry -> 0 + Point -> 1 + LineString -> 2 + Polygon -> 3 + MultiPoint -> 4 + MultiLineString -> 5 + MultiPolygon -> 6 + GeometryCollection -> 7 + +intToCoordinateType :: Word.Word32 -> Maybe CoordinateType +intToCoordinateType int = + case int of + 0 -> Just TwoD + 1 -> Just Z + 2 -> Just M + 3 -> Just ZM + _ -> Nothing + +coordinateTypeToInt :: CoordinateType -> Word.Word32 +coordinateTypeToInt coordinateType = + case coordinateType of + TwoD -> 0 + Z -> 1 + M -> 2 + ZM -> 3 diff --git a/src/Database/Esqueleto/Postgis/Wkb/GeometryCollection.hs b/src/Database/Esqueleto/Postgis/Wkb/GeometryCollection.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb/GeometryCollection.hs @@ -0,0 +1,56 @@ +module Database.Esqueleto.Postgis.Wkb.GeometryCollection + ( getGeometryCollection + , getEnclosedFeature + , builderGeometryCollection + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Foldable as Foldable +import qualified Data.Geospatial as Geospatial +import qualified Data.Sequence as Sequence + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry + + +-- Binary parsers + +getGeometryCollection :: BinaryGet.Get Geospatial.GeospatialGeometry + -> Endian.EndianType + -> Geometry.CoordinateType + -> BinaryGet.Get Geospatial.GeospatialGeometry +getGeometryCollection getGeospatialGeometry endianType _ = do + numberOfGeometries <- Endian.getFourBytes endianType + geoSpatialGeometries <- Sequence.replicateM (fromIntegral numberOfGeometries) getGeospatialGeometry + pure $ Geospatial.Collection geoSpatialGeometries + +getEnclosedFeature :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) + -> Geometry.GeometryType + -> (Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get feature) + -> BinaryGet.Get feature +getEnclosedFeature getWkbGeom expectedGeometryType getFeature = do + endianType <- Endian.getEndianType + 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" + + +-- Binary builders + +type BuilderGeospatialFeature = Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeospatialGeometry -> ByteStringBuilder.Builder + +builderGeometryCollection :: BuilderGeospatialFeature + -> Geometry.BuilderWkbGeometryType + -> Endian.EndianType + -> Sequence.Seq Geospatial.GeospatialGeometry + -> ByteStringBuilder.Builder +builderGeometryCollection builderGeospatialFeature builderWkbGeom endianType geometryCollection = + Endian.builderEndianType endianType + <> builderWkbGeom endianType (Geometry.WkbGeom Geometry.GeometryCollection Geometry.TwoD) + <> Endian.builderFourBytes endianType (fromIntegral $ length geometryCollection) + <> Foldable.foldMap (builderGeospatialFeature builderWkbGeom endianType) geometryCollection diff --git a/src/Database/Esqueleto/Postgis/Wkb/Geospatial.hs b/src/Database/Esqueleto/Postgis/Wkb/Geospatial.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb/Geospatial.hs @@ -0,0 +1,68 @@ +module Database.Esqueleto.Postgis.Wkb.Geospatial + ( getGeospatialGeometry + , builderGeospatialGeometry + ) where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Geospatial as Geospatial +import qualified Data.Monoid as Monoid + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry +import qualified Database.Esqueleto.Postgis.Wkb.GeometryCollection as GeometryCollection +import qualified Database.Esqueleto.Postgis.Wkb.Line as Line +import qualified Database.Esqueleto.Postgis.Wkb.Point as Point +import qualified Database.Esqueleto.Postgis.Wkb.Polygon as Polygon + + +-- Binary parsers + +getGeospatialGeometry :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) + -> BinaryGet.Get Geospatial.GeospatialGeometry +getGeospatialGeometry getWkbGeom = do + endianType <- Endian.getEndianType + 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.getPoint + Geometry.LineString -> Line.getLine + Geometry.Polygon -> Polygon.getPolygon + Geometry.MultiPoint -> Point.getMultiPoint getWkbGeom + Geometry.MultiLineString -> Line.getMultiLine getWkbGeom + Geometry.MultiPolygon -> Polygon.getMultiPolygon getWkbGeom + Geometry.GeometryCollection -> GeometryCollection.getGeometryCollection (getGeospatialGeometry getWkbGeom) + +getNoGeometry :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getNoGeometry _ _ = + pure Geospatial.NoGeometry + + +-- Binary builders + +builderGeospatialGeometry :: Geometry.BuilderWkbGeometryType + -> Endian.EndianType + -> Geospatial.GeospatialGeometry + -> ByteStringBuilder.Builder +builderGeospatialGeometry builderWkbGeom endianType geospatialGeometry = + case geospatialGeometry of + Geospatial.NoGeometry -> Monoid.mempty + Geospatial.Point geoPoint -> build Point.builderPoint geoPoint + Geospatial.Line geoLine -> build Line.builderLine geoLine + Geospatial.Polygon geoPolygon -> build Polygon.builderPolygon geoPolygon + Geospatial.MultiPoint geoMultiPoint -> build Point.builderMultiPoint geoMultiPoint + Geospatial.MultiLine geoMultiLine -> build Line.builderMultiLine geoMultiLine + Geospatial.MultiPolygon geoMultiPolygon -> build Polygon.builderMultiPolygon geoMultiPolygon + Geospatial.Collection geoCollection -> builderGeometryCollection endianType geoCollection + where builderGeometryCollection = + GeometryCollection.builderGeometryCollection builderGeospatialGeometry builderWkbGeom + build builder = builder builderWkbGeom endianType diff --git a/src/Database/Esqueleto/Postgis/Wkb/Line.hs b/src/Database/Esqueleto/Postgis/Wkb/Line.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb/Line.hs @@ -0,0 +1,63 @@ +module Database.Esqueleto.Postgis.Wkb.Line + ( Database.Esqueleto.Postgis.Wkb.Line.getLine + , getMultiLine + , builderLine + , builderMultiLine + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Foldable as Foldable +import qualified Data.Geospatial as Geospatial +import qualified Data.LineString as LineString +import qualified Data.Sequence as Sequence + + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry +import qualified Database.Esqueleto.Postgis.Wkb.GeometryCollection as GeometryCollection +import qualified Database.Esqueleto.Postgis.Wkb.Point as Point + +-- Binary parsers + +getLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getLine endianType coordType = do + gl <- getGeoLine endianType coordType + pure $ Geospatial.Line gl + +getMultiLine :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getMultiLine getWkbGeom endianType _ = do + numberOfLines <- Endian.getFourBytes endianType + geoLines <- Sequence.replicateM (fromIntegral numberOfLines) (GeometryCollection.getEnclosedFeature getWkbGeom Geometry.LineString getGeoLine) + pure $ Geospatial.MultiLine $ Geospatial.mergeGeoLines geoLines + +getGeoLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoLine +getGeoLine endianType coordType = do + numberOfPoints <- Endian.getFourBytes endianType + if numberOfPoints >= 2 then do + p1 <- Point.getCoordPoint endianType coordType + p2 <- Point.getCoordPoint endianType coordType + pts <- Point.getCoordPoints endianType coordType (numberOfPoints - 2) + pure $ Geospatial.GeoLine $ LineString.makeLineString p1 p2 pts + else + Monad.fail "Must have at least two points for a line" + + +-- Binary builders + +builderLine :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoLine -> ByteStringBuilder.Builder +builderLine builderWkbGeom endianType (Geospatial.GeoLine lineString) = do + let coordPoints = LineString.toSeq lineString + coordType = Geometry.coordTypeOfSequence coordPoints + Endian.builderEndianType endianType + <> builderWkbGeom endianType (Geometry.WkbGeom Geometry.LineString coordType) + <> Endian.builderFourBytes endianType (fromIntegral $ length coordPoints) + <> Foldable.foldMap (Point.builderCoordPoint endianType) coordPoints + +builderMultiLine :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoMultiLine -> ByteStringBuilder.Builder +builderMultiLine builderWkbGeom endianType (Geospatial.GeoMultiLine lineStrings) = + Endian.builderEndianType endianType + <> builderWkbGeom endianType (Geometry.WkbGeom Geometry.MultiLineString Geometry.TwoD) + <> Endian.builderFourBytes endianType (fromIntegral $ length lineStrings) + <> Foldable.foldMap (builderLine builderWkbGeom endianType . Geospatial.GeoLine) lineStrings diff --git a/src/Database/Esqueleto/Postgis/Wkb/Point.hs b/src/Database/Esqueleto/Postgis/Wkb/Point.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb/Point.hs @@ -0,0 +1,99 @@ +module Database.Esqueleto.Postgis.Wkb.Point + ( getPoint + , getMultiPoint + , getGeoPoint + , getCoordPoint + , getCoordPoints + , builderPoint + , builderMultiPoint + , builderCoordPoint + , builderCoordPoints + ) where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Foldable as Foldable +import qualified Data.Geospatial as Geospatial +import qualified Data.Monoid as Monoid +import qualified Data.Sequence as Sequence +import qualified Data.Word as Word + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry +import qualified Database.Esqueleto.Postgis.Wkb.GeometryCollection as GeometryCollection + +-- Binary parsers + +getPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getPoint endianType coordType = do + geoPoint <- getGeoPoint endianType coordType + pure $ Geospatial.Point geoPoint + +getMultiPoint :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getMultiPoint getWkbGeom endianType _ = do + numberOfPoints <- Endian.getFourBytes endianType + geoPoints <- Sequence.replicateM (fromIntegral numberOfPoints) (GeometryCollection.getEnclosedFeature getWkbGeom Geometry.Point getGeoPoint) + pure $ Geospatial.MultiPoint $ Geospatial.mergeGeoPoints geoPoints + +getGeoPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPoint +getGeoPoint endianType coordType = do + p <- getCoordPoint endianType coordType + pure $ Geospatial.GeoPoint p + +getCoordPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPositionWithoutCRS +getCoordPoint endianType coordType = + case coordType of + Geometry.TwoD -> do + point <- Geospatial.PointXY <$> getDouble <*> getDouble + return $ Geospatial.GeoPointXY point + Geometry.Z -> do + point <- Geospatial.PointXYZ <$> getDouble <*> getDouble <*> getDouble + return $ Geospatial.GeoPointXYZ point + Geometry.M -> do + point <- Geospatial.PointXYZ <$> getDouble <*> getDouble <*> getDouble + return $ Geospatial.GeoPointXYZ point + Geometry.ZM -> do + point <- Geospatial.PointXYZM <$> getDouble <*> getDouble <*> getDouble <*> getDouble + return $ Geospatial.GeoPointXYZM point + where getDouble = Endian.getDouble endianType + +getCoordPoints :: Endian.EndianType -> Geometry.CoordinateType -> Word.Word32 -> BinaryGet.Get (Sequence.Seq Geospatial.GeoPositionWithoutCRS) +getCoordPoints endianType coordType numberOfPoints = + Sequence.replicateM (fromIntegral numberOfPoints) (getCoordPoint endianType coordType) + + +-- Binary builders + +builderPoint :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoPoint -> ByteStringBuilder.Builder +builderPoint builderWkbGeom endianType (Geospatial.GeoPoint coordPoint) = + case Geometry.geoPositionWithoutCRSToCoordinateType coordPoint of + Just coordinateType -> + Endian.builderEndianType endianType + <> builderWkbGeom endianType (Geometry.WkbGeom Geometry.Point coordinateType) + <> builderCoordPoint endianType coordPoint + Nothing -> + Monoid.mempty + +builderMultiPoint :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoMultiPoint -> ByteStringBuilder.Builder +builderMultiPoint builderWkbGeom endianType (Geospatial.GeoMultiPoint coordPoints) = + Endian.builderEndianType endianType + <> builderWkbGeom endianType (Geometry.WkbGeom Geometry.MultiPoint coordType) + <> Endian.builderFourBytes endianType (fromIntegral $ length coordPoints) + <> Foldable.foldMap (builderPoint builderWkbGeom endianType . Geospatial.GeoPoint) coordPoints + where coordType = Geometry.coordTypeOfSequence coordPoints + +builderCoordPoint :: Endian.EndianType -> Geospatial.GeoPositionWithoutCRS -> ByteStringBuilder.Builder +builderCoordPoint endianType coordPoint = + case coordPoint of + Geospatial.GeoEmpty -> Monoid.mempty + Geospatial.GeoPointXY (Geospatial.PointXY x y) -> + Foldable.foldMap builderDouble [x, y] + Geospatial.GeoPointXYZ (Geospatial.PointXYZ x y z) -> + Foldable.foldMap builderDouble [x, y, z] + Geospatial.GeoPointXYZM (Geospatial.PointXYZM x y z m) -> + Foldable.foldMap builderDouble [x, y, z, m] + where builderDouble = Endian.builderDouble endianType + +builderCoordPoints :: Endian.EndianType -> Sequence.Seq Geospatial.GeoPositionWithoutCRS -> ByteStringBuilder.Builder +builderCoordPoints endianType = + Foldable.foldMap (builderCoordPoint endianType) diff --git a/src/Database/Esqueleto/Postgis/Wkb/Polygon.hs b/src/Database/Esqueleto/Postgis/Wkb/Polygon.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Postgis/Wkb/Polygon.hs @@ -0,0 +1,89 @@ +module Database.Esqueleto.Postgis.Wkb.Polygon + ( getPolygon + , getMultiPolygon + , builderPolygon + , builderMultiPolygon + ) where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Foldable as Foldable +import qualified Data.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.Sequence as Sequence + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry +import qualified Database.Esqueleto.Postgis.Wkb.GeometryCollection as GeometryCollection +import qualified Database.Esqueleto.Postgis.Wkb.Point as Point +import qualified Data.SeqHelper as SeqHelper + +-- Binary parsers + +getPolygon :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getPolygon endianType coordType = do + geoPolygon <- getGeoPolygon endianType coordType + pure $ Geospatial.Polygon geoPolygon + +getMultiPolygon :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getMultiPolygon getWkbGeom endianType _ = do + numberOfPolygons <- Endian.getFourBytes endianType + geoPolygons <- Sequence.replicateM (fromIntegral numberOfPolygons) (GeometryCollection.getEnclosedFeature 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 (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) +getLinearRings endianType coordType = do + numberOfRings <- Endian.getFourBytes endianType + Sequence.replicateM (fromIntegral numberOfRings) (getLinearRing endianType coordType) + +getLinearRing :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) +getLinearRing endianType coordType = do + numberOfPoints <- Endian.getFourBytes endianType + if numberOfPoints >= 4 then do + p1 <- Point.getCoordPoint endianType coordType + p2 <- Point.getCoordPoint endianType coordType + p3 <- Point.getCoordPoint endianType coordType + pts@(_ Sequence.:|> lastS) <- Point.getCoordPoints endianType coordType (numberOfPoints - 3) + if lastS == p1 then + pure $ LinearRing.makeLinearRing p1 p2 p3 (SeqHelper.sequenceHead pts) + else + Monad.fail $ + "First and last points of linear ring are different: first=" + ++ show p1 ++ " last=" ++ show lastS + else + Monad.fail $ + "Must have at least four points for a linear ring: " + ++ show numberOfPoints + + +-- Binary builders + +builderPolygon :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoPolygon -> ByteStringBuilder.Builder +builderPolygon builderWkbGeom endianType (Geospatial.GeoPolygon linearRings) = do + let coordType = Geometry.coordTypeOfLinearRings linearRings + Endian.builderEndianType endianType + <> builderWkbGeom endianType (Geometry.WkbGeom Geometry.Polygon coordType) + <> Endian.builderFourBytes endianType (fromIntegral $ length linearRings) + <> Foldable.foldMap (builderLinearRing endianType) linearRings + +builderMultiPolygon :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoMultiPolygon -> ByteStringBuilder.Builder +builderMultiPolygon builderWkbGeom endianType (Geospatial.GeoMultiPolygon polygons) = + Endian.builderEndianType endianType + <> builderWkbGeom endianType (Geometry.WkbGeom Geometry.MultiPolygon Geometry.TwoD) + <> Endian.builderFourBytes endianType (fromIntegral $ length polygons) + <> Foldable.foldMap (builderPolygon builderWkbGeom endianType . Geospatial.GeoPolygon) polygons + +builderLinearRing :: Endian.EndianType -> LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS -> ByteStringBuilder.Builder +builderLinearRing endianType linearRing = do + let coordPoints = LinearRing.toSeq linearRing + lastCoordPoint = LinearRing.ringHead linearRing + lengthOfRing = fromIntegral $ length coordPoints + 1 + Endian.builderFourBytes endianType lengthOfRing + <> Foldable.foldMap (Point.builderCoordPoint endianType) coordPoints + <> Point.builderCoordPoint endianType lastCoordPoint 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,182 @@ +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.Sequence as Sequence +import qualified Data.Word as Word +import qualified HaskellWorks.Hspec.Hedgehog as HedgehogHspec +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Hspec (Spec, it) + +import qualified Database.Esqueleto.Postgis.Ewkb as Ewkb +import qualified Database.Esqueleto.Postgis.Ewkb.Geometry as EwkbGeometry +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry +import qualified Database.Esqueleto.Postgis.Wkb as Wkb + +-- Helpers + +type GeometryGenerator = Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry + +testRoundTripWkbGeometryParsing :: String -> GeometryGenerator -> Spec +testRoundTripWkbGeometryParsing name generator = + mapM_ (testRoundTripGeometryParsing' roundTripWkb name generator) coordPointGenerators + +testRoundTripEwkbGeometryParsing :: String -> GeometryGenerator -> Spec +testRoundTripEwkbGeometryParsing name generator = + mapM_ (testRoundTripGeometryParsing' roundTripEwkb name generator) coordPointGenerators + +testRoundTripGeometryParsing' :: (Endian.EndianType -> Geospatial.GeospatialGeometry -> PropertyT IO ()) -> String -> GeometryGenerator -> (Geometry.CoordinateType, Gen Geospatial.GeoPositionWithoutCRS) -> Spec +testRoundTripGeometryParsing' f name generator (coordType, genCoordPoint) = + it ("round trips wkb " ++ name ++ ": " ++ show coordType) $ + HedgehogHspec.require $ property $ do + geometry <- forAll $ generator genCoordPoint + endianType <- forAll genEndianType + f endianType geometry + +roundTripWkb :: MonadTest m => Endian.EndianType -> Geospatial.GeospatialGeometry -> m () +roundTripWkb endianType geometry = + let + p = Wkb.parseByteString . Wkb.toByteString endianType + in + p geometry === Right geometry + +roundTripEwkb :: MonadTest m => Endian.EndianType -> Geospatial.GeospatialGeometry -> m () +roundTripEwkb endianType geometry = + let + p = Ewkb.parseByteString . Ewkb.toByteString endianType (EwkbGeometry.Srid (4326 :: Word.Word32)) + in + p geometry === Right geometry + +-- Generators + +upperBoundOfMultiGeometries :: Int +upperBoundOfMultiGeometries = 10 + +upperBoundOfPoints :: Int +upperBoundOfPoints = 100 + +coordPointGenerators :: [(Geometry.CoordinateType, Gen Geospatial.GeoPositionWithoutCRS)] +coordPointGenerators = + [ (Geometry.TwoD, genCoordPointXY) + , (Geometry.Z, genCoordPointXYZ) +-- We can't roundtrip or express M in the current geometry (hs-geojson) +-- , (Geometry.M, genCoordPointXYZ) + , (Geometry.ZM, genCoordPointXYZM) + ] + +genGeometryCollection :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genGeometryCollection genCoordPoint = do + geoCollection <- Gen.seq (Range.linear 0 upperBoundOfMultiGeometries) (genGeospatialGeometry genCoordPoint) + return $ Geospatial.Collection geoCollection + +genGeospatialGeometry :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genGeospatialGeometry genCoordPoint = Gen.recursive Gen.choice + [ genPoint genCoordPoint + , genLine genCoordPoint + , genPolygon genCoordPoint + , genMultiPoint genCoordPoint + , genMultiLine genCoordPoint + , genMultiPolygon genCoordPoint + ] + [ genGeometryCollection genCoordPoint ] + +genMultiPolygon :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genMultiPolygon genCoordPoint = do + geoMultiPolygon <- Geospatial.GeoMultiPolygon <$> Gen.seq (Range.linear 0 upperBoundOfMultiGeometries) (genLinearRings genCoordPoint) + return $ Geospatial.MultiPolygon geoMultiPolygon + +genPolygon :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genPolygon genCoordPoint = do + geoPolygon <- Geospatial.GeoPolygon <$> genLinearRings genCoordPoint + return $ Geospatial.Polygon geoPolygon + +genMultiLine :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genMultiLine genCoordPoint = do + geoMultiLine <- Geospatial.GeoMultiLine <$> Gen.seq (Range.linear 0 upperBoundOfMultiGeometries) (genLineString genCoordPoint) + return $ Geospatial.MultiLine geoMultiLine + +genLine :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genLine genCoordPoint = do + geoLine <- Geospatial.GeoLine <$> genLineString genCoordPoint + return $ Geospatial.Line geoLine + +genMultiPoint :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genMultiPoint genCoordPoint = do + geoMultiPoint <- Geospatial.GeoMultiPoint <$> genCoordPoints genCoordPoint + return $ Geospatial.MultiPoint geoMultiPoint + +genPoint :: Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry +genPoint genCoordPoint = do + geoPoint <- Geospatial.GeoPoint <$> genCoordPoint + return $ Geospatial.Point geoPoint + +genLinearRings :: Gen Geospatial.GeoPositionWithoutCRS -> Gen (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) +genLinearRings genCoordPoint = + Gen.seq (Range.linear 0 upperBoundOfMultiGeometries) (genLinearRing genCoordPoint) + +genLinearRing :: Gen Geospatial.GeoPositionWithoutCRS -> Gen (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) +genLinearRing genCoordPoint = + LinearRing.makeLinearRing <$> genCoordPoint <*> genCoordPoint <*> genCoordPoint <*> genCoordPoints genCoordPoint + +genLineString :: Gen Geospatial.GeoPositionWithoutCRS -> Gen (LineString.LineString Geospatial.GeoPositionWithoutCRS) +genLineString genCoordPoint = + LineString.makeLineString <$> genCoordPoint <*> genCoordPoint <*> genCoordPoints genCoordPoint + +genCoordPoints :: Gen Geospatial.GeoPositionWithoutCRS -> Gen (Sequence.Seq Geospatial.GeoPositionWithoutCRS) +genCoordPoints = + Gen.seq (Range.linear 0 upperBoundOfPoints) + +genCoordPointXY :: Gen Geospatial.GeoPositionWithoutCRS +genCoordPointXY = do + point <- Geospatial.PointXY <$> genDouble <*> genDouble + return $ Geospatial.GeoPointXY point + +genCoordPointXYZ :: Gen Geospatial.GeoPositionWithoutCRS +genCoordPointXYZ = do + point <- Geospatial.PointXYZ <$> genDouble <*> genDouble <*> genDouble + return $ Geospatial.GeoPointXYZ point + +genCoordPointXYZM :: Gen Geospatial.GeoPositionWithoutCRS +genCoordPointXYZM = do + point <- Geospatial.PointXYZM <$> genDouble <*> genDouble <*> genDouble <*> genDouble + return $ Geospatial.GeoPointXYZM point + +genDouble :: Gen Double +genDouble = Gen.double $ Range.linearFrac (-10e6) 10e6 + +genEndianType :: Gen Endian.EndianType +genEndianType = Gen.choice + [ Gen.constant Endian.BigEndian + , Gen.constant Endian.LittleEndian + ] + + +-- Example + +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)) Sequence.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)) Sequence.empty + +lineString3 :: LineString.LineString Geospatial.GeoPositionWithoutCRS +lineString3 = LineString.makeLineString (Geospatial.GeoPointXY (Geospatial.PointXY 15 15)) (Geospatial.GeoPointXY (Geospatial.PointXY 20 20)) (Sequence.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)) (Sequence.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)) Sequence.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)) Sequence.empty diff --git a/test/Ewkb/GeometrySpec.hs b/test/Ewkb/GeometrySpec.hs new file mode 100644 --- /dev/null +++ b/test/Ewkb/GeometrySpec.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ewkb.GeometrySpec where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Word as Word +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Database.Esqueleto.Postgis.Ewkb.Geometry as Ewkb +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Wkb + +spec :: Spec +spec = + testValidGetEwkbGeometryType + +testValidGetEwkbGeometryType :: Spec +testValidGetEwkbGeometryType = + describe "get extended wkb geometry type for valid data" $ + mapM_ testGetEwkbGeometryType testValues + +testGetEwkbGeometryType :: Ewkb.EwkbGeometryType -> Spec +testGetEwkbGeometryType geometryType = + it ("Parse " ++ show geometryType) $ + mapM_ test [Endian.BigEndian, Endian.LittleEndian] + where test endianType = roundTrip endianType geometryType `shouldBe` geometryType + +roundTrip :: Endian.EndianType -> Ewkb.EwkbGeometryType -> Ewkb.EwkbGeometryType +roundTrip endianType geometryType = + BinaryGet.runGet (Ewkb.getEwkbGeom endianType) encodedGeometryType + where encodedGeometryType = ByteStringBuilder.toLazyByteString $ Ewkb.builderEwkbGeom endianType geometryType + +testValues :: [Ewkb.EwkbGeometryType] +testValues = + [ Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.TwoD) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.Z) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.M) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.ZM) Ewkb.NoSrid + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.TwoD) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.Z) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.M) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Geometry Wkb.ZM) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Point Wkb.ZM) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.LineString Wkb.ZM) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.Polygon Wkb.ZM) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPoint Wkb.ZM) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiLineString Wkb.ZM) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.MultiPolygon Wkb.ZM) (Ewkb.Srid srid) + , Ewkb.EwkbGeom (Wkb.WkbGeom Wkb.GeometryCollection Wkb.ZM) (Ewkb.Srid srid) + ] + +srid :: Word.Word32 +srid = 4326 diff --git a/test/Ewkb/LineSpec.hs b/test/Ewkb/LineSpec.hs new file mode 100644 --- /dev/null +++ b/test/Ewkb/LineSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ewkb.LineSpec where + +import Test.Hspec (Spec, describe) + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = do + testEwkbLineParsing + testEwkbMultiLineParsing + + +-- Test Wkb Line Parsing + +testEwkbLineParsing :: Spec +testEwkbLineParsing = + describe "Test ewkb line parsing" $ + SpecHelper.testRoundTripEwkbGeometryParsing "line" SpecHelper.genLine + + +-- Test Wkb MultiLine Parsing + +testEwkbMultiLineParsing :: Spec +testEwkbMultiLineParsing = + describe "Test ewkb multiline parsing" $ + SpecHelper.testRoundTripEwkbGeometryParsing "multiLine" SpecHelper.genMultiLine diff --git a/test/Ewkb/PointSpec.hs b/test/Ewkb/PointSpec.hs new file mode 100644 --- /dev/null +++ b/test/Ewkb/PointSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ewkb.PointSpec where + +import Test.Hspec (Spec, describe) + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = do + testEwkbPointParsing + testEwkbMultiPointParsing + + +-- Test Wkb Point Parsing + +testEwkbPointParsing :: Spec +testEwkbPointParsing = + describe "Test ewkb point parsing" $ + SpecHelper.testRoundTripEwkbGeometryParsing "point" SpecHelper.genPoint + + +-- Test Wkb MultiPoint Parsing + +testEwkbMultiPointParsing :: Spec +testEwkbMultiPointParsing = + describe "Test ewkb multipoint parsing" $ + SpecHelper.testRoundTripEwkbGeometryParsing "multipoint" SpecHelper.genMultiPoint diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -21,7 +21,6 @@ import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger (..), runStderrLoggingT) import Control.Monad.Trans.Resource (MonadThrow, ResourceT, runResourceT) -import Data.Geospatial (PointXY (..), PointXYZ (..), PointXYZM (..)) import Data.LineString (LineString, makeLineString) import Data.LinearRing (LinearRing, makeLinearRing) import Data.List.NonEmpty (NonEmpty) @@ -47,7 +46,21 @@ import qualified Hedgehog.Range as Range import Test.Tasty import Test.Tasty.HUnit +import Test.Tasty.Hspec(testSpec) +import qualified Ewkb.GeometrySpec +import qualified Ewkb.LineSpec +import qualified Ewkb.PointSpec + +import qualified Wkb.EndianSpec +import qualified Wkb.GeometryCollectionSpec +import qualified Wkb.GeometrySpec +import qualified Wkb.HexParsingSpec +import qualified Wkb.LineSpec +import qualified Wkb.PointSpec +import qualified Wkb.PolygonSpec + + connString :: ConnectionString connString = "host=localhost port=5432 user=test dbname=test password=test" @@ -87,11 +100,30 @@ $ (initializeDB >> act >>= \ret -> transactionUndo >> return ret) main :: IO () -main = defaultMain tests +main = do + -- normally hspec discover does this, but we don't want to use + -- convuleted preprocessor, + -- it sometimes doesn't work and it's hard to understand why. + -- so I prefer to just import everything by hand. + -- also, go look at the source of hspec discover, it's kinda shocking. + hspecTrees <- sequence [ + testSpec "Ewkb.GeometrySpec" Ewkb.GeometrySpec.spec, + testSpec "Ewkb.LineSpec" Ewkb.LineSpec.spec, + testSpec "Ewkb.PointSpec" Ewkb.PointSpec.spec, -tests :: TestTree -tests = testGroup "Tests" [unitTests] + testSpec "Wkb.EndianSpec" Wkb.EndianSpec.spec, + testSpec "Wkb.GeometryCollectionSpec" Wkb.GeometryCollectionSpec.spec, + testSpec "Wkb.GeometrySpec" Wkb.GeometrySpec.spec, + testSpec "Wkb.HexParsingSpec" Wkb.HexParsingSpec.spec, + testSpec "Wkb.LineSpec" Wkb.LineSpec.spec, + testSpec "Wkb.PointSpec" Wkb.PointSpec.spec, + testSpec "Wkb.PolygonSpec" Wkb.PolygonSpec.spec + ] + + defaultMain $ + testGroup "all tests" $ postgisBindingsTests : hspecTrees + test' :: Gen (PostgisGeometry PointXY) -> TestTree test' gen = testCase "roundtrip xy geometry" $ do @@ -119,10 +151,10 @@ selectList @(Unityzm) [] [] (entityVal <$> result) @?= [someUnit] -unitTests :: TestTree -unitTests = +postgisBindingsTests :: TestTree +postgisBindingsTests = testGroup - "Unit tests" + "postgis binding tests" [ testGroup "roundtrip tests xy" $ (test') <$> (genCollection genPointxy : genGeometry genPointxy), testGroup "roundtrip tests xyz" $ diff --git a/test/Wkb/EndianSpec.hs b/test/Wkb/EndianSpec.hs new file mode 100644 --- /dev/null +++ b/test/Wkb/EndianSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wkb.EndianSpec where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian + +spec :: Spec +spec = + testGetEndian + +testGetEndian :: Spec +testGetEndian = + describe "get endian" $ do + it "Returns BigEndian for 0" $ + roundTrip Endian.BigEndian `shouldBe` Endian.BigEndian + it "Returns LittleEndian for 1" $ + roundTrip Endian.LittleEndian `shouldBe` Endian.LittleEndian + it "Returns fail for other" $ + BinaryGet.runGetOrFail Endian.getEndianType (ByteStringBuilder.toLazyByteString $ ByteStringBuilder.word8 5) `shouldBe` Left ("", 1, "Invalid EndianType") + +roundTrip :: Endian.EndianType -> Endian.EndianType +roundTrip endianType = + BinaryGet.runGet Endian.getEndianType encodedEndianType + where encodedEndianType = ByteStringBuilder.toLazyByteString $ Endian.builderEndianType endianType diff --git a/test/Wkb/GeometryCollectionSpec.hs b/test/Wkb/GeometryCollectionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Wkb/GeometryCollectionSpec.hs @@ -0,0 +1,14 @@ + +{-# LANGUAGE OverloadedStrings #-} + +module Wkb.GeometryCollectionSpec where + +import Test.Hspec (Spec, describe) + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = + describe "Test wkb geometry collection parsing" $ + SpecHelper.testRoundTripWkbGeometryParsing "geometry collection" SpecHelper.genGeometryCollection + diff --git a/test/Wkb/GeometrySpec.hs b/test/Wkb/GeometrySpec.hs new file mode 100644 --- /dev/null +++ b/test/Wkb/GeometrySpec.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wkb.GeometrySpec where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Database.Esqueleto.Postgis.Wkb.Endian as Endian +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry + +spec :: Spec +spec = + testValidGetGeometryTypeWithCoords + +testValidGetGeometryTypeWithCoords :: Spec +testValidGetGeometryTypeWithCoords = + describe "get geometry type with coords type for valid data" $ + mapM_ testGetGeometryTypeWithCoords geometryTypes + +testGetGeometryTypeWithCoords :: Geometry.WkbGeometryType -> Spec +testGetGeometryTypeWithCoords geometryType = + it ("Parse " ++ show geometryType) $ + mapM_ test [Endian.BigEndian, Endian.LittleEndian] + where test endianType = + roundTrip endianType geometryType `shouldBe` geometryType + +roundTrip :: Endian.EndianType -> Geometry.WkbGeometryType -> Geometry.WkbGeometryType +roundTrip endianType geometryType = + BinaryGet.runGet (Geometry.getWkbGeom endianType) encodedGeometryType + where encodedGeometryType = ByteStringBuilder.toLazyByteString $ Geometry.builderWkbGeom endianType geometryType + +geometryTypes :: [Geometry.WkbGeometryType] +geometryTypes = + [ Geometry.WkbGeom Geometry.Geometry Geometry.TwoD + , Geometry.WkbGeom Geometry.Point Geometry.TwoD + , Geometry.WkbGeom Geometry.LineString Geometry.TwoD + , Geometry.WkbGeom Geometry.Polygon Geometry.TwoD + , Geometry.WkbGeom Geometry.MultiPoint Geometry.TwoD + , Geometry.WkbGeom Geometry.MultiLineString Geometry.TwoD + , Geometry.WkbGeom Geometry.MultiPolygon Geometry.TwoD + , Geometry.WkbGeom Geometry.GeometryCollection Geometry.TwoD + , Geometry.WkbGeom Geometry.Geometry Geometry.Z + , Geometry.WkbGeom Geometry.Point Geometry.Z + , Geometry.WkbGeom Geometry.LineString Geometry.Z + , Geometry.WkbGeom Geometry.Polygon Geometry.Z + , Geometry.WkbGeom Geometry.MultiPoint Geometry.Z + , Geometry.WkbGeom Geometry.MultiLineString Geometry.Z + , Geometry.WkbGeom Geometry.MultiPolygon Geometry.Z + , Geometry.WkbGeom Geometry.GeometryCollection Geometry.Z + , Geometry.WkbGeom Geometry.Geometry Geometry.M + , Geometry.WkbGeom Geometry.Point Geometry.M + , Geometry.WkbGeom Geometry.LineString Geometry.M + , Geometry.WkbGeom Geometry.Polygon Geometry.M + , Geometry.WkbGeom Geometry.MultiPoint Geometry.M + , Geometry.WkbGeom Geometry.MultiLineString Geometry.M + , Geometry.WkbGeom Geometry.MultiPolygon Geometry.M + , Geometry.WkbGeom Geometry.GeometryCollection Geometry.M + , Geometry.WkbGeom Geometry.Geometry Geometry.ZM + , Geometry.WkbGeom Geometry.Point Geometry.ZM + , Geometry.WkbGeom Geometry.LineString Geometry.ZM + , Geometry.WkbGeom Geometry.Polygon Geometry.ZM + , Geometry.WkbGeom Geometry.MultiPoint Geometry.ZM + , Geometry.WkbGeom Geometry.MultiLineString Geometry.ZM + , Geometry.WkbGeom Geometry.MultiPolygon Geometry.ZM + , Geometry.WkbGeom Geometry.GeometryCollection Geometry.ZM + ] diff --git a/test/Wkb/HexParsingSpec.hs b/test/Wkb/HexParsingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Wkb/HexParsingSpec.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wkb.HexParsingSpec where + +import qualified Data.Geospatial as Geospatial +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Database.Esqueleto.Postgis.Hex as Hex +import qualified Database.Esqueleto.Postgis.Wkb as Wkb + +spec :: Spec +spec = + testWkbHexParsing + +testWkbHexParsing :: Spec +testWkbHexParsing = + describe "Test hex encoded wkb point" $ do + it "Parse valid hex wkb" $ + Wkb.parseHexByteString exampleHexPoint `shouldBe` Right expectedPoint + it "Not parse valid hex but invalid wkb" $ + Wkb.parseHexByteString (Hex.Hex "deadbeef") `shouldBe` Left "Could not parse wkb: Invalid EndianType" + it "Some valid, some invalid hex" $ + Wkb.parseHexByteString (Hex.Hex "deadfish") `shouldBe` Left "Invalid hex representation: deadfish" + it "All bad" $ + Wkb.parseHexByteString (Hex.Hex "cowboyx") `shouldBe` Left "Invalid hex representation: cowboyx" + +exampleHexPoint :: Hex.Hex +exampleHexPoint = Hex.Hex "0101000000000000000000f03f0000000000000040" + +expectedPoint :: Geospatial.GeospatialGeometry +expectedPoint = Geospatial.Point (Geospatial.GeoPoint (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0))) diff --git a/test/Wkb/LineSpec.hs b/test/Wkb/LineSpec.hs new file mode 100644 --- /dev/null +++ b/test/Wkb/LineSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wkb.LineSpec where + +import Test.Hspec (Spec, describe) + +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = do + testWkbLineParsing + testWkbMultiLineParsing + + +-- Test Wkb Line Parsing + +testWkbLineParsing :: Spec +testWkbLineParsing = + describe "Test wkb line parsing" $ + SpecHelper.testRoundTripWkbGeometryParsing "line" SpecHelper.genLine + + +-- Test Wkb MultiLine Parsing + +testWkbMultiLineParsing :: Spec +testWkbMultiLineParsing = + describe "Test wkb multiline parsing" $ + SpecHelper.testRoundTripWkbGeometryParsing "multiLine" SpecHelper.genMultiLine diff --git a/test/Wkb/PointSpec.hs b/test/Wkb/PointSpec.hs new file mode 100644 --- /dev/null +++ b/test/Wkb/PointSpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wkb.PointSpec where + +import qualified Data.Binary.Get as BinaryGet +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.Geospatial as Geospatial +import qualified HaskellWorks.Hspec.Hedgehog as HedgehogHspec +import Hedgehog +import Test.Hspec (Spec, describe, it) + +import qualified Database.Esqueleto.Postgis.Wkb.Geometry as Geometry +import qualified Database.Esqueleto.Postgis.Wkb.Point as Point +import qualified Data.SpecHelper as SpecHelper + +spec :: Spec +spec = do + testCoordPointParsing + testWkbPointParsing + testWkbMultiPointParsing + + +-- Test Coord Point Parsing + +testCoordPointParsing :: Spec +testCoordPointParsing = + describe "Test coord point parsing" $ + mapM_ testCoordPointParsing' SpecHelper.coordPointGenerators + +testCoordPointParsing' :: (Geometry.CoordinateType, Gen Geospatial.GeoPositionWithoutCRS) -> Spec +testCoordPointParsing' (coordType, genCoordPoint) = + it ("round trips coord point: " ++ show coordType) $ HedgehogHspec.require $ property $ do + coordPoint <- forAll genCoordPoint + endianType <- forAll SpecHelper.genEndianType + roundTrip endianType coordPoint === coordPoint + where + roundTrip endianType coordPoint = + BinaryGet.runGet (Point.getCoordPoint endianType coordType) (encodedCoordPoint endianType coordPoint) + encodedCoordPoint endianType coordPoint = + ByteStringBuilder.toLazyByteString $ Point.builderCoordPoint endianType coordPoint + + +-- Test Wkb Point Parsing + +testWkbPointParsing :: Spec +testWkbPointParsing = + describe "Test wkb point parsing" $ + SpecHelper.testRoundTripWkbGeometryParsing "point" SpecHelper.genPoint + + +-- Test Wkb MultiPoint Parsing + +testWkbMultiPointParsing :: Spec +testWkbMultiPointParsing = + describe "Test wkb multipoint parsing" $ + SpecHelper.testRoundTripWkbGeometryParsing "multipoint" SpecHelper.genMultiPoint diff --git a/test/Wkb/PolygonSpec.hs b/test/Wkb/PolygonSpec.hs new file mode 100644 --- /dev/null +++ b/test/Wkb/PolygonSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wkb.PolygonSpec where + +import qualified Data.ByteString.Builder as ByteStringBuilder +import qualified Data.SpecHelper as SpecHelper +import qualified Database.Esqueleto.Postgis.Wkb as Wkb +import Test.Hspec (Spec, describe, it, shouldBe) + +spec :: Spec +spec = do + testWkbPolygonParsing + testWkbMultiPolygonParsing + +-- Test Wkb Polygon Parsing + +testWkbPolygonParsing :: Spec +testWkbPolygonParsing = + describe "Test wkb polygon" $ do + testValidWkbPolyonParsing + testInvalidWkbPolyonParsing + +testValidWkbPolyonParsing :: Spec +testValidWkbPolyonParsing = + SpecHelper.testRoundTripWkbGeometryParsing "polygon" SpecHelper.genPolygon + +testInvalidWkbPolyonParsing :: Spec +testInvalidWkbPolyonParsing = + it "does 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})" + where + 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 + +-- Test Wkb MultiPolygon Parsing + +testWkbMultiPolygonParsing :: Spec +testWkbMultiPolygonParsing = + describe "Test wkb multipolygon parsing" $ + SpecHelper.testRoundTripWkbGeometryParsing "multipolygon" SpecHelper.genMultiPolygon