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
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)
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
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
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
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