module Data.Internal.Wkb.Polygon
  ( getPolygon
  , getMultiPolygon
  , builderPolygon
  , builderMultiPolygon
  ) where

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

import qualified 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
import qualified Data.SeqHelper                       as SeqHelper

-- Binary parsers

getPolygon :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry
getPolygon :: EndianType -> CoordinateType -> Get GeospatialGeometry
getPolygon EndianType
endianType CoordinateType
coordType = do
  GeoPolygon
geoPolygon <- EndianType -> CoordinateType -> Get GeoPolygon
getGeoPolygon 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
$ GeoPolygon -> GeospatialGeometry
Geospatial.Polygon GeoPolygon
geoPolygon

getMultiPolygon :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry
getMultiPolygon :: (EndianType -> Get WkbGeometryType)
-> EndianType -> CoordinateType -> Get GeospatialGeometry
getMultiPolygon EndianType -> Get WkbGeometryType
getWkbGeom EndianType
endianType CoordinateType
_ = do
  Word32
numberOfPolygons <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  Seq GeoPolygon
geoPolygons <- Int -> Get GeoPolygon -> Get (Seq GeoPolygon)
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
numberOfPolygons) ((EndianType -> Get WkbGeometryType)
-> GeometryType
-> (EndianType -> CoordinateType -> Get GeoPolygon)
-> Get GeoPolygon
forall feature.
(EndianType -> Get WkbGeometryType)
-> GeometryType
-> (EndianType -> CoordinateType -> Get feature)
-> Get feature
GeometryCollection.getEnclosedFeature EndianType -> Get WkbGeometryType
getWkbGeom GeometryType
Geometry.Polygon EndianType -> CoordinateType -> Get GeoPolygon
getGeoPolygon)
  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
$ GeoMultiPolygon -> GeospatialGeometry
Geospatial.MultiPolygon (GeoMultiPolygon -> GeospatialGeometry)
-> GeoMultiPolygon -> GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ Seq GeoPolygon -> GeoMultiPolygon
Geospatial.mergeGeoPolygons Seq GeoPolygon
geoPolygons

getGeoPolygon :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoPolygon
getGeoPolygon :: EndianType -> CoordinateType -> Get GeoPolygon
getGeoPolygon EndianType
endianType CoordinateType
coordType = do
  Seq (LinearRing GeoPositionWithoutCRS)
linearRings <- EndianType
-> CoordinateType -> Get (Seq (LinearRing GeoPositionWithoutCRS))
getLinearRings EndianType
endianType CoordinateType
coordType
  GeoPolygon -> Get GeoPolygon
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeoPolygon -> Get GeoPolygon) -> GeoPolygon -> Get GeoPolygon
forall a b. (a -> b) -> a -> b
$ Seq (LinearRing GeoPositionWithoutCRS) -> GeoPolygon
Geospatial.GeoPolygon Seq (LinearRing GeoPositionWithoutCRS)
linearRings

getLinearRings :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get (Sequence.Seq (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS))
getLinearRings :: EndianType
-> CoordinateType -> Get (Seq (LinearRing GeoPositionWithoutCRS))
getLinearRings EndianType
endianType CoordinateType
coordType = do
  Word32
numberOfRings <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  Int
-> Get (LinearRing GeoPositionWithoutCRS)
-> Get (Seq (LinearRing 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
numberOfRings) (EndianType
-> CoordinateType -> Get (LinearRing GeoPositionWithoutCRS)
getLinearRing EndianType
endianType CoordinateType
coordType)

getLinearRing :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get (LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS)
getLinearRing :: EndianType
-> CoordinateType -> Get (LinearRing GeoPositionWithoutCRS)
getLinearRing EndianType
endianType CoordinateType
coordType = do
  Word32
numberOfPoints <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  if Word32
numberOfPoints Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
4 then do
    GeoPositionWithoutCRS
p1 <- EndianType -> CoordinateType -> Get GeoPositionWithoutCRS
Point.getCoordPoint EndianType
endianType CoordinateType
coordType
    GeoPositionWithoutCRS
p2 <- EndianType -> CoordinateType -> Get GeoPositionWithoutCRS
Point.getCoordPoint EndianType
endianType CoordinateType
coordType
    GeoPositionWithoutCRS
p3 <- EndianType -> CoordinateType -> Get GeoPositionWithoutCRS
Point.getCoordPoint EndianType
endianType CoordinateType
coordType
    pts :: Seq GeoPositionWithoutCRS
pts@(Seq GeoPositionWithoutCRS
_ Sequence.:|> GeoPositionWithoutCRS
lastS) <- EndianType
-> CoordinateType -> Word32 -> Get (Seq GeoPositionWithoutCRS)
Point.getCoordPoints EndianType
endianType CoordinateType
coordType (Word32
numberOfPoints Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
3)
    if GeoPositionWithoutCRS
lastS GeoPositionWithoutCRS -> GeoPositionWithoutCRS -> Bool
forall a. Eq a => a -> a -> Bool
== GeoPositionWithoutCRS
p1 then
      LinearRing GeoPositionWithoutCRS
-> Get (LinearRing GeoPositionWithoutCRS)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LinearRing GeoPositionWithoutCRS
 -> Get (LinearRing GeoPositionWithoutCRS))
-> LinearRing GeoPositionWithoutCRS
-> Get (LinearRing GeoPositionWithoutCRS)
forall a b. (a -> b) -> a -> b
$ GeoPositionWithoutCRS
-> GeoPositionWithoutCRS
-> GeoPositionWithoutCRS
-> Seq GeoPositionWithoutCRS
-> LinearRing GeoPositionWithoutCRS
forall a. (Eq a, Show a) => a -> a -> a -> Seq a -> LinearRing a
LinearRing.makeLinearRing GeoPositionWithoutCRS
p1 GeoPositionWithoutCRS
p2 GeoPositionWithoutCRS
p3 (Seq GeoPositionWithoutCRS -> Seq GeoPositionWithoutCRS
forall a. Seq a -> Seq a
SeqHelper.sequenceHead Seq GeoPositionWithoutCRS
pts)
    else
      String -> Get (LinearRing GeoPositionWithoutCRS)
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail (String -> Get (LinearRing GeoPositionWithoutCRS))
-> String -> Get (LinearRing GeoPositionWithoutCRS)
forall a b. (a -> b) -> a -> b
$
        String
"First and last points of linear ring are different: first="
         String -> String -> String
forall a. [a] -> [a] -> [a]
++ GeoPositionWithoutCRS -> String
forall a. Show a => a -> String
show GeoPositionWithoutCRS
p1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" last=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GeoPositionWithoutCRS -> String
forall a. Show a => a -> String
show GeoPositionWithoutCRS
lastS
  else
    String -> Get (LinearRing GeoPositionWithoutCRS)
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail (String -> Get (LinearRing GeoPositionWithoutCRS))
-> String -> Get (LinearRing GeoPositionWithoutCRS)
forall a b. (a -> b) -> a -> b
$
      String
"Must have at least four points for a linear ring: "
       String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
numberOfPoints


-- Binary builders

builderPolygon :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoPolygon -> ByteStringBuilder.Builder
builderPolygon :: BuilderWkbGeometryType -> EndianType -> GeoPolygon -> Builder
builderPolygon BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (Geospatial.GeoPolygon Seq (LinearRing GeoPositionWithoutCRS)
linearRings) = do
  let coordType :: CoordinateType
coordType = Seq (LinearRing GeoPositionWithoutCRS) -> CoordinateType
Geometry.coordTypeOfLinearRings Seq (LinearRing GeoPositionWithoutCRS)
linearRings
  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.Polygon 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 (LinearRing GeoPositionWithoutCRS) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (LinearRing GeoPositionWithoutCRS)
linearRings)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (LinearRing GeoPositionWithoutCRS -> Builder)
-> Seq (LinearRing GeoPositionWithoutCRS) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (EndianType -> LinearRing GeoPositionWithoutCRS -> Builder
builderLinearRing EndianType
endianType) Seq (LinearRing GeoPositionWithoutCRS)
linearRings

builderMultiPolygon :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoMultiPolygon -> ByteStringBuilder.Builder
builderMultiPolygon :: BuilderWkbGeometryType -> EndianType -> GeoMultiPolygon -> Builder
builderMultiPolygon BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (Geospatial.GeoMultiPolygon Seq (Seq (LinearRing GeoPositionWithoutCRS))
polygons) =
  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.MultiPolygon 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 (Seq (LinearRing GeoPositionWithoutCRS)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Seq (LinearRing GeoPositionWithoutCRS))
polygons)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Seq (LinearRing GeoPositionWithoutCRS) -> Builder)
-> Seq (Seq (LinearRing GeoPositionWithoutCRS)) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (BuilderWkbGeometryType -> EndianType -> GeoPolygon -> Builder
builderPolygon BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (GeoPolygon -> Builder)
-> (Seq (LinearRing GeoPositionWithoutCRS) -> GeoPolygon)
-> Seq (LinearRing GeoPositionWithoutCRS)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (LinearRing GeoPositionWithoutCRS) -> GeoPolygon
Geospatial.GeoPolygon) Seq (Seq (LinearRing GeoPositionWithoutCRS))
polygons

builderLinearRing :: Endian.EndianType -> LinearRing.LinearRing Geospatial.GeoPositionWithoutCRS -> ByteStringBuilder.Builder
builderLinearRing :: EndianType -> LinearRing GeoPositionWithoutCRS -> Builder
builderLinearRing EndianType
endianType LinearRing GeoPositionWithoutCRS
linearRing = do
  let coordPoints :: Seq GeoPositionWithoutCRS
coordPoints = LinearRing GeoPositionWithoutCRS -> Seq GeoPositionWithoutCRS
forall a. LinearRing a -> Seq a
LinearRing.toSeq LinearRing GeoPositionWithoutCRS
linearRing
      lastCoordPoint :: GeoPositionWithoutCRS
lastCoordPoint = LinearRing GeoPositionWithoutCRS -> GeoPositionWithoutCRS
forall a. LinearRing a -> a
LinearRing.ringHead LinearRing GeoPositionWithoutCRS
linearRing
      lengthOfRing :: Word32
lengthOfRing = 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  EndianType -> Word32 -> Builder
Endian.builderFourBytes EndianType
endianType Word32
lengthOfRing
    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 (EndianType -> GeoPositionWithoutCRS -> Builder
Point.builderCoordPoint EndianType
endianType) Seq GeoPositionWithoutCRS
coordPoints
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EndianType -> GeoPositionWithoutCRS -> Builder
Point.builderCoordPoint EndianType
endianType GeoPositionWithoutCRS
lastCoordPoint