module Data.Internal.Wkb.Point
  ( getPoint
  , getMultiPoint
  , getGeoPoint
  , getCoordPoint
  , getCoordPoints
  , builderPoint
  , builderMultiPoint
  , builderCoordPoint
  , builderCoordPoints
  ) where

import qualified Data.Binary.Get                      as BinaryGet
import qualified Data.ByteString.Builder              as ByteStringBuilder
import qualified Data.Foldable                        as Foldable
import qualified Data.Geospatial                      as Geospatial
import qualified Data.Monoid                          as Monoid
import qualified Data.Sequence                        as Sequence
import qualified Data.Word                            as Word

import qualified Data.Internal.Wkb.Endian             as Endian
import qualified Data.Internal.Wkb.Geometry           as Geometry
import qualified Data.Internal.Wkb.GeometryCollection as GeometryCollection

-- Binary parsers

getPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry
getPoint :: EndianType -> CoordinateType -> Get GeospatialGeometry
getPoint EndianType
endianType CoordinateType
coordType = do
  GeoPoint
geoPoint <- EndianType -> CoordinateType -> Get GeoPoint
getGeoPoint EndianType
endianType CoordinateType
coordType
  GeospatialGeometry -> Get GeospatialGeometry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeospatialGeometry -> Get GeospatialGeometry)
-> GeospatialGeometry -> Get GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ GeoPoint -> GeospatialGeometry
Geospatial.Point GeoPoint
geoPoint

getMultiPoint :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry
getMultiPoint :: (EndianType -> Get WkbGeometryType)
-> EndianType -> CoordinateType -> Get GeospatialGeometry
getMultiPoint EndianType -> Get WkbGeometryType
getWkbGeom EndianType
endianType CoordinateType
_ = do
  Word32
numberOfPoints <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  Seq GeoPoint
geoPoints <- Int -> Get GeoPoint -> Get (Seq GeoPoint)
forall (m :: * -> *) a. Applicative m => Int -> m a -> m (Seq a)
Sequence.replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
numberOfPoints) ((EndianType -> Get WkbGeometryType)
-> GeometryType
-> (EndianType -> CoordinateType -> Get GeoPoint)
-> Get GeoPoint
forall feature.
(EndianType -> Get WkbGeometryType)
-> GeometryType
-> (EndianType -> CoordinateType -> Get feature)
-> Get feature
GeometryCollection.getEnclosedFeature EndianType -> Get WkbGeometryType
getWkbGeom GeometryType
Geometry.Point EndianType -> CoordinateType -> Get GeoPoint
getGeoPoint)
  GeospatialGeometry -> Get GeospatialGeometry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeospatialGeometry -> Get GeospatialGeometry)
-> GeospatialGeometry -> Get GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ GeoMultiPoint -> GeospatialGeometry
Geospatial.MultiPoint (GeoMultiPoint -> GeospatialGeometry)
-> GeoMultiPoint -> GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ Seq GeoPoint -> GeoMultiPoint
Geospatial.mergeGeoPoints Seq GeoPoint
geoPoints

getGeoPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPoint
getGeoPoint :: EndianType -> CoordinateType -> Get GeoPoint
getGeoPoint EndianType
endianType CoordinateType
coordType = do
  GeoPositionWithoutCRS
p <- EndianType -> CoordinateType -> Get GeoPositionWithoutCRS
getCoordPoint EndianType
endianType CoordinateType
coordType
  GeoPoint -> Get GeoPoint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeoPoint -> Get GeoPoint) -> GeoPoint -> Get GeoPoint
forall a b. (a -> b) -> a -> b
$ GeoPositionWithoutCRS -> GeoPoint
Geospatial.GeoPoint GeoPositionWithoutCRS
p

getCoordPoint :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPositionWithoutCRS
getCoordPoint :: EndianType -> CoordinateType -> Get GeoPositionWithoutCRS
getCoordPoint EndianType
endianType CoordinateType
coordType =
  case CoordinateType
coordType of
    CoordinateType
Geometry.TwoD -> do
      PointXY
point <- Double -> Double -> PointXY
Geospatial.PointXY (Double -> Double -> PointXY)
-> Get Double -> Get (Double -> PointXY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDouble Get (Double -> PointXY) -> Get Double -> Get PointXY
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble
      GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall (m :: * -> *) a. Monad m => a -> m a
return (GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS)
-> GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ PointXY -> GeoPositionWithoutCRS
Geospatial.GeoPointXY PointXY
point
    CoordinateType
Geometry.Z -> do
      PointXYZ
point <- Double -> Double -> Double -> PointXYZ
Geospatial.PointXYZ (Double -> Double -> Double -> PointXYZ)
-> Get Double -> Get (Double -> Double -> PointXYZ)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDouble Get (Double -> Double -> PointXYZ)
-> Get Double -> Get (Double -> PointXYZ)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble Get (Double -> PointXYZ) -> Get Double -> Get PointXYZ
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble
      GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall (m :: * -> *) a. Monad m => a -> m a
return (GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS)
-> GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ PointXYZ -> GeoPositionWithoutCRS
Geospatial.GeoPointXYZ PointXYZ
point
    CoordinateType
Geometry.M -> do
      PointXYZ
point <- Double -> Double -> Double -> PointXYZ
Geospatial.PointXYZ (Double -> Double -> Double -> PointXYZ)
-> Get Double -> Get (Double -> Double -> PointXYZ)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDouble Get (Double -> Double -> PointXYZ)
-> Get Double -> Get (Double -> PointXYZ)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble Get (Double -> PointXYZ) -> Get Double -> Get PointXYZ
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble
      GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall (m :: * -> *) a. Monad m => a -> m a
return (GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS)
-> GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ PointXYZ -> GeoPositionWithoutCRS
Geospatial.GeoPointXYZ PointXYZ
point
    CoordinateType
Geometry.ZM -> do
      PointXYZM
point <- Double -> Double -> Double -> Double -> PointXYZM
Geospatial.PointXYZM (Double -> Double -> Double -> Double -> PointXYZM)
-> Get Double -> Get (Double -> Double -> Double -> PointXYZM)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDouble Get (Double -> Double -> Double -> PointXYZM)
-> Get Double -> Get (Double -> Double -> PointXYZM)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble Get (Double -> Double -> PointXYZM)
-> Get Double -> Get (Double -> PointXYZM)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble Get (Double -> PointXYZM) -> Get Double -> Get PointXYZM
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
getDouble
      GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall (m :: * -> *) a. Monad m => a -> m a
return (GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS)
-> GeoPositionWithoutCRS -> Get GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ PointXYZM -> GeoPositionWithoutCRS
Geospatial.GeoPointXYZM PointXYZM
point
  where getDouble :: Get Double
getDouble = EndianType -> Get Double
Endian.getDouble EndianType
endianType

getCoordPoints :: Endian.EndianType -> Geometry.CoordinateType -> Word.Word32 -> BinaryGet.Get (Sequence.Seq Geospatial.GeoPositionWithoutCRS)
getCoordPoints :: EndianType
-> CoordinateType -> Word32 -> Get (Seq GeoPositionWithoutCRS)
getCoordPoints EndianType
endianType CoordinateType
coordType Word32
numberOfPoints =
  Int -> Get GeoPositionWithoutCRS -> Get (Seq GeoPositionWithoutCRS)
forall (m :: * -> *) a. Applicative m => Int -> m a -> m (Seq a)
Sequence.replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
numberOfPoints) (EndianType -> CoordinateType -> Get GeoPositionWithoutCRS
getCoordPoint EndianType
endianType CoordinateType
coordType)


-- Binary builders

builderPoint :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoPoint -> ByteStringBuilder.Builder
builderPoint :: BuilderWkbGeometryType -> EndianType -> GeoPoint -> Builder
builderPoint BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (Geospatial.GeoPoint GeoPositionWithoutCRS
coordPoint) =
  case GeoPositionWithoutCRS -> Maybe CoordinateType
Geometry.geoPositionWithoutCRSToCoordinateType GeoPositionWithoutCRS
coordPoint of
    Just CoordinateType
coordinateType ->
      EndianType -> Builder
Endian.builderEndianType EndianType
endianType
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (GeometryType -> CoordinateType -> WkbGeometryType
Geometry.WkbGeom GeometryType
Geometry.Point CoordinateType
coordinateType)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EndianType -> GeoPositionWithoutCRS -> Builder
builderCoordPoint EndianType
endianType GeoPositionWithoutCRS
coordPoint
    Maybe CoordinateType
Nothing ->
      Builder
forall a. Monoid a => a
Monoid.mempty

builderMultiPoint :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoMultiPoint -> ByteStringBuilder.Builder
builderMultiPoint :: BuilderWkbGeometryType -> EndianType -> GeoMultiPoint -> Builder
builderMultiPoint BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (Geospatial.GeoMultiPoint Seq GeoPositionWithoutCRS
coordPoints) =
  EndianType -> Builder
Endian.builderEndianType EndianType
endianType
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (GeometryType -> CoordinateType -> WkbGeometryType
Geometry.WkbGeom GeometryType
Geometry.MultiPoint CoordinateType
coordType)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EndianType -> Word32 -> Builder
Endian.builderFourBytes EndianType
endianType (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Seq GeoPositionWithoutCRS -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GeoPositionWithoutCRS
coordPoints)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (GeoPositionWithoutCRS -> Builder)
-> Seq GeoPositionWithoutCRS -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (BuilderWkbGeometryType -> EndianType -> GeoPoint -> Builder
builderPoint BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (GeoPoint -> Builder)
-> (GeoPositionWithoutCRS -> GeoPoint)
-> GeoPositionWithoutCRS
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeoPositionWithoutCRS -> GeoPoint
Geospatial.GeoPoint) Seq GeoPositionWithoutCRS
coordPoints
  where coordType :: CoordinateType
coordType = Seq GeoPositionWithoutCRS -> CoordinateType
Geometry.coordTypeOfSequence Seq GeoPositionWithoutCRS
coordPoints

builderCoordPoint :: Endian.EndianType -> Geospatial.GeoPositionWithoutCRS -> ByteStringBuilder.Builder
builderCoordPoint :: EndianType -> GeoPositionWithoutCRS -> Builder
builderCoordPoint EndianType
endianType GeoPositionWithoutCRS
coordPoint =
  case GeoPositionWithoutCRS
coordPoint of
    GeoPositionWithoutCRS
Geospatial.GeoEmpty -> Builder
forall a. Monoid a => a
Monoid.mempty
    Geospatial.GeoPointXY (Geospatial.PointXY Double
x Double
y) ->
      (Double -> Builder) -> [Double] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap Double -> Builder
builderDouble [Double
x, Double
y]
    Geospatial.GeoPointXYZ (Geospatial.PointXYZ Double
x Double
y Double
z) ->
      (Double -> Builder) -> [Double] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap Double -> Builder
builderDouble [Double
x, Double
y, Double
z]
    Geospatial.GeoPointXYZM (Geospatial.PointXYZM Double
x Double
y Double
z Double
m) ->
      (Double -> Builder) -> [Double] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap Double -> Builder
builderDouble [Double
x, Double
y, Double
z, Double
m]
  where builderDouble :: Double -> Builder
builderDouble = EndianType -> Double -> Builder
Endian.builderDouble EndianType
endianType

builderCoordPoints :: Endian.EndianType -> Sequence.Seq Geospatial.GeoPositionWithoutCRS -> ByteStringBuilder.Builder
builderCoordPoints :: EndianType -> Seq GeoPositionWithoutCRS -> Builder
builderCoordPoints EndianType
endianType =
  (GeoPositionWithoutCRS -> Builder)
-> Seq GeoPositionWithoutCRS -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (EndianType -> GeoPositionWithoutCRS -> Builder
builderCoordPoint EndianType
endianType)