esqueleto-postgis (empty) → 1.0.0
raw patch · 6 files changed
+643/−0 lines, 6 filesdep +basedep +containersdep +esqueleto
Dependencies added: base, containers, esqueleto, esqueleto-postgis, geojson, hedgehog, monad-logger, persistent, persistent-postgresql, resourcet, tasty, tasty-hunit, tasty-quickcheck, text, wkt-geom
Files
- Changelog.md +13/−0
- LICENSE +21/−0
- Readme.md +79/−0
- esqueleto-postgis.cabal +95/−0
- src/Database/Esqueleto/Postgis.hs +227/−0
- test/Test.hs +208/−0
+ Changelog.md view
@@ -0,0 +1,13 @@+# Change log for esqueleto-postgis project++## Version 1.0.0 ++ add st_contains++ add st_intersects++ add st_point++ add custom datatype to map to persistent.++ bunch of roundtrip tests and sanity tests for added functions++## Version 0.0.0 ++import [template](https://github.com/jappeace/template).+
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Jappie Klooster++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Readme.md view
@@ -0,0 +1,79 @@+[](https://jappieklooster.nl/tag/haskell.html)+[](https://github.com/jappeace/haskell-template-project/actions)+[](https://discord.gg/Hp4agqy)+[](https://hackage.haskell.org/package/esqueleto-postgis) ++> Show me the place where space is not.++Implement (partial) postgis functionality for esqueleto.+https://postgis.net/++uses wkt-geom to get a persistent instance,+then maps that to a custom datatype 'PostgisGeometry' which is valid+for roundtripping.++Then the esqueleto combinators are defined around this datatype.++# Tutorial+you can specify some posgis geometry,+use the point to nidicate dimensions, +pointxy = 2 dimensions+pointxyz = 3, pointxyzm = 4.+The library forces you to work in the same dimensions.++You can specify a table with the custom datatype, which will have geometry as sql type:++```haskell+share+ [mkPersist sqlSettings, mkMigrate "migrateAll"]+ [persistUpperCase|+ Unit sql=unit+ geom (PostgisGeometry PointXY)+ deriving Eq Show+|]+```++then you can simply query on tat datatype:++```+test = testCase ("it finds the one unit with st_contains") $ do+ result <- runDB $ do+ _ <- insert $+ Unit+ { unitGeom = Polygon $ makePolygon (PointXY 0 0) (PointXY 0 2) (PointXY 2 2) $ Seq.fromList [(PointXY 2 0)]+ }++ selectOne $ do+ unit <- from $ table @Unit+ where_ $ unit ^. UnitGeom `st_contains` (val $ Point (PointXY 1 1))+ pure countRows++ -- expectation, the result should be 1+ unValue <$> result @?= (Just (1 :: Int)),+```++# Contributing+contributions are welcome.+There are still many bindings missing!++# Hacking++### Tools+Enter the nix shell.+```+nix develop+```+You can checkout the makefile to see what's available:+```+cat makefile+```++### Running+```+make run+```++### Fast filewatch which runs tests+```+make ghcid+```
+ esqueleto-postgis.cabal view
@@ -0,0 +1,95 @@+cabal-version: 3.0++-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack++name: esqueleto-postgis+version: 1.0.0+homepage: https://github.com/jappeace/esqueleto-postgis#readme+bug-reports: https://github.com/jappeace/esqueleto-postgis/issues+author: Jappie Klooster+maintainer: jappieklooster@hotmail.com+copyright: 2024 Jappie Klooster+license: MIT+synopsis: postgis bindings for esqueleto.+description: postgis bindings for esqueleto. Makes postgres a spatial database but now typesafely+category: Database+license-file: LICENSE+build-type: Simple+extra-source-files:+ Readme.md+ LICENSE+extra-doc-files:+ Changelog.md++source-repository head+ type: git+ location: https://github.com/jappeace/esqueleto-postgis++common common-options+ default-extensions: + EmptyCase+ FlexibleContexts+ FlexibleInstances+ InstanceSigs+ MultiParamTypeClasses+ LambdaCase+ MultiWayIf+ NamedFieldPuns+ TupleSections+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DerivingStrategies+ GeneralizedNewtypeDeriving+ StandaloneDeriving+ OverloadedStrings+ TypeApplications+ NumericUnderscores++ ghc-options:+ -Wall -Wincomplete-uni-patterns+ -Wincomplete-record-updates -Widentities -Wredundant-constraints+ -Wcpp-undef -fwarn-tabs -Wpartial-fields+ -fdefer-diagnostics -Wunused-packages+ -fenable-th-splice-warnings+ -fno-omit-yields++ build-depends:+ base >=4.9.1.0 && <4.20.0.0,+ containers >= 0.6.5 && < 0.7,+ esqueleto >= 3.5.10 && < 3.6,+ text >= 1.2.5 && < 1.3,+ persistent >= 2.13.3 && < 2.14,+ geojson >= 4.1.1 && < 4.2,+ wkt-geom >= 0.0.12 && < 0.1,+++ default-language: Haskell2010++library+ import: common-options+ exposed-modules:+ Database.Esqueleto.Postgis+ hs-source-dirs:+ src++test-suite unit+ import: common-options+ type: exitcode-stdio-1.0+ main-is: Test.hs+ ghc-options: -Wno-unused-packages+ hs-source-dirs:+ test+ build-depends:+ tasty,+ tasty-hunit,+ tasty-quickcheck,+ esqueleto-postgis,+ persistent-postgresql,+ resourcet,+ monad-logger,+ hedgehog,
+ src/Database/Esqueleto/Postgis.hs view
@@ -0,0 +1,227 @@+{-# 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 = pack . 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 (Show, Functor, Eq)++data GeomErrors+ = MismatchingDimensionsXYZ PointXYZ+ | MismatchingDimensionsXYZM PointXYZM+ | MismatchingDimensionsXY PointXY+ | NoGeometry+ | EmptyPoint+ | NotImplemented+ | EmptyMultiline+ | EmptyMultiPoint+ | NotEnoughElements+ | EmptyMultipolygon+ | EmptyCollection+ deriving (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 one two three other =+ if Just one == last'+ then makeLinearRing one two three other+ else makeLinearRing one two three (other |> one)+ where+ last' = Seq.lookup (length other) other++from2dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXY+from2dGeoPositionWithoutCRSToPoint = \case+ GeoEmpty -> Left EmptyPoint+ GeoPointXY x -> Right x+ GeoPointXYZ x -> Left (MismatchingDimensionsXYZ x)+ GeoPointXYZM x -> Left (MismatchingDimensionsXYZM x)++from3dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXYZ+from3dGeoPositionWithoutCRSToPoint = \case+ GeoEmpty -> Left EmptyPoint+ GeoPointXY x -> Left (MismatchingDimensionsXY x)+ GeoPointXYZ x -> Right x+ GeoPointXYZM x -> Left (MismatchingDimensionsXYZM x)++from4dGeoPositionWithoutCRSToPoint :: GeoPositionWithoutCRS -> Either GeomErrors PointXYZM+from4dGeoPositionWithoutCRSToPoint = \case+ GeoEmpty -> Left EmptyPoint+ GeoPointXY x -> Left (MismatchingDimensionsXY x)+ GeoPointXYZ x -> Left (MismatchingDimensionsXYZ x)+ GeoPointXYZM x -> Right x++renderPair :: PointXY -> Text.Builder+renderPair (PointXY {..}) = fromString (show _xyX) <> " " <> fromString (show _xyY)+++renderXYZ :: PointXYZ -> Text.Builder+renderXYZ (PointXYZ {..}) = fromString (show _xyzX) <> " " <> fromString (show _xyzY) <> " " <> fromString (show _xyzZ)+++renderXYZM :: PointXYZM -> Text.Builder+renderXYZM (PointXYZM {..}) = fromString (show _xyzmX) <> " " <> fromString (show _xyzmY) <> " " <> fromString (show _xyzmZ) <> " " <> fromString (show _xyzmM)+++renderGeometry :: PostgisGeometry Text.Builder -> Text.Builder+renderGeometry = \case+ Point point -> "POINT(" <> point <> ")"+ MultiPoint points -> "MULTIPOINT (" <> fold (Non.intersperse "," ((\x -> "(" <> x <> ")") <$> points)) <> ")"+ Line line -> "LINESTRING(" <> renderLines line <> ")"+ Multiline (multiline) -> "MULTILINESTRING(" <> fold (Non.intersperse "," ((\line -> "(" <> renderLines line <> ")") <$> multiline)) <> ")"+ Polygon polygon -> "POLYGON((" <> renderLines polygon <> "))"+ MultiPolygon multipolygon -> "MULTIPOLYGON(" <> fold (Non.intersperse "," ((\line -> "((" <> renderLines line <> "))") <$> multipolygon)) <> ")"+ Collection collection -> "GEOMETRYCOLLECTION(" <> fold (Non.intersperse "," (renderGeometry <$> collection)) <> ")"++renderLines :: Foldable f => f Text.Builder -> Text.Builder+renderLines line = fold (List.intersperse "," $ toList line)++from2dGeospatialGeometry :: (Eq a, Show a) => (GeoPositionWithoutCRS -> Either GeomErrors a) -> GeospatialGeometry -> Either GeomErrors (PostgisGeometry a)+from2dGeospatialGeometry interpreter = \case+ Geospatial.NoGeometry -> Left NoGeometry+ Geospatial.Point (GeoPoint point) -> (Point <$> interpreter point)+ Geospatial.MultiPoint (Geospatial.GeoMultiPoint points) -> do+ list' <- sequence $ toList (interpreter <$> points)+ case nonEmpty list' of+ Nothing -> Left EmptyMultiPoint+ Just x -> Right $ MultiPoint x+ Geospatial.Line (Geospatial.GeoLine linestring) -> Line <$> traverse interpreter linestring+ Geospatial.MultiLine (Geospatial.GeoMultiLine multiline) -> do+ seqRes <- traverse (traverse interpreter) multiline+ case Non.nonEmpty (toList seqRes) of+ Just nonEmpty' -> Right $ Multiline nonEmpty'+ Nothing -> Left EmptyMultiline+ Geospatial.Polygon (Geospatial.GeoPolygon polygon) -> Polygon <$> (toLinearRing interpreter) polygon+ Geospatial.MultiPolygon (Geospatial.GeoMultiPolygon multipolygon) -> do+ seqRings <- traverse (toLinearRing interpreter) multipolygon+ case Non.nonEmpty (toList seqRings) of+ Just nonEmpty' -> Right $ MultiPolygon nonEmpty'+ Nothing -> Left EmptyMultipolygon+ Geospatial.Collection seq' -> do+ seqs <- traverse (from2dGeospatialGeometry interpreter) seq'+ case Non.nonEmpty (toList seqs) of+ Just nonEmpty' -> Right $ Collection nonEmpty'+ Nothing -> Left EmptyCollection+++toLinearRing :: (Eq a, Show a) => (GeoPositionWithoutCRS -> Either GeomErrors a) -> Seq (LinearRing GeoPositionWithoutCRS) -> Either GeomErrors (LinearRing a)+toLinearRing interpreter polygon = do+ aSeq <- traverse interpreter (foldMap toSeq polygon)+ case aSeq of+ (one :<| two :<| three :<| rem') -> Right $ makeLinearRing one two three rem'+ _other -> Left NotEnoughElements++instance PersistField (PostgisGeometry PointXY) where+ toPersistValue geom =+ PersistText $ toStrict $ toLazyText $ renderGeometry $ renderPair <$> geom+ fromPersistValue (PersistLiteral_ Escaped bs) = do+ result <- first pack $ parseHexByteString (Hex bs)+ first tshow $ (from2dGeospatialGeometry from2dGeoPositionWithoutCRSToPoint) result+ fromPersistValue other = Left ("PersistField.Polygon: invalid persist value:" <> tshow other)++instance PersistField (PostgisGeometry PointXYZ) where+ toPersistValue geom =+ PersistText $ toStrict $ toLazyText $ renderGeometry $ renderXYZ <$> geom+ fromPersistValue (PersistLiteral_ Escaped bs) = do+ result <- first pack $ parseHexByteString (Hex bs)+ first tshow $ (from2dGeospatialGeometry from3dGeoPositionWithoutCRSToPoint) result+ fromPersistValue other = Left ("PersistField.Polygon: invalid persist value:" <> tshow other)++instance PersistField (PostgisGeometry PointXYZM) where+ toPersistValue geom =+ PersistText $ toStrict $ toLazyText $ renderGeometry $ renderXYZM <$> geom+ fromPersistValue (PersistLiteral_ Escaped bs) = do+ result <- first pack $ parseHexByteString (Hex bs)+ first tshow $ (from2dGeospatialGeometry from4dGeoPositionWithoutCRSToPoint) result+ fromPersistValue other = Left ("PersistField.Polygon: invalid persist value:" <> tshow other)++instance PersistFieldSql (PostgisGeometry PointXY) where+ sqlType _ = SqlOther "geometry"++instance PersistFieldSql (PostgisGeometry PointXYZ) where+ sqlType _ = SqlOther "geometry"++instance PersistFieldSql (PostgisGeometry PointXYZM) where+ sqlType _ = SqlOther "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 a b = unsafeSqlFunction "ST_CONTAINS" (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 a b = unsafeSqlFunction "ST_Intersects" (a, b)++st_point :: SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value (PostgisGeometry PointXY))+st_point a b = unsafeSqlFunction "ST_POINT" (a, b)++st_point_xyz :: SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value (PostgisGeometry PointXYZ))+st_point_xyz a b c = unsafeSqlFunction "ST_POINT" (a, b, c)++st_point_xyzm :: SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value Double) -> SqlExpr (Value (PostgisGeometry PointXYZM))+st_point_xyzm a b c m = unsafeSqlFunction "ST_POINT" (a, b, c, m)
+ test/Test.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Main where++import Control.Monad.IO.Class+import Control.Monad.Logger (MonadLogger (..), runStderrLoggingT)+import Control.Monad.Trans.Resource (MonadThrow, ResourceT, runResourceT)+import Data.Geospatial (PointXY (..), PointXYZ (..), PointXYZM (..))+import Data.LineString (LineString, makeLineString)+import Data.LinearRing (LinearRing)+import Data.List.NonEmpty (NonEmpty)+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Database.Esqueleto.Experimental+import Database.Esqueleto.Postgis+import Database.Persist+import Database.Persist.Postgresql+ ( ConnectionString,+ withPostgresqlConn,+ )+import Database.Persist.TH+ ( mkMigrate,+ mkPersist,+ persistUpperCase,+ share,+ sqlSettings,+ )+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.HUnit++connString :: ConnectionString+connString = "host=localhost port=5432 user=test dbname=test password=test"++-- Test schema+share+ [mkPersist sqlSettings, mkMigrate "migrateAll"]+ [persistUpperCase|+ Unit sql=unit+ geom (PostgisGeometry PointXY)+ deriving Eq Show++ Unityz sql=unityz+ geom (PostgisGeometry PointXYZ)+ deriving Eq Show++ Unityzm sql=unityzm+ geom (PostgisGeometry PointXYZM)+ deriving Eq Show+|]++initializeDB ::+ (MonadIO m) =>+ SqlPersistT (ResourceT m) ()+initializeDB = do+ runMigration migrateAll++runDB :: (forall m. (MonadIO m, MonadLogger m, MonadThrow m) => SqlPersistT (ResourceT m) a) -> IO a+runDB act =+ runStderrLoggingT+ . runResourceT+ . withPostgresqlConn connString+ . runSqlConn+ $ (initializeDB >> act >>= \ret -> transactionUndo >> return ret)++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++test' :: Gen (PostgisGeometry PointXY) -> TestTree+test' gen =+ testCase ("List comparison (different length)") $ do+ someUnit <- Gen.sample (Unit <$> gen)+ result <- runDB $ do+ _ <- insert someUnit+ selectList @(Unit) [] []+ (entityVal <$> result) @?= [someUnit]++testxyz :: Gen (PostgisGeometry PointXYZ) -> TestTree+testxyz gen =+ testCase ("List comparison (different length)") $ do+ someUnit <- Gen.sample (Unityz <$> gen)+ result <- runDB $ do+ _ <- insert someUnit+ selectList @(Unityz) [] []+ (entityVal <$> result) @?= [someUnit]++testxyzm :: Gen (PostgisGeometry PointXYZM) -> TestTree+testxyzm gen =+ testCase ("List comparison (different length)") $ do+ someUnit <- Gen.sample (Unityzm <$> gen)+ result <- runDB $ do+ _ <- insert someUnit+ selectList @(Unityzm) [] []+ (entityVal <$> result) @?= [someUnit]++unitTests :: TestTree+unitTests =+ testGroup+ "Unit tests"+ [ testGroup "roundtrip tests xy" $+ (test') <$> (genCollection genPointxy : genGeometry genPointxy),+ testGroup "roundtrip tests xyz" $+ (testxyz) <$> (genCollection genPointxyz : genGeometry genPointxyz),+ testGroup "roundtrip tests xyzm" $+ (testxyzm) <$> (genCollection genPointxyzm : genGeometry genPointxyzm),+ testGroup "function bindings" $+ [ testCase ("it finds the one unit with st_contains") $ do+ result <- runDB $ do+ _ <- insert $+ Unit+ { unitGeom = Polygon $ makePolygon (PointXY 0 0) (PointXY 0 2) (PointXY 2 2) $ Seq.fromList [(PointXY 2 0)]+ }++ selectOne $ do+ unit <- from $ table @Unit+ where_ $ unit ^. UnitGeom `st_contains` (val $ Point (PointXY 1 1))+ pure countRows+ unValue <$> result @?= (Just (1 :: Int)),+ testCase ("it finds the one unit with intersection st_point") $ do+ result <- runDB $ do+ _ <- insert $+ Unit+ { unitGeom = Polygon $ makePolygon (PointXY 0 0) (PointXY 0 2) (PointXY 2 2) $ Seq.fromList [(PointXY 2 0)]+ }++ selectOne $ do+ unit <- from $ table @Unit+ where_ $ unit ^. UnitGeom `st_contains` (st_point (val 1) (val 1))+ pure countRows+ unValue <$> result @?= (Just (1 :: Int)),+ testCase ("it finds the one unit with intersection st_intersects") $ do+ result <- runDB $ do+ _ <- insert $+ Unit+ { unitGeom = Polygon $ makePolygon (PointXY 0 0) (PointXY 0 2) (PointXY 2 2) $ Seq.fromList [(PointXY 2 0)]+ }++ selectOne $ do+ unit <- from $ table @Unit+ where_ $ unit ^. UnitGeom `st_intersects` (st_point (val 1) (val 1))+ pure countRows+ unValue <$> result @?= (Just (1 :: Int))+ ]+ ]++genDouble :: Gen Double+genDouble = Gen.double (Range.exponentialFloat (-10) 10)++genPointxy :: Gen PointXY+genPointxy = PointXY <$> genDouble <*> genDouble++genPointxyz :: Gen PointXYZ+genPointxyz = PointXYZ <$> genDouble <*> genDouble <*> genDouble++genPointxyzm :: Gen PointXYZM+genPointxyzm = PointXYZM <$> genDouble <*> genDouble <*> genDouble <*> genDouble++genPoints :: Gen a -> Gen (NonEmpty a)+genPoints genPoint = Gen.nonEmpty (Range.constant 1 10) genPoint++genSeq :: Gen a -> Gen (Seq a)+genSeq genPoint = Seq.fromList <$> Gen.list (Range.constant 0 10) genPoint++genLineString :: Gen a -> Gen (LineString a)+genLineString genPoint = makeLineString <$> genPoint <*> genPoint <*> genSeq genPoint++genMultiLineString :: Gen a -> Gen (NonEmpty (LineString a))+genMultiLineString genPoint = Gen.nonEmpty (Range.constant 1 10) (genLineString genPoint)++genLinearring :: (Eq a, Show a) => Gen a -> Gen (LinearRing a)+genLinearring genPoint = makePolygon <$> genPoint <*> genPoint <*> genPoint <*> genSeq genPoint++genMultiLinearring :: (Eq a, Show a) => Gen a -> Gen (NonEmpty (LinearRing a))+genMultiLinearring genPoint = Gen.nonEmpty (Range.constant 1 10) (genLinearring genPoint)++genCollection :: (Eq a, Show a) => Gen a -> Gen (PostgisGeometry a)+genCollection genPoint = Collection <$> Gen.nonEmpty (Range.constant 1 10) (Gen.choice (genGeometry genPoint))++genGeometry :: (Eq a, Show a) => Gen a -> [Gen (PostgisGeometry a)]+genGeometry genPoint =+ [ -- pure NoGeometry+ (Point <$> genPoint),+ (MultiPoint <$> genPoints genPoint),+ (Line <$> genLineString genPoint),+ (Multiline <$> genMultiLineString genPoint),+ (Polygon <$> genLinearring genPoint),+ (MultiPolygon <$> genMultiLinearring genPoint)+ ]