mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
416 lines
13 KiB
Haskell
416 lines
13 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
-- | Convert the simple AST to an SQL query, ready to be passed
|
|
-- to the mysql package's query/exec functions.
|
|
module Hasura.Backends.MySQL.ToQuery
|
|
( Printer,
|
|
toQueryPretty,
|
|
fromSelect,
|
|
toQueryFlat,
|
|
Query (..),
|
|
renderBuilderPretty,
|
|
runBuilderPretty,
|
|
)
|
|
where
|
|
|
|
import Data.ByteString (ByteString)
|
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
|
import Data.List (intersperse)
|
|
import Data.String
|
|
import Data.Text qualified as T
|
|
import Data.Text.Encoding qualified as T
|
|
import Data.Text.Lazy.Builder qualified as LT
|
|
import Data.Tuple (swap)
|
|
import Hasura.Backends.MySQL.Types
|
|
import Hasura.Prelude hiding (GT, LT)
|
|
|
|
newtype Query = Query {unQuery :: ByteString} deriving (Show, Eq, Monoid, Semigroup)
|
|
|
|
data Printer
|
|
= SeqPrinter [Printer]
|
|
| SepByPrinter Printer [Printer]
|
|
| NewlinePrinter
|
|
| QueryPrinter Query
|
|
| IndentPrinter Int Printer
|
|
deriving (Show, Eq)
|
|
|
|
instance IsString Printer where
|
|
fromString = QueryPrinter . Query . fromString
|
|
|
|
(<+>) :: Printer -> Printer -> Printer
|
|
(<+>) x y = SeqPrinter [x, y]
|
|
|
|
-- Printer generators
|
|
|
|
fromExpression :: Expression -> Printer
|
|
fromExpression =
|
|
\case
|
|
ValueExpression value -> QueryPrinter (fromScalarType value)
|
|
AndExpression xs ->
|
|
case xs of
|
|
[] -> truePrinter
|
|
_ ->
|
|
SepByPrinter
|
|
(NewlinePrinter <+> "AND ")
|
|
(fmap (\x -> "(" <+> fromExpression x <+> ")") (toList xs))
|
|
OrExpression xs ->
|
|
case xs of
|
|
[] -> falsePrinter
|
|
_ ->
|
|
SepByPrinter
|
|
(NewlinePrinter <+> "OR ")
|
|
(fmap (\x -> "(" <+> fromExpression x <+> ")") (toList xs))
|
|
NotExpression expression -> "NOT " <+> fromExpression expression
|
|
ExistsExpression sel -> "EXISTS (" <+> fromSelect sel <+> ")"
|
|
InExpression x xs ->
|
|
fromExpression x <+> " IN " <+> SeqPrinter (fmap fromExpression xs)
|
|
ColumnExpression fieldName -> fromFieldName fieldName
|
|
MethodExpression field method args ->
|
|
fromExpression field
|
|
<+> "."
|
|
<+> fromString (T.unpack method)
|
|
<+> "("
|
|
<+> SeqPrinter (map fromExpression args)
|
|
<+> ")"
|
|
OpExpression op x y ->
|
|
"("
|
|
<+> fromExpression x
|
|
<+> ") "
|
|
<+> fromOp op
|
|
<+> " ("
|
|
<+> fromExpression y
|
|
<+> ")"
|
|
|
|
fromScalarType :: ScalarValue -> Query
|
|
fromScalarType = \case
|
|
BigValue v -> Query $ fromString $ show v
|
|
BinaryValue v -> Query $ fromString $ show v
|
|
BitValue v -> Query $ fromString $ show v
|
|
BlobValue v -> Query $ fromString $ show v
|
|
CharValue v -> Query $ fromString $ show v
|
|
DatetimeValue v -> Query $ fromString $ show v
|
|
DateValue v -> Query $ fromString $ show v
|
|
DecimalValue v -> Query $ fromString $ show v
|
|
DoubleValue v -> Query $ fromString $ show v
|
|
EnumValue v -> Query $ fromString $ show v
|
|
FloatValue v -> Query $ fromString $ show v
|
|
GeometrycollectionValue v -> Query $ fromString $ show v
|
|
GeometryValue v -> Query $ fromString $ show v
|
|
IntValue v -> Query $ fromString $ show v
|
|
JsonValue v -> Query $ fromString $ show v
|
|
LinestringValue v -> Query $ fromString $ show v
|
|
MediumValue v -> Query $ fromString $ show v
|
|
MultilinestringValue v -> Query $ fromString $ show v
|
|
MultipointValue v -> Query $ fromString $ show v
|
|
MultipolygonValue v -> Query $ fromString $ show v
|
|
NullValue -> Query $ fromString "NULL"
|
|
NumericValue v -> Query $ fromString $ show v
|
|
PointValue v -> Query $ fromString $ show v
|
|
PolygonValue v -> Query $ fromString $ show v
|
|
SmallValue v -> Query $ fromString $ show v
|
|
TextValue v -> Query $ fromString $ show v
|
|
TimestampValue v -> Query $ fromString $ show v
|
|
TimeValue v -> Query $ fromString $ show v
|
|
TinyValue v -> Query $ fromString $ show v
|
|
VarbinaryValue v -> Query $ fromString $ show v
|
|
VarcharValue v -> Query $ fromString $ show v
|
|
YearValue v -> Query $ fromString $ show v
|
|
other -> error $ "fromscalartype: not implemented " <> show other
|
|
|
|
fromOp :: Op -> Printer
|
|
fromOp =
|
|
\case
|
|
LT -> "<"
|
|
GT -> ">"
|
|
GTE -> ">="
|
|
LTE -> "<="
|
|
IN -> "IN"
|
|
NIN -> "NOT IN"
|
|
LIKE -> "LIKE"
|
|
NLIKE -> "NOT LIKE"
|
|
EQ' -> "="
|
|
NEQ' -> "!="
|
|
|
|
fromFieldName :: FieldName -> Printer
|
|
fromFieldName (FieldName {..}) =
|
|
fromNameText fNameEntity <+> "." <+> fromNameText fName
|
|
|
|
fromSelect :: Select -> Printer
|
|
fromSelect Select {..} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
$ [ "SELECT "
|
|
<+> IndentPrinter
|
|
7
|
|
( SepByPrinter
|
|
("," <+> NewlinePrinter)
|
|
(map fromProjection (toList selectProjections))
|
|
),
|
|
"FROM " <+> IndentPrinter 5 (fromFrom selectFrom),
|
|
fromWhere selectWhere,
|
|
fromOrderBys selectOrderBy,
|
|
fromOffsetAndLimit selectSqlTop selectSqlOffset
|
|
]
|
|
|
|
-- https://dev.mysql.com/doc/refman/5.7/en/select.html
|
|
fromOffsetAndLimit :: Top -> Maybe Int -> Printer
|
|
fromOffsetAndLimit NoTop Nothing = ""
|
|
fromOffsetAndLimit NoTop (Just offset) =
|
|
SeqPrinter
|
|
[ "LIMIT " <+> fromString (show (maxBound :: Int)),
|
|
IndentPrinter 9 (SepByPrinter NewlinePrinter [" OFFSET " <+> fromString (show offset)])
|
|
]
|
|
fromOffsetAndLimit (Top val) Nothing = SeqPrinter ["LIMIT " <+> fromString (show val)]
|
|
fromOffsetAndLimit (Top val) (Just offset) =
|
|
SeqPrinter
|
|
[ "LIMIT " <+> fromString (show val),
|
|
IndentPrinter 9 (SepByPrinter NewlinePrinter [" OFFSET " <+> fromString (show offset)])
|
|
]
|
|
|
|
fromOrderBys ::
|
|
Maybe (NonEmpty OrderBy) -> Printer
|
|
fromOrderBys Nothing = ""
|
|
fromOrderBys (Just orderBys) =
|
|
SeqPrinter
|
|
[ "ORDER BY ",
|
|
IndentPrinter
|
|
9
|
|
( SepByPrinter
|
|
NewlinePrinter
|
|
[ SepByPrinter
|
|
("," <+> NewlinePrinter)
|
|
(concatMap fromOrderBy (toList orderBys))
|
|
]
|
|
)
|
|
]
|
|
|
|
fromOrderBy :: OrderBy -> [Printer]
|
|
fromOrderBy OrderBy {..} =
|
|
[ fromNullsOrder orderByFieldName orderByNullsOrder,
|
|
-- Above: This doesn't do anything when using text, ntext or image
|
|
-- types. See below on CAST commentary.
|
|
wrapNullHandling (fromFieldName orderByFieldName)
|
|
<+> " "
|
|
<+> fromOrder orderByOrder
|
|
]
|
|
where
|
|
wrapNullHandling inner = inner
|
|
|
|
fromOrder :: Order -> Printer
|
|
fromOrder =
|
|
\case
|
|
Asc -> "ASC"
|
|
Desc -> "DESC"
|
|
|
|
-- Source <https://gregrs-uk.github.io/2011-02-02/mysql-order-by-with-nulls-first-or-last/>
|
|
fromNullsOrder :: FieldName -> NullsOrder -> Printer
|
|
fromNullsOrder fieldName =
|
|
\case
|
|
NullsAnyOrder -> ""
|
|
-- ISNULL(NULL)=1, ISNULL(_) = 0 -- therefore we need DESC to put
|
|
-- nulls first.
|
|
NullsFirst -> "ISNULL(" <+> fromFieldName fieldName <+> ") DESC"
|
|
NullsLast -> "ISNULL(" <+> fromFieldName fieldName <+> ") ASC"
|
|
|
|
fromProjection :: Projection -> Printer
|
|
fromProjection =
|
|
\case
|
|
ExpressionProjection aliasedExpression ->
|
|
fromAliased (fmap fromExpression aliasedExpression)
|
|
FieldNameProjection aliasedFieldName ->
|
|
fromAliased (fmap fromFieldName aliasedFieldName)
|
|
AggregateProjection aliasedAggregate ->
|
|
fromAliased (fmap fromAggregate aliasedAggregate)
|
|
AggregateProjections aliasedAggregates ->
|
|
fromAliased
|
|
( fmap
|
|
( \aggs ->
|
|
"STRUCT("
|
|
<+> IndentPrinter
|
|
7
|
|
( SepByPrinter
|
|
", "
|
|
(fmap (fromAliased . fmap fromAggregate) (toList aggs))
|
|
)
|
|
<+> ")"
|
|
)
|
|
aliasedAggregates
|
|
)
|
|
StarProjection -> "*"
|
|
EntityProjection aliasedEntity ->
|
|
fromAliased
|
|
( fmap
|
|
( \(fields :: [(FieldName, FieldOrigin)]) ->
|
|
-- Example:
|
|
-- STRUCT(
|
|
-- IFNULL(
|
|
-- `aa_articles1`.`aggregate`,
|
|
-- STRUCT(0 as count, struct(null as id) as sum)
|
|
-- ) as aggregate
|
|
-- ) AS `articles_aggregate`
|
|
--
|
|
-- The (AS `articles_aggregate`) part at the end is rendered by 'fromAliased' evaluating
|
|
-- at the root of this branch, and not by anything below
|
|
"STRUCT("
|
|
<+> ( SepByPrinter
|
|
", "
|
|
( fields
|
|
<&> \(fieldName@FieldName {..}, fieldOrigin :: FieldOrigin) ->
|
|
"IFNULL("
|
|
<+> fromFieldName fieldName
|
|
<+> ", "
|
|
<+> fromFieldOrigin fieldOrigin
|
|
<+> ") AS "
|
|
<+> fromNameText fName
|
|
)
|
|
)
|
|
<+> ")"
|
|
)
|
|
aliasedEntity
|
|
)
|
|
ArrayEntityProjection entityAlias aliasedEntity ->
|
|
fromAliased
|
|
( fmap
|
|
( \aggs ->
|
|
"ARRAY(SELECT AS STRUCT "
|
|
<+> IndentPrinter
|
|
7
|
|
(SepByPrinter ", " (fmap fromFieldNameNaked (toList aggs)))
|
|
<+> " FROM "
|
|
<+> fromNameText (entityAliasText entityAlias)
|
|
<+> ".agg)"
|
|
)
|
|
aliasedEntity
|
|
)
|
|
where
|
|
fromFieldNameNaked :: FieldName -> Printer
|
|
fromFieldNameNaked (FieldName {..}) =
|
|
fromNameText fName
|
|
|
|
fromAggregate :: Aggregate -> Printer
|
|
fromAggregate =
|
|
\case
|
|
CountAggregate countable -> "COUNT(" <+> fromCountable countable <+> ")"
|
|
OpAggregate text args ->
|
|
QueryPrinter (Query $ fromString $ show text)
|
|
<+> "("
|
|
<+> SepByPrinter ", " (map fromExpression (toList args))
|
|
<+> ")"
|
|
TextAggregate text -> fromExpression (ValueExpression (TextValue text))
|
|
|
|
fromCountable :: Countable FieldName -> Printer
|
|
fromCountable =
|
|
\case
|
|
StarCountable -> "*"
|
|
NonNullFieldCountable fields ->
|
|
SepByPrinter ", " (map fromFieldName (toList fields))
|
|
DistinctCountable fields ->
|
|
"DISTINCT "
|
|
<+> SepByPrinter ", " (map fromFieldName (toList fields))
|
|
|
|
fromWhere :: Where -> Printer
|
|
fromWhere =
|
|
\case
|
|
Where [] -> ""
|
|
Where expressions ->
|
|
"WHERE "
|
|
<+> IndentPrinter 6 (fromExpression (AndExpression expressions))
|
|
|
|
fromFrom :: From -> Printer
|
|
fromFrom =
|
|
\case
|
|
FromQualifiedTable aliasedQualifiedTableName ->
|
|
fromAliased (fmap fromTableName aliasedQualifiedTableName)
|
|
FromSelect select -> fromAliased (fmap (parens . fromSelect) select)
|
|
|
|
parens :: Printer -> Printer
|
|
parens x = "(" <+> IndentPrinter 1 x <+> ")"
|
|
|
|
fromTableName :: TableName -> Printer
|
|
fromTableName TableName {name, schema} =
|
|
maybe "" ((<+> ".") . fromNameText) schema <+> fromNameText name
|
|
|
|
fromAliased :: Aliased Printer -> Printer
|
|
fromAliased Aliased {..} =
|
|
aliasedThing
|
|
<+> ((" AS " <+>) . fromNameText) aliasedAlias
|
|
|
|
fromNameText :: Text -> Printer
|
|
fromNameText t = QueryPrinter (Query . fromString . T.unpack $ t)
|
|
|
|
truePrinter :: Printer
|
|
truePrinter = "TRUE"
|
|
|
|
falsePrinter :: Printer
|
|
falsePrinter = "FALSE"
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Basic printing API
|
|
|
|
toQueryFlat :: Printer -> Query
|
|
toQueryFlat = go 0
|
|
where
|
|
go level =
|
|
\case
|
|
QueryPrinter q -> q
|
|
SeqPrinter xs -> mconcat (filter notEmpty (map (go level) xs))
|
|
SepByPrinter x xs ->
|
|
mconcat
|
|
(intersperse (go level x) (filter notEmpty (map (go level) xs)))
|
|
NewlinePrinter -> Query " "
|
|
IndentPrinter n p -> go (level + n) p
|
|
notEmpty = (/= mempty)
|
|
|
|
toQueryPretty :: Printer -> Query
|
|
toQueryPretty = go 0
|
|
where
|
|
go level =
|
|
\case
|
|
QueryPrinter q -> q
|
|
SeqPrinter xs -> mconcat (filter notEmpty (map (go level) xs))
|
|
SepByPrinter x xs ->
|
|
mconcat
|
|
(intersperse (go level x) (filter notEmpty (map (go level) xs)))
|
|
NewlinePrinter -> Query $ fromString $ show $ "\n" <> indentation level
|
|
IndentPrinter n p -> go (level + n) p
|
|
indentation n = T.replicate n " "
|
|
notEmpty = (/= mempty)
|
|
|
|
-- | Produces a query with holes, and a mapping for each
|
|
renderBuilderPretty :: Printer -> (LT.Builder, InsOrdHashMap Int ScalarValue)
|
|
renderBuilderPretty =
|
|
second (OMap.fromList . map swap . OMap.toList)
|
|
. flip runState mempty
|
|
. runBuilderPretty
|
|
|
|
runBuilderPretty :: Printer -> State (InsOrdHashMap ScalarValue Int) LT.Builder
|
|
runBuilderPretty = go 0
|
|
where
|
|
go level =
|
|
\case
|
|
SeqPrinter xs -> fmap (mconcat . filter notEmpty) (mapM (go level) xs)
|
|
SepByPrinter x xs -> do
|
|
i <- go level x
|
|
fmap (mconcat . intersperse i . filter notEmpty) (mapM (go level) xs)
|
|
NewlinePrinter -> pure ("\n" <> indentation level)
|
|
IndentPrinter n p -> go (level + n) p
|
|
QueryPrinter Query {unQuery = q} -> pure . LT.fromText . T.decodeUtf8 $ q
|
|
indentation n = LT.fromText (T.replicate n " ")
|
|
notEmpty = (/= mempty)
|
|
|
|
fromFieldOrigin :: FieldOrigin -> Printer
|
|
fromFieldOrigin = \case
|
|
NoOrigin -> "NULL"
|
|
AggregateOrigin aliasedAggregates ->
|
|
"STRUCT("
|
|
<+>
|
|
-- Example: "0 AS count, STRUCT(NULL AS id) AS sum"
|
|
SepByPrinter ", " (fromAliased . fmap fromNullAggregate <$> aliasedAggregates)
|
|
<+> ")"
|
|
|
|
fromNullAggregate :: Aggregate -> Printer
|
|
fromNullAggregate = \case
|
|
CountAggregate _ -> "0"
|
|
OpAggregate _text _exp -> "NULL"
|
|
TextAggregate _text -> "NULL"
|