mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
b167120f96
We'll see if this improves compile times at all, but I think it's worth doing as at least the most minimal form of module documentation. This was accomplished by first compiling everything with -ddump-minimal-imports, and then a bunch of scripting (with help from ormolu) **EDIT** it doesn't seem to improve CI compile times but the noise floor is high as it looks like we're not caching library dependencies anymore PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2730 GitOrigin-RevId: 667eb8de1e0f1af70420cbec90402922b8b84cb4
128 lines
4.5 KiB
Haskell
128 lines
4.5 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Hasura.Backends.MySQL.Instances.Execute () where
|
|
|
|
import Data.Aeson as J
|
|
import Data.Bifunctor
|
|
import Data.Coerce
|
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
|
import Data.Text qualified as T
|
|
import Data.Text.Encoding qualified as T
|
|
import Data.Tree
|
|
import Database.MySQL.Base (fetchFields, query, storeResult)
|
|
import Hasura.Backends.MySQL.Connection
|
|
import Hasura.Backends.MySQL.DataLoader.Execute (OutputValue (..), RecordSet (..))
|
|
import Hasura.Backends.MySQL.DataLoader.Execute qualified as DataLoader
|
|
import Hasura.Backends.MySQL.DataLoader.Plan qualified as DataLoader
|
|
import Hasura.Backends.MySQL.Plan
|
|
import Hasura.Backends.MySQL.ToQuery as ToQuery
|
|
import Hasura.Backends.MySQL.Types qualified as MySQL
|
|
import Hasura.Base.Error
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Execute.Backend
|
|
import Hasura.GraphQL.Namespace
|
|
import Hasura.GraphQL.Parser
|
|
import Hasura.Prelude hiding (first, second)
|
|
import Hasura.RQL.IR
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.AnyBackend qualified as AB
|
|
import Hasura.Session
|
|
import Hasura.Tracing qualified as Tracing
|
|
|
|
instance BackendExecute 'MySQL where
|
|
type PreparedQuery 'MySQL = Text
|
|
type MultiplexedQuery 'MySQL = Void
|
|
type ExecutionMonad 'MySQL = Tracing.TraceT (ExceptT QErr IO)
|
|
mkDBQueryPlan = mysqlDBQueryPlan
|
|
mkDBMutationPlan = error "mkDBMutationPlan: MySQL backend does not support this operation yet."
|
|
mkDBSubscriptionPlan _ _ _ _ = error "mkDBSubscriptionPlan: MySQL backend does not support this operation yet."
|
|
mkDBQueryExplain = mysqlDBQueryExplain
|
|
mkLiveQueryExplain _ = error "mkLiveQueryExplain: MySQL backend does not support this operation yet."
|
|
mkDBRemoteRelationshipPlan = error "mkDBRemoteRelationshipPlan: MySQL does not support this operation yet."
|
|
|
|
mysqlDBQueryPlan ::
|
|
forall m.
|
|
( MonadError QErr m
|
|
) =>
|
|
UserInfo ->
|
|
SourceName ->
|
|
SourceConfig 'MySQL ->
|
|
QueryDB 'MySQL (Const Void) (UnpreparedValue 'MySQL) ->
|
|
m (DBStepInfo 'MySQL)
|
|
mysqlDBQueryPlan userInfo sourceName sourceConfig qrf = do
|
|
(headAndTail, actionsForest) <- queryToActionForest userInfo qrf
|
|
pure
|
|
( DBStepInfo
|
|
@'MySQL
|
|
sourceName
|
|
sourceConfig
|
|
(Just (T.pack (drawForest (fmap (fmap show) actionsForest))))
|
|
( do
|
|
result <-
|
|
DataLoader.runExecute
|
|
sourceConfig
|
|
headAndTail
|
|
(DataLoader.execute actionsForest)
|
|
either
|
|
(throw500WithDetail "MySQL DataLoader Error" . toJSON . show)
|
|
(pure . encJFromRecordSet)
|
|
result
|
|
)
|
|
)
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Encoding for Hasura's GraphQL JSON representation
|
|
|
|
mysqlDBQueryExplain ::
|
|
MonadError QErr m =>
|
|
RootFieldAlias ->
|
|
UserInfo ->
|
|
SourceName ->
|
|
SourceConfig 'MySQL ->
|
|
QueryDB 'MySQL (Const Void) (UnpreparedValue 'MySQL) ->
|
|
m (AB.AnyBackend DBStepInfo)
|
|
mysqlDBQueryExplain fieldName userInfo sourceName sourceConfig qrf = do
|
|
select :: MySQL.Select <- planQuery (_uiSession userInfo) qrf
|
|
let sqlQuery = selectSQLTextForQuery select
|
|
sqlQueryText = (T.decodeUtf8 . unQuery . toQueryPretty) (ToQuery.fromSelect select)
|
|
explainResult =
|
|
withMySQLPool
|
|
(MySQL.scConnectionPool sourceConfig)
|
|
( \conn -> do
|
|
query conn ("EXPLAIN FORMAT=JSON " <> (unQuery sqlQuery))
|
|
result <- storeResult conn
|
|
fields <- fetchFields result
|
|
rows <- fetchAllRows result
|
|
let texts = concat $ parseTextRows fields rows
|
|
pure $ encJFromJValue $ ExplainPlan fieldName (Just sqlQueryText) (Just texts)
|
|
)
|
|
pure $
|
|
AB.mkAnyBackend $
|
|
DBStepInfo @'MySQL sourceName sourceConfig Nothing explainResult
|
|
|
|
selectSQLTextForQuery :: MySQL.Select -> ToQuery.Query
|
|
selectSQLTextForQuery select = toQueryFlat $ ToQuery.fromSelect select
|
|
|
|
encJFromRecordSet :: RecordSet -> EncJSON
|
|
encJFromRecordSet RecordSet {rows} =
|
|
encJFromList
|
|
( map
|
|
( encJFromAssocList
|
|
. map (first coerce . second encJFromOutputValue)
|
|
. OMap.toList
|
|
)
|
|
(toList rows)
|
|
)
|
|
|
|
encJFromOutputValue :: DataLoader.OutputValue -> EncJSON
|
|
encJFromOutputValue =
|
|
\case
|
|
ArrayOutputValue array -> encJFromList (map encJFromOutputValue (toList array))
|
|
RecordOutputValue m ->
|
|
encJFromAssocList
|
|
. map (first coerce . second encJFromOutputValue)
|
|
. OMap.toList
|
|
$ m
|
|
ScalarOutputValue value -> encJFromJValue value
|
|
NullOutputValue {} -> encJFromJValue J.Null
|