1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-22 23:11:41 +03:00
graphql-engine/server/src-lib/Hasura/SQL/WKT.hs
Robert 11a454c2d6 server, pro: actually reformat the code-base using ormolu
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
2021-09-23 22:57:37 +00:00

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])