mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 01:12:56 +03:00
40617719ef
We only use these `Show` instances in error messages (where we call `show` explicitly anyway) and test cases (in which Hspec requires `Show a` for any `a` in an assertion). This removes the instance in favor of a custom `showQErr` function (which serializes the error to JSON). It is then used in certain error message production which previously called `show` on a `QErr`. There are two places where we serialize a QErr and then construct a new QErr from the resulting string. Instead, we modify the existing QErr to add extra information. An orphan `Show QErr` instance is retained for tests so that we can have nice test failure messages. This is preparation for future changes in which the error message within `QErr` will not be exposed directly, and therefore will not have a `Show` instance. That said, it feels like a sensible kind of cleanup anyway. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4897 GitOrigin-RevId: 8f79f7a356f0aea571156f39aefac242bf751f3a
287 lines
8.6 KiB
Haskell
287 lines
8.6 KiB
Haskell
{-# OPTIONS_GHC -Wno-deferred-type-errors #-}
|
|
|
|
module Hasura.SQL.WKTSpec
|
|
( spec,
|
|
)
|
|
where
|
|
|
|
import Data.Either (isLeft)
|
|
import Hasura.Base.Error.TestInstances ()
|
|
import Hasura.Prelude
|
|
import Hasura.SQL.GeoJSON qualified as G
|
|
import Hasura.SQL.WKT
|
|
import Test.Hspec
|
|
|
|
spec :: Spec
|
|
spec = describe "WKT" do
|
|
runSpec "Point" pointSpec
|
|
runSpec "MultiPoint" multiPointSpec
|
|
runSpec "LineString" lineStringSpec
|
|
runSpec "MultiLineString" multiLineStringSpec
|
|
runSpec "Polygon" polygonSpec
|
|
runSpec "MultiPolygon" multiPolygonSpec
|
|
runSpec "GeometryCollection" geometryCollectionSpec
|
|
runNegativeSpec "3D types should error" negativeSpecs
|
|
|
|
negativeSpecs :: [G.Point]
|
|
negativeSpecs =
|
|
[ mkPoint $ mkPosition 1 2 (Just 3),
|
|
mkPoint $ mkPosition 1 2 (Just (-1))
|
|
]
|
|
|
|
runNegativeSpec :: forall a. ToWKT a => String -> [a] -> Spec
|
|
runNegativeSpec name = it name . traverse_ go
|
|
where
|
|
go wkt =
|
|
getWKT <$> toWKT wkt `shouldSatisfy` isLeft
|
|
|
|
runSpec :: forall a. ToWKT a => String -> [(Text, a)] -> Spec
|
|
runSpec name = it name . traverse_ go
|
|
where
|
|
go (t, wkt) =
|
|
getWKT <$> toWKT wkt `shouldBe` Right t
|
|
|
|
pointSpec :: [(Text, G.Point)]
|
|
pointSpec =
|
|
[ ( "POINT (1.0 2.0)",
|
|
mkPoint $ mkPosition 1 2 Nothing
|
|
),
|
|
( "POINT (1.1 2.2)",
|
|
mkPoint $ mkPosition 1.1 2.2 Nothing
|
|
),
|
|
( "POINT (1.1 -2.2)",
|
|
mkPoint $ mkPosition 1.1 (-2.2) Nothing
|
|
)
|
|
]
|
|
|
|
multiPointSpec :: [(Text, G.MultiPoint)]
|
|
multiPointSpec =
|
|
[ ( "MULTIPOINT (1.0 2.0)",
|
|
mkMultiPoint [mkPosition 1 2 Nothing]
|
|
),
|
|
( "MULTIPOINT (1.1 2.2, 4.4 5.5)",
|
|
mkMultiPoint
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing
|
|
]
|
|
)
|
|
]
|
|
|
|
lineStringSpec :: [(Text, G.LineString)]
|
|
lineStringSpec =
|
|
[ ( "LINESTRING (1.0 2.0, 3.0 4.0)",
|
|
mkLineString
|
|
[ mkPosition 1 2 Nothing,
|
|
mkPosition 3 4 Nothing
|
|
]
|
|
),
|
|
( "LINESTRING (1.1 2.2, 4.4 5.5, 7.7 8.8)",
|
|
mkLineString
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
]
|
|
)
|
|
]
|
|
|
|
multiLineStringSpec :: [(Text, G.MultiLineString)]
|
|
multiLineStringSpec =
|
|
[ ( "MULTILINESTRING ((1.1 2.2, 4.4 5.5, 7.7 8.8))",
|
|
mkMultiLineString
|
|
[ mkLineString
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
]
|
|
]
|
|
),
|
|
( "MULTILINESTRING ((1.1 2.2, 4.4 5.5, 7.7 8.8), (1.1 2.2, 4.4 5.5))",
|
|
mkMultiLineString
|
|
[ mkLineString
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
],
|
|
mkLineString
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing
|
|
]
|
|
]
|
|
)
|
|
]
|
|
|
|
polygonSpec :: [(Text, G.Polygon)]
|
|
polygonSpec =
|
|
[ ( "POLYGON ((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2))",
|
|
mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
]
|
|
]
|
|
),
|
|
( "POLYGON ((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2), (1.1 2.2, 4.4 5.5, 7.7 8.8, 1.0 1.0, 1.1 2.2))",
|
|
mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
],
|
|
mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing,
|
|
mkPosition 1.0 1.0 Nothing
|
|
]
|
|
]
|
|
)
|
|
]
|
|
|
|
multiPolygonSpec :: [(Text, G.MultiPolygon)]
|
|
multiPolygonSpec =
|
|
[ ( "MULTIPOLYGON (((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2)))",
|
|
mkMultiPolygon
|
|
[ mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
]
|
|
]
|
|
]
|
|
),
|
|
( "MULTIPOLYGON (((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2)), ((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2), (1.1 2.2, 4.4 5.5, 7.7 8.8, 1.0 1.0, 1.1 2.2)))",
|
|
mkMultiPolygon
|
|
[ mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
]
|
|
],
|
|
mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
],
|
|
mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing,
|
|
mkPosition 1.0 1.0 Nothing
|
|
]
|
|
]
|
|
]
|
|
)
|
|
]
|
|
|
|
geometryCollectionSpec :: [(Text, G.GeometryCollection)]
|
|
geometryCollectionSpec =
|
|
[ ( "GEOMETRYCOLLECTION (POINT (1.0 2.0), LINESTRING (3.0 4.0, 5.0 6.0))",
|
|
mkGeometryCollection
|
|
[ G.GPoint $ mkPoint $ mkPosition 1 2 Nothing,
|
|
G.GLineString $
|
|
mkLineString
|
|
[ mkPosition 3 4 Nothing,
|
|
mkPosition 5 6 Nothing
|
|
]
|
|
]
|
|
),
|
|
( "GEOMETRYCOLLECTION (POINT (1.1 -2.2), MULTIPOINT (1.1 2.2, 4.4 5.5), LINESTRING (1.1 2.2, 4.4 5.5, 7.7 8.8), MULTILINESTRING ((1.1 2.2, 4.4 5.5, 7.7 8.8), (1.1 2.2, 4.4 5.5)), POLYGON ((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2), (1.1 2.2, 4.4 5.5, 7.7 8.8, 1.0 1.0, 1.1 2.2)), MULTIPOLYGON (((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2)), ((1.1 2.2, 4.4 5.5, 7.7 8.8, 1.1 2.2), (1.1 2.2, 4.4 5.5, 7.7 8.8, 1.0 1.0, 1.1 2.2))))",
|
|
mkGeometryCollection
|
|
[ G.GPoint $ mkPoint $ mkPosition 1.1 (-2.2) Nothing,
|
|
G.GMultiPoint $
|
|
mkMultiPoint
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing
|
|
],
|
|
G.GLineString $
|
|
mkLineString
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
],
|
|
G.GMultiLineString $
|
|
mkMultiLineString
|
|
[ mkLineString
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
],
|
|
mkLineString
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing
|
|
]
|
|
],
|
|
G.GPolygon $
|
|
mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
],
|
|
mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing,
|
|
mkPosition 1.0 1.0 Nothing
|
|
]
|
|
],
|
|
G.GMultiPolygon $
|
|
mkMultiPolygon
|
|
[ mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
]
|
|
],
|
|
mkPolygon
|
|
[ mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing
|
|
],
|
|
mkLinearRing
|
|
[ mkPosition 1.1 2.2 Nothing,
|
|
mkPosition 4.4 5.5 Nothing,
|
|
mkPosition 7.7 8.8 Nothing,
|
|
mkPosition 1.0 1.0 Nothing
|
|
]
|
|
]
|
|
]
|
|
]
|
|
)
|
|
]
|
|
|
|
mkGeometryCollection :: [G.Geometry] -> G.GeometryCollection
|
|
mkGeometryCollection = G.GeometryCollection . fmap (`G.GeometryWithCRS` Nothing)
|
|
|
|
mkMultiPolygon :: [G.Polygon] -> G.MultiPolygon
|
|
mkMultiPolygon = G.MultiPolygon
|
|
|
|
mkLinearRing :: [G.Position] -> G.LinearRing
|
|
mkLinearRing (x : y : z : xs) = G.LinearRing x y z xs
|
|
mkLinearRing _ = error "mkLinearRing requires >2 points"
|
|
|
|
mkPolygon :: [G.LinearRing] -> G.Polygon
|
|
mkPolygon = G.Polygon
|
|
|
|
mkMultiLineString :: [G.LineString] -> G.MultiLineString
|
|
mkMultiLineString = G.MultiLineString
|
|
|
|
mkLineString :: [G.Position] -> G.LineString
|
|
mkLineString (x : y : xs) = G.LineString x y xs
|
|
mkLineString _ = error "mkLineString requires >1 points"
|
|
|
|
mkMultiPoint :: [G.Position] -> G.MultiPoint
|
|
mkMultiPoint = G.MultiPoint
|
|
|
|
mkPoint :: G.Position -> G.Point
|
|
mkPoint = G.Point
|
|
|
|
mkPosition :: Double -> Double -> Maybe Double -> G.Position
|
|
mkPosition = G.Position
|