{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module Database.Postgis.Trivial.Storable.Geometry where

import GHC.Base hiding ( foldr )
import Control.Monad ( mapM_ )
import Control.Exception ( throw )
import Control.Applicative ( (<$>) )
import qualified Data.Vector.Storable as VS

import Database.Postgis.Trivial.PGISConst
import Database.Postgis.Trivial.Types
import Database.Postgis.Trivial.Internal
import Database.Postgis.Trivial.Cast


-- | Translator of Unboxed vectors (direct)
transToS :: (Castable p, VS.Storable p, VS.Storable (Cast p)) =>
        VS.Vector p -> VS.Vector (Cast p)
transToS :: forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector p -> Vector (Cast p)
transToS = (p -> Cast p) -> Vector p -> Vector (Cast p)
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map p -> Cast p
forall p. Castable p => p -> Cast p
toPointND

-- | Translator of Unboxed vectors (reverse)
transFromS :: (Castable p, VS.Storable p, VS.Storable (Cast p)) =>
        VS.Vector (Cast p) -> VS.Vector p
transFromS :: forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector (Cast p) -> Vector p
transFromS = (Cast p -> p) -> Vector (Cast p) -> Vector p
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map Cast p -> p
forall p. Castable p => Cast p -> p
fromPointND

-- | Chain putter
putChainS :: (PointND a, VS.Storable a) => Putter (VS.Vector a)
putChainS :: forall a. (PointND a, Storable a) => Putter (Vector a)
putChainS Vector a
vs = do
        Putter Int
putChainLen Putter Int -> Putter Int
forall a b. (a -> b) -> a -> b
$ Vector a -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector a
vs
        (a -> Put) -> Vector a -> Put
forall (m :: * -> *) a b.
(Monad m, Storable a) =>
(a -> m b) -> Vector a -> m ()
VS.mapM_ a -> Put
forall a. PointND a => Putter a
putPointND Vector a
vs

-- | Chain getter
getChainS :: (PointND a, VS.Storable a) => HeaderGetter (VS.Vector a)
getChainS :: forall a. (PointND a, Storable a) => HeaderGetter (Vector a)
getChainS = HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> ReaderT Header Get (Vector a))
-> ReaderT Header Get (Vector a)
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> ReaderT Header Get a -> ReaderT Header Get (Vector a)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
`VS.replicateM` ReaderT Header Get a
forall a. PointND a => HeaderGetter a
getPointND)

-- | Point geometry
data Point p = Point SRID p

instance (Castable p, VS.Storable p) => Geometry (Point p) where
    putGeometry :: Putter (Point p)
putGeometry (Point SRID
srid p
v) = do
        SRID -> Word32 -> (Bool, Bool) -> Put
putHeader SRID
srid Word32
pgisPoint (forall a. PointND a => (Bool, Bool)
dimProps @(Cast p))
        Putter (Cast p)
forall a. PointND a => Putter a
putPointND (p -> Cast p
forall p. Castable p => p -> Cast p
toPointND p
v::Cast p)
    getGeometry :: Get (Point p)
getGeometry = do
        Header
h <- Get Header
getHeaderPre
        (Cast p
v::(Cast p), SRID
srid) <- if Header -> Word32
lookupType Header
hWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
pgisPoint
            then Header -> HeaderGetter (Cast p) -> Get (Cast p, SRID)
forall a. Header -> HeaderGetter a -> Get (a, SRID)
makeResult Header
h (HeaderGetter ()
skipHeader HeaderGetter () -> HeaderGetter (Cast p) -> HeaderGetter (Cast p)
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter (Cast p)
forall a. PointND a => HeaderGetter a
getPointND)
            else GeometryError -> Get (Cast p, SRID)
forall a e. Exception e => e -> a
throw (GeometryError -> Get (Cast p, SRID))
-> GeometryError -> Get (Cast p, SRID)
forall a b. (a -> b) -> a -> b
$
                String -> GeometryError
GeometryError String
"invalid data for point geometry"
        Point p -> Get (Point p)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRID -> p -> Point p
forall p. SRID -> p -> Point p
Point SRID
srid (Cast p -> p
forall p. Castable p => Cast p -> p
fromPointND Cast p
v::p))

-- | LineString geometry
data LineString p = LineString SRID (VS.Vector p)

instance (Castable p, VS.Storable p, VS.Storable (Cast p)) =>
        Geometry (LineString p) where
    putGeometry :: Putter (LineString p)
putGeometry (LineString SRID
srid Vector p
vs) = do
        SRID -> Word32 -> (Bool, Bool) -> Put
putHeader SRID
srid Word32
pgisLinestring (forall a. PointND a => (Bool, Bool)
dimProps @(Cast p))
        Putter (Vector (Cast p))
forall a. (PointND a, Storable a) => Putter (Vector a)
putChainS (Vector p -> Vector (Cast p)
forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector p -> Vector (Cast p)
transToS (Vector p
vs::VS.Vector p)::VS.Vector (Cast p))
    getGeometry :: Get (LineString p)
getGeometry = do
        Header
h <- Get Header
getHeaderPre
        (Vector (Cast p)
vs::VS.Vector (Cast p), SRID
srid) <-
            if Header -> Word32
lookupType Header
hWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
pgisLinestring
            then Header
-> HeaderGetter (Vector (Cast p)) -> Get (Vector (Cast p), SRID)
forall a. Header -> HeaderGetter a -> Get (a, SRID)
makeResult Header
h (HeaderGetter ()
skipHeader HeaderGetter ()
-> HeaderGetter (Vector (Cast p)) -> HeaderGetter (Vector (Cast p))
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter (Vector (Cast p))
forall a. (PointND a, Storable a) => HeaderGetter (Vector a)
getChainS)
            else GeometryError -> Get (Vector (Cast p), SRID)
forall a e. Exception e => e -> a
throw (GeometryError -> Get (Vector (Cast p), SRID))
-> GeometryError -> Get (Vector (Cast p), SRID)
forall a b. (a -> b) -> a -> b
$
                String -> GeometryError
GeometryError String
"invalid data for linestring geometry"
        LineString p -> Get (LineString p)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRID -> Vector p -> LineString p
forall p. SRID -> Vector p -> LineString p
LineString SRID
srid (Vector (Cast p) -> Vector p
forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector (Cast p) -> Vector p
transFromS Vector (Cast p)
vs::VS.Vector p))

-- | Polygon geometry
data Polygon t2 p = Polygon SRID (t2 (VS.Vector p))

instance (Castable p, VS.Storable p, VS.Storable (Cast p), GeoChain t2,
        Repl t2 (VS.Vector (Cast p))) => Geometry (Polygon t2 p) where
    putGeometry :: Putter (Polygon t2 p)
putGeometry (Polygon SRID
srid t2 (Vector p)
vss) = do
        SRID -> Word32 -> (Bool, Bool) -> Put
putHeader SRID
srid Word32
pgisPolygon (forall a. PointND a => (Bool, Bool)
dimProps @(Cast p))
        Putter Int
putChainLen Putter Int -> Putter Int
forall a b. (a -> b) -> a -> b
$ t2 (Vector p) -> Int
forall p. t2 p -> Int
forall (t :: * -> *) p. GeoChain t => t p -> Int
count t2 (Vector p)
vss
        (Vector p -> Put) -> t2 (Vector p) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vector p
vs -> Putter (Vector (Cast p))
forall a. (PointND a, Storable a) => Putter (Vector a)
putChainS (Vector p -> Vector (Cast p)
forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector p -> Vector (Cast p)
transToS Vector p
vs::VS.Vector (Cast p))) t2 (Vector p)
vss
    getGeometry :: Get (Polygon t2 p)
getGeometry = do
        Header
h <- Get Header
getHeaderPre
        (t2 (Vector (Cast p))
vss::t2 (VS.Vector (Cast p)), SRID
srid) <- if Header -> Word32
lookupType Header
hWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
pgisPolygon
            then Header
-> HeaderGetter (t2 (Vector (Cast p)))
-> Get (t2 (Vector (Cast p)), SRID)
forall a. Header -> HeaderGetter a -> Get (a, SRID)
makeResult Header
h (HeaderGetter ()
skipHeader HeaderGetter () -> HeaderGetter Int -> HeaderGetter Int
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> HeaderGetter (t2 (Vector (Cast p))))
-> HeaderGetter (t2 (Vector (Cast p)))
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int
-> HeaderGetter (Vector (Cast p))
-> HeaderGetter (t2 (Vector (Cast p)))
forall (t :: * -> *) b.
Repl t b =>
Int -> HeaderGetter b -> HeaderGetter (t b)
`repl` HeaderGetter (Vector (Cast p))
forall a. (PointND a, Storable a) => HeaderGetter (Vector a)
getChainS))
            else GeometryError -> Get (t2 (Vector (Cast p)), SRID)
forall a e. Exception e => e -> a
throw (GeometryError -> Get (t2 (Vector (Cast p)), SRID))
-> GeometryError -> Get (t2 (Vector (Cast p)), SRID)
forall a b. (a -> b) -> a -> b
$
                String -> GeometryError
GeometryError String
"invalid data for polygon geometry"
        Polygon t2 p -> Get (Polygon t2 p)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRID -> t2 (Vector p) -> Polygon t2 p
forall (t2 :: * -> *) p. SRID -> t2 (Vector p) -> Polygon t2 p
Polygon SRID
srid (Vector (Cast p) -> Vector p
forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector (Cast p) -> Vector p
transFromS (Vector (Cast p) -> Vector p)
-> t2 (Vector (Cast p)) -> t2 (Vector p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t2 (Vector (Cast p))
vss::t2 (VS.Vector p)))

-- | MultiPoint geometry
data MultiPoint p = MultiPoint SRID (VS.Vector p)

instance (Castable p, VS.Storable p, VS.Storable (Cast p)) =>
        Geometry (MultiPoint p) where
    putGeometry :: Putter (MultiPoint p)
putGeometry (MultiPoint SRID
srid Vector p
vs) = do
        SRID -> Word32 -> (Bool, Bool) -> Put
putHeader SRID
srid Word32
pgisMultiPoint (forall a. PointND a => (Bool, Bool)
dimProps @(Cast p))
        Putter Int
putChainLen Putter Int -> Putter Int
forall a b. (a -> b) -> a -> b
$ Vector p -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector p
vs
        (p -> Put) -> Vector p -> Put
forall (m :: * -> *) a b.
(Monad m, Storable a) =>
(a -> m b) -> Vector a -> m ()
VS.mapM_ (\p
v -> do
            Putter (Point p)
forall a. Geometry a => Putter a
putGeometry (SRID -> p -> Point p
forall p. SRID -> p -> Point p
Point SRID
srid p
v :: Point p)
            ) Vector p
vs
    getGeometry :: Get (MultiPoint p)
getGeometry = do
        Header
h <- Get Header
getHeaderPre
        (Vector (Cast p)
vs::t (Cast p), SRID
srid) <- if Header -> Word32
lookupType Header
hWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
pgisMultiPoint
            then Header
-> HeaderGetter (Vector (Cast p)) -> Get (Vector (Cast p), SRID)
forall a. Header -> HeaderGetter a -> Get (a, SRID)
makeResult Header
h (
                HeaderGetter ()
skipHeader HeaderGetter () -> HeaderGetter Int -> HeaderGetter Int
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> HeaderGetter (Vector (Cast p)))
-> HeaderGetter (Vector (Cast p))
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    (Int
-> ReaderT Header Get (Cast p) -> HeaderGetter (Vector (Cast p))
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
`VS.replicateM` (HeaderGetter ()
skipHeader HeaderGetter ()
-> ReaderT Header Get (Cast p) -> ReaderT Header Get (Cast p)
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT Header Get (Cast p)
forall a. PointND a => HeaderGetter a
getPointND))
                )
            else GeometryError -> Get (Vector (Cast p), SRID)
forall a e. Exception e => e -> a
throw (GeometryError -> Get (Vector (Cast p), SRID))
-> GeometryError -> Get (Vector (Cast p), SRID)
forall a b. (a -> b) -> a -> b
$
                String -> GeometryError
GeometryError String
"invalid data for multipoint geometry"
        MultiPoint p -> Get (MultiPoint p)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRID -> Vector p -> MultiPoint p
forall p. SRID -> Vector p -> MultiPoint p
MultiPoint SRID
srid (Vector (Cast p) -> Vector p
forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector (Cast p) -> Vector p
transFromS Vector (Cast p)
vs::VS.Vector p))

-- | MultiLineString geometry
data MultiLineString t2 p = MultiLineString SRID (t2 (VS.Vector p))

instance (Castable p, VS.Storable p, VS.Storable (Cast p), GeoChain t2,
        Repl t2 (VS.Vector (Cast p))) => Geometry (MultiLineString t2 p) where
    putGeometry :: Putter (MultiLineString t2 p)
putGeometry (MultiLineString SRID
srid t2 (Vector p)
vss) = do
        SRID -> Word32 -> (Bool, Bool) -> Put
putHeader SRID
srid Word32
pgisMultiLinestring (forall a. PointND a => (Bool, Bool)
dimProps @(Cast p))
        Putter Int
putChainLen Putter Int -> Putter Int
forall a b. (a -> b) -> a -> b
$ t2 (Vector p) -> Int
forall p. t2 p -> Int
forall (t :: * -> *) p. GeoChain t => t p -> Int
count t2 (Vector p)
vss
        (Vector p -> Put) -> t2 (Vector p) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vector p
vs -> do
            Putter (LineString p)
forall a. Geometry a => Putter a
putGeometry (SRID -> Vector p -> LineString p
forall p. SRID -> Vector p -> LineString p
LineString SRID
srid Vector p
vs :: LineString p)
            ) t2 (Vector p)
vss
    getGeometry :: Get (MultiLineString t2 p)
getGeometry = do
        Header
h <- Get Header
getHeaderPre
        (t2 (Vector (Cast p))
vss::t2 (t1 (Cast p)), SRID
srid) <- if Header -> Word32
lookupType Header
hWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
pgisMultiLinestring
            then Header
-> HeaderGetter (t2 (Vector (Cast p)))
-> Get (t2 (Vector (Cast p)), SRID)
forall a. Header -> HeaderGetter a -> Get (a, SRID)
makeResult Header
h (
                HeaderGetter ()
skipHeader HeaderGetter () -> HeaderGetter Int -> HeaderGetter Int
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> HeaderGetter (t2 (Vector (Cast p))))
-> HeaderGetter (t2 (Vector (Cast p)))
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int
-> HeaderGetter (Vector (Cast p))
-> HeaderGetter (t2 (Vector (Cast p)))
forall (t :: * -> *) b.
Repl t b =>
Int -> HeaderGetter b -> HeaderGetter (t b)
`repl` (HeaderGetter ()
skipHeader HeaderGetter ()
-> HeaderGetter (Vector (Cast p)) -> HeaderGetter (Vector (Cast p))
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter (Vector (Cast p))
forall a. (PointND a, Storable a) => HeaderGetter (Vector a)
getChainS))
                )
            else GeometryError -> Get (t2 (Vector (Cast p)), SRID)
forall a e. Exception e => e -> a
throw (GeometryError -> Get (t2 (Vector (Cast p)), SRID))
-> GeometryError -> Get (t2 (Vector (Cast p)), SRID)
forall a b. (a -> b) -> a -> b
$
                String -> GeometryError
GeometryError String
"invalid data for multilinestring geometry"
        MultiLineString t2 p -> Get (MultiLineString t2 p)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRID -> t2 (Vector p) -> MultiLineString t2 p
forall (t2 :: * -> *) p.
SRID -> t2 (Vector p) -> MultiLineString t2 p
MultiLineString SRID
srid (Vector (Cast p) -> Vector p
forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector (Cast p) -> Vector p
transFromS (Vector (Cast p) -> Vector p)
-> t2 (Vector (Cast p)) -> t2 (Vector p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t2 (Vector (Cast p))
vss::t2 (VS.Vector p)))

-- | MultiPolygon geometry
data MultiPolygon t3 t2 p = MultiPolygon SRID (t3 (t2 (VS.Vector p)))

instance (Castable p, VS.Storable p, VS.Storable (Cast p),
        Repl t3 (t2 (VS.Vector (Cast p))), Repl t2 (VS.Vector (Cast p)),
        GeoChain t2, GeoChain t3) => Geometry (MultiPolygon t3 t2 p) where
    putGeometry :: Putter (MultiPolygon t3 t2 p)
putGeometry (MultiPolygon SRID
srid t3 (t2 (Vector p))
vsss) = do
        SRID -> Word32 -> (Bool, Bool) -> Put
putHeader SRID
srid Word32
pgisMultiPolygon (forall a. PointND a => (Bool, Bool)
dimProps @(Cast p))
        Putter Int
putChainLen Putter Int -> Putter Int
forall a b. (a -> b) -> a -> b
$ t3 (t2 (Vector p)) -> Int
forall p. t3 p -> Int
forall (t :: * -> *) p. GeoChain t => t p -> Int
count t3 (t2 (Vector p))
vsss
        (t2 (Vector p) -> Put) -> t3 (t2 (Vector p)) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\t2 (Vector p)
vss -> do
            Putter (Polygon t2 p)
forall a. Geometry a => Putter a
putGeometry (SRID -> t2 (Vector p) -> Polygon t2 p
forall (t2 :: * -> *) p. SRID -> t2 (Vector p) -> Polygon t2 p
Polygon SRID
srid t2 (Vector p)
vss :: Polygon t2 p)
            ) t3 (t2 (Vector p))
vsss
    getGeometry :: Get (MultiPolygon t3 t2 p)
getGeometry = do
        Header
h <- Get Header
getHeaderPre
        (t3 (t2 (Vector (Cast p)))
vsss::t3 (t2 (VS.Vector (Cast p))), SRID
srid) <-
            if Header -> Word32
lookupType Header
hWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
pgisMultiPolygon
            then Header
-> HeaderGetter (t3 (t2 (Vector (Cast p))))
-> Get (t3 (t2 (Vector (Cast p))), SRID)
forall a. Header -> HeaderGetter a -> Get (a, SRID)
makeResult Header
h (do
                HeaderGetter ()
skipHeader HeaderGetter () -> HeaderGetter Int -> HeaderGetter Int
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> HeaderGetter (t3 (t2 (Vector (Cast p)))))
-> HeaderGetter (t3 (t2 (Vector (Cast p))))
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int
-> HeaderGetter (t2 (Vector (Cast p)))
-> HeaderGetter (t3 (t2 (Vector (Cast p))))
forall (t :: * -> *) b.
Repl t b =>
Int -> HeaderGetter b -> HeaderGetter (t b)
`repl` (HeaderGetter ()
skipHeader HeaderGetter () -> HeaderGetter Int -> HeaderGetter Int
forall a b.
ReaderT Header Get a
-> ReaderT Header Get b -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HeaderGetter Int
getChainLen
                    HeaderGetter Int
-> (Int -> HeaderGetter (t2 (Vector (Cast p))))
-> HeaderGetter (t2 (Vector (Cast p)))
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int
-> HeaderGetter (Vector (Cast p))
-> HeaderGetter (t2 (Vector (Cast p)))
forall (t :: * -> *) b.
Repl t b =>
Int -> HeaderGetter b -> HeaderGetter (t b)
`repl` HeaderGetter (Vector (Cast p))
forall a. (PointND a, Storable a) => HeaderGetter (Vector a)
getChainS)))
                )
            else GeometryError -> Get (t3 (t2 (Vector (Cast p))), SRID)
forall a e. Exception e => e -> a
throw (GeometryError -> Get (t3 (t2 (Vector (Cast p))), SRID))
-> GeometryError -> Get (t3 (t2 (Vector (Cast p))), SRID)
forall a b. (a -> b) -> a -> b
$
                String -> GeometryError
GeometryError String
"invalid data for multipolygon geometry"
        MultiPolygon t3 t2 p -> Get (MultiPolygon t3 t2 p)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRID -> t3 (t2 (Vector p)) -> MultiPolygon t3 t2 p
forall (t3 :: * -> *) (t2 :: * -> *) p.
SRID -> t3 (t2 (Vector p)) -> MultiPolygon t3 t2 p
MultiPolygon SRID
srid ((Vector (Cast p) -> Vector p
forall p.
(Castable p, Storable p, Storable (Cast p)) =>
Vector (Cast p) -> Vector p
transFromS (Vector (Cast p) -> Vector p)
-> t2 (Vector (Cast p)) -> t2 (Vector p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (t2 (Vector (Cast p)) -> t2 (Vector p))
-> t3 (t2 (Vector (Cast p))) -> t3 (t2 (Vector p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            t3 (t2 (Vector (Cast p)))
vsss::t3 (t2 (VS.Vector p))))

-- | Point putter
putPoint :: Castable p => SRID -> p -> Geo (Point p)
putPoint :: forall p. Castable p => SRID -> p -> Geo (Point p)
putPoint SRID
srid p
p = Point p -> Geo (Point p)
forall g. g -> Geo g
Geo (SRID -> p -> Point p
forall p. SRID -> p -> Point p
Point SRID
srid p
p)

-- | Point getter
getPoint :: Geo (Point p) -> (SRID, p)
getPoint :: forall p. Geo (Point p) -> (SRID, p)
getPoint (Geo (Point SRID
srid p
p)) = (SRID
srid, p
p)

-- | Linestring putter
putLS :: SRID -> VS.Vector p -> Geo (LineString p)
putLS :: forall p. SRID -> Vector p -> Geo (LineString p)
putLS SRID
srid Vector p
ps = LineString p -> Geo (LineString p)
forall g. g -> Geo g
Geo (SRID -> Vector p -> LineString p
forall p. SRID -> Vector p -> LineString p
LineString SRID
srid Vector p
ps)

-- | LineString getter
getLS :: Geo (LineString p) -> (SRID, VS.Vector p)
getLS :: forall p. Geo (LineString p) -> (SRID, Vector p)
getLS (Geo (LineString SRID
srid Vector p
vs)) = (SRID
srid, Vector p
vs)

-- | Polygon putter
putPoly :: SRID -> t2 (VS.Vector p) -> Geo (Polygon t2 p)
putPoly :: forall (t2 :: * -> *) p.
SRID -> t2 (Vector p) -> Geo (Polygon t2 p)
putPoly SRID
srid t2 (Vector p)
pss = Polygon t2 p -> Geo (Polygon t2 p)
forall g. g -> Geo g
Geo (SRID -> t2 (Vector p) -> Polygon t2 p
forall (t2 :: * -> *) p. SRID -> t2 (Vector p) -> Polygon t2 p
Polygon SRID
srid t2 (Vector p)
pss)

-- | Polygon getter
getPoly :: Geo (Polygon t2 p) -> (SRID, t2 (VS.Vector p))
getPoly :: forall (t2 :: * -> *) p.
Geo (Polygon t2 p) -> (SRID, t2 (Vector p))
getPoly (Geo (Polygon SRID
srid t2 (Vector p)
vss)) = (SRID
srid, t2 (Vector p)
vss)

-- | MultiPoint putter
putMPoint :: SRID -> VS.Vector p -> Geo (MultiPoint p)
putMPoint :: forall p. SRID -> Vector p -> Geo (MultiPoint p)
putMPoint SRID
srid Vector p
ps = MultiPoint p -> Geo (MultiPoint p)
forall g. g -> Geo g
Geo (SRID -> Vector p -> MultiPoint p
forall p. SRID -> Vector p -> MultiPoint p
MultiPoint SRID
srid Vector p
ps)

-- | MultiPoint getter
getMPoint :: Geo (MultiPoint p) -> (SRID, VS.Vector p)
getMPoint :: forall p. Geo (MultiPoint p) -> (SRID, Vector p)
getMPoint (Geo (MultiPoint SRID
srid Vector p
vs)) = (SRID
srid, Vector p
vs)

-- | MultiLineString putter
putMLS :: SRID -> t2 (VS.Vector p) -> Geo (MultiLineString t2 p)
putMLS :: forall (t2 :: * -> *) p.
SRID -> t2 (Vector p) -> Geo (MultiLineString t2 p)
putMLS SRID
srid t2 (Vector p)
pss = MultiLineString t2 p -> Geo (MultiLineString t2 p)
forall g. g -> Geo g
Geo (SRID -> t2 (Vector p) -> MultiLineString t2 p
forall (t2 :: * -> *) p.
SRID -> t2 (Vector p) -> MultiLineString t2 p
MultiLineString SRID
srid t2 (Vector p)
pss)

-- | MultiLineString getter
getMLS :: Geo (MultiLineString t2 p) -> (SRID, t2 (VS.Vector p))
getMLS :: forall (t2 :: * -> *) p.
Geo (MultiLineString t2 p) -> (SRID, t2 (Vector p))
getMLS (Geo (MultiLineString SRID
srid t2 (Vector p)
vs)) = (SRID
srid, t2 (Vector p)
vs)

-- | MultiPolygon putter
putMPoly :: SRID -> t3 (t2 (VS.Vector p)) -> Geo (MultiPolygon t3 t2 p)
putMPoly :: forall (t3 :: * -> *) (t2 :: * -> *) p.
SRID -> t3 (t2 (Vector p)) -> Geo (MultiPolygon t3 t2 p)
putMPoly SRID
srid t3 (t2 (Vector p))
psss = MultiPolygon t3 t2 p -> Geo (MultiPolygon t3 t2 p)
forall g. g -> Geo g
Geo (SRID -> t3 (t2 (Vector p)) -> MultiPolygon t3 t2 p
forall (t3 :: * -> *) (t2 :: * -> *) p.
SRID -> t3 (t2 (Vector p)) -> MultiPolygon t3 t2 p
MultiPolygon SRID
srid t3 (t2 (Vector p))
psss)

-- | MultiPolygon getter
getMPoly :: Geo (MultiPolygon t3 t2 p) -> (SRID, t3 (t2 (VS.Vector p)))
getMPoly :: forall (t3 :: * -> *) (t2 :: * -> *) p.
Geo (MultiPolygon t3 t2 p) -> (SRID, t3 (t2 (Vector p)))
getMPoly (Geo (MultiPolygon SRID
srid t3 (t2 (Vector p))
vs)) = (SRID
srid, t3 (t2 (Vector p))
vs)