module Data.Internal.Wkb.GeometryCollection
  ( getGeometryCollection
  , getEnclosedFeature
  , builderGeometryCollection
  ) where

import qualified Control.Monad              as Monad
import qualified Data.Binary.Get            as BinaryGet
import qualified Data.ByteString.Builder    as ByteStringBuilder
import qualified Data.Foldable              as Foldable
import qualified Data.Geospatial            as Geospatial
import qualified Data.Sequence              as Sequence

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


-- Binary parsers

getGeometryCollection :: BinaryGet.Get Geospatial.GeospatialGeometry
                          -> Endian.EndianType
                          -> Geometry.CoordinateType
                          -> BinaryGet.Get Geospatial.GeospatialGeometry
getGeometryCollection :: Get GeospatialGeometry
-> EndianType -> CoordinateType -> Get GeospatialGeometry
getGeometryCollection Get GeospatialGeometry
getGeospatialGeometry EndianType
endianType CoordinateType
_ = do
  Word32
numberOfGeometries <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  Seq GeospatialGeometry
geoSpatialGeometries <- Int -> Get GeospatialGeometry -> Get (Seq GeospatialGeometry)
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
numberOfGeometries) Get GeospatialGeometry
getGeospatialGeometry
  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
$ Seq GeospatialGeometry -> GeospatialGeometry
Geospatial.Collection Seq GeospatialGeometry
geoSpatialGeometries

getEnclosedFeature :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType)
                      -> Geometry.GeometryType
                      -> (Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get feature)
                      -> BinaryGet.Get feature
getEnclosedFeature :: (EndianType -> Get WkbGeometryType)
-> GeometryType
-> (EndianType -> CoordinateType -> Get feature)
-> Get feature
getEnclosedFeature EndianType -> Get WkbGeometryType
getWkbGeom GeometryType
expectedGeometryType EndianType -> CoordinateType -> Get feature
getFeature = do
  EndianType
endianType <- Get EndianType
Endian.getEndianType
  WkbGeometryType
geometryTypeWithCoords <- EndianType -> Get WkbGeometryType
getWkbGeom EndianType
endianType
  let (Geometry.WkbGeom GeometryType
geoType CoordinateType
coordType) = WkbGeometryType
geometryTypeWithCoords
  if GeometryType
geoType GeometryType -> GeometryType -> Bool
forall a. Eq a => a -> a -> Bool
== GeometryType
expectedGeometryType then
    EndianType -> CoordinateType -> Get feature
getFeature EndianType
endianType CoordinateType
coordType
  else
    String -> Get feature
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail String
"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
-> BuilderWkbGeometryType
-> EndianType
-> Seq GeospatialGeometry
-> Builder
builderGeometryCollection BuilderGeospatialFeature
builderGeospatialFeature BuilderWkbGeometryType
builderWkbGeom EndianType
endianType Seq GeospatialGeometry
geometryCollection =
  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.GeometryCollection CoordinateType
Geometry.TwoD)
    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 GeospatialGeometry -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GeospatialGeometry
geometryCollection)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (GeospatialGeometry -> Builder)
-> Seq GeospatialGeometry -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (BuilderGeospatialFeature
builderGeospatialFeature BuilderWkbGeometryType
builderWkbGeom EndianType
endianType) Seq GeospatialGeometry
geometryCollection