{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Haskell bindings for postgres postgis
--   for a good explenation see <https://postgis.net/>
--
--   Make sure to use the correct 'SpatialType'.
--   Earth spanning applications should use Geography,
--   local applications should use 'Geometry' because it's more convenient.
--   You don't have to use Geography if you're only interested in
--   topological functions such as 'st_intersects' and 'st_union',
--   these are indifferent to space distortions,
--   see <https://jappie.me/announcement-esqueleto-postgis-v4.html>
--
--   if you can't use a function for example when you're using 'Geography'.
--   there is the option to 'st_transform_geography'.
module Database.Esqueleto.Postgis
  (
    Postgis(..),
    SpatialType(..),
    getPoints,

    -- * Spatial relationships
    module Database.Esqueleto.Postgis.Spatial,

    -- * Measurement functions
    module Database.Esqueleto.Postgis.Measurement,

    -- * Geometry accessors
    module Database.Esqueleto.Postgis.Accessor,

    -- * Geometry constructors
    st_collect,
    st_makeenvelope,
    st_makeline,
    st_makepolygon_line,

    -- * Geometry editors
    module Database.Esqueleto.Postgis.Editor,

    -- * Geometry validation
    st_makevalid,
    st_isvalidreason,

    -- * SRS functions
    st_setsrid,

    -- * Geometry output
    st_astext,
    st_asgeojson,
    st_asewkt,
    st_geohash,

    -- * Geometry processing
    module Database.Esqueleto.Postgis.Processing,

    -- * Affine transformations
    st_translate,
    st_scale,
    st_rotate,
    st_rotatex,
    st_rotatez,

    -- * Bounding box
    st_expand,

    -- * Linear referencing
    st_lineinterpolatepoint,
    st_linelocatepoint,
    st_linesubstring,

    -- * Points
    point,
    point_v,
    st_point,
    st_point_xyz,
    st_point_xyzm,

    -- * Transform
    st_transform_geography,
    st_transform_geometry,
    -- ** SRID
    SRID,
    wgs84,
    mercator,
    britishNationalGrid,
    SridUnit(..),

    -- * Other
    makePolygon,
    PostgisGeometry,
    HasPgType,

    -- * Re-exports
    PointXY(..),
    PointXYZ(..),
    PointXYZM(..),
  )
where

import Database.Esqueleto.Postgis.Geometry (Postgis(..), SpatialType(..), HasPgType(..), PostgisGeometry)
import Database.Esqueleto.Postgis.Spatial
import Database.Esqueleto.Postgis.Measurement
import Database.Esqueleto.Postgis.Accessor
import Database.Esqueleto.Postgis.Editor
import Database.Esqueleto.Postgis.Processing

import Database.Esqueleto.Experimental(val)
import Data.Proxy
import Data.Bifunctor (first)
import Database.Esqueleto.Postgis.Ewkb (parseHexByteString)
import Data.Foldable (Foldable (toList), fold)
import Data.Geospatial (GeoPoint (..), GeoPositionWithoutCRS (..), GeospatialGeometry, PointXY (..), PointXYZ (..), PointXYZM (..))
import Data.Geospatial qualified as Geospatial
import Data.LineString (LineString, fromLineString, lineStringHead)
import Data.LinearRing (LinearRing, fromLinearRing, makeLinearRing, ringHead, toSeq)
import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
import Data.List.NonEmpty qualified as Non
import Data.Semigroup qualified as S
import Data.Sequence (Seq (..), (|>))
import Data.Sequence qualified as Seq
import Data.String (IsString (..))
import Data.Text (Text, pack)
import Data.Text.Encoding(encodeUtf8)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder qualified as Text
import Database.Esqueleto.Experimental (SqlExpr, Value)
import Database.Esqueleto.Internal.Internal (unsafeSqlFunction, unsafeSqlCastAs )
import Database.Persist.Sql
import Data.Base16.Types(assertBase16)
import Data.ByteString(fromStrict)

-- | unwrap postgis geometry so you can for example return it from an API
getPoints :: PostgisGeometry point -> NonEmpty point
getPoints :: forall point. PostgisGeometry point -> NonEmpty point
getPoints PostgisGeometry point
geom = case PostgisGeometry point
geom of
  Point point
p -> point
p point -> [point] -> NonEmpty point
forall a. a -> [a] -> NonEmpty a
:| []
  MultiPoint NonEmpty point
pts -> NonEmpty point
pts
  Line LineString point
ls -> LineString point -> NonEmpty point
forall a. LineString a -> NonEmpty a
linestringNonEmpty LineString point
ls
  Multiline NonEmpty (LineString point)
lss -> NonEmpty (NonEmpty point) -> NonEmpty point
forall a. Semigroup a => NonEmpty a -> a
S.sconcat ((LineString point -> NonEmpty point)
-> NonEmpty (LineString point) -> NonEmpty (NonEmpty point)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LineString point -> NonEmpty point
forall a. LineString a -> NonEmpty a
linestringNonEmpty NonEmpty (LineString point)
lss)
  Polygon LinearRing point
ring -> LinearRing point -> NonEmpty point
forall a. LinearRing a -> NonEmpty a
linearRingNonEmpty LinearRing point
ring
  MultiPolygon NonEmpty (LinearRing point)
rings -> NonEmpty (NonEmpty point) -> NonEmpty point
forall a. Semigroup a => NonEmpty a -> a
S.sconcat ((LinearRing point -> NonEmpty point)
-> NonEmpty (LinearRing point) -> NonEmpty (NonEmpty point)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LinearRing point -> NonEmpty point
forall a. LinearRing a -> NonEmpty a
linearRingNonEmpty NonEmpty (LinearRing point)
rings)
  Collection NonEmpty (PostgisGeometry point)
geoms -> NonEmpty (NonEmpty point) -> NonEmpty point
forall a. Semigroup a => NonEmpty a -> a
S.sconcat ((PostgisGeometry point -> NonEmpty point)
-> NonEmpty (PostgisGeometry point) -> NonEmpty (NonEmpty point)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PostgisGeometry point -> NonEmpty point
forall point. PostgisGeometry point -> NonEmpty point
getPoints NonEmpty (PostgisGeometry point)
geoms)

linestringNonEmpty :: LineString a -> NonEmpty a
linestringNonEmpty :: forall a. LineString a -> NonEmpty a
linestringNonEmpty LineString a
ls = LineString a -> a
forall a. LineString a -> a
lineStringHead LineString a
ls a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 (LineString a -> [a]
forall a. LineString a -> [a]
fromLineString LineString a
ls)

linearRingNonEmpty :: LinearRing a -> NonEmpty a
linearRingNonEmpty :: forall a. LinearRing a -> NonEmpty a
linearRingNonEmpty LinearRing a
ls = LinearRing a -> a
forall a. LinearRing a -> a
ringHead LinearRing a
ls a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 (LinearRing a -> [a]
forall a. LinearRing a -> [a]
fromLinearRing LinearRing a
ls)

tshow :: (Show a) => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

data GeomErrors
  = MismatchingDimensionsXYZ PointXYZ
  | MismatchingDimensionsXYZM PointXYZM
  | MismatchingDimensionsXY PointXY
  | NoGeometry
  | EmptyPoint
  | NotImplemented
  | EmptyMultiline
  | EmptyMultiPoint
  | NotEnoughElements
  | EmptyMultipolygon
  | EmptyCollection
  deriving (Int -> GeomErrors -> ShowS
[GeomErrors] -> ShowS
GeomErrors -> String
(Int -> GeomErrors -> ShowS)
-> (GeomErrors -> String)
-> ([GeomErrors] -> ShowS)
-> Show GeomErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeomErrors -> ShowS
showsPrec :: Int -> GeomErrors -> ShowS
$cshow :: GeomErrors -> String
show :: GeomErrors -> String
$cshowList :: [GeomErrors] -> ShowS
showList :: [GeomErrors] -> ShowS
Show)

-- | checks if the first point is the last, and if not so makes it so.
--   this is required for inserting into the database
makePolygon :: (Eq point, Show point) => point -> point -> point -> Seq point -> LinearRing point
makePolygon :: forall point.
(Eq point, Show point) =>
point -> point -> point -> Seq point -> LinearRing point
makePolygon point
one point
two point
three Seq point
other =
  if point -> Maybe point
forall a. a -> Maybe a
Just point
one Maybe point -> Maybe point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe point
last'
    then point -> point -> point -> Seq point -> LinearRing point
forall point.
(Eq point, Show point) =>
point -> point -> point -> Seq point -> LinearRing point
makeLinearRing point
one point
two point
three Seq point
other
    else point -> point -> point -> Seq point -> LinearRing point
forall point.
(Eq point, Show point) =>
point -> point -> point -> Seq point -> LinearRing point
makeLinearRing point
one point
two point
three (Seq point
other Seq point -> point -> Seq point
forall a. Seq a -> a -> Seq a
|> point
one)
  where
    last' :: Maybe point
last' = Int -> Seq point -> Maybe point
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq point -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq point
other) Seq point
other

from2dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXY
from2dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXY
from2dGeoPositionWithoutCRSToPoint = \case
  GeoPositionWithoutCRS
GeoEmpty -> GeomErrors -> Either GeomErrors PointXY
forall a b. a -> Either a b
Left GeomErrors
EmptyPoint
  GeoPointXY PointXY
x -> PointXY -> Either GeomErrors PointXY
forall a b. b -> Either a b
Right PointXY
x
  GeoPointXYZ PointXYZ
x -> GeomErrors -> Either GeomErrors PointXY
forall a b. a -> Either a b
Left (PointXYZ -> GeomErrors
MismatchingDimensionsXYZ PointXYZ
x)
  GeoPointXYZM PointXYZM
x -> GeomErrors -> Either GeomErrors PointXY
forall a b. a -> Either a b
Left (PointXYZM -> GeomErrors
MismatchingDimensionsXYZM PointXYZM
x)

from3dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXYZ
from3dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXYZ
from3dGeoPositionWithoutCRSToPoint = \case
  GeoPositionWithoutCRS
GeoEmpty -> GeomErrors -> Either GeomErrors PointXYZ
forall a b. a -> Either a b
Left GeomErrors
EmptyPoint
  GeoPointXY PointXY
x -> GeomErrors -> Either GeomErrors PointXYZ
forall a b. a -> Either a b
Left (PointXY -> GeomErrors
MismatchingDimensionsXY PointXY
x)
  GeoPointXYZ PointXYZ
x -> PointXYZ -> Either GeomErrors PointXYZ
forall a b. b -> Either a b
Right PointXYZ
x
  GeoPointXYZM PointXYZM
x -> GeomErrors -> Either GeomErrors PointXYZ
forall a b. a -> Either a b
Left (PointXYZM -> GeomErrors
MismatchingDimensionsXYZM PointXYZM
x)

from4dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXYZM
from4dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXYZM
from4dGeoPositionWithoutCRSToPoint = \case
  GeoPositionWithoutCRS
GeoEmpty -> GeomErrors -> Either GeomErrors PointXYZM
forall a b. a -> Either a b
Left GeomErrors
EmptyPoint
  GeoPointXY PointXY
x -> GeomErrors -> Either GeomErrors PointXYZM
forall a b. a -> Either a b
Left (PointXY -> GeomErrors
MismatchingDimensionsXY PointXY
x)
  GeoPointXYZ PointXYZ
x -> GeomErrors -> Either GeomErrors PointXYZM
forall a b. a -> Either a b
Left (PointXYZ -> GeomErrors
MismatchingDimensionsXYZ PointXYZ
x)
  GeoPointXYZM PointXYZM
x -> PointXYZM -> Either GeomErrors PointXYZM
forall a b. b -> Either a b
Right PointXYZM
x

renderPair :: PointXY -> Text.Builder
renderPair :: PointXY -> Builder
renderPair (PointXY {Double
_xyX :: Double
_xyY :: Double
_xyY :: PointXY -> Double
_xyX :: PointXY -> Double
..}) = String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyX) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyY)

renderXYZ :: PointXYZ -> Text.Builder
renderXYZ :: PointXYZ -> Builder
renderXYZ (PointXYZ {Double
_xyzX :: Double
_xyzY :: Double
_xyzZ :: Double
_xyzZ :: PointXYZ -> Double
_xyzY :: PointXYZ -> Double
_xyzX :: PointXYZ -> Double
..}) = String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyzX) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyzY) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyzZ)

renderXYZM :: PointXYZM -> Text.Builder
renderXYZM :: PointXYZM -> Builder
renderXYZM (PointXYZM {Double
_xyzmX :: Double
_xyzmY :: Double
_xyzmZ :: Double
_xyzmM :: Double
_xyzmM :: PointXYZM -> Double
_xyzmZ :: PointXYZM -> Double
_xyzmY :: PointXYZM -> Double
_xyzmX :: PointXYZM -> Double
..}) = String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyzmX) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyzmY) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyzmZ) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString (Double -> String
forall a. Show a => a -> String
show Double
_xyzmM)

renderGeometry :: forall (spatialType :: SpatialType) . HasPgType spatialType => Postgis spatialType Text.Builder -> Text.Builder
renderGeometry :: forall (spatialType :: SpatialType).
HasPgType spatialType =>
Postgis spatialType Builder -> Builder
renderGeometry Postgis spatialType Builder
geom =
  let result :: Builder
result = Postgis spatialType Builder -> Builder
forall (spatialType :: SpatialType).
Postgis spatialType Builder -> Builder
renderGeometryUntyped Postgis spatialType Builder
geom
  -- wrap it in quotes and cast it to whatever type we decided it should be
  in Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
result Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"' :: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
Text.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Proxy spatialType -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy spatialType -> Text
pgType (Proxy spatialType -> Text) -> Proxy spatialType -> Text
forall a b. (a -> b) -> a -> b
$ (forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @spatialType) )

-- can't add quotes and types in the recursion because it's already part of the string
renderGeometryUntyped :: Postgis spatialType Text.Builder -> Text.Builder
renderGeometryUntyped :: forall (spatialType :: SpatialType).
Postgis spatialType Builder -> Builder
renderGeometryUntyped = \case
  Point Builder
point' -> Builder
"POINT(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
point' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
  MultiPoint NonEmpty Builder
points -> Builder
"MULTIPOINT (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Builder -> Builder
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
Non.intersperse Builder
"," ((\Builder
x -> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")") (Builder -> Builder) -> NonEmpty Builder -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Builder
points)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
  Line LineString Builder
line -> Builder
"LINESTRING(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LineString Builder -> Builder
forall (f :: * -> *). Foldable f => f Builder -> Builder
renderLines LineString Builder
line Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
  Multiline NonEmpty (LineString Builder)
multiline -> Builder
"MULTILINESTRING(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Builder -> Builder
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
Non.intersperse Builder
"," ((\LineString Builder
line -> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LineString Builder -> Builder
forall (f :: * -> *). Foldable f => f Builder -> Builder
renderLines LineString Builder
line Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")") (LineString Builder -> Builder)
-> NonEmpty (LineString Builder) -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LineString Builder)
multiline)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
  Polygon LinearRing Builder
polygon -> Builder
"POLYGON((" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LinearRing Builder -> Builder
forall (f :: * -> *). Foldable f => f Builder -> Builder
renderLines LinearRing Builder
polygon Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"))"
  MultiPolygon NonEmpty (LinearRing Builder)
multipolygon -> Builder
"MULTIPOLYGON(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Builder -> Builder
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
Non.intersperse Builder
"," ((\LinearRing Builder
line -> Builder
"((" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LinearRing Builder -> Builder
forall (f :: * -> *). Foldable f => f Builder -> Builder
renderLines LinearRing Builder
line Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"))") (LinearRing Builder -> Builder)
-> NonEmpty (LinearRing Builder) -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LinearRing Builder)
multipolygon)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
  Collection NonEmpty (PostgisGeometry Builder)
collection -> Builder
"GEOMETRYCOLLECTION(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Builder -> Builder
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
Non.intersperse Builder
"," (PostgisGeometry Builder -> Builder
forall (spatialType :: SpatialType).
Postgis spatialType Builder -> Builder
renderGeometryUntyped (PostgisGeometry Builder -> Builder)
-> NonEmpty (PostgisGeometry Builder) -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (PostgisGeometry Builder)
collection)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"



renderLines :: (Foldable f) => f Text.Builder -> Text.Builder
renderLines :: forall (f :: * -> *). Foldable f => f Builder -> Builder
renderLines f Builder
line = [Builder] -> Builder
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse Builder
"," ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ f Builder -> [Builder]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Builder
line)

from2dGeospatialGeometry :: (Eq a, Show a) => (GeoPositionWithoutCRS -> Either GeomErrors a) -> GeospatialGeometry -> Either GeomErrors (Postgis spatialType a)
from2dGeospatialGeometry :: forall a (spatialType :: SpatialType).
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (Postgis spatialType a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors a
interpreter = \case
  GeospatialGeometry
Geospatial.NoGeometry -> GeomErrors -> Either GeomErrors (Postgis spatialType a)
forall a b. a -> Either a b
Left GeomErrors
NoGeometry
  Geospatial.Point (GeoPoint GeoPositionWithoutCRS
point') -> (a -> Postgis spatialType a
forall (spatialType :: SpatialType) point.
point -> Postgis spatialType point
Point (a -> Postgis spatialType a)
-> Either GeomErrors a -> Either GeomErrors (Postgis spatialType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GeoPositionWithoutCRS -> Either GeomErrors a
interpreter GeoPositionWithoutCRS
point')
  Geospatial.MultiPoint (Geospatial.GeoMultiPoint Seq GeoPositionWithoutCRS
points) -> do
    [a]
list' <- [Either GeomErrors a] -> Either GeomErrors [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either GeomErrors a] -> Either GeomErrors [a])
-> [Either GeomErrors a] -> Either GeomErrors [a]
forall a b. (a -> b) -> a -> b
$ Seq (Either GeomErrors a) -> [Either GeomErrors a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (GeoPositionWithoutCRS -> Either GeomErrors a
interpreter (GeoPositionWithoutCRS -> Either GeomErrors a)
-> Seq GeoPositionWithoutCRS -> Seq (Either GeomErrors a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq GeoPositionWithoutCRS
points)
    case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [a]
list' of
      Maybe (NonEmpty a)
Nothing -> GeomErrors -> Either GeomErrors (Postgis spatialType a)
forall a b. a -> Either a b
Left GeomErrors
EmptyMultiPoint
      Just NonEmpty a
x -> Postgis spatialType a -> Either GeomErrors (Postgis spatialType a)
forall a b. b -> Either a b
Right (Postgis spatialType a
 -> Either GeomErrors (Postgis spatialType a))
-> Postgis spatialType a
-> Either GeomErrors (Postgis spatialType a)
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> Postgis spatialType a
forall (spatialType :: SpatialType) point.
NonEmpty point -> Postgis spatialType point
MultiPoint NonEmpty a
x
  Geospatial.Line (Geospatial.GeoLine LineString GeoPositionWithoutCRS
linestring) -> LineString a -> Postgis spatialType a
forall (spatialType :: SpatialType) point.
LineString point -> Postgis spatialType point
Line (LineString a -> Postgis spatialType a)
-> Either GeomErrors (LineString a)
-> Either GeomErrors (Postgis spatialType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GeoPositionWithoutCRS -> Either GeomErrors a)
-> LineString GeoPositionWithoutCRS
-> Either GeomErrors (LineString a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LineString a -> f (LineString b)
traverse GeoPositionWithoutCRS -> Either GeomErrors a
interpreter LineString GeoPositionWithoutCRS
linestring
  Geospatial.MultiLine (Geospatial.GeoMultiLine Seq (LineString GeoPositionWithoutCRS)
multiline) -> do
    Seq (LineString a)
seqRes <- (LineString GeoPositionWithoutCRS
 -> Either GeomErrors (LineString a))
-> Seq (LineString GeoPositionWithoutCRS)
-> Either GeomErrors (Seq (LineString a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse ((GeoPositionWithoutCRS -> Either GeomErrors a)
-> LineString GeoPositionWithoutCRS
-> Either GeomErrors (LineString a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LineString a -> f (LineString b)
traverse GeoPositionWithoutCRS -> Either GeomErrors a
interpreter) Seq (LineString GeoPositionWithoutCRS)
multiline
    case [LineString a] -> Maybe (NonEmpty (LineString a))
forall a. [a] -> Maybe (NonEmpty a)
Non.nonEmpty (Seq (LineString a) -> [LineString a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (LineString a)
seqRes) of
      Just NonEmpty (LineString a)
nonEmpty' -> Postgis spatialType a -> Either GeomErrors (Postgis spatialType a)
forall a b. b -> Either a b
Right (Postgis spatialType a
 -> Either GeomErrors (Postgis spatialType a))
-> Postgis spatialType a
-> Either GeomErrors (Postgis spatialType a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (LineString a) -> Postgis spatialType a
forall (spatialType :: SpatialType) point.
NonEmpty (LineString point) -> Postgis spatialType point
Multiline NonEmpty (LineString a)
nonEmpty'
      Maybe (NonEmpty (LineString a))
Nothing -> GeomErrors -> Either GeomErrors (Postgis spatialType a)
forall a b. a -> Either a b
Left GeomErrors
EmptyMultiline
  Geospatial.Polygon (Geospatial.GeoPolygon Seq (LinearRing GeoPositionWithoutCRS)
polygon) -> LinearRing a -> Postgis spatialType a
forall (spatialType :: SpatialType) point.
LinearRing point -> Postgis spatialType point
Polygon (LinearRing a -> Postgis spatialType a)
-> Either GeomErrors (LinearRing a)
-> Either GeomErrors (Postgis spatialType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GeoPositionWithoutCRS -> Either GeomErrors a)
-> Seq (LinearRing GeoPositionWithoutCRS)
-> Either GeomErrors (LinearRing a)
forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> Seq (LinearRing GeoPositionWithoutCRS)
-> Either GeomErrors (LinearRing a)
toLinearRing GeoPositionWithoutCRS -> Either GeomErrors a
interpreter) Seq (LinearRing GeoPositionWithoutCRS)
polygon
  Geospatial.MultiPolygon (Geospatial.GeoMultiPolygon Seq (Seq (LinearRing GeoPositionWithoutCRS))
multipolygon) -> do
    Seq (LinearRing a)
seqRings <- (Seq (LinearRing GeoPositionWithoutCRS)
 -> Either GeomErrors (LinearRing a))
-> Seq (Seq (LinearRing GeoPositionWithoutCRS))
-> Either GeomErrors (Seq (LinearRing a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse ((GeoPositionWithoutCRS -> Either GeomErrors a)
-> Seq (LinearRing GeoPositionWithoutCRS)
-> Either GeomErrors (LinearRing a)
forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> Seq (LinearRing GeoPositionWithoutCRS)
-> Either GeomErrors (LinearRing a)
toLinearRing GeoPositionWithoutCRS -> Either GeomErrors a
interpreter) Seq (Seq (LinearRing GeoPositionWithoutCRS))
multipolygon
    case [LinearRing a] -> Maybe (NonEmpty (LinearRing a))
forall a. [a] -> Maybe (NonEmpty a)
Non.nonEmpty (Seq (LinearRing a) -> [LinearRing a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (LinearRing a)
seqRings) of
      Just NonEmpty (LinearRing a)
nonEmpty' -> Postgis spatialType a -> Either GeomErrors (Postgis spatialType a)
forall a b. b -> Either a b
Right (Postgis spatialType a
 -> Either GeomErrors (Postgis spatialType a))
-> Postgis spatialType a
-> Either GeomErrors (Postgis spatialType a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (LinearRing a) -> Postgis spatialType a
forall (spatialType :: SpatialType) point.
NonEmpty (LinearRing point) -> Postgis spatialType point
MultiPolygon NonEmpty (LinearRing a)
nonEmpty'
      Maybe (NonEmpty (LinearRing a))
Nothing -> GeomErrors -> Either GeomErrors (Postgis spatialType a)
forall a b. a -> Either a b
Left GeomErrors
EmptyMultipolygon
  Geospatial.Collection Seq GeospatialGeometry
seq' -> do
    Seq (Postgis 'Geometry a)
seqs <- (GeospatialGeometry -> Either GeomErrors (Postgis 'Geometry a))
-> Seq GeospatialGeometry
-> Either GeomErrors (Seq (Postgis 'Geometry a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse ((GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (Postgis 'Geometry a)
forall a (spatialType :: SpatialType).
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (Postgis spatialType a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors a
interpreter) Seq GeospatialGeometry
seq'
    case [Postgis 'Geometry a] -> Maybe (NonEmpty (Postgis 'Geometry a))
forall a. [a] -> Maybe (NonEmpty a)
Non.nonEmpty (Seq (Postgis 'Geometry a) -> [Postgis 'Geometry a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Postgis 'Geometry a)
seqs) of
      Just NonEmpty (Postgis 'Geometry a)
nonEmpty' -> Postgis spatialType a -> Either GeomErrors (Postgis spatialType a)
forall a b. b -> Either a b
Right (Postgis spatialType a
 -> Either GeomErrors (Postgis spatialType a))
-> Postgis spatialType a
-> Either GeomErrors (Postgis spatialType a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Postgis 'Geometry a) -> Postgis spatialType a
forall (spatialType :: SpatialType) point.
NonEmpty (PostgisGeometry point) -> Postgis spatialType point
Collection NonEmpty (Postgis 'Geometry a)
nonEmpty'
      Maybe (NonEmpty (Postgis 'Geometry a))
Nothing -> GeomErrors -> Either GeomErrors (Postgis spatialType a)
forall a b. a -> Either a b
Left GeomErrors
EmptyCollection

toLinearRing :: (Eq a, Show a) => (GeoPositionWithoutCRS -> Either GeomErrors a) -> Seq (LinearRing GeoPositionWithoutCRS) -> Either GeomErrors (LinearRing a)
toLinearRing :: forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> Seq (LinearRing GeoPositionWithoutCRS)
-> Either GeomErrors (LinearRing a)
toLinearRing GeoPositionWithoutCRS -> Either GeomErrors a
interpreter Seq (LinearRing GeoPositionWithoutCRS)
polygon = do
  Seq a
aSeq <- (GeoPositionWithoutCRS -> Either GeomErrors a)
-> Seq GeoPositionWithoutCRS -> Either GeomErrors (Seq a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse GeoPositionWithoutCRS -> Either GeomErrors a
interpreter ((LinearRing GeoPositionWithoutCRS -> Seq GeoPositionWithoutCRS)
-> Seq (LinearRing GeoPositionWithoutCRS)
-> Seq GeoPositionWithoutCRS
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LinearRing GeoPositionWithoutCRS -> Seq GeoPositionWithoutCRS
forall a. LinearRing a -> Seq a
toSeq Seq (LinearRing GeoPositionWithoutCRS)
polygon)
  case Seq a
aSeq of
    (a
one :<| a
two :<| a
three :<| Seq a
rem') -> LinearRing a -> Either GeomErrors (LinearRing a)
forall a b. b -> Either a b
Right (LinearRing a -> Either GeomErrors (LinearRing a))
-> LinearRing a -> Either GeomErrors (LinearRing a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Seq a -> LinearRing a
forall point.
(Eq point, Show point) =>
point -> point -> point -> Seq point -> LinearRing point
makeLinearRing a
one a
two a
three Seq a
rem'
    Seq a
_other -> GeomErrors -> Either GeomErrors (LinearRing a)
forall a b. a -> Either a b
Left GeomErrors
NotEnoughElements

instance HasPgType spatialType => PersistField (Postgis spatialType PointXY) where
  toPersistValue :: Postgis spatialType PointXY -> PersistValue
toPersistValue Postgis spatialType PointXY
geom =
    LiteralType -> ByteString -> PersistValue
PersistLiteral_ LiteralType
Unescaped (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ LazyText -> Text
toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> LazyText
toLazyText (Builder -> LazyText) -> Builder -> LazyText
forall a b. (a -> b) -> a -> b
$ Postgis spatialType Builder -> Builder
forall (spatialType :: SpatialType).
HasPgType spatialType =>
Postgis spatialType Builder -> Builder
renderGeometry  (Postgis spatialType Builder -> Builder)
-> Postgis spatialType Builder -> Builder
forall a b. (a -> b) -> a -> b
$ PointXY -> Builder
renderPair (PointXY -> Builder)
-> Postgis spatialType PointXY -> Postgis spatialType Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Postgis spatialType PointXY
geom
  fromPersistValue :: PersistValue -> Either Text (Postgis spatialType PointXY)
fromPersistValue (PersistLiteral_ LiteralType
Escaped ByteString
bs) = do
    GeospatialGeometry
result <- (String -> Text)
-> Either String GeospatialGeometry
-> Either Text GeospatialGeometry
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack (Either String GeospatialGeometry
 -> Either Text GeospatialGeometry)
-> Either String GeospatialGeometry
-> Either Text GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ Base16 ByteString -> Either String GeospatialGeometry
parseHexByteString (Base16 ByteString -> Either String GeospatialGeometry)
-> Base16 ByteString -> Either String GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ ByteString -> Base16 ByteString
forall a. a -> Base16 a
assertBase16 (ByteString -> Base16 ByteString)
-> ByteString -> Base16 ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
bs
    (GeomErrors -> Text)
-> Either GeomErrors (Postgis spatialType PointXY)
-> Either Text (Postgis spatialType PointXY)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GeomErrors -> Text
forall a. Show a => a -> Text
tshow (Either GeomErrors (Postgis spatialType PointXY)
 -> Either Text (Postgis spatialType PointXY))
-> Either GeomErrors (Postgis spatialType PointXY)
-> Either Text (Postgis spatialType PointXY)
forall a b. (a -> b) -> a -> b
$ ((GeoPositionWithoutCRS -> Either GeomErrors PointXY)
-> GeospatialGeometry
-> Either GeomErrors (Postgis spatialType PointXY)
forall a (spatialType :: SpatialType).
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (Postgis spatialType a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors PointXY
from2dGeoPositionWithoutCRSToPoint) GeospatialGeometry
result
  fromPersistValue PersistValue
other = Text -> Either Text (Postgis spatialType PointXY)
forall a b. a -> Either a b
Left (Text
"PersistField.Polygon: invalid persist value:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistValue -> Text
forall a. Show a => a -> Text
tshow PersistValue
other)

instance HasPgType spatialType => PersistField (Postgis spatialType PointXYZ) where
  toPersistValue :: Postgis spatialType PointXYZ -> PersistValue
toPersistValue Postgis spatialType PointXYZ
geom =
    LiteralType -> ByteString -> PersistValue
PersistLiteral_ LiteralType
Unescaped (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ LazyText -> Text
toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> LazyText
toLazyText (Builder -> LazyText) -> Builder -> LazyText
forall a b. (a -> b) -> a -> b
$ Postgis spatialType Builder -> Builder
forall (spatialType :: SpatialType).
HasPgType spatialType =>
Postgis spatialType Builder -> Builder
renderGeometry (Postgis spatialType Builder -> Builder)
-> Postgis spatialType Builder -> Builder
forall a b. (a -> b) -> a -> b
$ PointXYZ -> Builder
renderXYZ (PointXYZ -> Builder)
-> Postgis spatialType PointXYZ -> Postgis spatialType Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Postgis spatialType PointXYZ
geom
  fromPersistValue :: PersistValue -> Either Text (Postgis spatialType PointXYZ)
fromPersistValue (PersistLiteral_ LiteralType
Escaped ByteString
bs) = do
    GeospatialGeometry
result <- (String -> Text)
-> Either String GeospatialGeometry
-> Either Text GeospatialGeometry
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack (Either String GeospatialGeometry
 -> Either Text GeospatialGeometry)
-> Either String GeospatialGeometry
-> Either Text GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ Base16 ByteString -> Either String GeospatialGeometry
parseHexByteString (Base16 ByteString -> Either String GeospatialGeometry)
-> Base16 ByteString -> Either String GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ ByteString -> Base16 ByteString
forall a. a -> Base16 a
assertBase16 (ByteString -> Base16 ByteString)
-> ByteString -> Base16 ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
bs
    (GeomErrors -> Text)
-> Either GeomErrors (Postgis spatialType PointXYZ)
-> Either Text (Postgis spatialType PointXYZ)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GeomErrors -> Text
forall a. Show a => a -> Text
tshow (Either GeomErrors (Postgis spatialType PointXYZ)
 -> Either Text (Postgis spatialType PointXYZ))
-> Either GeomErrors (Postgis spatialType PointXYZ)
-> Either Text (Postgis spatialType PointXYZ)
forall a b. (a -> b) -> a -> b
$ ((GeoPositionWithoutCRS -> Either GeomErrors PointXYZ)
-> GeospatialGeometry
-> Either GeomErrors (Postgis spatialType PointXYZ)
forall a (spatialType :: SpatialType).
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (Postgis spatialType a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors PointXYZ
from3dGeoPositionWithoutCRSToPoint) GeospatialGeometry
result
  fromPersistValue PersistValue
other = Text -> Either Text (Postgis spatialType PointXYZ)
forall a b. a -> Either a b
Left (Text
"PersistField.Polygon: invalid persist value:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistValue -> Text
forall a. Show a => a -> Text
tshow PersistValue
other)

instance HasPgType spatialType => PersistField (Postgis spatialType PointXYZM) where
  toPersistValue :: Postgis spatialType PointXYZM -> PersistValue
toPersistValue Postgis spatialType PointXYZM
geom =
    LiteralType -> ByteString -> PersistValue
PersistLiteral_ LiteralType
Unescaped (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ LazyText -> Text
toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> LazyText
toLazyText (Builder -> LazyText) -> Builder -> LazyText
forall a b. (a -> b) -> a -> b
$ Postgis spatialType Builder -> Builder
forall (spatialType :: SpatialType).
HasPgType spatialType =>
Postgis spatialType Builder -> Builder
renderGeometry (Postgis spatialType Builder -> Builder)
-> Postgis spatialType Builder -> Builder
forall a b. (a -> b) -> a -> b
$ PointXYZM -> Builder
renderXYZM (PointXYZM -> Builder)
-> Postgis spatialType PointXYZM -> Postgis spatialType Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Postgis spatialType PointXYZM
geom
  fromPersistValue :: PersistValue -> Either Text (Postgis spatialType PointXYZM)
fromPersistValue (PersistLiteral_ LiteralType
Escaped ByteString
bs) = do
    GeospatialGeometry
result <- (String -> Text)
-> Either String GeospatialGeometry
-> Either Text GeospatialGeometry
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack (Either String GeospatialGeometry
 -> Either Text GeospatialGeometry)
-> Either String GeospatialGeometry
-> Either Text GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ Base16 ByteString -> Either String GeospatialGeometry
parseHexByteString (Base16 ByteString -> Either String GeospatialGeometry)
-> Base16 ByteString -> Either String GeospatialGeometry
forall a b. (a -> b) -> a -> b
$ ByteString -> Base16 ByteString
forall a. a -> Base16 a
assertBase16 (ByteString -> Base16 ByteString)
-> ByteString -> Base16 ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
bs
    (GeomErrors -> Text)
-> Either GeomErrors (Postgis spatialType PointXYZM)
-> Either Text (Postgis spatialType PointXYZM)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GeomErrors -> Text
forall a. Show a => a -> Text
tshow (Either GeomErrors (Postgis spatialType PointXYZM)
 -> Either Text (Postgis spatialType PointXYZM))
-> Either GeomErrors (Postgis spatialType PointXYZM)
-> Either Text (Postgis spatialType PointXYZM)
forall a b. (a -> b) -> a -> b
$ ((GeoPositionWithoutCRS -> Either GeomErrors PointXYZM)
-> GeospatialGeometry
-> Either GeomErrors (Postgis spatialType PointXYZM)
forall a (spatialType :: SpatialType).
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (Postgis spatialType a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors PointXYZM
from4dGeoPositionWithoutCRSToPoint) GeospatialGeometry
result
  fromPersistValue PersistValue
other = Text -> Either Text (Postgis spatialType PointXYZM)
forall a b. a -> Either a b
Left (Text
"PersistField.Polygon: invalid persist value:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistValue -> Text
forall a. Show a => a -> Text
tshow PersistValue
other)

instance forall spatialType . HasPgType spatialType => PersistFieldSql (Postgis spatialType PointXY) where
  sqlType :: Proxy (Postgis spatialType PointXY) -> SqlType
sqlType Proxy (Postgis spatialType PointXY)
_ = Text -> SqlType
SqlOther (Text -> SqlType) -> Text -> SqlType
forall a b. (a -> b) -> a -> b
$ Proxy spatialType -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy spatialType -> Text
pgType (Proxy spatialType -> Text) -> Proxy spatialType -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @spatialType

instance HasPgType spatialType => PersistFieldSql (Postgis spatialType PointXYZ) where
  sqlType :: Proxy (Postgis spatialType PointXYZ) -> SqlType
sqlType Proxy (Postgis spatialType PointXYZ)
_ = Text -> SqlType
SqlOther (Text -> SqlType) -> Text -> SqlType
forall a b. (a -> b) -> a -> b
$ Proxy spatialType -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy spatialType -> Text
pgType (Proxy spatialType -> Text) -> Proxy spatialType -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @spatialType

instance HasPgType spatialType => PersistFieldSql (Postgis spatialType PointXYZM) where
  sqlType :: Proxy (Postgis spatialType PointXYZM) -> SqlType
sqlType Proxy (Postgis spatialType PointXYZM)
_ = Text -> SqlType
SqlOther (Text -> SqlType) -> Text -> SqlType
forall a b. (a -> b) -> a -> b
$ Proxy spatialType -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy spatialType -> Text
pgType (Proxy spatialType -> Text) -> Proxy spatialType -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @spatialType

-- | SRID
-- you can find your local like this: https://blog.rustprooflabs.com/2020/11/postgis-find-local-srid
-- geography appears to use 'wgs84'. So I hardcoded the use going from geom to geography as that.
--
-- you can use the num instance to put in whatever.
-- however, if you miss a srid please submit a PR.
newtype SRID (unit :: SridUnit) = SRID Int
  deriving newtype (Integer -> SRID unit
SRID unit -> SRID unit
SRID unit -> SRID unit -> SRID unit
(SRID unit -> SRID unit -> SRID unit)
-> (SRID unit -> SRID unit -> SRID unit)
-> (SRID unit -> SRID unit -> SRID unit)
-> (SRID unit -> SRID unit)
-> (SRID unit -> SRID unit)
-> (SRID unit -> SRID unit)
-> (Integer -> SRID unit)
-> Num (SRID unit)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (unit :: SridUnit). Integer -> SRID unit
forall (unit :: SridUnit). SRID unit -> SRID unit
forall (unit :: SridUnit). SRID unit -> SRID unit -> SRID unit
$c+ :: forall (unit :: SridUnit). SRID unit -> SRID unit -> SRID unit
+ :: SRID unit -> SRID unit -> SRID unit
$c- :: forall (unit :: SridUnit). SRID unit -> SRID unit -> SRID unit
- :: SRID unit -> SRID unit -> SRID unit
$c* :: forall (unit :: SridUnit). SRID unit -> SRID unit -> SRID unit
* :: SRID unit -> SRID unit -> SRID unit
$cnegate :: forall (unit :: SridUnit). SRID unit -> SRID unit
negate :: SRID unit -> SRID unit
$cabs :: forall (unit :: SridUnit). SRID unit -> SRID unit
abs :: SRID unit -> SRID unit
$csignum :: forall (unit :: SridUnit). SRID unit -> SRID unit
signum :: SRID unit -> SRID unit
$cfromInteger :: forall (unit :: SridUnit). Integer -> SRID unit
fromInteger :: Integer -> SRID unit
Num, PersistValue -> Either Text (SRID unit)
SRID unit -> PersistValue
(SRID unit -> PersistValue)
-> (PersistValue -> Either Text (SRID unit))
-> PersistField (SRID unit)
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
forall (unit :: SridUnit). PersistValue -> Either Text (SRID unit)
forall (unit :: SridUnit). SRID unit -> PersistValue
$ctoPersistValue :: forall (unit :: SridUnit). SRID unit -> PersistValue
toPersistValue :: SRID unit -> PersistValue
$cfromPersistValue :: forall (unit :: SridUnit). PersistValue -> Either Text (SRID unit)
fromPersistValue :: PersistValue -> Either Text (SRID unit)
PersistField)

-- | default for geography type in postgis.
--   Geodetic CRS: WGS 84
--   https://epsg.io/4326
wgs84 :: SRID 'Degree
wgs84 :: SRID 'Degree
wgs84 = SRID 'Degree
4326

-- | most maps are in this, it has some large distortions further away from equator
--   https://epsg.io/3857
mercator :: SRID 'Linear
mercator :: SRID 'Linear
mercator = SRID 'Linear
3857

-- | if you're in england this is pretty good.
--   https://epsg.io/27700
britishNationalGrid :: SRID 'Linear
britishNationalGrid :: SRID 'Linear
britishNationalGrid = SRID 'Linear
27700


-- | Diferent 'SRID' come in different units,
--   important for converting from geograhy to geometry.
data SridUnit = Linear -- ^ meters or feet
          | Degree -- ^ spheroids

-- | Project a geography onto a geometry.
--   allows using of functions such as 'st_union' which only work in flat space (geometry).
--   https://postgis.net/docs/ST_Transform.html
st_transform_geography :: forall a. SRID 'Linear ->
                        SqlExpr (Value (Postgis 'Geography a)) -> -- ^ g1 (library handles the conversion)
                        SqlExpr (Value (Postgis 'Geometry a))
st_transform_geography :: forall a.
SRID 'Linear
-> SqlExpr (Value (Postgis 'Geography a))
-> SqlExpr (Value (Postgis 'Geometry a))
st_transform_geography SRID 'Linear
srid SqlExpr (Value (Postgis 'Geography a))
geography =
  Builder
-> (SqlExpr (Value (Postgis 'Geometry a)),
    SqlExpr (Value (SRID 'Linear)))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Transform" (SqlExpr (Value (Postgis 'Geometry a))
casted, SRID 'Linear -> SqlExpr (Value (SRID 'Linear))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val SRID 'Linear
srid)
  where
    casted :: SqlExpr (Value (Postgis 'Geometry a))
    casted :: SqlExpr (Value (Postgis 'Geometry a))
casted = SqlExpr (Value (Postgis 'Geography a))
-> SqlExpr (Value (Postgis 'Geometry a))
forall (two :: SpatialType) (one :: SpatialType) a.
HasPgType two =>
SqlExpr (Value (Postgis one a)) -> SqlExpr (Value (Postgis two a))
unsafe_cast_pg_type SqlExpr (Value (Postgis 'Geography a))
geography

-- | project a geometry as a geography, assumes 'wgs84'.
--   https://postgis.net/docs/ST_Transform.html
st_transform_geometry :: SqlExpr (Value (Postgis 'Geometry a)) -> -- ^ g1 (library handles the conversion)
                        SqlExpr (Value (Postgis 'Geography a))
st_transform_geometry :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geography a))
st_transform_geometry SqlExpr (Value (Postgis 'Geometry a))
input = SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geography a))
forall (two :: SpatialType) (one :: SpatialType) a.
HasPgType two =>
SqlExpr (Value (Postgis one a)) -> SqlExpr (Value (Postgis two a))
unsafe_cast_pg_type SqlExpr (Value (Postgis 'Geometry a))
forall a. SqlExpr (Value (Postgis 'Geometry a))
transformed
  where
    transformed :: SqlExpr (Value (Postgis 'Geometry a))
    transformed :: forall a. SqlExpr (Value (Postgis 'Geometry a))
transformed =
      Builder
-> (SqlExpr (Value (Postgis 'Geometry a)),
    SqlExpr (Value (SRID 'Degree)))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Transform" (SqlExpr (Value (Postgis 'Geometry a))
input, SRID 'Degree -> SqlExpr (Value (SRID 'Degree))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val SRID 'Degree
wgs84)

-- postgis doesn't appear to care about casting between spaces,
-- the user probably wants to use st_transform instead.
unsafe_cast_pg_type :: forall two one a . HasPgType two => SqlExpr (Value (Postgis one a)) -> SqlExpr (Value (Postgis two a))
unsafe_cast_pg_type :: forall (two :: SpatialType) (one :: SpatialType) a.
HasPgType two =>
SqlExpr (Value (Postgis one a)) -> SqlExpr (Value (Postgis two a))
unsafe_cast_pg_type = Text
-> SqlExpr (Value (Postgis one a))
-> SqlExpr (Value (Postgis two a))
forall a b. Text -> SqlExpr (Value a) -> SqlExpr (Value b)
unsafeSqlCastAs Text
castAs
  where
    castAs :: Text
castAs = Proxy two -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy two -> Text
pgType (Proxy two -> Text) -> Proxy two -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @two

-- ---------------------------------------------------------------------------
-- Geometry Constructors
-- ---------------------------------------------------------------------------

-- | Aggregate function that collects geometries into a geometry collection.
--   https://postgis.net/docs/ST_Collect.html
st_collect ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value (Postgis 'Geometry a))
st_collect :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
st_collect SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Collect" SqlExpr (Value (Postgis 'Geometry a))
a

-- | Creates a rectangular polygon from minimum and maximum coordinates.
--   https://postgis.net/docs/ST_MakeEnvelope.html
st_makeenvelope ::
  SqlExpr (Value Double) -> -- ^ xmin
  SqlExpr (Value Double) -> -- ^ ymin
  SqlExpr (Value Double) -> -- ^ xmax
  SqlExpr (Value Double) -> -- ^ ymax
  SqlExpr (Value Int) ->    -- ^ srid
  SqlExpr (Value (Postgis 'Geometry a))
st_makeenvelope :: forall a.
SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Int)
-> SqlExpr (Value (Postgis 'Geometry a))
st_makeenvelope SqlExpr (Value Double)
xmin' SqlExpr (Value Double)
ymin' SqlExpr (Value Double)
xmax' SqlExpr (Value Double)
ymax' SqlExpr (Value Int)
srid' = Builder
-> (SqlExpr (Value Double), SqlExpr (Value Double),
    SqlExpr (Value Double), SqlExpr (Value Double),
    SqlExpr (Value Int))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_MakeEnvelope" (SqlExpr (Value Double)
xmin', SqlExpr (Value Double)
ymin', SqlExpr (Value Double)
xmax', SqlExpr (Value Double)
ymax', SqlExpr (Value Int)
srid')

-- | Creates a linestring from two point geometries.
--   https://postgis.net/docs/ST_MakeLine.html
st_makeline ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value (Postgis 'Geometry a))
st_makeline :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
st_makeline SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value (Postgis 'Geometry a))
b = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)),
    SqlExpr (Value (Postgis 'Geometry a)))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_MakeLine" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value (Postgis 'Geometry a))
b)

-- | Creates a polygon from a closed linestring shell.
--   Named st_makepolygon_line to avoid collision with 'makePolygon'.
--   https://postgis.net/docs/ST_MakePolygon.html
st_makepolygon_line ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value (Postgis 'Geometry a))
st_makepolygon_line :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
st_makepolygon_line SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_MakePolygon" SqlExpr (Value (Postgis 'Geometry a))
a

-- ---------------------------------------------------------------------------
-- Geometry Validation
-- ---------------------------------------------------------------------------

-- | Attempts to make an invalid geometry valid without losing vertices.
--   https://postgis.net/docs/ST_MakeValid.html
st_makevalid ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value (Postgis 'Geometry a))
st_makevalid :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
st_makevalid SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_MakeValid" SqlExpr (Value (Postgis 'Geometry a))
a

-- | Returns text describing why a geometry is invalid, or "Valid Geometry".
--   https://postgis.net/docs/ST_IsValidReason.html
st_isvalidreason ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Text)
st_isvalidreason :: forall a.
SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
st_isvalidreason SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_IsValidReason" SqlExpr (Value (Postgis 'Geometry a))
a

-- ---------------------------------------------------------------------------
-- SRS Functions
-- ---------------------------------------------------------------------------

-- | Sets the SRID on a geometry to a particular integer value.
--   https://postgis.net/docs/ST_SetSRID.html
st_setsrid ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Int) ->
  SqlExpr (Value (Postgis 'Geometry a))
st_setsrid :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Int) -> SqlExpr (Value (Postgis 'Geometry a))
st_setsrid SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Int)
srid' = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Int))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_SetSRID" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Int)
srid')

-- ---------------------------------------------------------------------------
-- Geometry Output
-- ---------------------------------------------------------------------------

-- | Returns the Well-Known Text (WKT) representation of the geometry.
--   https://postgis.net/docs/ST_AsText.html
st_astext ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Text)
st_astext :: forall a.
SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
st_astext SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_AsText" SqlExpr (Value (Postgis 'Geometry a))
a

-- | Returns the GeoJSON representation of the geometry.
--   https://postgis.net/docs/ST_AsGeoJSON.html
st_asgeojson ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Text)
st_asgeojson :: forall a.
SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
st_asgeojson SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_AsGeoJSON" SqlExpr (Value (Postgis 'Geometry a))
a

-- | Returns the Extended Well-Known Text (EWKT) representation of the geometry.
--   https://postgis.net/docs/ST_AsEWKT.html
st_asewkt ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Text)
st_asewkt :: forall a.
SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
st_asewkt SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_AsEWKT" SqlExpr (Value (Postgis 'Geometry a))
a

-- | Returns a GeoHash representation of the geometry.
--   https://postgis.net/docs/ST_GeoHash.html
st_geohash ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Text)
st_geohash :: forall a.
SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
st_geohash SqlExpr (Value (Postgis 'Geometry a))
a = Builder
-> SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Text)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_GeoHash" SqlExpr (Value (Postgis 'Geometry a))
a

-- ---------------------------------------------------------------------------
-- Affine Transformations
-- ---------------------------------------------------------------------------

-- | Translates a geometry by given X and Y offsets.
--   https://postgis.net/docs/ST_Translate.html
st_translate ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) -> -- ^ deltaX
  SqlExpr (Value Double) -> -- ^ deltaY
  SqlExpr (Value (Postgis 'Geometry a))
st_translate :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (Postgis 'Geometry a))
st_translate SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
dx SqlExpr (Value Double)
dy = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double),
    SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Translate" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
dx, SqlExpr (Value Double)
dy)

-- | Scales a geometry by given X and Y factors.
--   https://postgis.net/docs/ST_Scale.html
st_scale ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) -> -- ^ scaleX
  SqlExpr (Value Double) -> -- ^ scaleY
  SqlExpr (Value (Postgis 'Geometry a))
st_scale :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (Postgis 'Geometry a))
st_scale SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
sx SqlExpr (Value Double)
sy = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double),
    SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Scale" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
sx, SqlExpr (Value Double)
sy)

-- | Rotates a geometry around the origin by an angle in radians.
--   https://postgis.net/docs/ST_Rotate.html
st_rotate ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) -> -- ^ angle in radians
  SqlExpr (Value (Postgis 'Geometry a))
st_rotate :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double) -> SqlExpr (Value (Postgis 'Geometry a))
st_rotate SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
angle = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Rotate" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
angle)

-- | Rotates a geometry around the X axis by an angle in radians.
--   https://postgis.net/docs/ST_RotateX.html
st_rotatex ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) -> -- ^ angle in radians
  SqlExpr (Value (Postgis 'Geometry a))
st_rotatex :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double) -> SqlExpr (Value (Postgis 'Geometry a))
st_rotatex SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
angle = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_RotateX" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
angle)

-- | Rotates a geometry around the Z axis by an angle in radians.
--   https://postgis.net/docs/ST_RotateZ.html
st_rotatez ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) -> -- ^ angle in radians
  SqlExpr (Value (Postgis 'Geometry a))
st_rotatez :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double) -> SqlExpr (Value (Postgis 'Geometry a))
st_rotatez SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
angle = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_RotateZ" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
angle)

-- ---------------------------------------------------------------------------
-- Bounding Box
-- ---------------------------------------------------------------------------

-- | Returns a bounding box expanded in all directions by a given distance.
--   https://postgis.net/docs/ST_Expand.html
st_expand ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) ->
  SqlExpr (Value (Postgis 'Geometry a))
st_expand :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double) -> SqlExpr (Value (Postgis 'Geometry a))
st_expand SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
d = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Expand" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
d)

-- ---------------------------------------------------------------------------
-- Linear Referencing
-- ---------------------------------------------------------------------------

-- | Returns a point interpolated along a line at a fractional distance (0.0 to 1.0).
--   https://postgis.net/docs/ST_LineInterpolatePoint.html
st_lineinterpolatepoint ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) -> -- ^ fraction (0.0 to 1.0)
  SqlExpr (Value (Postgis 'Geometry a))
st_lineinterpolatepoint :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double) -> SqlExpr (Value (Postgis 'Geometry a))
st_lineinterpolatepoint SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
f = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_LineInterpolatePoint" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
f)

-- | Returns a float between 0 and 1 representing the location of the closest point on a line to a given point.
--   https://postgis.net/docs/ST_LineLocatePoint.html
st_linelocatepoint ::
  SqlExpr (Value (Postgis 'Geometry a)) -> -- ^ line
  SqlExpr (Value (Postgis 'Geometry a)) -> -- ^ point
  SqlExpr (Value Double)
st_linelocatepoint :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value (Postgis 'Geometry a)) -> SqlExpr (Value Double)
st_linelocatepoint SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value (Postgis 'Geometry a))
b = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)),
    SqlExpr (Value (Postgis 'Geometry a)))
-> SqlExpr (Value Double)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_LineLocatePoint" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value (Postgis 'Geometry a))
b)

-- | Returns the portion of a line between two fractional locations (0.0 to 1.0).
--   https://postgis.net/docs/ST_LineSubstring.html
st_linesubstring ::
  SqlExpr (Value (Postgis 'Geometry a)) ->
  SqlExpr (Value Double) -> -- ^ start fraction
  SqlExpr (Value Double) -> -- ^ end fraction
  SqlExpr (Value (Postgis 'Geometry a))
st_linesubstring :: forall a.
SqlExpr (Value (Postgis 'Geometry a))
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (Postgis 'Geometry a))
st_linesubstring SqlExpr (Value (Postgis 'Geometry a))
a SqlExpr (Value Double)
s SqlExpr (Value Double)
e = Builder
-> (SqlExpr (Value (Postgis 'Geometry a)), SqlExpr (Value Double),
    SqlExpr (Value Double))
-> SqlExpr (Value (Postgis 'Geometry a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_LineSubstring" (SqlExpr (Value (Postgis 'Geometry a))
a, SqlExpr (Value Double)
s, SqlExpr (Value Double)
e)

point ::
  Double -> -- ^ x or longitude
  Double -> -- ^ y or latitude
  (Postgis spatialType PointXY)
point :: forall (spatialType :: SpatialType).
Double -> Double -> Postgis spatialType PointXY
point Double
x Double
y = PointXY -> Postgis spatialType PointXY
forall (spatialType :: SpatialType) point.
point -> Postgis spatialType point
Point (PointXY {_xyX :: Double
_xyX = Double
x, _xyY :: Double
_xyY = Double
y})

point_v :: HasPgType spatialType =>
  Double -> -- ^ x or longitude
  Double -> -- ^ y or latitude
  SqlExpr (Value (Postgis spatialType PointXY))
point_v :: forall (spatialType :: SpatialType).
HasPgType spatialType =>
Double -> Double -> SqlExpr (Value (Postgis spatialType PointXY))
point_v = (Postgis spatialType PointXY
 -> SqlExpr (Value (Postgis spatialType PointXY)))
-> (Double -> Postgis spatialType PointXY)
-> Double
-> SqlExpr (Value (Postgis spatialType PointXY))
forall a b. (a -> b) -> (Double -> a) -> Double -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Postgis spatialType PointXY
-> SqlExpr (Value (Postgis spatialType PointXY))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val ((Double -> Postgis spatialType PointXY)
 -> Double -> SqlExpr (Value (Postgis spatialType PointXY)))
-> (Double -> Double -> Postgis spatialType PointXY)
-> Double
-> Double
-> SqlExpr (Value (Postgis spatialType PointXY))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Postgis spatialType PointXY
forall (spatialType :: SpatialType).
Double -> Double -> Postgis spatialType PointXY
point

st_point ::  forall spatialType . HasPgType spatialType =>
  SqlExpr (Value Double) -> -- ^ x or longitude
  SqlExpr (Value Double) -> -- ^ y or latitude
  SqlExpr (Value (Postgis spatialType PointXY))
st_point :: forall (spatialType :: SpatialType).
HasPgType spatialType =>
SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (Postgis spatialType PointXY))
st_point SqlExpr (Value Double)
a SqlExpr (Value Double)
b = Text
-> SqlExpr (Value Any)
-> SqlExpr (Value (Postgis spatialType PointXY))
forall a b. Text -> SqlExpr (Value a) -> SqlExpr (Value b)
unsafeSqlCastAs Text
castAs (SqlExpr (Value Any)
 -> SqlExpr (Value (Postgis spatialType PointXY)))
-> SqlExpr (Value Any)
-> SqlExpr (Value (Postgis spatialType PointXY))
forall a b. (a -> b) -> a -> b
$ Builder
-> (SqlExpr (Value Double), SqlExpr (Value Double))
-> SqlExpr (Value Any)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_POINT" (SqlExpr (Value Double)
a, SqlExpr (Value Double)
b)
  where
    castAs :: Text
castAs = Proxy spatialType -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy spatialType -> Text
pgType (Proxy spatialType -> Text) -> Proxy spatialType -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @spatialType


st_point_xyz ::  forall spatialType . HasPgType spatialType =>
  SqlExpr (Value Double) -> -- ^ x or longitude
  SqlExpr (Value Double) -> -- ^ y or latitude
  SqlExpr (Value Double) -> -- ^ z elevation/altitude
  SqlExpr (Value (Postgis spatialType PointXYZ))
st_point_xyz :: forall (spatialType :: SpatialType).
HasPgType spatialType =>
SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (Postgis spatialType PointXYZ))
st_point_xyz SqlExpr (Value Double)
a SqlExpr (Value Double)
b SqlExpr (Value Double)
c = Text
-> SqlExpr (Value Any)
-> SqlExpr (Value (Postgis spatialType PointXYZ))
forall a b. Text -> SqlExpr (Value a) -> SqlExpr (Value b)
unsafeSqlCastAs Text
castAs (SqlExpr (Value Any)
 -> SqlExpr (Value (Postgis spatialType PointXYZ)))
-> SqlExpr (Value Any)
-> SqlExpr (Value (Postgis spatialType PointXYZ))
forall a b. (a -> b) -> a -> b
$ Builder
-> (SqlExpr (Value Double), SqlExpr (Value Double),
    SqlExpr (Value Double))
-> SqlExpr (Value Any)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_POINT" (SqlExpr (Value Double)
a, SqlExpr (Value Double)
b, SqlExpr (Value Double)
c)
  where
    castAs :: Text
castAs = Proxy spatialType -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy spatialType -> Text
pgType (Proxy spatialType -> Text) -> Proxy spatialType -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @spatialType

st_point_xyzm :: forall spatialType . HasPgType spatialType =>
  SqlExpr (Value Double) -> -- ^ x or longitude
  SqlExpr (Value Double) -> -- ^ y or latitude
  SqlExpr (Value Double) -> -- ^ z elevation/altitude
  SqlExpr (Value Double) -> -- ^ m measure, user defined dimension
  SqlExpr (Value (Postgis spatialType PointXYZM))
st_point_xyzm :: forall (spatialType :: SpatialType).
HasPgType spatialType =>
SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (Postgis spatialType PointXYZM))
st_point_xyzm SqlExpr (Value Double)
a SqlExpr (Value Double)
b SqlExpr (Value Double)
c SqlExpr (Value Double)
m = Text
-> SqlExpr (Value Any)
-> SqlExpr (Value (Postgis spatialType PointXYZM))
forall a b. Text -> SqlExpr (Value a) -> SqlExpr (Value b)
unsafeSqlCastAs Text
castAs (SqlExpr (Value Any)
 -> SqlExpr (Value (Postgis spatialType PointXYZM)))
-> SqlExpr (Value Any)
-> SqlExpr (Value (Postgis spatialType PointXYZM))
forall a b. (a -> b) -> a -> b
$ Builder
-> (SqlExpr (Value Double), SqlExpr (Value Double),
    SqlExpr (Value Double), SqlExpr (Value Double))
-> SqlExpr (Value Any)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_POINT" (SqlExpr (Value Double)
a, SqlExpr (Value Double)
b, SqlExpr (Value Double)
c, SqlExpr (Value Double)
m)
  where
    castAs :: Text
castAs = Proxy spatialType -> Text
forall (spatialType :: SpatialType) (proxy :: SpatialType -> *).
HasPgType spatialType =>
proxy spatialType -> Text
forall (proxy :: SpatialType -> *). proxy spatialType -> Text
pgType (Proxy spatialType -> Text) -> Proxy spatialType -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SpatialType). Proxy t
Proxy @spatialType