mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 09:51:59 +03:00
58 lines
1.7 KiB
Haskell
58 lines
1.7 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Hasura.RQL.DML.Explain where
|
|
|
|
import Data.Aeson
|
|
import Data.Aeson.Casing
|
|
import Data.Aeson.TH
|
|
|
|
import qualified Data.ByteString.Builder as BB
|
|
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DML.Internal
|
|
import Hasura.RQL.DML.Select
|
|
import Hasura.RQL.GBoolExp
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.Types
|
|
|
|
import qualified Data.String.Conversions as CS
|
|
import qualified Data.Text as T
|
|
import qualified Database.PG.Query as Q
|
|
|
|
data RQLExplain =
|
|
RQLExplain
|
|
{ rqleQuery :: !SelectQuery
|
|
, rqleRole :: !RoleName
|
|
, rqleHeaders :: !HeaderObj
|
|
} deriving (Show, Eq)
|
|
$(deriveJSON (aesonDrop 4 camelCase) ''RQLExplain)
|
|
|
|
data ExplainResp =
|
|
ExplainResp
|
|
{ erSql :: !T.Text
|
|
, erPlans :: !Value
|
|
} deriving (Show, Eq)
|
|
$(deriveJSON (aesonDrop 2 camelCase) ''ExplainResp)
|
|
|
|
phaseOneExplain :: SelectQuery -> P1 SelectData
|
|
phaseOneExplain = convSelectQuery txtRHSBuilder
|
|
|
|
phaseTwoExplain :: (P2C m) => SelectData -> m RespBody
|
|
phaseTwoExplain sel = do
|
|
planResp <- liftTx $ runIdentity . Q.getRow <$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder withExplain) [] True
|
|
plans <- decodeBS planResp
|
|
return $ encode $ ExplainResp selectSQLT plans
|
|
where
|
|
selectSQL = toSQL $ mkSQLSelect sel
|
|
explainSQL = BB.string7 "EXPLAIN (FORMAT JSON) "
|
|
withExplain = explainSQL <> selectSQL
|
|
|
|
decodeBS bs = case eitherDecode bs of
|
|
Left e -> throw500 $
|
|
"Plan query response is invalid json; " <> T.pack e
|
|
Right a -> return a
|
|
|
|
selectSQLT = CS.cs $ BB.toLazyByteString selectSQL
|