module Data.Internal.Ewkb.Geometry
  ( EwkbGeometryType (..)
  , SridType (..)
  , getEwkbGeom
  , getWkbGeom
  , builderWkbGeom
  , builderEwkbGeom
  ) where

import qualified Control.Monad              as Monad
import qualified Data.Binary.Get            as BinaryGet
import           Data.Bits                  ((.&.), (.|.))
import qualified Data.ByteString.Builder    as ByteStringBuilder
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 (Int -> SridType -> ShowS
[SridType] -> ShowS
SridType -> String
(Int -> SridType -> ShowS)
-> (SridType -> String) -> ([SridType] -> ShowS) -> Show SridType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SridType] -> ShowS
$cshowList :: [SridType] -> ShowS
show :: SridType -> String
$cshow :: SridType -> String
showsPrec :: Int -> SridType -> ShowS
$cshowsPrec :: Int -> SridType -> ShowS
Show, SridType -> SridType -> Bool
(SridType -> SridType -> Bool)
-> (SridType -> SridType -> Bool) -> Eq SridType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SridType -> SridType -> Bool
$c/= :: SridType -> SridType -> Bool
== :: SridType -> SridType -> Bool
$c== :: SridType -> SridType -> Bool
Eq)

data EwkbGeometryType = EwkbGeom Geometry.WkbGeometryType SridType deriving (Int -> EwkbGeometryType -> ShowS
[EwkbGeometryType] -> ShowS
EwkbGeometryType -> String
(Int -> EwkbGeometryType -> ShowS)
-> (EwkbGeometryType -> String)
-> ([EwkbGeometryType] -> ShowS)
-> Show EwkbGeometryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EwkbGeometryType] -> ShowS
$cshowList :: [EwkbGeometryType] -> ShowS
show :: EwkbGeometryType -> String
$cshow :: EwkbGeometryType -> String
showsPrec :: Int -> EwkbGeometryType -> ShowS
$cshowsPrec :: Int -> EwkbGeometryType -> ShowS
Show, EwkbGeometryType -> EwkbGeometryType -> Bool
(EwkbGeometryType -> EwkbGeometryType -> Bool)
-> (EwkbGeometryType -> EwkbGeometryType -> Bool)
-> Eq EwkbGeometryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EwkbGeometryType -> EwkbGeometryType -> Bool
$c/= :: EwkbGeometryType -> EwkbGeometryType -> Bool
== :: EwkbGeometryType -> EwkbGeometryType -> Bool
$c== :: EwkbGeometryType -> EwkbGeometryType -> Bool
Eq)


-- Binary parsers

getEwkbGeom :: Endian.EndianType -> BinaryGet.Get EwkbGeometryType
getEwkbGeom :: EndianType -> Get EwkbGeometryType
getEwkbGeom EndianType
endianType = do
  Word32
rawGeometryType <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  SridType
ewkbSrid <- EndianType -> Word32 -> Get SridType
getEwkbSrid EndianType
endianType Word32
rawGeometryType
  WkbGeometryType
geomType <- Word32 -> Get WkbGeometryType
rawtoWkbGeometryType Word32
rawGeometryType
  EwkbGeometryType -> Get EwkbGeometryType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EwkbGeometryType -> Get EwkbGeometryType)
-> EwkbGeometryType -> Get EwkbGeometryType
forall a b. (a -> b) -> a -> b
$ WkbGeometryType -> SridType -> EwkbGeometryType
EwkbGeom WkbGeometryType
geomType SridType
ewkbSrid

getWkbGeom :: Endian.EndianType -> BinaryGet.Get Geometry.WkbGeometryType
getWkbGeom :: EndianType -> Get WkbGeometryType
getWkbGeom EndianType
endianType = do
  Word32
rawGeometryType <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
  SridType
_ <- EndianType -> Word32 -> Get SridType
getEwkbSrid EndianType
endianType Word32
rawGeometryType
  Word32 -> Get WkbGeometryType
rawtoWkbGeometryType Word32
rawGeometryType

getEwkbSrid :: Endian.EndianType -> Word.Word32 -> BinaryGet.Get SridType
getEwkbSrid :: EndianType -> Word32 -> Get SridType
getEwkbSrid EndianType
endianType Word32
int =
  if Word32
int Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
sridMask Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then do
    Word32
srid <- EndianType -> Get Word32
Endian.getFourBytes EndianType
endianType
    if Word32
srid Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
supportedSrid then
      SridType -> Get SridType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SridType -> Get SridType) -> SridType -> Get SridType
forall a b. (a -> b) -> a -> b
$ Word32 -> SridType
Srid Word32
srid
    else
      String -> Get SridType
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail (String -> Get SridType) -> String -> Get SridType
forall a b. (a -> b) -> a -> b
$ String
"Invalid SRID only " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
supportedSrid String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" supported: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
srid
  else
    SridType -> Get SridType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SridType
NoSrid


-- Binary builders

builderEwkbGeom :: Endian.EndianType -> EwkbGeometryType -> ByteStringBuilder.Builder
builderEwkbGeom :: EndianType -> EwkbGeometryType -> Builder
builderEwkbGeom EndianType
endianType (EwkbGeom WkbGeometryType
wkbGeometryType SridType
NoSrid) =
  EndianType -> WkbGeometryType -> Builder
builderWkbGeom EndianType
endianType WkbGeometryType
wkbGeometryType
builderEwkbGeom EndianType
endianType (EwkbGeom WkbGeometryType
wkbGeometryType (Srid Word32
srid)) = do
  let int :: Word32
int = WkbGeometryType -> Word32
wkbGeometryTypeToInt WkbGeometryType
wkbGeometryType Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
sridMask
  EndianType -> Word32 -> Builder
Endian.builderFourBytes EndianType
endianType Word32
int
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EndianType -> Word32 -> Builder
Endian.builderFourBytes EndianType
endianType Word32
srid

builderWkbGeom :: Endian.EndianType -> Geometry.WkbGeometryType -> ByteStringBuilder.Builder
builderWkbGeom :: EndianType -> WkbGeometryType -> Builder
builderWkbGeom EndianType
endianType WkbGeometryType
wkbGeometryType =
  EndianType -> Word32 -> Builder
Endian.builderFourBytes EndianType
endianType (Word32 -> Builder) -> Word32 -> Builder
forall a b. (a -> b) -> a -> b
$ WkbGeometryType -> Word32
wkbGeometryTypeToInt WkbGeometryType
wkbGeometryType


-- Helpers

wkbGeometryTypeToInt :: Geometry.WkbGeometryType -> Word.Word32
wkbGeometryTypeToInt :: WkbGeometryType -> Word32
wkbGeometryTypeToInt (Geometry.WkbGeom GeometryType
geometryType CoordinateType
coordinateType) =
  CoordinateType -> Word32
coordinateTypeToInt CoordinateType
coordinateType Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. GeometryType -> Word32
geometryTypeToInt GeometryType
geometryType

rawtoWkbGeometryType :: Word.Word32 -> BinaryGet.Get Geometry.WkbGeometryType
rawtoWkbGeometryType :: Word32 -> Get WkbGeometryType
rawtoWkbGeometryType Word32
rawGeometryType = do
  let geomType :: Maybe GeometryType
geomType = Word32 -> Maybe GeometryType
intToGeometryType Word32
rawGeometryType
      coordType :: CoordinateType
coordType = Word32 -> CoordinateType
intToCoordinateType Word32
rawGeometryType
  case Maybe GeometryType
geomType of
    Just GeometryType
g -> WkbGeometryType -> Get WkbGeometryType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WkbGeometryType -> Get WkbGeometryType)
-> WkbGeometryType -> Get WkbGeometryType
forall a b. (a -> b) -> a -> b
$ GeometryType -> CoordinateType -> WkbGeometryType
Geometry.WkbGeom GeometryType
g CoordinateType
coordType
    Maybe GeometryType
_      -> String -> Get WkbGeometryType
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail (String -> Get WkbGeometryType) -> String -> Get WkbGeometryType
forall a b. (a -> b) -> a -> b
$ String
"Invalid EwkbGeometry: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
rawGeometryType


intToGeometryType :: Word.Word32 -> Maybe Geometry.GeometryType
intToGeometryType :: Word32 -> Maybe GeometryType
intToGeometryType Word32
int =
  case Word32
int Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
geometryMask of
    Word32
0 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.Geometry
    Word32
1 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.Point
    Word32
2 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.LineString
    Word32
3 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.Polygon
    Word32
4 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.MultiPoint
    Word32
5 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.MultiLineString
    Word32
6 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.MultiPolygon
    Word32
7 -> GeometryType -> Maybe GeometryType
forall a. a -> Maybe a
Just GeometryType
Geometry.GeometryCollection
    Word32
_ -> Maybe GeometryType
forall a. Maybe a
Nothing

geometryTypeToInt :: Geometry.GeometryType -> Word.Word32
geometryTypeToInt :: GeometryType -> Word32
geometryTypeToInt GeometryType
geometryType =
  case GeometryType
geometryType of
    GeometryType
Geometry.Geometry           -> Word32
0
    GeometryType
Geometry.Point              -> Word32
1
    GeometryType
Geometry.LineString         -> Word32
2
    GeometryType
Geometry.Polygon            -> Word32
3
    GeometryType
Geometry.MultiPoint         -> Word32
4
    GeometryType
Geometry.MultiLineString    -> Word32
5
    GeometryType
Geometry.MultiPolygon       -> Word32
6
    GeometryType
Geometry.GeometryCollection -> Word32
7

intToCoordinateType :: Word.Word32 -> Geometry.CoordinateType
intToCoordinateType :: Word32 -> CoordinateType
intToCoordinateType Word32
int =
  case (Word32 -> Bool
hasZ Word32
int, Word32 -> Bool
hasM Word32
int) of
    (Bool
False, Bool
False) -> CoordinateType
Geometry.TwoD
    (Bool
False, Bool
True)  -> CoordinateType
Geometry.M
    (Bool
True, Bool
False)  -> CoordinateType
Geometry.Z
    (Bool
True, Bool
True)   -> CoordinateType
Geometry.ZM

coordinateTypeToInt :: Geometry.CoordinateType -> Word.Word32
coordinateTypeToInt :: CoordinateType -> Word32
coordinateTypeToInt CoordinateType
coordinateType =
  case CoordinateType
coordinateType of
    CoordinateType
Geometry.TwoD -> Word32
0
    CoordinateType
Geometry.Z    -> Word32
zMask
    CoordinateType
Geometry.M    -> Word32
mMask
    CoordinateType
Geometry.ZM   -> Word32
zMask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mMask

hasZ :: Word.Word32 -> Bool
hasZ :: Word32 -> Bool
hasZ Word32
int =
  Word32
int Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
zMask Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0

hasM :: Word.Word32 -> Bool
hasM :: Word32 -> Bool
hasM Word32
int =
  Word32
int Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x40000000 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0


-- Constants

zMask :: Word.Word32
zMask :: Word32
zMask = Word32
0x80000000

mMask :: Word.Word32
mMask :: Word32
mMask = Word32
0x40000000

sridMask :: Word.Word32
sridMask :: Word32
sridMask = Word32
0x20000000

geometryMask :: Word.Word32
geometryMask :: Word32
geometryMask = Word32
0x0fffffff

supportedSrid :: Word.Word32
supportedSrid :: Word32
supportedSrid = Word32
4326