mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-24 07:52:14 +03:00
11a454c2d6
This commit applies ormolu to the whole Haskell code base by running `make format`. For in-flight branches, simply merging changes from `main` will result in merge conflicts. To avoid this, update your branch using the following instructions. Replace `<format-commit>` by the hash of *this* commit. $ git checkout my-feature-branch $ git merge <format-commit>^ # and resolve conflicts normally $ make format $ git commit -a -m "reformat with ormolu" $ git merge -s ours post-ormolu https://github.com/hasura/graphql-engine-mono/pull/2404 GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
95 lines
2.6 KiB
Haskell
95 lines
2.6 KiB
Haskell
module Hasura.SQL.WKT
|
|
( ToWKT (..),
|
|
WKT (..),
|
|
)
|
|
where
|
|
|
|
import Data.List (intersperse)
|
|
import Hasura.Base.Error qualified as E
|
|
import Hasura.Prelude
|
|
import Hasura.SQL.GeoJSON qualified as G
|
|
|
|
newtype WKT = WKT {getWKT :: Text}
|
|
|
|
class ToWKT a where
|
|
toWKT :: a -> Either E.QErr WKT
|
|
|
|
instance ToWKT G.Point where
|
|
toWKT = mkWKT "POINT" . positionToText . G.unPoint
|
|
|
|
instance ToWKT G.MultiPoint where
|
|
toWKT = mkWKT "MULTIPOINT" . commaSeparated . G.unMultiPoint
|
|
|
|
instance ToWKT G.LineString where
|
|
toWKT = mkWKT "LINESTRING" . lineStringToText
|
|
|
|
instance ToWKT G.MultiLineString where
|
|
toWKT =
|
|
mkWKT "MULTILINESTRING"
|
|
. fmap (mconcat . intersperse ", ")
|
|
. traverse (fmap parens . lineStringToText)
|
|
. G.unMultiLineString
|
|
|
|
instance ToWKT G.Polygon where
|
|
toWKT =
|
|
mkWKT "POLYGON"
|
|
. fmap (mconcat . intersperse ", ")
|
|
. traverse (fmap parens . linearRingToText)
|
|
. G.unPolygon
|
|
|
|
instance ToWKT G.MultiPolygon where
|
|
toWKT =
|
|
mkWKT "MULTIPOLYGON"
|
|
. fmap (mconcat . intersperse ", ")
|
|
. traverse
|
|
( fmap (parens . mconcat . intersperse ", ")
|
|
. traverse (fmap parens . linearRingToText)
|
|
. G.unPolygon
|
|
)
|
|
. G.unMultiPolygon
|
|
|
|
instance ToWKT G.GeometryCollection where
|
|
toWKT =
|
|
mkWKT "GEOMETRYCOLLECTION"
|
|
. fmap (mconcat . intersperse ", ")
|
|
. traverse (fmap getWKT . toWKT . G._gwcGeom)
|
|
. G.unGeometryCollection
|
|
|
|
instance ToWKT G.Geometry where
|
|
toWKT =
|
|
\case
|
|
G.GPoint p -> toWKT p
|
|
G.GMultiPoint m -> toWKT m
|
|
G.GLineString l -> toWKT l
|
|
G.GMultiLineString m -> toWKT m
|
|
G.GPolygon p -> toWKT p
|
|
G.GMultiPolygon m -> toWKT m
|
|
G.GGeometryCollection g -> toWKT g
|
|
|
|
instance ToWKT G.GeometryWithCRS where
|
|
toWKT = toWKT . G._gwcGeom
|
|
|
|
mkWKT :: Text -> Either E.QErr Text -> Either E.QErr WKT
|
|
mkWKT name args = WKT . wktFormat <$> args
|
|
where
|
|
wktFormat :: Text -> Text
|
|
wktFormat a = name <> " " <> parens a
|
|
|
|
parens :: Text -> Text
|
|
parens t = "(" <> t <> ")"
|
|
|
|
commaSeparated :: [G.Position] -> Either E.QErr Text
|
|
commaSeparated = fmap (mconcat . intersperse ", ") . traverse positionToText
|
|
|
|
positionToText :: G.Position -> Either E.QErr Text
|
|
positionToText (G.Position x y mz) =
|
|
case mz of
|
|
Nothing -> pure $ tshow x <> " " <> tshow y
|
|
Just _ -> Left $ E.err400 E.ParseFailed "3 dimmensional coordinates are not supported"
|
|
|
|
lineStringToText :: G.LineString -> Either E.QErr Text
|
|
lineStringToText (G.LineString ls1 ls2 lsRest) = commaSeparated (ls1 : ls2 : lsRest)
|
|
|
|
linearRingToText :: G.LinearRing -> Either E.QErr Text
|
|
linearRingToText (G.LinearRing p1 p2 p3 pRest) = commaSeparated (p1 : p2 : p3 : pRest <> [p1])
|