esqueleto-postgis 3.0.0 → 4.0.0

raw patch · 4 files changed

+130/−15 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Changelog.md +9/−0
• esqueleto-postgis.cabal +1/−1
• src/Database/Esqueleto/Postgis.hs +95/−13
• test/Test.hs +25/−1

@@ -1,5 +1,14 @@ # Change log for esqueleto-postgis project +## Version 4.0.0 +Hotfix!+++ `st_union` can't work on geography, banned that.++ `st_intersects` was to strict and worked only on geography++ add `st_transform_geometry` and `st_transform_geography` to convert between the two.++ hopefully I've explained the srid system somewhat understandable, it's kinda confusing.++ restrict `st_contains` to geometry as well        .+ ## Version 3.0.0  * add spatial type, split up postgis from geoemetry.   this will allow us to deal with curveture of earth and other weird SRID's:

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           esqueleto-postgis-version:        3.0.0+version:        4.0.0 homepage:       https://github.com/jappeace/esqueleto-postgis#readme bug-reports:    https://github.com/jappeace/esqueleto-postgis/issues author:         Jappie Klooster

@@ -8,6 +8,13 @@  -- | 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.+--+--   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(..),@@ -28,10 +35,22 @@     st_point,     st_point_xyz,     st_point_xyzm,-    -- * other +    -- * transform+    st_transform_geography,+    st_transform_geometry,+    -- ** srid+    SRID,+    wgs84,+    mercator ,+    britishNationalGrid,+    SridUnit    (..),+++    -- * other     makePolygon,     PostgisGeometry,+    HasPgType,      -- * re-exports     PointXY(..),@@ -88,10 +107,14 @@ tshow = pack . show  --- | Spatial Reference System.+-- | Guarantees we don't accidently mix curved space with flat space.+--   Postgis will catch this too, this just put's it in the type system. data SpatialType = Geometry -- ^ assume a flat space.                  | Geography -- ^ assume curvature of the earth. +-- | technical typeclass to bind a spatial type to a string value.+--   because we represent the constructors as a datakind, we need+--   this to go back to a value. class HasPgType (spatialType :: SpatialType) where   pgType :: Proxy spatialType -> Text @@ -267,9 +290,9 @@ --   https://postgis.net/docs/ST_Contains.html st_contains ::   -- | geom a-  SqlExpr (Value (Postgis spatialType a)) ->+  SqlExpr (Value (Postgis 'Geometry a)) ->   -- | geom b-  SqlExpr (Value (Postgis spatialType a)) ->+  SqlExpr (Value (Postgis 'Geometry a)) ->   SqlExpr (Value Bool) st_contains a b = unsafeSqlFunction "ST_CONTAINS" (a, b) @@ -285,6 +308,66 @@   SqlExpr (Value Bool) st_dwithin a b c = unsafeSqlFunction "ST_DWithin" (a, b, c) +-- | 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 (Num, PersistField)++-- | default for geography type in postgis.+--   Geodetic CRS: WGS 84+--   https://epsg.io/4326+wgs84 :: SRID 'Degree+wgs84 = 4326++-- | most maps are in this, it has some large distortions further away from equator+--   https://epsg.io/3857+mercator :: SRID 'Linear+mercator = 3857++-- | if you're in england this is pretty good.+--   https://epsg.io/27700+britishNationalGrid :: SRID 'Linear+britishNationalGrid = 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 srid geography =+  unsafeSqlFunction "ST_Transform" (casted, val srid)+  where+    casted :: SqlExpr (Value (Postgis 'Geometry a))+    casted = unsafe_cast_pg_type 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 input = unsafe_cast_pg_type transformed+  where+    transformed :: SqlExpr (Value (Postgis 'Geometry a))+    transformed =+      unsafeSqlFunction "ST_Transform" (input, val 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 = unsafeSqlCastAs castAs+  where+    castAs = pgType $ Proxy @two+ -- | allows union of geometries, eg group a bunch together, --   https://postgis.net/docs/ST_Union.html --   for example:@@ -302,21 +385,20 @@ --    pure unit -- @ st_union ::-  SqlExpr (Value (Postgis spatialType a)) ->-  SqlExpr (Value (Postgis spatialType a))+  SqlExpr (Value (Postgis 'Geometry a)) ->+  SqlExpr (Value (Postgis 'Geometry a)) st_union a = unsafeSqlFunction "ST_union" a  st_unions ::-  forall spatialType a . HasPgType spatialType =>-  SqlExpr (Value (Postgis spatialType a)) ->-  SqlExpr (Value (Postgis spatialType a)) ->-  SqlExpr (Value (Postgis spatialType a))+  SqlExpr (Value (Postgis 'Geometry a)) ->+  SqlExpr (Value (Postgis 'Geometry a)) ->+  SqlExpr (Value (Postgis 'Geometry a)) st_unions a b =   -- casts to prevent   -- function st_union(unknown, unknown) is not unique", sqlErrorDetail = "", sqlErrorHint = "Could not choose a best candidate function. You might need to add explicit type casts.   unsafeSqlFunction "ST_union" ((unsafeSqlCastAs casted a), (unsafeSqlCastAs casted b))   where-    casted = (pgType $ Proxy @spatialType)+    casted = (pgType $ Proxy @'Geometry)  -- | calculate the distance between two points --   https://postgis.net/docs/ST_Distance.html@@ -331,8 +413,8 @@ --   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 (Postgis spatialType a)) -> -- ^ geomA or geogA+  SqlExpr (Value (Postgis spatialType a)) -> -- ^ geomB or geogB   SqlExpr (Value Bool) st_intersects a b = unsafeSqlFunction "ST_Intersects" (a, b) 

@@ -71,6 +71,10 @@     geom (PostgisGeometry PointXY)     label Text +  GeoGrid+    geo (Postgis 'Geography PointXY)+    label Text+   Unit sql=unit     geom       (PostgisGeometry PointXY)     deriving Eq Show@@ -218,10 +222,30 @@                 grid <- from $ table @Grid                 pure $ st_union $ grid ^. GridGeom             unValue <$> result @?= (Just $ Polygon $ makeLinearRing (PointXY {_xyX = 0.0, _xyY = 2.0}) (PointXY {_xyX = 2.0, _xyY = 2.0}) (PointXY {_xyX = 4.0, _xyY = 2.0}) (Seq.fromList [PointXY {_xyX = 4.0, _xyY = 0.0}, PointXY {_xyX = 2.0, _xyY = 0.0}, PointXY {_xyX = 0.0, _xyY = 0.0}])),+          testCase ("union_in_PG_and then get out some Haskell") $ do+            result <- runDB $ do+              _ <-+                insert $+                  GeoGrid+                    { geoGridGeo = Polygon $ makePolygon (PointXY 0 0) (PointXY 0 2) (PointXY 2 2) $ Seq.fromList [(PointXY 2 0)],+                      geoGridLabel = "x"+                    }+              _ <-+                insert $+                  GeoGrid+                    { geoGridGeo = Polygon $ makePolygon (PointXY 2 0) (PointXY 2 2) (PointXY 4 2) $ Seq.fromList [(PointXY 4 0)],+                      geoGridLabel = "y"+                    }++              selectOne $ do+                grid <- from $ table @GeoGrid+                pure $ st_transform_geometry $ st_union $ st_transform_geography mercator $ grid ^. GeoGridGeo+            -- as degrees it doesn't appear to be merging them.+            unValue <$> result @?= (Just (Polygon (makeLinearRing (PointXY {_xyX = 1.9999999999999996, _xyY = 1.9999999999999996}) (PointXY {_xyX = 3.999999999999999, _xyY = 1.9999999999999996}) (PointXY {_xyX = 3.999999999999999, _xyY = 0.0}) (Seq.fromList [PointXY {_xyX = 1.9999999999999996, _xyY = 0.0},PointXY {_xyX = 0.0, _xyY = 0.0},PointXY {_xyX = 0.0, _xyY = 1.9999999999999996}])))),           testCase ("see if we can unions in PG and then get out some Haskell") $ do             result <- runDB $ do               selectOne $-                pure $ st_unions @'Geometry  (val (Polygon $ makePolygon (PointXY 0 0) (PointXY 0 2) (PointXY 2 2) $ Seq.fromList [(PointXY 2 0)])) $+                pure $ st_unions (val (Polygon $ makePolygon (PointXY 0 0) (PointXY 0 2) (PointXY 2 2) $ Seq.fromList [(PointXY 2 0)])) $                         val $ Polygon $ makePolygon (PointXY 2 0) (PointXY 2 2) (PointXY 4 2) $ Seq.fromList [(PointXY 4 0)]             unValue <$> result @?= (Just $ Polygon $ makeLinearRing (PointXY {_xyX = 0.0, _xyY = 2.0}) (PointXY {_xyX = 2.0, _xyY = 2.0}) (PointXY {_xyX = 4.0, _xyY = 2.0}) (Seq.fromList [PointXY {_xyX = 4.0, _xyY = 0.0}, PointXY {_xyX = 2.0, _xyY = 0.0}, PointXY {_xyX = 0.0, _xyY = 0.0}])),