module Data.Internal.Wkb.Line
  ( 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 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

-- Binary parsers

getLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry
getLine :: EndianType -> CoordinateType -> Get GeospatialGeometry
getLine EndianType
endianType CoordinateType
coordType = do
  GeoLine
gl <- EndianType -> CoordinateType -> Get GeoLine
getGeoLine 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
$ GeoLine -> GeospatialGeometry
Geospatial.Line GeoLine
gl

getMultiLine :: (Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType) -> Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeospatialGeometry
getMultiLine :: (EndianType -> Get WkbGeometryType)
-> EndianType -> CoordinateType -> Get GeospatialGeometry
getMultiLine EndianType -> Get WkbGeometryType
getWkbGeom EndianType
endianType CoordinateType
_ = do
  Word32
numberOfLines <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  Seq GeoLine
geoLines <- Int -> Get GeoLine -> Get (Seq GeoLine)
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
numberOfLines) ((EndianType -> Get WkbGeometryType)
-> GeometryType
-> (EndianType -> CoordinateType -> Get GeoLine)
-> Get GeoLine
forall feature.
(EndianType -> Get WkbGeometryType)
-> GeometryType
-> (EndianType -> CoordinateType -> Get feature)
-> Get feature
GeometryCollection.getEnclosedFeature EndianType -> Get WkbGeometryType
getWkbGeom GeometryType
Geometry.LineString EndianType -> CoordinateType -> Get GeoLine
getGeoLine)
  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
$ GeoMultiLine -> GeospatialGeometry
Geospatial.MultiLine (GeoMultiLine -> GeospatialGeometry)
-> GeoMultiLine -> GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ Seq GeoLine -> GeoMultiLine
Geospatial.mergeGeoLines Seq GeoLine
geoLines

getGeoLine :: Endian.EndianType -> Geometry.CoordinateType -> BinaryGet.Get Geospatial.GeoLine
getGeoLine :: EndianType -> CoordinateType -> Get GeoLine
getGeoLine 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
2 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
    Seq GeoPositionWithoutCRS
pts <- 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
2)
    GeoLine -> Get GeoLine
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeoLine -> Get GeoLine) -> GeoLine -> Get GeoLine
forall a b. (a -> b) -> a -> b
$ LineString GeoPositionWithoutCRS -> GeoLine
Geospatial.GeoLine (LineString GeoPositionWithoutCRS -> GeoLine)
-> LineString GeoPositionWithoutCRS -> GeoLine
forall a b. (a -> b) -> a -> b
$ GeoPositionWithoutCRS
-> GeoPositionWithoutCRS
-> Seq GeoPositionWithoutCRS
-> LineString GeoPositionWithoutCRS
forall a. a -> a -> Seq a -> LineString a
LineString.makeLineString GeoPositionWithoutCRS
p1 GeoPositionWithoutCRS
p2 Seq GeoPositionWithoutCRS
pts
  else
    String -> Get GeoLine
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail String
"Must have at least two points for a line"


-- Binary builders

builderLine :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoLine -> ByteStringBuilder.Builder
builderLine :: BuilderWkbGeometryType -> EndianType -> GeoLine -> Builder
builderLine BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (Geospatial.GeoLine LineString GeoPositionWithoutCRS
lineString) = do
  let coordPoints :: Seq GeoPositionWithoutCRS
coordPoints = LineString GeoPositionWithoutCRS -> Seq GeoPositionWithoutCRS
forall a. LineString a -> Seq a
LineString.toSeq LineString GeoPositionWithoutCRS
lineString
      coordType :: CoordinateType
coordType = Seq GeoPositionWithoutCRS -> CoordinateType
Geometry.coordTypeOfSequence 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.LineString 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 (EndianType -> GeoPositionWithoutCRS -> Builder
Point.builderCoordPoint EndianType
endianType) Seq GeoPositionWithoutCRS
coordPoints

builderMultiLine :: Geometry.BuilderWkbGeometryType -> Endian.EndianType -> Geospatial.GeoMultiLine -> ByteStringBuilder.Builder
builderMultiLine :: BuilderWkbGeometryType -> EndianType -> GeoMultiLine -> Builder
builderMultiLine BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (Geospatial.GeoMultiLine Seq (LineString GeoPositionWithoutCRS)
lineStrings) =
  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.MultiLineString 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 (LineString GeoPositionWithoutCRS) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (LineString GeoPositionWithoutCRS)
lineStrings)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (LineString GeoPositionWithoutCRS -> Builder)
-> Seq (LineString GeoPositionWithoutCRS) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (BuilderWkbGeometryType -> EndianType -> GeoLine -> Builder
builderLine BuilderWkbGeometryType
builderWkbGeom EndianType
endianType (GeoLine -> Builder)
-> (LineString GeoPositionWithoutCRS -> GeoLine)
-> LineString GeoPositionWithoutCRS
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineString GeoPositionWithoutCRS -> GeoLine
Geospatial.GeoLine) Seq (LineString GeoPositionWithoutCRS)
lineStrings