mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
d91029ad51
### Description This PR removes all `fmapX` and `traverseX` functions from RQL.IR, favouring instead `Functor` and `Traversable` instances throughout the code. This was a relatively straightforward change, except for two small pain points: `AnnSelectG` and `AnnInsert`. Both were parametric over two types `a` and `v`, making it impossible to make them traversable functors... But it turns out that in every single use case, `a ~ f v`. By changing those types to take such an `f :: Type -> Type` as an argument instead of `a :: Type` makes it possible to make them functors. The only small difference is for `AnnIns`, I had to introduce one `Identity` transformation for one of the `f` parameters. This is relatively straightforward. ### Notes This PR fixes the most verbose BigQuery hint (`let` instead of `<- pure`). https://github.com/hasura/graphql-engine-mono/pull/1668 GitOrigin-RevId: e632263a8c559aa04aeae10dcaec915b4a81ad1a
140 lines
5.3 KiB
Haskell
140 lines
5.3 KiB
Haskell
module Hasura.GraphQL.Schema.Common where
|
||
|
||
import Hasura.Prelude
|
||
|
||
import qualified Data.Aeson as J
|
||
import qualified Data.HashMap.Strict as Map
|
||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||
import qualified Data.Text as T
|
||
|
||
import Data.Either (isRight)
|
||
import Data.Text.Extended
|
||
import Language.GraphQL.Draft.Syntax as G
|
||
|
||
import qualified Hasura.Backends.Postgres.SQL.Types as PG
|
||
import qualified Hasura.GraphQL.Execute.Types as ET (GraphQLQueryType)
|
||
import qualified Hasura.GraphQL.Parser as P
|
||
import qualified Hasura.RQL.IR.Select as IR
|
||
|
||
import Hasura.Base.Error
|
||
import Hasura.GraphQL.Parser (UnpreparedValue)
|
||
import Hasura.RQL.Types
|
||
|
||
|
||
type SelectExp b = IR.AnnSimpleSelectG b UnpreparedValue (UnpreparedValue b)
|
||
type AggSelectExp b = IR.AnnAggregateSelectG b UnpreparedValue (UnpreparedValue b)
|
||
type ConnectionSelectExp b = IR.ConnectionSelect b UnpreparedValue (UnpreparedValue b)
|
||
type SelectArgs b = IR.SelectArgsG b (UnpreparedValue b)
|
||
type TablePerms b = IR.TablePermG b (UnpreparedValue b)
|
||
type AnnotatedFields b = IR.AnnFieldsG b UnpreparedValue (UnpreparedValue b)
|
||
type AnnotatedField b = IR.AnnFieldG b UnpreparedValue (UnpreparedValue b)
|
||
|
||
data QueryContext =
|
||
QueryContext
|
||
{ qcStringifyNum :: !Bool
|
||
, qcDangerousBooleanCollapse :: !Bool
|
||
, qcQueryType :: !ET.GraphQLQueryType
|
||
, qcRemoteRelationshipContext :: !(HashMap RemoteSchemaName (IntrospectionResult, ParsedIntrospection))
|
||
, qcFunctionPermsContext :: !FunctionPermissionsCtx
|
||
}
|
||
|
||
textToName :: MonadError QErr m => Text -> m G.Name
|
||
textToName textName = G.mkName textName `onNothing` throw400 ValidationFailed
|
||
("cannot include " <> textName <<> " in the GraphQL schema because "
|
||
<> " it is not a valid GraphQL identifier")
|
||
|
||
partialSQLExpToUnpreparedValue :: PartialSQLExp b -> P.UnpreparedValue b
|
||
partialSQLExpToUnpreparedValue (PSESessVar pftype var) = P.UVSessionVar pftype var
|
||
partialSQLExpToUnpreparedValue (PSESQLExp sqlExp) = P.UVLiteral sqlExp
|
||
|
||
mapField
|
||
:: Functor m
|
||
=> P.InputFieldsParser m (Maybe a)
|
||
-> (a -> b)
|
||
-> P.InputFieldsParser m (Maybe b)
|
||
mapField fp f = fmap (fmap f) fp
|
||
|
||
parsedSelectionsToFields
|
||
:: (Text -> a) -- ^ how to handle @__typename@ fields
|
||
-> OMap.InsOrdHashMap G.Name (P.ParsedSelection a)
|
||
-> IR.Fields a
|
||
parsedSelectionsToFields mkTypename = OMap.toList
|
||
>>> map (FieldName . G.unName *** P.handleTypename (mkTypename . G.unName))
|
||
|
||
numericAggOperators :: [G.Name]
|
||
numericAggOperators =
|
||
[ $$(G.litName "sum")
|
||
, $$(G.litName "avg")
|
||
, $$(G.litName "stddev")
|
||
, $$(G.litName "stddev_samp")
|
||
, $$(G.litName "stddev_pop")
|
||
, $$(G.litName "variance")
|
||
, $$(G.litName "var_samp")
|
||
, $$(G.litName "var_pop")
|
||
]
|
||
|
||
comparisonAggOperators :: [G.Name]
|
||
comparisonAggOperators = [$$(litName "max"), $$(litName "min")]
|
||
|
||
data NodeIdVersion
|
||
= NIVersion1
|
||
deriving (Show, Eq)
|
||
|
||
nodeIdVersionInt :: NodeIdVersion -> Int
|
||
nodeIdVersionInt NIVersion1 = 1
|
||
|
||
currentNodeIdVersion :: NodeIdVersion
|
||
currentNodeIdVersion = NIVersion1
|
||
|
||
instance J.FromJSON NodeIdVersion where
|
||
parseJSON v = do
|
||
versionInt :: Int <- J.parseJSON v
|
||
case versionInt of
|
||
1 -> pure NIVersion1
|
||
_ -> fail $ "expecting version 1 for node id, but got " <> show versionInt
|
||
|
||
mkDescriptionWith :: Maybe PG.PGDescription -> Text -> G.Description
|
||
mkDescriptionWith descM defaultTxt = G.Description $ case descM of
|
||
Nothing -> defaultTxt
|
||
Just (PG.PGDescription descTxt) -> T.unlines [descTxt, "\n", defaultTxt]
|
||
|
||
-- TODO why do we do these validations at this point? What does it mean to track
|
||
-- a function but not add it to the schema...?
|
||
-- Auke:
|
||
-- I believe the intention is simply to allow the console to do postgres data management
|
||
-- Karthikeyan: Yes, this is correct. We allowed this pre PDV but somehow
|
||
-- got removed in PDV. OTOH, I’m not sure how prevalent this feature
|
||
-- actually is
|
||
takeValidTables :: forall b. Backend b => TableCache b -> TableCache b
|
||
takeValidTables = Map.filterWithKey graphQLTableFilter . Map.filter tableFilter
|
||
where
|
||
tableFilter = not . isSystemDefined . _tciSystemDefined . _tiCoreInfo
|
||
graphQLTableFilter tableName tableInfo =
|
||
-- either the table name should be GraphQL compliant
|
||
-- or it should have a GraphQL custom name set with it
|
||
isRight (tableGraphQLName @b tableName) ||
|
||
isJust (_tcCustomName $ _tciCustomConfig $ _tiCoreInfo tableInfo)
|
||
|
||
-- TODO and what about graphql-compliant function names here too?
|
||
takeValidFunctions :: forall b. FunctionCache b -> FunctionCache b
|
||
takeValidFunctions = Map.filter functionFilter
|
||
where
|
||
functionFilter = not . isSystemDefined . _fiSystemDefined
|
||
|
||
|
||
-- root field builder helpers
|
||
|
||
requiredFieldParser
|
||
:: (Functor n, Functor m)
|
||
=> (a -> b)
|
||
-> m (P.FieldParser n a)
|
||
-> m (Maybe (P.FieldParser n b))
|
||
requiredFieldParser f = fmap $ Just . fmap f
|
||
|
||
optionalFieldParser
|
||
:: (Functor n, Functor m)
|
||
=> (a -> b)
|
||
-> m (Maybe (P.FieldParser n a))
|
||
-> m (Maybe (P.FieldParser n b))
|
||
optionalFieldParser = fmap . fmap . fmap
|