diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +# Changelog +All notable changes to this project will be documented in this file. + +## [0.0.5] - 2019-01-07 +### Added +- Add serializers back into ByteString [https://github.com/indicatrix/wkt-geom/issues/7]. +- New API for WKB which takes hex (base 16) encoded ByteString [https://github.com/indicatrix/wkt-geom/issues/6]. +- Improvements in testing (added Hedgehog). +- Support for WKT encodings for 3D (XYZ) and 4D (XYZM) points, lines and polygons. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,10 @@ -# wkt-geom +# wkt-geom [![Build Status](https://travis-ci.org/indicatrix/wkt-geom.png?branch=master)](https://travis-ci.org/indicatrix/wkt-geom) [Hackage](https://hackage.haskell.org/package/wkt-geom) -![CircleCI](https://circleci.com/gh/sitewisely/wkt-geom/tree/master.svg?style=svg&circle-token=234d1b3bda2ff80367f7c38dc7ff7a3a051eea42) +A parser for Well Known Text (WKT), Well Known Binary (WKB) and the PostgreSQL extension Extended Well Know Binary (eWKB). -http://www.opengeospatial.org/standards/sfa (Section 7) -http://edndoc.esri.com/arcsde/9.0/general_topics/wkt_representation.htm +See: +- http://www.opengeospatial.org/standards/sfa (Section 7) +- http://edndoc.esri.com/arcsde/9.0/general_topics/wkt_representation.htm + +### Other Projects +- [Terroformer Wkt Parser](http://terraformer.io/wkt-parser/) diff --git a/hlint/Main.hs b/hlint/Main.hs new file mode 100644 --- /dev/null +++ b/hlint/Main.hs @@ -0,0 +1,12 @@ +module Main where + +import Control.Monad (unless) +import Language.Haskell.HLint (hlint) +import System.Environment (getArgs) +import System.Exit (exitFailure) + +main :: IO () +main = do + args <- getArgs + hlints <- hlint $ ["src/", "test/", "hlint/", "--cpp-define=HLINT", "--cpp-ansi"] ++ args + unless (null hlints) exitFailure diff --git a/src/Data/Ewkb.hs b/src/Data/Ewkb.hs --- a/src/Data/Ewkb.hs +++ b/src/Data/Ewkb.hs @@ -5,19 +5,36 @@ ------------------------------------------------------------------- module Data.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 Data.Hex as Hex import qualified Data.Internal.Ewkb.Geometry as EwkbGeometry +import qualified Data.Internal.Wkb.Endian as Endian import qualified Data.Internal.Wkb.Geospatial as WkbGeospatial +-- | +-- Representation of EWKB as Binary parseByteString :: LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry parseByteString byteString = case BinaryGet.runGetOrFail - (WkbGeospatial.geospatialGeometry EwkbGeometry.wkbGeometryType) + (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 + +toByteString :: Endian.EndianType -> Geospatial.GeospatialGeometry -> LazyByteString.ByteString +toByteString endianType = + ByteStringBuilder.toLazyByteString . WkbGeospatial.builderGeospatialGeometry + EwkbGeometry.builderWkbGeom endianType diff --git a/src/Data/Hex.hs b/src/Data/Hex.hs new file mode 100644 --- /dev/null +++ b/src/Data/Hex.hs @@ -0,0 +1,25 @@ +module Data.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 +import Data.Monoid ((<>)) + +newtype Hex = Hex ByteString.ByteString + +safeConvert :: (LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry) -> Hex -> Either String Geospatial.GeospatialGeometry +safeConvert f (Hex byteString) = + let + (decoded, rest) = ByteStringBase16.decode byteString + in + if ByteString.null rest then + f $ LazyByteString.fromStrict decoded + else + Left ("Invalid hex representation: " <> ByteStringChar8.unpack byteString) + + diff --git a/src/Data/Internal/Ewkb/Geometry.hs b/src/Data/Internal/Ewkb/Geometry.hs --- a/src/Data/Internal/Ewkb/Geometry.hs +++ b/src/Data/Internal/Ewkb/Geometry.hs @@ -1,35 +1,77 @@ module Data.Internal.Ewkb.Geometry ( EwkbGeometryType (..) , SridType (..) - , ewkbGeometryType - , wkbGeometryType + , getEwkbGeom + , getWkbGeom + , builderWkbGeom + , builderEwkbGeom ) where import qualified Control.Monad as Monad import qualified Data.Binary.Get as BinaryGet -import Data.Bits ((.&.)) +import Data.Bits ((.&.), (.|.)) +import qualified Data.ByteString.Builder as ByteStringBuilder +import Data.Monoid ((<>)) import qualified Data.Word as Word import qualified Data.Internal.Wkb.Endian as Endian import qualified Data.Internal.Wkb.Geometry as Geometry +-- Types + 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 + +-- 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 -wkbGeometryType :: Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType -wkbGeometryType endianType = do - rawGeometryType <- Endian.fourBytes endianType +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 @@ -38,20 +80,10 @@ 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 + case int .&. geometryMask of 0 -> Just Geometry.Geometry 1 -> Just Geometry.Point 2 -> Just Geometry.LineString @@ -62,6 +94,18 @@ 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 @@ -70,11 +114,36 @@ (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 .&. 0x80000000 /= 0 + 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/Data/Internal/Wkb/Endian.hs b/src/Data/Internal/Wkb/Endian.hs --- a/src/Data/Internal/Wkb/Endian.hs +++ b/src/Data/Internal/Wkb/Endian.hs @@ -1,18 +1,22 @@ module Data.Internal.Wkb.Endian ( EndianType (..) - , endianType - , fourBytes - , doubleBytes + , getEndianType + , getFourBytes + , getDouble + , builderEndianType + , builderFourBytes + , builderDouble ) where -import qualified Control.Monad as Monad -import qualified Data.Binary.Get as BinaryGet -import qualified Data.Word as Word +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) -endianType :: BinaryGet.Get EndianType -endianType = do +getEndianType :: BinaryGet.Get EndianType +getEndianType = do byte <- BinaryGet.getWord8 case byte of 0 -> @@ -22,18 +26,38 @@ _ -> Monad.fail "Invalid EndianType" -fourBytes :: EndianType -> BinaryGet.Get Word.Word32 -fourBytes et = - case et of +getFourBytes :: EndianType -> BinaryGet.Get Word.Word32 +getFourBytes endianType = + case endianType of LittleEndian -> BinaryGet.getWord32le BigEndian -> BinaryGet.getWord32be -doubleBytes :: EndianType -> BinaryGet.Get Double -doubleBytes et = - case et of +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/Data/Internal/Wkb/Geometry.hs b/src/Data/Internal/Wkb/Geometry.hs --- a/src/Data/Internal/Wkb/Geometry.hs +++ b/src/Data/Internal/Wkb/Geometry.hs @@ -2,15 +2,27 @@ ( GeometryType (..) , CoordinateType (..) , WkbGeometryType (..) - , geometryTypeWithCoords + , 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 Data.Internal.Wkb.Endian as Endian +-- Types + data GeometryType = Geometry | Point @@ -25,9 +37,12 @@ data WkbGeometryType = WkbGeom GeometryType CoordinateType deriving (Show, Eq) -geometryTypeWithCoords :: Endian.EndianType -> BinaryGet.Get WkbGeometryType -geometryTypeWithCoords endianType = do - fullGeometryType <- Endian.fourBytes endianType + +-- 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 @@ -35,6 +50,36 @@ _ -> 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 @@ -48,6 +93,18 @@ 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 @@ -56,3 +113,11 @@ 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/Data/Internal/Wkb/GeometryCollection.hs b/src/Data/Internal/Wkb/GeometryCollection.hs --- a/src/Data/Internal/Wkb/GeometryCollection.hs +++ b/src/Data/Internal/Wkb/GeometryCollection.hs @@ -1,34 +1,57 @@ module Data.Internal.Wkb.GeometryCollection - ( geometryCollection - , enclosedFeature + ( 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 Data.Monoid ((<>)) import qualified Data.Sequence as Sequence import qualified Data.Internal.Wkb.Endian as Endian import qualified Data.Internal.Wkb.Geometry as Geometry -geometryCollection :: BinaryGet.Get Geospatial.GeospatialGeometry + +-- Binary parsers + +getGeometryCollection :: BinaryGet.Get Geospatial.GeospatialGeometry -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry -geometryCollection getGeospatialGeometry endianType _ = do - numberOfGeometries <- Endian.fourBytes endianType +getGeometryCollection getGeospatialGeometry endianType _ = do + numberOfGeometries <- Endian.getFourBytes endianType geoSpatialGeometries <- Sequence.replicateM (fromIntegral numberOfGeometries) getGeospatialGeometry pure $ Geospatial.Collection geoSpatialGeometries -enclosedFeature :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) +getEnclosedFeature :: (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 +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/Data/Internal/Wkb/Geospatial.hs b/src/Data/Internal/Wkb/Geospatial.hs --- a/src/Data/Internal/Wkb/Geospatial.hs +++ b/src/Data/Internal/Wkb/Geospatial.hs @@ -1,9 +1,12 @@ module Data.Internal.Wkb.Geospatial - ( geospatialGeometry + ( 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 Data.Internal.Wkb.Endian as Endian import qualified Data.Internal.Wkb.Geometry as Geometry @@ -12,10 +15,13 @@ import qualified Data.Internal.Wkb.Point as Point import qualified Data.Internal.Wkb.Polygon as Polygon -geospatialGeometry :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) + +-- Binary parsers + +getGeospatialGeometry :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> BinaryGet.Get Geospatial.GeospatialGeometry -geospatialGeometry getWkbGeom = do - endianType <- Endian.endianType +getGeospatialGeometry getWkbGeom = do + endianType <- Endian.getEndianType geometryTypeWithCoords <- getWkbGeom endianType let (Geometry.WkbGeom geomType coordType) = geometryTypeWithCoords getFeature geomType getWkbGeom endianType coordType @@ -28,15 +34,35 @@ 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) + 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/Data/Internal/Wkb/Line.hs b/src/Data/Internal/Wkb/Line.hs --- a/src/Data/Internal/Wkb/Line.hs +++ b/src/Data/Internal/Wkb/Line.hs @@ -1,37 +1,64 @@ module Data.Internal.Wkb.Line - ( Data.Internal.Wkb.Line.line - , multiLine + ( Data.Internal.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 Data.Monoid ((<>)) import qualified Data.Sequence as Sequence + 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 +-- Binary parsers + +getLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getLine endianType coordType = do + gl <- getGeoLine 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 <- Sequence.replicateM (fromIntegral numberOfLines) (GeometryCollection.enclosedFeature getWkbGeom Geometry.LineString geoLine) +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 -geoLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoLine -geoLine endianType coordType = do - numberOfPoints <- Endian.fourBytes endianType +getGeoLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoLine +getGeoLine endianType coordType = do + numberOfPoints <- Endian.getFourBytes endianType if numberOfPoints >= 2 then do - p1 <- Point.coordPoint endianType coordType - p2 <- Point.coordPoint endianType coordType - pts <- Point.coordPoints endianType coordType (numberOfPoints - 2) + 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/Data/Internal/Wkb/Point.hs b/src/Data/Internal/Wkb/Point.hs --- a/src/Data/Internal/Wkb/Point.hs +++ b/src/Data/Internal/Wkb/Point.hs @@ -1,12 +1,21 @@ module Data.Internal.Wkb.Point - ( point - , multiPoint - , coordPoint - , coordPoints + ( 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 Data.Monoid ((<>)) +import qualified Data.Monoid as Monoid import qualified Data.Sequence as Sequence import qualified Data.Word as Word @@ -14,46 +23,78 @@ 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 +-- Binary parsers -multiPoint :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry -multiPoint getWkbGeom endianType _ = do - numberOfPoints <- Endian.fourBytes endianType - geoPoints <- Sequence.replicateM (fromIntegral numberOfPoints) (GeometryCollection.enclosedFeature getWkbGeom Geometry.Point geoPoint) +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 -geoPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPoint -geoPoint endianType coordType = do - p <- coordPoint endianType coordType +getGeoPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPoint +getGeoPoint endianType coordType = do + p <- getCoordPoint endianType coordType pure $ Geospatial.GeoPoint p -coordPoints :: Endian.EndianType -> Geometry.CoordinateType -> Word.Word32 -> BinaryGet.Get (Sequence.Seq Geospatial.GeoPositionWithoutCRS) -coordPoints endianType coordType numberOfPoints = - Sequence.replicateM (fromIntegral numberOfPoints) (coordPoint endianType coordType) - -coordPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPositionWithoutCRS -coordPoint endianType coordType = +getCoordPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPositionWithoutCRS +getCoordPoint endianType coordType = case coordType of Geometry.TwoD -> do - x <- Endian.doubleBytes endianType - y <- Endian.doubleBytes endianType - pure $ Geospatial.GeoPointXY (Geospatial.PointXY x y) + point <- Geospatial.PointXY <$> getDouble <*> getDouble + return $ Geospatial.GeoPointXY point Geometry.Z -> do - x <- Endian.doubleBytes endianType - y <- Endian.doubleBytes endianType - z <- Endian.doubleBytes endianType - pure $ Geospatial.GeoPointXYZ (Geospatial.PointXYZ x y z) + point <- Geospatial.PointXYZ <$> getDouble <*> getDouble <*> getDouble + return $ Geospatial.GeoPointXYZ point Geometry.M -> do - x <- Endian.doubleBytes endianType - y <- Endian.doubleBytes endianType - m <- Endian.doubleBytes endianType - pure $ Geospatial.GeoPointXYZ (Geospatial.PointXYZ x y m) + point <- Geospatial.PointXYZ <$> getDouble <*> getDouble <*> getDouble + return $ Geospatial.GeoPointXYZ point 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) + 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/Data/Internal/Wkb/Polygon.hs b/src/Data/Internal/Wkb/Polygon.hs --- a/src/Data/Internal/Wkb/Polygon.hs +++ b/src/Data/Internal/Wkb/Polygon.hs @@ -1,12 +1,17 @@ module Data.Internal.Wkb.Polygon - ( polygon - , multiPolygon + ( 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 Data.Monoid ((<>)) import qualified Data.Sequence as Sequence import qualified Data.Internal.Wkb.Endian as Endian @@ -15,15 +20,17 @@ import qualified Data.Internal.Wkb.Point as Point import qualified Data.SeqHelper as SeqHelper -polygon :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry -polygon endianType coordType = do +-- Binary parsers + +getPolygon :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry +getPolygon 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 <- Sequence.replicateM (fromIntegral numberOfPolygons) (GeometryCollection.enclosedFeature getWkbGeom Geometry.Polygon getGeoPolygon) +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 @@ -33,17 +40,17 @@ getLinearRings :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) getLinearRings endianType coordType = do - numberOfRings <- Endian.fourBytes endianType + 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.fourBytes endianType + numberOfPoints <- Endian.getFourBytes endianType if numberOfPoints >= 4 then do - p1 <- Point.coordPoint endianType coordType - p2 <- Point.coordPoint endianType coordType - p3 <- Point.coordPoint endianType coordType - pts@(_ Sequence.:|> lastS) <- Point.coordPoints endianType coordType (numberOfPoints - 3) + 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 @@ -54,3 +61,30 @@ 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/src/Data/Internal/Wkt/Line.hs b/src/Data/Internal/Wkt/Line.hs --- a/src/Data/Internal/Wkt/Line.hs +++ b/src/Data/Internal/Wkt/Line.hs @@ -20,37 +20,49 @@ lineString = do _ <- Trifecta.string "linestring" _ <- Trifecta.spaces - (Trifecta.string "empty" >> pure emptyLine) <|> Geospatial.GeoLine <$> line + (Trifecta.string "empty" >> pure emptyLine) <|> nonEmptyLines +nonEmptyLines :: Trifecta.Parser Geospatial.GeoLine +nonEmptyLines = + (Trifecta.string "zm" >> Geospatial.GeoLine <$> line Point.justPointsXYZM) + <|> (Trifecta.string "z" >> Geospatial.GeoLine <$> line Point.justPointsXYZ) + <|> Geospatial.GeoLine <$> line Point.justPointsXY + multiLineString :: Trifecta.Parser Geospatial.GeoMultiLine multiLineString = do _ <- Trifecta.string "multilinestring" _ <- Trifecta.spaces - x <- Wkt.emptySet <|> manyLines + x <- Wkt.emptySet <|> nonEmptyMultiLines pure $ Geospatial.GeoMultiLine x -manyLines :: Trifecta.Parser (Sequence.Seq (LineString.LineString Geospatial.GeoPositionWithoutCRS)) -manyLines = do +nonEmptyMultiLines :: Trifecta.Parser (Sequence.Seq (LineString.LineString Geospatial.GeoPositionWithoutCRS)) +nonEmptyMultiLines = + (Trifecta.string "zm" >> manyLines Point.justPointsXYZM) + <|> (Trifecta.string "z" >> manyLines Point.justPointsXYZ) + <|> manyLines Point.justPointsXY + +manyLines :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (Sequence.Seq (LineString.LineString Geospatial.GeoPositionWithoutCRS)) +manyLines pointParser = do _ <- Trifecta.spaces >> Trifecta.char '(' - x <- line - xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> line) + x <- line pointParser + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> line pointParser) _ <- Trifecta.char ')' >> Trifecta.spaces pure $ x Sequence.:<| Sequence.fromList xs -line :: Trifecta.Parser (LineString.LineString Geospatial.GeoPositionWithoutCRS) -line = do +line :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (LineString.LineString Geospatial.GeoPositionWithoutCRS) +line pointParser = do _ <- Trifecta.spaces >> Trifecta.char '(' >> Trifecta.spaces - first <- Point.justPoints - second <- commandPoint - rest <- Trifecta.many commandPoint + first <- pointParser + second <- commandPoint pointParser + rest <- Trifecta.many (commandPoint pointParser) _ <- Trifecta.char ')' >> Trifecta.spaces pure $ LineString.makeLineString first second (Sequence.fromList rest) -commandPoint :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -commandPoint = do +commandPoint :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser Geospatial.GeoPositionWithoutCRS +commandPoint pointParser = do _ <- Trifecta.char ',' _ <- Trifecta.spaces - Point.justPoints + pointParser emptyLine :: Geospatial.GeoLine emptyLine = Geospatial.GeoLine $ LineString.makeLineString Geospatial.GeoEmpty Geospatial.GeoEmpty Sequence.empty diff --git a/src/Data/Internal/Wkt/Point.hs b/src/Data/Internal/Wkt/Point.hs --- a/src/Data/Internal/Wkt/Point.hs +++ b/src/Data/Internal/Wkt/Point.hs @@ -1,7 +1,9 @@ module Data.Internal.Wkt.Point ( point , multiPoint - , justPoints + , justPointsXY + , justPointsXYZ + , justPointsXYZM , emptyPoint , emptyMultiPoint ) where @@ -17,47 +19,86 @@ point = do _ <- Trifecta.string "point" _ <- Trifecta.spaces - (Trifecta.string "empty" >> pure emptyPoint) <|> fmap Geospatial.GeoPoint bracketedPoint + (Trifecta.string "empty" >> pure emptyPoint) <|> nonEmptyPoints +nonEmptyPoints :: Trifecta.Parser Geospatial.GeoPoint +nonEmptyPoints = + (Trifecta.string "zm" >> fmap Geospatial.GeoPoint (bracketedPoint justPointsXYZM)) + <|> (Trifecta.string "z" >> fmap Geospatial.GeoPoint (bracketedPoint justPointsXYZ)) + <|> fmap Geospatial.GeoPoint (bracketedPoint justPointsXY) + multiPoint :: Trifecta.Parser Geospatial.GeoMultiPoint multiPoint = do _ <- Trifecta.string "multipoint" _ <- Trifecta.spaces - xl <- Wkt.emptySet <|> manyPoints + xl <- Wkt.emptySet <|> nonEmptyMultipoints pure $ Geospatial.GeoMultiPoint xl -manyPoints :: Trifecta.Parser (Sequence.Seq Geospatial.GeoPositionWithoutCRS) -manyPoints = do - _ <- Trifecta.char '(' >> Trifecta.spaces - xl <- unbracketedPoints <|> bracketedPoints +nonEmptyMultipoints :: Trifecta.Parser (Sequence.Seq Geospatial.GeoPositionWithoutCRS) +nonEmptyMultipoints = + (Trifecta.string "zm" >> manyPoints justPointsXYZM) + <|> (Trifecta.string "z" >> manyPoints justPointsXYZ) + <|> manyPoints justPointsXY + +manyPoints :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (Sequence.Seq Geospatial.GeoPositionWithoutCRS) +manyPoints pointParser = do + _ <- Trifecta.spaces >> Trifecta.char '(' >> Trifecta.spaces + xl <- unbracketedPoints pointParser <|> bracketedPoints pointParser _ <- Trifecta.spaces >> Trifecta.char ')' >> Trifecta.spaces pure xl -unbracketedPoints :: Trifecta.Parser (Sequence.Seq Geospatial.GeoPositionWithoutCRS) -unbracketedPoints = do - x <- justPoints - xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> justPoints) +unbracketedPoints :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (Sequence.Seq Geospatial.GeoPositionWithoutCRS) +unbracketedPoints pointParser = do + x <- pointParser + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> pointParser ) pure $ x Sequence.<| Sequence.fromList xs -bracketedPoints :: Trifecta.Parser (Sequence.Seq Geospatial.GeoPositionWithoutCRS) -bracketedPoints = do - x <- bracketedPoint - xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> bracketedPoint) +bracketedPoints :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (Sequence.Seq Geospatial.GeoPositionWithoutCRS) +bracketedPoints pointParser = do + x <- bracketedPoint pointParser + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> bracketedPoint pointParser) pure $ x Sequence.<| Sequence.fromList xs -bracketedPoint :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -bracketedPoint = do +bracketedPoint :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser Geospatial.GeoPositionWithoutCRS +bracketedPoint pointParser = do _ <- Trifecta.spaces >> Trifecta.char '(' >> Trifecta.spaces - x <- justPoints + x <- pointParser _ <- Trifecta.spaces >> Trifecta.char ')' >> Trifecta.spaces pure x -justPoints :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -justPoints = do +firstXy :: Trifecta.Parser (Scientific.Scientific, Scientific.Scientific) +firstXy = do x <- Wkt.number _ <- Trifecta.spaces y <- Wkt.number - pure $ Geospatial.GeoPointXY (Geospatial.PointXY (Scientific.toRealFloat x) (Scientific.toRealFloat y)) + pure (x, y) + +firstXyz :: Trifecta.Parser (Scientific.Scientific, Scientific.Scientific, Scientific.Scientific) +firstXyz = do + (x, y) <- firstXy + _ <- Trifecta.spaces + z <- Wkt.number + pure (x, y, z) + +justPointsXY :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS +justPointsXY = do + (x,y) <- firstXy + let xy = Geospatial.PointXY (Scientific.toRealFloat x) (Scientific.toRealFloat y) + pure $ Geospatial.GeoPointXY xy + +justPointsXYZ :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS +justPointsXYZ = do + (x,y,z) <- firstXyz + let xyz = Geospatial.PointXYZ (Scientific.toRealFloat x) (Scientific.toRealFloat y) (Scientific.toRealFloat z) + pure $ Geospatial.GeoPointXYZ xyz + +justPointsXYZM :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS +justPointsXYZM = do + (x,y,z) <- firstXyz + _ <- Trifecta.spaces + m <- Wkt.number + let xyzm = Geospatial.PointXYZM (Scientific.toRealFloat x) (Scientific.toRealFloat y) (Scientific.toRealFloat z) (Scientific.toRealFloat m) + pure $ Geospatial.GeoPointXYZM xyzm emptyPoint :: Geospatial.GeoPoint emptyPoint = Geospatial.GeoPoint Geospatial.GeoEmpty diff --git a/src/Data/Internal/Wkt/Polygon.hs b/src/Data/Internal/Wkt/Polygon.hs --- a/src/Data/Internal/Wkt/Polygon.hs +++ b/src/Data/Internal/Wkt/Polygon.hs @@ -20,39 +20,51 @@ polygon = do _ <- Trifecta.string "polygon" _ <- Trifecta.spaces - x <- Wkt.emptySet <|> polygon' + x <- Wkt.emptySet <|> nonEmptyPolygon pure $ Geospatial.GeoPolygon x +nonEmptyPolygon :: Trifecta.Parser (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) +nonEmptyPolygon = + (Trifecta.string "zm" >> polygon' Point.justPointsXYZM) + <|> (Trifecta.string "z" >> polygon' Point.justPointsXYZ) + <|> polygon' Point.justPointsXY + multiPolygon :: Trifecta.Parser Geospatial.GeoMultiPolygon multiPolygon = do _ <- Trifecta.string "multipolygon" _ <- Trifecta.spaces - xs <- Wkt.emptySet <|> multiPolygon' + xs <- Wkt.emptySet <|> nonEmptyMultiPolygon pure $ Geospatial.GeoMultiPolygon xs -polygon' :: Trifecta.Parser (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) -polygon' = do +nonEmptyMultiPolygon :: Trifecta.Parser (Sequence.Seq (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS))) +nonEmptyMultiPolygon = + (Trifecta.string "zm" >> multiPolygon' Point.justPointsXYZM) + <|> (Trifecta.string "z" >> multiPolygon' Point.justPointsXYZ) + <|> multiPolygon' Point.justPointsXY + +polygon' :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)) +polygon' pointParser = do _ <- Trifecta.spaces >> Trifecta.char '(' - x <- linearRing - xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> linearRing) + x <- linearRing pointParser + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> linearRing pointParser) _ <- Trifecta.char ')' >> Trifecta.spaces pure $ x Sequence.:<| Sequence.fromList xs -multiPolygon' :: Trifecta.Parser (Sequence.Seq (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS))) -multiPolygon' = do +multiPolygon' :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (Sequence.Seq (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS))) +multiPolygon' pointParser = do _ <- Trifecta.spaces >> Trifecta.char '(' - x <- polygon' - xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> polygon') + x <- polygon' pointParser + xs <- Trifecta.many (Trifecta.char ',' >> Trifecta.spaces >> polygon' pointParser) _ <- Trifecta.char ')' >> Trifecta.spaces pure $ x Sequence.:<| Sequence.fromList xs -linearRing :: Trifecta.Parser (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) -linearRing = do +linearRing :: Trifecta.Parser Geospatial.GeoPositionWithoutCRS -> Trifecta.Parser (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) +linearRing pointParser = do _ <- Trifecta.spaces >> Trifecta.char '(' >> Trifecta.spaces - first <- Point.justPoints - second <- Line.commandPoint - third <- Line.commandPoint - rest <- Trifecta.many Line.commandPoint + first <- pointParser + second <- Line.commandPoint pointParser + third <- Line.commandPoint pointParser + rest <- Trifecta.many (Line.commandPoint pointParser) _ <- Trifecta.char ')' >> Trifecta.spaces pure $ LinearRing.makeLinearRing first second third (SeqHelper.sequenceHead $ Sequence.fromList rest) diff --git a/src/Data/Wkb.hs b/src/Data/Wkb.hs --- a/src/Data/Wkb.hs +++ b/src/Data/Wkb.hs @@ -5,19 +5,35 @@ ------------------------------------------------------------------- module Data.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 Data.Hex as Hex +import qualified Data.Internal.Wkb.Endian as Endian import qualified Data.Internal.Wkb.Geometry as Geometry import qualified Data.Internal.Wkb.Geospatial as WkbGeospatial +-- | +-- Representation of WKB as Binary parseByteString :: LazyByteString.ByteString -> Either String Geospatial.GeospatialGeometry parseByteString byteString = case BinaryGet.runGetOrFail - (WkbGeospatial.geospatialGeometry Geometry.geometryTypeWithCoords) + (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 + +toByteString :: Endian.EndianType -> Geospatial.GeospatialGeometry -> LazyByteString.ByteString +toByteString endianType = + ByteStringBuilder.toLazyByteString . WkbGeospatial.builderGeospatialGeometry Geometry.builderWkbGeom endianType diff --git a/test/Data/Internal/Ewkb/GeometrySpec.hs b/test/Data/Internal/Ewkb/GeometrySpec.hs --- a/test/Data/Internal/Ewkb/GeometrySpec.hs +++ b/test/Data/Internal/Ewkb/GeometrySpec.hs @@ -4,8 +4,6 @@ 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) @@ -20,98 +18,85 @@ testValidGetEwkbGeometryType :: Spec testValidGetEwkbGeometryType = describe "get extended wkb geometry type for valid data" $ - mapM_ testGetEwkbGeometryType expectations + mapM_ testGetEwkbGeometryType testValues -testGetEwkbGeometryType :: (Word.Word32, Maybe Word.Word32, Ewkb.EwkbGeometryType) -> Spec -testGetEwkbGeometryType (rawGeomType, maybeSrid, expected) = - it ("Parse " ++ show expected) $ +testGetEwkbGeometryType :: Ewkb.EwkbGeometryType -> Spec +testGetEwkbGeometryType geometryType = + it ("Parse " ++ show geometryType) $ mapM_ test [Endian.BigEndian, Endian.LittleEndian] - where test endianType = - BinaryGet.runGet (Ewkb.ewkbGeometryType endianType) (getByteString endianType rawGeomType maybeSrid) `shouldBe` expected + where test endianType = roundTrip endianType geometryType `shouldBe` geometryType -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 +roundTrip :: Endian.EndianType -> Ewkb.EwkbGeometryType -> Ewkb.EwkbGeometryType +roundTrip endianType geometryType = + BinaryGet.runGet (Ewkb.getEwkbGeom endianType) encodedGeometryType + where encodedGeometryType = ByteStringBuilder.toLazyByteString $ Ewkb.builderEwkbGeom endianType geometryType -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)) +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 diff --git a/test/Data/Internal/Wkb/EndianSpec.hs b/test/Data/Internal/Wkb/EndianSpec.hs --- a/test/Data/Internal/Wkb/EndianSpec.hs +++ b/test/Data/Internal/Wkb/EndianSpec.hs @@ -4,8 +4,6 @@ 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 @@ -18,12 +16,13 @@ testGetEndian = describe "get endian" $ do it "Returns BigEndian for 0" $ - BinaryGet.runGet Endian.endianType (getByteString 0) `shouldBe` Endian.BigEndian + roundTrip Endian.BigEndian `shouldBe` Endian.BigEndian it "Returns LittleEndian for 1" $ - BinaryGet.runGet Endian.endianType (getByteString 1) `shouldBe` Endian.LittleEndian + roundTrip Endian.LittleEndian `shouldBe` Endian.LittleEndian it "Returns fail for other" $ - BinaryGet.runGetOrFail Endian.endianType (getByteString 5) `shouldBe` Left ("", 1, "Invalid EndianType") + BinaryGet.runGetOrFail Endian.getEndianType (ByteStringBuilder.toLazyByteString $ ByteStringBuilder.word8 5) `shouldBe` Left ("", 1, "Invalid EndianType") -getByteString :: Word.Word8 -> LazyByteString.ByteString -getByteString int = - ByteStringBuilder.toLazyByteString $ ByteStringBuilder.word8 int +roundTrip :: Endian.EndianType -> Endian.EndianType +roundTrip endianType = + BinaryGet.runGet Endian.getEndianType encodedEndianType + where encodedEndianType = ByteStringBuilder.toLazyByteString $ Endian.builderEndianType endianType diff --git a/test/Data/Internal/Wkb/GeometryCollectionSpec.hs b/test/Data/Internal/Wkb/GeometryCollectionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkb/GeometryCollectionSpec.hs @@ -0,0 +1,14 @@ + +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.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/Data/Internal/Wkb/GeometrySpec.hs b/test/Data/Internal/Wkb/GeometrySpec.hs --- a/test/Data/Internal/Wkb/GeometrySpec.hs +++ b/test/Data/Internal/Wkb/GeometrySpec.hs @@ -4,8 +4,6 @@ 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 @@ -18,56 +16,52 @@ testValidGetGeometryTypeWithCoords :: Spec testValidGetGeometryTypeWithCoords = describe "get geometry type with coords type for valid data" $ - mapM_ testGetGeometryTypeWithCoords expectations + mapM_ testGetGeometryTypeWithCoords geometryTypes -testGetGeometryTypeWithCoords :: (Word.Word32, Geometry.WkbGeometryType) -> Spec -testGetGeometryTypeWithCoords (int, expected) = - it ("Parse " ++ show expected) $ +testGetGeometryTypeWithCoords :: Geometry.WkbGeometryType -> Spec +testGetGeometryTypeWithCoords geometryType = + it ("Parse " ++ show geometryType) $ mapM_ test [Endian.BigEndian, Endian.LittleEndian] where test endianType = - BinaryGet.runGet (Geometry.geometryTypeWithCoords endianType) (getByteString endianType int) `shouldBe` expected + roundTrip endianType geometryType `shouldBe` geometryType -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 +roundTrip :: Endian.EndianType -> Geometry.WkbGeometryType -> Geometry.WkbGeometryType +roundTrip endianType geometryType = + BinaryGet.runGet (Geometry.getWkbGeom endianType) encodedGeometryType + where encodedGeometryType = ByteStringBuilder.toLazyByteString $ Geometry.builderWkbGeom endianType geometryType -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) +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/Data/Internal/Wkb/HexParsingSpec.hs b/test/Data/Internal/Wkb/HexParsingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkb/HexParsingSpec.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkb.HexParsingSpec where + +import qualified Data.Geospatial as Geospatial +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.Hex as Hex +import qualified Data.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/Data/Internal/Wkb/LineSpec.hs b/test/Data/Internal/Wkb/LineSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkb/LineSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.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/Data/Internal/Wkb/PointSpec.hs b/test/Data/Internal/Wkb/PointSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkb/PointSpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.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 Data.Internal.Wkb.Geometry as Geometry +import qualified Data.Internal.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/Data/Internal/Wkb/PolygonSpec.hs b/test/Data/Internal/Wkb/PolygonSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkb/PolygonSpec.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkb.PolygonSpec where + +import qualified Data.ByteString.Builder as ByteStringBuilder +import Data.Monoid ((<>)) +import Test.Hspec (Spec, describe, it, shouldBe) + +import qualified Data.SpecHelper as SpecHelper +import qualified Data.Wkb as Wkb + +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 diff --git a/test/Data/Internal/Wkt/GeometryCollectionSpec.hs b/test/Data/Internal/Wkt/GeometryCollectionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkt/GeometryCollectionSpec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkt.GeometryCollectionSpec where + +import Control.Lens ((^?!)) +import qualified Data.Geospatial as Geospatial +import qualified Data.Sequence as Sequence +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 :: Sequence.Seq Geospatial.GeospatialGeometry +exampleGeometryCollection = + Sequence.fromList + [ Geospatial.Point $ Geospatial.GeoPoint SpecHelper.point1 + , Geospatial.Point $ Geospatial.GeoPoint SpecHelper.point2 + , Geospatial.Line $ Geospatial.GeoLine SpecHelper.lineString4 + ] diff --git a/test/Data/Internal/Wkt/LineSpec.hs b/test/Data/Internal/Wkt/LineSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkt/LineSpec.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkt.LineSpec 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.Sequence as Sequence +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 + it "Parse z lines" $ + Wkt.parseString Wkt.lineString "linestring z (1.0 2.0 3.0,1.0 2.5 4.0,1.0 3.0 5.0)" ^?! Trifecta._Success `shouldBe` example3DLine + it "Parse z lines" $ + Wkt.parseString Wkt.lineString "linestring z(1.0 2.0 3.0,1.0 2.5 4.0,1.0 3.0 5.0)" ^?! Trifecta._Success `shouldBe` example3DLine + it "Parse z lines" $ + Wkt.parseString Wkt.lineString "linestringz(1.0 2.0 3.0,1.0 2.5 4.0,1.0 3.0 5.0)" ^?! Trifecta._Success `shouldBe` example3DLine + it "Parse zm lines" $ + Wkt.parseString Wkt.lineString "linestring zm (1.0 2.0 3.0 4.0,1.0 2.5 4.0 5.5, 1.0 3.0 5.0 7.0)" ^?! Trifecta._Success `shouldBe` example4DLine + + +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 + it "Parse z lines" $ + Wkt.parseString Wkt.multiLineString "multilinestring z ((1.0 2.0 3.0,1.0 2.5 4.0,1.0 3.0 5.0))" ^?! Trifecta._Success `shouldBe` example3DMultiLine + it "Parse zm lines" $ + Wkt.parseString Wkt.multiLineString "multilinestring zm ((1.0 2.0 3.0 4.0,1.0 2.5 4.0 5.5, 1.0 3.0 5.0 7.0))" ^?! Trifecta._Success `shouldBe` example4DMultiLine + +exampleLine :: Geospatial.GeoLine +exampleLine = Geospatial.GeoLine exampleLineString + +example3DLine :: Geospatial.GeoLine +example3DLine = Geospatial.GeoLine exampleLine3DString + +example4DLine :: Geospatial.GeoLine +example4DLine = Geospatial.GeoLine exampleLine4DString + +exampleMultiLine :: Geospatial.GeoMultiLine +exampleMultiLine = Geospatial.GeoMultiLine (Sequence.singleton exampleLineString) + +example3DMultiLine :: Geospatial.GeoMultiLine +example3DMultiLine = Geospatial.GeoMultiLine (Sequence.singleton exampleLine3DString) + +example4DMultiLine :: Geospatial.GeoMultiLine +example4DMultiLine = Geospatial.GeoMultiLine (Sequence.singleton exampleLine4DString) + +exampleLineString :: LineString.LineString Geospatial.GeoPositionWithoutCRS +exampleLineString = LineString.makeLineString (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0)) (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.5)) (Sequence.singleton (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 3.0))) + +exampleLine3DString :: LineString.LineString Geospatial.GeoPositionWithoutCRS +exampleLine3DString = LineString.makeLineString (Geospatial.GeoPointXYZ (Geospatial.PointXYZ 1.0 2.0 3.0)) (Geospatial.GeoPointXYZ (Geospatial.PointXYZ 1.0 2.5 4.0)) (Sequence.singleton (Geospatial.GeoPointXYZ (Geospatial.PointXYZ 1.0 3.0 5.0))) + +exampleLine4DString :: LineString.LineString Geospatial.GeoPositionWithoutCRS +exampleLine4DString = LineString.makeLineString (Geospatial.GeoPointXYZM (Geospatial.PointXYZM 1.0 2.0 3.0 4.0)) (Geospatial.GeoPointXYZM (Geospatial.PointXYZM 1.0 2.5 4.0 5.5)) (Sequence.singleton (Geospatial.GeoPointXYZM (Geospatial.PointXYZM 1.0 3.0 5.0 7.0))) diff --git a/test/Data/Internal/Wkt/PointSpec.hs b/test/Data/Internal/Wkt/PointSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkt/PointSpec.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkt.PointSpec where + +import Control.Lens ((^?), (^?!)) +import qualified Data.Geospatial as Geospatial +import qualified Data.Maybe as Maybe +import qualified Data.Sequence as Sequence +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 + it "Parse z points" $ + Wkt.parseString Wkt.point "point z (1.0 2.0 3.0)" ^?! Trifecta._Success `shouldBe` example3DPoint + it "Parse zm points" $ + Wkt.parseString Wkt.point "point zm (1.0 2.0 3.0 4.0)" ^?! Trifecta._Success `shouldBe` example4DPoint + +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 + it "Parse z points" $ + Wkt.parseString Wkt.multiPoint "multipoint z ((1.0 2.0 3.0),(2.0 2.0 2.0))" ^?! Trifecta._Success `shouldBe` exampleMulti3DPoint + it "Parse zm points" $ + Wkt.parseString Wkt.multiPoint "multipoint zm ((1.0 2.0 3.0 4.0),(2.0 2.0 2.0 2.0))" ^?! Trifecta._Success `shouldBe` exampleMulti4DPoint + +examplePoint :: Geospatial.GeoPoint +examplePoint = Geospatial.GeoPoint (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0)) + +example3DPoint :: Geospatial.GeoPoint +example3DPoint = Geospatial.GeoPoint (Geospatial.GeoPointXYZ (Geospatial.PointXYZ 1.0 2.0 3.0)) + +example4DPoint :: Geospatial.GeoPoint +example4DPoint = Geospatial.GeoPoint (Geospatial.GeoPointXYZM (Geospatial.PointXYZM 1.0 2.0 3.0 4.0)) + +exampleMultiPoint :: Geospatial.GeoMultiPoint +exampleMultiPoint = Geospatial.GeoMultiPoint (Sequence.fromList [Geospatial.GeoPointXY (Geospatial.PointXY 1.0 2.0), Geospatial.GeoPointXY (Geospatial.PointXY 2.0 2.0)]) + +exampleMulti3DPoint :: Geospatial.GeoMultiPoint +exampleMulti3DPoint = Geospatial.GeoMultiPoint (Sequence.fromList [Geospatial.GeoPointXYZ (Geospatial.PointXYZ 1.0 2.0 3.0), Geospatial.GeoPointXYZ (Geospatial.PointXYZ 2.0 2.0 2.0)]) + +exampleMulti4DPoint :: Geospatial.GeoMultiPoint +exampleMulti4DPoint = Geospatial.GeoMultiPoint (Sequence.fromList [Geospatial.GeoPointXYZM (Geospatial.PointXYZM 1.0 2.0 3.0 4.0), Geospatial.GeoPointXYZM (Geospatial.PointXYZM 2.0 2.0 2.0 2.0)]) diff --git a/test/Data/Internal/Wkt/PolygonSpec.hs b/test/Data/Internal/Wkt/PolygonSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Internal/Wkt/PolygonSpec.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Internal.Wkt.PolygonSpec where + +import Control.Lens ((^?!)) +import qualified Data.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.Sequence as Sequence +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 + it "Parse something with z" $ + Wkt.parseString Wkt.polygon "polygon z ((4.0 0.0 1.0, 0.0 4.0 1.0, -4.0 0.0 1.0, 0.0 -4.0 1.0, 4.0 0.0 1.0))" ^?! Trifecta._Success `shouldBe` examplePolygon3D + it "Parse something with zm" $ + Wkt.parseString Wkt.polygon "polygon zm ((4.0 0.0 1.0 0.5, 0.0 4.0 1.0 0.5, -4.0 0.0 1.0 0.5, 0.0 -4.0 1.0 0.5, 4.0 0.0 1.0 0.5))" ^?! Trifecta._Success `shouldBe` examplePolygon4D + + +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 + it "Parse something with z" $ + Wkt.parseString Wkt.multiPolygon "multipolygon z (((4.0 0.0 1.0, 0.0 4.0 1.0, -4.0 0.0 1.0, 0.0 -4.0 1.0, 4.0 0.0 1.0)))" ^?! Trifecta._Success `shouldBe` exampleMultiPolygon3D + it "Parse something with zm" $ + Wkt.parseString Wkt.multiPolygon "multipolygon zm (((4.0 0.0 1.0 0.5, 0.0 4.0 1.0 0.5, -4.0 0.0 1.0 0.5, 0.0 -4.0 1.0 0.5, 4.0 0.0 1.0 0.5)))" ^?! Trifecta._Success `shouldBe` exampleMultiPolygon4D + +examplePolygon :: Geospatial.GeoPolygon +examplePolygon = + Geospatial.GeoPolygon (Sequence.singleton linearRingSingle) + +examplePolygon3D :: Geospatial.GeoPolygon +examplePolygon3D = + Geospatial.GeoPolygon (Sequence.singleton linearRingSingle3D) + +examplePolygon4D :: Geospatial.GeoPolygon +examplePolygon4D = + Geospatial.GeoPolygon (Sequence.singleton linearRingSingle4D) + +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)) (Sequence.fromList [Geospatial.GeoPointXY (Geospatial.PointXY 0.0 (-4.0))]) + +linearRingSingle3D :: LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS +linearRingSingle3D = LinearRing.makeLinearRing (Geospatial.GeoPointXYZ (Geospatial.PointXYZ 4.0 0.0 1.0)) (Geospatial.GeoPointXYZ (Geospatial.PointXYZ 0.0 4.0 1.0)) (Geospatial.GeoPointXYZ (Geospatial.PointXYZ (-4.0) 0.0 1.0)) (Sequence.fromList [Geospatial.GeoPointXYZ (Geospatial.PointXYZ 0.0 (-4.0) 1.0)]) + +linearRingSingle4D :: LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS +linearRingSingle4D = LinearRing.makeLinearRing (Geospatial.GeoPointXYZM (Geospatial.PointXYZM 4.0 0.0 1.0 0.5)) (Geospatial.GeoPointXYZM (Geospatial.PointXYZM 0.0 4.0 1.0 0.5)) (Geospatial.GeoPointXYZM (Geospatial.PointXYZM (-4.0) 0.0 1.0 0.5)) (Sequence.fromList [Geospatial.GeoPointXYZM (Geospatial.PointXYZM 0.0 (-4.0) 1.0 0.5)]) + +linearRingDouble :: Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) +linearRingDouble = Sequence.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)) (Sequence.fromList [ Geospatial.GeoPointXY (Geospatial.PointXY 0.0 (-2.0))]) + ] + +exampleMultiPolygon :: Geospatial.GeoMultiPolygon +exampleMultiPolygon = Geospatial.GeoMultiPolygon (Sequence.singleton (Sequence.singleton linearRingSingle)) + +exampleMultiPolygon3D :: Geospatial.GeoMultiPolygon +exampleMultiPolygon3D = Geospatial.GeoMultiPolygon (Sequence.singleton (Sequence.singleton linearRingSingle3D)) + +exampleMultiPolygon4D :: Geospatial.GeoMultiPolygon +exampleMultiPolygon4D = Geospatial.GeoMultiPolygon (Sequence.singleton (Sequence.singleton linearRingSingle4D)) + +exampleMultiPolygonWithHole :: Geospatial.GeoMultiPolygon +exampleMultiPolygonWithHole = Geospatial.GeoMultiPolygon (Sequence.singleton linearRingDouble) diff --git a/test/Data/SpecHelper.hs b/test/Data/SpecHelper.hs --- a/test/Data/SpecHelper.hs +++ b/test/Data/SpecHelper.hs @@ -1,9 +1,144 @@ 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.Geospatial as Geospatial +import qualified Data.LinearRing as LinearRing +import qualified Data.LineString as LineString +import qualified Data.Sequence as Sequence +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 Data.Internal.Wkb.Endian as Endian +import qualified Data.Internal.Wkb.Geometry as Geometry +import qualified Data.Wkb as Wkb + +-- Helpers + +type GeometryGenerator = Gen Geospatial.GeoPositionWithoutCRS -> Gen Geospatial.GeospatialGeometry + +roundTripWkb :: Endian.EndianType -> Geospatial.GeospatialGeometry -> Either String Geospatial.GeospatialGeometry +roundTripWkb endianType = Wkb.parseByteString . Wkb.toByteString endianType + +testRoundTripWkbGeometryParsing :: String -> GeometryGenerator -> Spec +testRoundTripWkbGeometryParsing name generator = + mapM_ (testRoundTripWkbGeometryParsing' name generator) coordPointGenerators + +testRoundTripWkbGeometryParsing' :: String -> GeometryGenerator -> (Geometry.CoordinateType, Gen Geospatial.GeoPositionWithoutCRS) -> Spec +testRoundTripWkbGeometryParsing' name generator (coordType, genCoordPoint) = + it ("round trips wkb " ++ name ++ ": " ++ show coordType) $ + HedgehogHspec.require $ property $ do + geometry <- forAll $ generator genCoordPoint + endianType <- forAll genEndianType + roundTripWkb endianType 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) diff --git a/test/Data/WkbGeometryCollectionSpec.hs b/test/Data/WkbGeometryCollectionSpec.hs deleted file mode 100644 --- a/test/Data/WkbGeometryCollectionSpec.hs +++ /dev/null @@ -1,54 +0,0 @@ - -{-# 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.Sequence as Sequence -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 $ - Sequence.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 deleted file mode 100644 --- a/test/Data/WkbLineSpec.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# 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.Sequence as Sequence -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 (Sequence.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 deleted file mode 100644 --- a/test/Data/WkbPointSpec.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# 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.Sequence as Sequence -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 (Sequence.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 deleted file mode 100644 --- a/test/Data/WkbPolygonSpec.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# 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.Sequence as Sequence -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 (Sequence.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 - (Sequence.fromList - [ Sequence.singleton SpecHelper.linearRing1 - , Sequence.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 deleted file mode 100644 --- a/test/Data/WktGeometryCollectionSpec.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Data.WktGeometryCollectionSpec where - -import Control.Lens ((^?!)) -import qualified Data.Geospatial as Geospatial -import qualified Data.Sequence as Sequence -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 :: Sequence.Seq Geospatial.GeospatialGeometry -exampleGeometryCollection = - Sequence.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 deleted file mode 100644 --- a/test/Data/WktLineSpec.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# 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.Sequence as Sequence -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 (Sequence.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)) (Sequence.singleton (Geospatial.GeoPointXY (Geospatial.PointXY 1.0 3.0))) diff --git a/test/Data/WktPointSpec.hs b/test/Data/WktPointSpec.hs deleted file mode 100644 --- a/test/Data/WktPointSpec.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Data.WktPointSpec where - -import Control.Lens ((^?), (^?!)) -import qualified Data.Geospatial as Geospatial -import qualified Data.Maybe as Maybe -import qualified Data.Sequence as Sequence -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 (Sequence.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 deleted file mode 100644 --- a/test/Data/WktPolygonSpec.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Data.WktPolygonSpec where - -import Control.Lens ((^?!)) -import qualified Data.Geospatial as Geospatial -import qualified Data.LinearRing as LinearRing -import qualified Data.Sequence as Sequence -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 (Sequence.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)) (Sequence.fromList [Geospatial.GeoPointXY (Geospatial.PointXY 0.0 (-4.0))]) - -linearRingDouble :: Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS) -linearRingDouble = Sequence.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)) (Sequence.fromList [ Geospatial.GeoPointXY (Geospatial.PointXY 0.0 (-2.0))]) - ] - -exampleMultiPolygon :: Geospatial.GeoMultiPolygon -exampleMultiPolygon = Geospatial.GeoMultiPolygon (Sequence.singleton (Sequence.singleton linearRingSingle)) - -exampleMultiPolygonWithHole :: Geospatial.GeoMultiPolygon -exampleMultiPolygonWithHole = Geospatial.GeoMultiPolygon (Sequence.singleton linearRingDouble) diff --git a/wkt-geom.cabal b/wkt-geom.cabal --- a/wkt-geom.cabal +++ b/wkt-geom.cabal @@ -1,24 +1,26 @@ -name: wkt-geom -version: 0.0.4 -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. +name: wkt-geom +version: 0.0.5 +synopsis: A parser of WKT, WKB and eWKB. +description: Well Known Text (WKT), Well Known Binary (WKB) 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 + 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-2019 Wkt-Geom Project +category: Data +build-type: Simple +extra-source-files: README.md + , CHANGELOG.md +cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Data.Ewkb + , Data.Hex , Data.Wkb , Data.Wkt , Data.Internal.Ewkb.Geometry @@ -36,15 +38,16 @@ , Data.Internal.Wkt.GeometryCollection - build-depends: base < 5 && >= 4.8 - , binary >= 0.8 - , bytestring >= 0.10 - , containers >= 0.5.10.1 - , geojson >= 3.0.3 - , scientific >= 0.3.6 - , trifecta >= 1.7 - , utf8-string >= 1 - , vector >= 0.10 + build-depends: base < 5 && >= 4.8 + , base16-bytestring >= 0.1.1.6 + , binary >= 0.8 + , bytestring >= 0.10 + , containers >= 0.5.10.1 + , geojson >= 3.0.3 + , scientific >= 0.3.6 + , trifecta >= 1.7 + , utf8-string >= 1 + , vector >= 0.10 ghc-options: -Wall default-language: Haskell2010 @@ -54,32 +57,46 @@ hs-source-dirs: test other-modules: Data.Internal.Ewkb.GeometrySpec , Data.Internal.Wkb.EndianSpec + , Data.Internal.Wkb.GeometryCollectionSpec , Data.Internal.Wkb.GeometrySpec - , Data.WkbGeometryCollectionSpec - , Data.WkbLineSpec - , Data.WkbPointSpec - , Data.WkbPolygonSpec - , Data.WktGeometryCollectionSpec - , Data.WktLineSpec - , Data.WktPointSpec - , Data.WktPolygonSpec + , Data.Internal.Wkb.HexParsingSpec + , Data.Internal.Wkb.LineSpec + , Data.Internal.Wkb.PointSpec + , Data.Internal.Wkb.PolygonSpec + , Data.Internal.Wkt.GeometryCollectionSpec + , Data.Internal.Wkt.LineSpec + , Data.Internal.Wkt.PointSpec + , Data.Internal.Wkt.PolygonSpec , Data.SpecHelper main-is: Spec.hs build-depends: base - , binary >= 0.8 - , ansi-wl-pprint >= 0.6 - , bytestring >= 0.10 - , containers >= 0.5.10.1 - , geojson >= 3.0.3 + , base16-bytestring >= 0.1.1.6 + , binary >= 0.8 + , ansi-wl-pprint >= 0.6 + , bytestring >= 0.10 + , containers >= 0.5.10.1 + , geojson >= 3.0.3 + , hedgehog , hspec + , hw-hspec-hedgehog , lens , QuickCheck - , scientific >= 0.3.6 - , trifecta >= 1.7 - , vector >= 0.10 + , scientific >= 0.3.6 + , trifecta >= 1.7 + , vector >= 0.10 , wkt-geom ghc-options: -Wall default-language: Haskell2010 + +test-suite wkt-geom-hlint + hs-source-dirs: hlint + main-is: Main.hs + type: exitcode-stdio-1.0 + build-depends: base + , hlint + default-language: Haskell2010 + ghc-options: -Wall + -threaded source-repository head type: git