{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Haskell bindings for postgres postgis
--   for a good explenation see <https://postgis.net/>
module Database.Esqueleto.Postgis
  ( PostgisGeometry (..),
    makePolygon,

    -- * functions
    st_contains,
    st_intersects,

    -- * points
    st_point,
    st_point_xyz,
    st_point_xyzm,
  )
where

import Data.Bifunctor (first)
import Data.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.Hex (Hex (..))
import Data.LineString (LineString)
import Data.LinearRing (LinearRing, makeLinearRing, toSeq)
import Data.List qualified as List
import Data.List.NonEmpty (nonEmpty)
import Data.List.NonEmpty qualified as Non
import Data.Sequence (Seq (..), (|>))
import Data.Sequence qualified as Seq
import Data.String (IsString (..))
import Data.Text (Text, pack)
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)
import Database.Persist.Sql
import GHC.Base (NonEmpty)
import Data.Geospatial (PointXYZM(..))
import Data.Geospatial (PointXYZ(..))

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

-- | like 'GeospatialGeometry' but not partial, eg no empty geometries, also only works
--   in a single dimention, eg PostgisGeometry PointXY can't work with PostgisGeometry PointXYZ.
--   so PointXY indicates a 2 dimension space, and PointXYZ a three dimension space.
data PostgisGeometry point
  = Point point
  | MultiPoint (NonEmpty point)
  | Line (LineString point)
  | Multiline (NonEmpty (LineString point))
  | Polygon (LinearRing point)
  | MultiPolygon (NonEmpty (LinearRing point))
  | Collection (NonEmpty (PostgisGeometry point))
  deriving (Int -> PostgisGeometry point -> ShowS
[PostgisGeometry point] -> ShowS
PostgisGeometry point -> String
(Int -> PostgisGeometry point -> ShowS)
-> (PostgisGeometry point -> String)
-> ([PostgisGeometry point] -> ShowS)
-> Show (PostgisGeometry point)
forall point. Show point => Int -> PostgisGeometry point -> ShowS
forall point. Show point => [PostgisGeometry point] -> ShowS
forall point. Show point => PostgisGeometry point -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall point. Show point => Int -> PostgisGeometry point -> ShowS
showsPrec :: Int -> PostgisGeometry point -> ShowS
$cshow :: forall point. Show point => PostgisGeometry point -> String
show :: PostgisGeometry point -> String
$cshowList :: forall point. Show point => [PostgisGeometry point] -> ShowS
showList :: [PostgisGeometry point] -> ShowS
Show, (forall a b. (a -> b) -> PostgisGeometry a -> PostgisGeometry b)
-> (forall a b. a -> PostgisGeometry b -> PostgisGeometry a)
-> Functor PostgisGeometry
forall a b. a -> PostgisGeometry b -> PostgisGeometry a
forall a b. (a -> b) -> PostgisGeometry a -> PostgisGeometry b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PostgisGeometry a -> PostgisGeometry b
fmap :: forall a b. (a -> b) -> PostgisGeometry a -> PostgisGeometry b
$c<$ :: forall a b. a -> PostgisGeometry b -> PostgisGeometry a
<$ :: forall a b. a -> PostgisGeometry b -> PostgisGeometry a
Functor, PostgisGeometry point -> PostgisGeometry point -> Bool
(PostgisGeometry point -> PostgisGeometry point -> Bool)
-> (PostgisGeometry point -> PostgisGeometry point -> Bool)
-> Eq (PostgisGeometry point)
forall point.
Eq point =>
PostgisGeometry point -> PostgisGeometry point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall point.
Eq point =>
PostgisGeometry point -> PostgisGeometry point -> Bool
== :: PostgisGeometry point -> PostgisGeometry point -> Bool
$c/= :: forall point.
Eq point =>
PostgisGeometry point -> PostgisGeometry point -> Bool
/= :: PostgisGeometry point -> PostgisGeometry point -> Bool
Eq)

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
_xyX :: PointXY -> Double
_xyY :: 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
_xyzX :: PointXYZ -> Double
_xyzY :: PointXYZ -> Double
_xyzZ :: 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
_xyzmX :: PointXYZM -> Double
_xyzmY :: PointXYZM -> Double
_xyzmZ :: PointXYZM -> Double
_xyzmM :: 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 :: PostgisGeometry Text.Builder -> Text.Builder
renderGeometry :: PostgisGeometry Builder -> Builder
renderGeometry = \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
renderGeometry (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 (PostgisGeometry a)
from2dGeospatialGeometry :: forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (PostgisGeometry a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors a
interpreter = \case
  GeospatialGeometry
Geospatial.NoGeometry -> GeomErrors -> Either GeomErrors (PostgisGeometry a)
forall a b. a -> Either a b
Left GeomErrors
NoGeometry
  Geospatial.Point (GeoPoint GeoPositionWithoutCRS
point) -> (a -> PostgisGeometry a
forall point. point -> PostgisGeometry point
Point (a -> PostgisGeometry a)
-> Either GeomErrors a -> Either GeomErrors (PostgisGeometry 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 (PostgisGeometry a)
forall a b. a -> Either a b
Left GeomErrors
EmptyMultiPoint
      Just NonEmpty a
x -> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. b -> Either a b
Right (PostgisGeometry a -> Either GeomErrors (PostgisGeometry a))
-> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> PostgisGeometry a
forall point. NonEmpty point -> PostgisGeometry point
MultiPoint NonEmpty a
x
  Geospatial.Line (Geospatial.GeoLine LineString GeoPositionWithoutCRS
linestring) -> LineString a -> PostgisGeometry a
forall point. LineString point -> PostgisGeometry point
Line (LineString a -> PostgisGeometry a)
-> Either GeomErrors (LineString a)
-> Either GeomErrors (PostgisGeometry 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' -> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. b -> Either a b
Right (PostgisGeometry a -> Either GeomErrors (PostgisGeometry a))
-> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (LineString a) -> PostgisGeometry a
forall point. NonEmpty (LineString point) -> PostgisGeometry point
Multiline NonEmpty (LineString a)
nonEmpty'
      Maybe (NonEmpty (LineString a))
Nothing -> GeomErrors -> Either GeomErrors (PostgisGeometry a)
forall a b. a -> Either a b
Left GeomErrors
EmptyMultiline
  Geospatial.Polygon (Geospatial.GeoPolygon Seq (LinearRing GeoPositionWithoutCRS)
polygon) -> LinearRing a -> PostgisGeometry a
forall point. LinearRing point -> PostgisGeometry point
Polygon (LinearRing a -> PostgisGeometry a)
-> Either GeomErrors (LinearRing a)
-> Either GeomErrors (PostgisGeometry 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' -> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. b -> Either a b
Right (PostgisGeometry a -> Either GeomErrors (PostgisGeometry a))
-> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (LinearRing a) -> PostgisGeometry a
forall point. NonEmpty (LinearRing point) -> PostgisGeometry point
MultiPolygon NonEmpty (LinearRing a)
nonEmpty'
      Maybe (NonEmpty (LinearRing a))
Nothing -> GeomErrors -> Either GeomErrors (PostgisGeometry a)
forall a b. a -> Either a b
Left GeomErrors
EmptyMultipolygon
  Geospatial.Collection Seq GeospatialGeometry
seq' -> do
    Seq (PostgisGeometry a)
seqs <- (GeospatialGeometry -> Either GeomErrors (PostgisGeometry a))
-> Seq GeospatialGeometry
-> Either GeomErrors (Seq (PostgisGeometry 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 (PostgisGeometry a)
forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (PostgisGeometry a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors a
interpreter) Seq GeospatialGeometry
seq'
    case [PostgisGeometry a] -> Maybe (NonEmpty (PostgisGeometry a))
forall a. [a] -> Maybe (NonEmpty a)
Non.nonEmpty (Seq (PostgisGeometry a) -> [PostgisGeometry a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (PostgisGeometry a)
seqs) of
      Just NonEmpty (PostgisGeometry a)
nonEmpty' -> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. b -> Either a b
Right (PostgisGeometry a -> Either GeomErrors (PostgisGeometry a))
-> PostgisGeometry a -> Either GeomErrors (PostgisGeometry a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (PostgisGeometry a) -> PostgisGeometry a
forall point.
NonEmpty (PostgisGeometry point) -> PostgisGeometry point
Collection NonEmpty (PostgisGeometry a)
nonEmpty'
      Maybe (NonEmpty (PostgisGeometry a))
Nothing -> GeomErrors -> Either GeomErrors (PostgisGeometry 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 PersistField (PostgisGeometry PointXY) where
  toPersistValue :: PostgisGeometry PointXY -> PersistValue
toPersistValue PostgisGeometry PointXY
geom =
    Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ PostgisGeometry Builder -> Builder
renderGeometry (PostgisGeometry Builder -> Builder)
-> PostgisGeometry Builder -> Builder
forall a b. (a -> b) -> a -> b
$ PointXY -> Builder
renderPair (PointXY -> Builder)
-> PostgisGeometry PointXY -> PostgisGeometry Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PostgisGeometry PointXY
geom
  fromPersistValue :: PersistValue -> Either Text (PostgisGeometry 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
$ Hex -> Either String GeospatialGeometry
parseHexByteString (ByteString -> Hex
Hex ByteString
bs)
    (GeomErrors -> Text)
-> Either GeomErrors (PostgisGeometry PointXY)
-> Either Text (PostgisGeometry 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 (PostgisGeometry PointXY)
 -> Either Text (PostgisGeometry PointXY))
-> Either GeomErrors (PostgisGeometry PointXY)
-> Either Text (PostgisGeometry PointXY)
forall a b. (a -> b) -> a -> b
$ ((GeoPositionWithoutCRS -> Either GeomErrors PointXY)
-> GeospatialGeometry
-> Either GeomErrors (PostgisGeometry PointXY)
forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (PostgisGeometry a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors PointXY
from2dGeoPositionWithoutCRSToPoint) GeospatialGeometry
result
  fromPersistValue PersistValue
other = Text -> Either Text (PostgisGeometry 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 PersistField (PostgisGeometry PointXYZ) where
  toPersistValue :: PostgisGeometry PointXYZ -> PersistValue
toPersistValue PostgisGeometry PointXYZ
geom =
    Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ PostgisGeometry Builder -> Builder
renderGeometry (PostgisGeometry Builder -> Builder)
-> PostgisGeometry Builder -> Builder
forall a b. (a -> b) -> a -> b
$ PointXYZ -> Builder
renderXYZ (PointXYZ -> Builder)
-> PostgisGeometry PointXYZ -> PostgisGeometry Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PostgisGeometry PointXYZ
geom
  fromPersistValue :: PersistValue -> Either Text (PostgisGeometry 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
$ Hex -> Either String GeospatialGeometry
parseHexByteString (ByteString -> Hex
Hex ByteString
bs)
    (GeomErrors -> Text)
-> Either GeomErrors (PostgisGeometry PointXYZ)
-> Either Text (PostgisGeometry 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 (PostgisGeometry PointXYZ)
 -> Either Text (PostgisGeometry PointXYZ))
-> Either GeomErrors (PostgisGeometry PointXYZ)
-> Either Text (PostgisGeometry PointXYZ)
forall a b. (a -> b) -> a -> b
$ ((GeoPositionWithoutCRS -> Either GeomErrors PointXYZ)
-> GeospatialGeometry
-> Either GeomErrors (PostgisGeometry PointXYZ)
forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (PostgisGeometry a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors PointXYZ
from3dGeoPositionWithoutCRSToPoint) GeospatialGeometry
result
  fromPersistValue PersistValue
other = Text -> Either Text (PostgisGeometry 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 PersistField (PostgisGeometry PointXYZM) where
  toPersistValue :: PostgisGeometry PointXYZM -> PersistValue
toPersistValue PostgisGeometry PointXYZM
geom =
    Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ PostgisGeometry Builder -> Builder
renderGeometry (PostgisGeometry Builder -> Builder)
-> PostgisGeometry Builder -> Builder
forall a b. (a -> b) -> a -> b
$ PointXYZM -> Builder
renderXYZM (PointXYZM -> Builder)
-> PostgisGeometry PointXYZM -> PostgisGeometry Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PostgisGeometry PointXYZM
geom
  fromPersistValue :: PersistValue -> Either Text (PostgisGeometry 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
$ Hex -> Either String GeospatialGeometry
parseHexByteString (ByteString -> Hex
Hex ByteString
bs)
    (GeomErrors -> Text)
-> Either GeomErrors (PostgisGeometry PointXYZM)
-> Either Text (PostgisGeometry 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 (PostgisGeometry PointXYZM)
 -> Either Text (PostgisGeometry PointXYZM))
-> Either GeomErrors (PostgisGeometry PointXYZM)
-> Either Text (PostgisGeometry PointXYZM)
forall a b. (a -> b) -> a -> b
$ ((GeoPositionWithoutCRS -> Either GeomErrors PointXYZM)
-> GeospatialGeometry
-> Either GeomErrors (PostgisGeometry PointXYZM)
forall a.
(Eq a, Show a) =>
(GeoPositionWithoutCRS -> Either GeomErrors a)
-> GeospatialGeometry -> Either GeomErrors (PostgisGeometry a)
from2dGeospatialGeometry GeoPositionWithoutCRS -> Either GeomErrors PointXYZM
from4dGeoPositionWithoutCRSToPoint) GeospatialGeometry
result
  fromPersistValue PersistValue
other = Text -> Either Text (PostgisGeometry 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 PersistFieldSql (PostgisGeometry PointXY) where
  sqlType :: Proxy (PostgisGeometry PointXY) -> SqlType
sqlType Proxy (PostgisGeometry PointXY)
_ = Text -> SqlType
SqlOther Text
"geometry"

instance PersistFieldSql (PostgisGeometry PointXYZ) where
  sqlType :: Proxy (PostgisGeometry PointXYZ) -> SqlType
sqlType Proxy (PostgisGeometry PointXYZ)
_ = Text -> SqlType
SqlOther Text
"geometry"

instance PersistFieldSql (PostgisGeometry PointXYZM) where
  sqlType :: Proxy (PostgisGeometry PointXYZM) -> SqlType
sqlType Proxy (PostgisGeometry PointXYZM)
_ = Text -> SqlType
SqlOther Text
"geometry"

-- | Returns TRUE if geometry A contains geometry B.
--   https://postgis.net/docs/ST_Contains.html
st_contains ::
  -- | geom a
  SqlExpr (Value (PostgisGeometry a)) ->
  -- | geom b
  SqlExpr (Value (PostgisGeometry a)) ->
  SqlExpr (Value Bool)
st_contains :: forall a.
SqlExpr (Value (PostgisGeometry a))
-> SqlExpr (Value (PostgisGeometry a)) -> SqlExpr (Value Bool)
st_contains SqlExpr (Value (PostgisGeometry a))
a SqlExpr (Value (PostgisGeometry a))
b = Builder
-> (SqlExpr (Value (PostgisGeometry a)),
    SqlExpr (Value (PostgisGeometry a)))
-> SqlExpr (Value Bool)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_CONTAINS" (SqlExpr (Value (PostgisGeometry a))
a, SqlExpr (Value (PostgisGeometry a))
b)

-- | Returns true if two geometries intersect.
--   Geometries intersect if they have any point in common.
--   https://postgis.net/docs/ST_Intersects.html
st_intersects ::
  SqlExpr (Value (PostgisGeometry a)) ->
  SqlExpr (Value (PostgisGeometry a)) ->
  SqlExpr (Value Bool)
st_intersects :: forall a.
SqlExpr (Value (PostgisGeometry a))
-> SqlExpr (Value (PostgisGeometry a)) -> SqlExpr (Value Bool)
st_intersects SqlExpr (Value (PostgisGeometry a))
a SqlExpr (Value (PostgisGeometry a))
b = Builder
-> (SqlExpr (Value (PostgisGeometry a)),
    SqlExpr (Value (PostgisGeometry a)))
-> SqlExpr (Value Bool)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_Intersects" (SqlExpr (Value (PostgisGeometry a))
a, SqlExpr (Value (PostgisGeometry a))
b)

st_point :: SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value (PostgisGeometry PointXY))
st_point :: SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (PostgisGeometry PointXY))
st_point SqlExpr (Value Double)
a SqlExpr (Value Double)
b = Builder
-> (SqlExpr (Value Double), SqlExpr (Value Double))
-> SqlExpr (Value (PostgisGeometry PointXY))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ST_POINT" (SqlExpr (Value Double)
a, SqlExpr (Value Double)
b)

st_point_xyz :: SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value (PostgisGeometry PointXYZ))
st_point_xyz :: SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (PostgisGeometry PointXYZ))
st_point_xyz SqlExpr (Value Double)
a SqlExpr (Value Double)
b SqlExpr (Value Double)
c = Builder
-> (SqlExpr (Value Double), SqlExpr (Value Double),
    SqlExpr (Value Double))
-> SqlExpr (Value (PostgisGeometry PointXYZ))
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)

st_point_xyzm :: SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value (PostgisGeometry PointXYZM))
st_point_xyzm :: SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value Double)
-> SqlExpr (Value (PostgisGeometry PointXYZM))
st_point_xyzm SqlExpr (Value Double)
a SqlExpr (Value Double)
b SqlExpr (Value Double)
c SqlExpr (Value Double)
m = Builder
-> (SqlExpr (Value Double), SqlExpr (Value Double),
    SqlExpr (Value Double), SqlExpr (Value Double))
-> SqlExpr (Value (PostgisGeometry PointXYZM))
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)