Update graphiql & implement simpler introspection system

source/AirGQL/GraphQL.hs

@@ -106,7 +106,7 @@ import AirGQL.Lib (
   AccessMode (ReadAndWrite, ReadOnly, WriteOnly),
   ColumnEntry (column_name, datatype, datatype_gql),
   GqlTypeName (root),
-  TableEntryRaw (name),
+  TableEntry (name),
   column_name_gql,
   getColumns,
  )
@@ -433,7 +433,7 @@ queryType
   :: Connection
   -> AccessMode
   -> Text
-  -> [TableEntryRaw]
+  -> [TableEntry]
   -> IO (Out.ObjectType IO)
 queryType connection accessMode dbId tables = do
   let
@@ -700,7 +700,7 @@ queryType connection accessMode dbId tables = do
     getResolvers :: IO (HashMap.HashMap Text (Resolver IO))
     getResolvers = do
       let
-        getTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
+        getTableTuple :: TableEntry -> IO (Text, Resolver IO)
         getTableTuple table = do
           outField <- getOutField table.name
           pure
@@ -741,7 +741,7 @@ queryType connection accessMode dbId tables = do
   --   getTableTuples <&> HashMap.fromList
 
   resolvers <- getResolvers
-  schemaResolver <- getSchemaResolver dbId connection accessMode tables
+  schemaResolver <- getSchemaResolver accessMode tables
 
   -- resolversPrimaryKey <- getResolversPrimaryKey
   let
@@ -1092,7 +1092,7 @@ mutationType
   -> Integer
   -> AccessMode
   -> Text
-  -> [TableEntryRaw]
+  -> [TableEntry]
   -> IO (Maybe (Out.ObjectType IO))
 mutationType connection maxRowsPerTable accessMode dbId tables = do
   let
@@ -1229,7 +1229,6 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
       columnEntries <- liftIO $ getColumns dbId connection tableName
 
       context <- ask
-
       let
         columnNames :: [Text]
         columnNames =
@@ -1602,7 +1601,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
     getMutationResolvers :: IO (HashMap.HashMap Text (Resolver IO))
     getMutationResolvers = do
       let
-        getInsertTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
+        getInsertTableTuple :: TableEntry -> IO (Text, Resolver IO)
         getInsertTableTuple table = do
           outFieldInsertion <- getOutField table.name
           pure
@@ -1612,7 +1611,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
                 (executeDbInserts table.name)
             )
 
-        getUpdateTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
+        getUpdateTableTuple :: TableEntry -> IO (Text, Resolver IO)
         getUpdateTableTuple table = do
           outFieldUpdate <- getOutFieldUpdate table.name
           pure
@@ -1622,7 +1621,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
                 (executeDbUpdates table.name)
             )
 
-        getDeleteTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
+        getDeleteTableTuple :: TableEntry -> IO (Text, Resolver IO)
         getDeleteTableTuple table = do
           outFieldDeletion <- getOutFieldDeletion table.name
           pure
@@ -1654,7 +1653,7 @@ getDerivedSchema
   :: SchemaConf
   -> Connection
   -> Text
-  -> [TableEntryRaw]
+  -> [TableEntry]
   -> IO (Schema IO)
 getDerivedSchema schemaConf connection dbId tables = do
   let sqlitePragmas = getSQLitePragmas schemaConf.pragmaConf

source/AirGQL/Introspection/Resolver.hs

@@ -0,0 +1,182 @@
+module AirGQL.Introspection.Resolver (makeType, makeConstField, makeChildField) where
+
+import Protolude (
+  Either (Left),
+  IO,
+  Int,
+  MonadReader (ask),
+  Text,
+  fromMaybe,
+  mempty,
+  note,
+  pure,
+  ($),
+  (+),
+  (<$>),
+  (<&>),
+  (<>),
+  (>=),
+ )
+import Protolude qualified as P
+
+import AirGQL.Introspection.Types qualified as IType
+import Data.HashMap.Strict qualified as HashMap
+import Language.GraphQL.Type qualified as Type
+import Language.GraphQL.Type.In qualified as In
+import Language.GraphQL.Type.Out qualified as Out
+
+
+type Result = Either Text
+
+
+maxDepth :: Int
+maxDepth = 9
+
+
+makeType :: IType.IntrospectionType -> Result (Out.Type IO)
+makeType = makeTypeWithDepth 0
+
+
+makeTypeWithDepth :: Int -> IType.IntrospectionType -> Result (Out.Type IO)
+makeTypeWithDepth depth ty = do
+  case ty.kind of
+    IType.Scalar -> do
+      name <- note "No `name` found for scalar" ty.name
+      pure $ Out.NamedScalarType $ Type.ScalarType name ty.description
+    IType.List -> do
+      ofType <- note "No `ofType` found for list" ty.ofType
+      Out.ListType <$> makeTypeWithDepth depth ofType
+    IType.Enum -> do
+      name <- note "No `name` found for enum" ty.name
+      enumValues <- note "No `enumValues` found for enum" ty.enumValues
+      let variants = enumValues <&> \variant -> (variant.name, Type.EnumValue variant.description)
+      pure $
+        Out.NamedEnumType $
+          Type.EnumType name ty.description $
+            HashMap.fromList variants
+    IType.NonNull -> do
+      ofType <- note "No `ofType` found for nonnull" ty.ofType
+      inner <- makeTypeWithDepth depth ofType
+      pure $ case inner of
+        Out.EnumBaseType enumType -> Out.NonNullEnumType enumType
+        Out.UnionBaseType unionType -> Out.NonNullUnionType unionType
+        Out.ScalarBaseType scalarType -> Out.NonNullScalarType scalarType
+        Out.ObjectBaseType objectType -> Out.NonNullObjectType objectType
+        Out.ListBaseType listType -> Out.NonNullListType listType
+        Out.InterfaceBaseType interfaceType -> Out.NonNullInterfaceType interfaceType
+    IType.InputObject -> do
+      Left "input object in out position"
+    IType.Object -> do
+      name <- note "No `name` found for object" ty.name
+      fields <- note "No `fields` found for object" ty.fields
+      resolvers <-
+        if depth >= maxDepth
+          then pure []
+          else P.for fields $ \field -> do
+            resolver <- makeChildFieldWithDepth (depth + 1) field
+            pure (field.name, resolver)
+
+      typenameResolver <-
+        makeConstFieldWithDepth
+          depth
+          (IType.field "__typename" $ IType.nonNull IType.typeString)
+          (Type.String name)
+
+      pure
+        $ Out.NamedObjectType
+        $ Type.ObjectType
+          name
+          ty.description
+          []
+        $ HashMap.fromList
+        $ ("__typename", typenameResolver) : resolvers
+
+
+makeConstField :: IType.Field -> Type.Value -> Result (Out.Resolver IO)
+makeConstField = makeConstFieldWithDepth 0
+
+
+makeConstFieldWithDepth :: Int -> IType.Field -> Type.Value -> Result (Out.Resolver IO)
+makeConstFieldWithDepth depth field value = do
+  ty <- makeTypeWithDepth depth field.type_
+  let gqlField = Out.Field field.description ty mempty
+  pure $ Out.ValueResolver gqlField $ pure value
+
+
+makeChildField :: IType.Field -> Result (Out.Resolver IO)
+makeChildField = makeChildFieldWithDepth 0
+
+
+makeChildFieldWithDepth :: Int -> IType.Field -> Result (Out.Resolver IO)
+makeChildFieldWithDepth depth field = do
+  args <- P.for field.args $ \arg -> do
+    ty <- makeInTypeWithDepth depth arg.type_
+    pure (arg.name, In.Argument arg.description ty arg.defaultValue)
+  ty <- makeTypeWithDepth depth field.type_
+  let gqlField = Out.Field field.description ty $ HashMap.fromList args
+  pure $ Out.ValueResolver gqlField $ do
+    context <- ask
+    let defaultValue =
+          if Out.isNonNullType ty
+            then
+              Type.String $
+                "Error: field '"
+                  <> field.name
+                  <> "' not found "
+            else Type.Null
+    case context.values of
+      Type.Object obj ->
+        pure $
+          fromMaybe defaultValue $
+            HashMap.lookup field.name obj
+      _ -> pure defaultValue
+
+
+makeInTypeWithDepth :: Int -> IType.IntrospectionType -> Result In.Type
+makeInTypeWithDepth depth ty = do
+  case ty.kind of
+    IType.Scalar -> do
+      name <- note "No `name` found for scalar" ty.name
+      pure $ In.NamedScalarType $ Type.ScalarType name ty.description
+    IType.List -> do
+      ofType <- note "No `ofType` found for list" ty.ofType
+      In.ListType <$> makeInTypeWithDepth depth ofType
+    IType.Enum -> do
+      name <- note "No `name` found for enum" ty.name
+      enumValues <- note "No `enumValues` found for enum" ty.enumValues
+      let variants = enumValues <&> \variant -> (variant.name, Type.EnumValue variant.description)
+      pure $
+        In.NamedEnumType $
+          Type.EnumType name ty.description $
+            HashMap.fromList variants
+    IType.NonNull -> do
+      ofType <- note "No `ofType` found for nonnull" ty.ofType
+      inner <- makeInTypeWithDepth depth ofType
+      pure $ case inner of
+        In.EnumBaseType enumType -> In.NonNullEnumType enumType
+        In.ScalarBaseType scalarType -> In.NonNullScalarType scalarType
+        In.InputObjectBaseType objectType -> In.NonNullInputObjectType objectType
+        In.ListBaseType listType -> In.NonNullListType listType
+    IType.Object -> do
+      Left "out object in input position"
+    IType.InputObject -> do
+      name <- note "No `name` found for object" ty.name
+      fields <- note "No `inputFields` found for object" ty.inputFields
+      gqlFields <-
+        if depth >= maxDepth
+          then pure []
+          else P.for fields $ \field -> do
+            inner <- makeInTypeWithDepth (depth + 1) field.type_
+            let inputField =
+                  In.InputField
+                    field.description
+                    inner
+                    field.defaultValue
+            pure (field.name, inputField)
+
+      pure
+        $ In.NamedInputObjectType
+        $ Type.InputObjectType
+          name
+          ty.description
+        $ HashMap.fromList gqlFields

source/AirGQL/Introspection/Types.hs

@@ -0,0 +1,481 @@
+module AirGQL.Introspection.Types (
+  Schema (..),
+  IntrospectionType (..),
+  TypeKind (..),
+  Field (..),
+  InputValue (..),
+  EnumValue (..),
+  list,
+  nonNull,
+  field,
+  withArguments,
+  inputValue,
+  inputValueWithDescription,
+  withName,
+  withDescription,
+  fieldWithDescription,
+  scalar,
+  object,
+  inputObject,
+  typeSchema,
+  typeIntrospectionType,
+  typeField,
+  typeString,
+  typeInt,
+  typeBool,
+  collectSchemaTypes,
+  enum,
+  enumValue,
+  enumValueWithDescription,
+  deprecatedEnumValue,
+) where
+
+import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict qualified as HashMap
+import Language.GraphQL.Class (ToGraphQL (toGraphQL))
+import Language.GraphQL.Type qualified as Value
+import Protolude (
+  Bool (False, True),
+  Generic,
+  Maybe (Just, Nothing),
+  MonadState (get, put),
+  Monoid (mempty),
+  Show,
+  State,
+  Text,
+  execState,
+  for_,
+  not,
+  show,
+  when,
+  ($),
+  (&),
+ )
+
+
+data Schema = Schema
+  { description :: Maybe Text
+  , types :: [IntrospectionType]
+  , queryType :: IntrospectionType
+  , mutationType :: Maybe IntrospectionType
+  }
+  deriving (Show, Generic)
+
+
+instance ToGraphQL Schema where
+  toGraphQL schema =
+    Value.Object $
+      HashMap.fromList
+        [ ("description", toGraphQL schema.description)
+        , ("types", toGraphQL schema.types)
+        , ("queryType", toGraphQL schema.queryType)
+        , ("mutationType", toGraphQL schema.mutationType)
+        , ("subscriptionType", Value.Null)
+        , ("directives", Value.List [])
+        ]
+
+
+typeSchema :: IntrospectionType
+typeSchema =
+  object
+    "__Schema"
+    [ field "description" typeString
+    , field "types" $ nonNull $ list $ nonNull typeIntrospectionType
+    , field "queryType" $ nonNull typeIntrospectionType
+    , field "mutationType" typeIntrospectionType
+    , field "subscriptionType" typeIntrospectionType
+    , field "directives" $ nonNull $ list $ nonNull typeDirective
+    ]
+
+
+typeDirective :: IntrospectionType
+typeDirective =
+  object
+    "__Directive"
+    [ field "name" typeString
+    , field "description" typeString
+    , field "args" $ nonNull $ list $ nonNull typeInputValue
+    , field "isRepeatable" $ nonNull typeBool
+    , field "locations" $ nonNull $ list $ nonNull typeDirectiveLocation
+    ]
+
+
+typeDirectiveLocation :: IntrospectionType
+typeDirectiveLocation =
+  enum
+    "__DirectiveLocation"
+    [ enumValue "QUERY"
+    , enumValue "MUTATION"
+    , enumValue "SUBSCRIPTION"
+    , enumValue "FIELD"
+    , enumValue "FRAGMENT_DEFINITION"
+    , enumValue "FRAGMENT_SPREAD"
+    , enumValue "INLINE_FRAGMENT"
+    , enumValue "VARIABLE_DEFINITION"
+    , enumValue "SCHEMA"
+    , enumValue "SCALAR"
+    , enumValue "OBJECT"
+    , enumValue "FIELD_DEFINITION"
+    , enumValue "ARGUMENT_DEFINITION"
+    , enumValue "INTERFACE"
+    , enumValue "UNION"
+    , enumValue "ENUM"
+    , enumValue "ENUM_VALUE"
+    , enumValue "INPUT_OBJECT"
+    , enumValue "INPUT_FIELD_DEFINITION"
+    ]
+
+
+data TypeKind = Scalar | Object | Enum | InputObject | List | NonNull
+  deriving (Show, Generic)
+
+
+-- $(deriveToGraphQL ''TypeKind)
+instance ToGraphQL TypeKind where
+  toGraphQL Scalar = Value.Enum "SCALAR"
+  toGraphQL Object = Value.Enum "OBJECT"
+  toGraphQL Enum = Value.Enum "ENUM"
+  toGraphQL InputObject = Value.Enum "INPUT_OBJECT"
+  toGraphQL List = Value.Enum "LIST"
+  toGraphQL NonNull = Value.Enum "NON_NULL"
+
+
+data IntrospectionType = IType
+  { kind :: TypeKind
+  , name :: Maybe Text
+  , description :: Maybe Text
+  , interfaces :: Maybe [IntrospectionType]
+  , possibleTypes :: Maybe [IntrospectionType]
+  , fields :: Maybe [Field]
+  , inputFields :: Maybe [InputValue]
+  , enumValues :: Maybe [EnumValue]
+  , ofType :: Maybe IntrospectionType
+  }
+  deriving (Show, Generic)
+
+
+instance ToGraphQL IntrospectionType where
+  toGraphQL ty =
+    Value.Object $
+      HashMap.fromList
+        [ ("kind", toGraphQL ty.kind)
+        , ("name", toGraphQL ty.name)
+        , ("description", toGraphQL ty.description)
+        , ("interfaces", toGraphQL ty.interfaces)
+        , ("possibleTypes", toGraphQL ty.possibleTypes)
+        , ("fields", toGraphQL ty.fields)
+        , ("enumValues", toGraphQL ty.enumValues)
+        , ("inputFields", toGraphQL ty.inputFields)
+        , ("ofType", toGraphQL ty.ofType)
+        ]
+
+
+typeIntrospectionType :: IntrospectionType
+typeIntrospectionType =
+  object
+    "__Type"
+    [ field
+        "kind"
+        $ enum
+          "__TypeKind"
+          [ enumValue "SCALAR"
+          , enumValue "OBJECT"
+          , enumValue "ENUM"
+          , enumValue "INPUT_OBJECT"
+          , enumValue "LIST"
+          , enumValue "NON_NULL"
+          , enumValue "INTERFACE"
+          ]
+    , field "name" typeString
+    , field "description" typeString
+    , field "interfaces" $ list $ nonNull typeIntrospectionType
+    , field "possibleTypes" $ list $ nonNull typeIntrospectionType
+    , field "fields" (list $ nonNull typeField)
+        & withArguments [inputValue "includeDeprecated" typeBool]
+    , field "enumValues" (list $ nonNull typeEnumValue)
+        & withArguments [inputValue "includeDeprecated" typeBool]
+    , field "inputFields" $ list $ nonNull typeInputValue
+    , field "ofType" typeIntrospectionType
+    ]
+
+
+emptyType :: TypeKind -> IntrospectionType
+emptyType kind =
+  IType
+    { kind
+    , name = Nothing
+    , description = Nothing
+    , interfaces = Nothing
+    , possibleTypes = Nothing
+    , fields = Nothing
+    , enumValues = Nothing
+    , inputFields = Nothing
+    , ofType = Nothing
+    }
+
+
+nonNull :: IntrospectionType -> IntrospectionType
+nonNull ty =
+  (emptyType NonNull)
+    { ofType = Just ty
+    }
+
+
+list :: IntrospectionType -> IntrospectionType
+list ty =
+  (emptyType List)
+    { ofType = Just ty
+    }
+
+
+object :: Text -> [Field] -> IntrospectionType
+object name fields =
+  (emptyType Object)
+    { fields = Just fields
+    , name = Just name
+    , interfaces = Just []
+    }
+
+
+inputObject :: Text -> [InputValue] -> IntrospectionType
+inputObject name fields =
+  (emptyType InputObject)
+    { inputFields = Just fields
+    , name = Just name
+    , interfaces = Just []
+    }
+
+
+enum :: Text -> [EnumValue] -> IntrospectionType
+enum name variants =
+  (emptyType Enum)
+    { enumValues = Just variants
+    , name = Just name
+    }
+
+
+withName :: Text -> IntrospectionType -> IntrospectionType
+withName newName (IType{..}) =
+  IType
+    { name = Just newName
+    , ..
+    }
+
+
+withDescription :: Text -> IntrospectionType -> IntrospectionType
+withDescription newDesc (IType{..}) =
+  IType
+    { description = Just newDesc
+    , ..
+    }
+
+
+scalar :: Text -> IntrospectionType
+scalar tyName =
+  emptyType Scalar
+    & withName tyName
+
+
+data Field = Field
+  { name :: Text
+  , description :: Maybe Text
+  , args :: [InputValue]
+  , type_ :: IntrospectionType
+  , isDeprecated :: Bool
+  , deprecationReason :: Maybe Text
+  }
+  deriving (Show, Generic)
+
+
+instance ToGraphQL Field where
+  toGraphQL thisField =
+    Value.Object $
+      HashMap.fromList
+        [ ("name", toGraphQL thisField.name)
+        , ("description", toGraphQL thisField.description)
+        , ("args", toGraphQL thisField.args)
+        , ("type", toGraphQL thisField.type_)
+        , ("isDeprecated", toGraphQL thisField.isDeprecated)
+        , ("deprecationReason", toGraphQL thisField.deprecationReason)
+        ]
+
+
+typeField :: IntrospectionType
+typeField =
+  object
+    "__Field"
+    [ field "name" $ nonNull typeString
+    , field "description" typeString
+    , field "args" $ nonNull $ list $ nonNull typeInputValue
+    , field "type" $ nonNull typeIntrospectionType
+    , field "isDeprecated" $ nonNull typeBool
+    , field "deprecationReason" typeString
+    ]
+
+
+fieldWithDescription :: Text -> Field -> Field
+fieldWithDescription newDesc (Field{..}) =
+  Field
+    { description = Just newDesc
+    , ..
+    }
+
+
+field :: Text -> IntrospectionType -> Field
+field fieldName fieldType =
+  Field
+    { name = fieldName
+    , description = Nothing
+    , args = []
+    , type_ = fieldType
+    , isDeprecated = False
+    , deprecationReason = Nothing
+    }
+
+
+withArguments :: [InputValue] -> Field -> Field
+withArguments argList (Field{..}) = Field{args = argList, ..}
+
+
+data InputValue = InputValue
+  { name :: Text
+  , description :: Maybe Text
+  , type_ :: IntrospectionType
+  , defaultValue :: Maybe Value.Value
+  }
+  deriving (Show, Generic)
+
+
+instance ToGraphQL InputValue where
+  toGraphQL value =
+    Value.Object $
+      HashMap.fromList
+        [ ("name", toGraphQL value.name)
+        , ("description", toGraphQL value.description)
+        , ("type", toGraphQL value.type_)
+        , -- TODO: I don't think show is the correct function here
+          ("defaultValue", Value.String $ show value.defaultValue)
+        ]
+
+
+typeInputValue :: IntrospectionType
+typeInputValue =
+  object
+    "__InputValue"
+    [ field "name" $ nonNull typeString
+    , field "description" typeString
+    , field "type" $ nonNull typeIntrospectionType
+    , field "defaultValue" typeString
+    ]
+
+
+inputValue :: Text -> IntrospectionType -> InputValue
+inputValue fieldName fieldType =
+  InputValue
+    { name = fieldName
+    , description = Nothing
+    , type_ = fieldType
+    , defaultValue = Nothing
+    }
+
+
+inputValueWithDescription :: Text -> InputValue -> InputValue
+inputValueWithDescription newDesc (InputValue{..}) =
+  InputValue
+    { description = Just newDesc
+    , ..
+    }
+
+
+data EnumValue = EnumValue
+  { name :: Text
+  , description :: Maybe Text
+  , isDeprecated :: Bool
+  , deprecationReason :: Maybe Text
+  }
+  deriving (Show, Generic)
+
+
+instance ToGraphQL EnumValue where
+  toGraphQL value =
+    Value.Object $
+      HashMap.fromList
+        [ ("name", toGraphQL value.name)
+        , ("description", toGraphQL value.description)
+        , ("isDeprecated", toGraphQL value.isDeprecated)
+        , ("deprecationReason", toGraphQL value.deprecationReason)
+        ]
+
+
+typeEnumValue :: IntrospectionType
+typeEnumValue =
+  object
+    "__EnumValue"
+    [ field "name" $ nonNull typeString
+    , field "description" typeString
+    , field "isDeprecated" $ nonNull typeBool
+    , field "deprecationReason" typeString
+    ]
+
+
+enumValue :: Text -> EnumValue
+enumValue name = EnumValue{name = name, description = Nothing, isDeprecated = False, deprecationReason = Nothing}
+
+
+enumValueWithDescription :: Text -> EnumValue -> EnumValue
+enumValueWithDescription newDesc (EnumValue{..}) =
+  EnumValue{description = Just newDesc, ..}
+
+
+deprecatedEnumValue :: Text -> EnumValue -> EnumValue
+deprecatedEnumValue reason (EnumValue{..}) =
+  EnumValue
+    { isDeprecated = True
+    , deprecationReason = Just reason
+    , ..
+    }
+
+
+typeString :: IntrospectionType
+typeString = scalar "String"
+
+
+typeInt :: IntrospectionType
+typeInt = scalar "Int"
+
+
+typeBool :: IntrospectionType
+typeBool = scalar "Boolean"
+
+
+collectSchemaTypes :: Schema -> Schema
+collectSchemaTypes schema = do
+  let basic = [typeInt, typeString, typeBool, typeSchema]
+  let all = do
+        collectTypes schema.queryType
+        for_ schema.mutationType collectTypes
+        for_ basic collectTypes
+  schema
+    { types = HashMap.elems $ execState all mempty
+    }
+
+
+-- | Collect a map of all the named types occurring inside a type
+collectTypes :: IntrospectionType -> State (HashMap Text IntrospectionType) ()
+collectTypes ty = do
+  for_ ty.ofType collectTypes
+  for_ ty.name $ \name -> do
+    current <- get
+    when (not $ HashMap.member name current) $ do
+      put $ HashMap.insert name ty current
+      for_ ty.interfaces $ \interfaces -> do
+        for_ interfaces collectTypes
+      for_ ty.possibleTypes $ \possibleTypes -> do
+        for_ possibleTypes collectTypes
+      for_ ty.inputFields $ \inputFields -> do
+        for_ inputFields $ \thisField -> collectTypes thisField.type_
+      for_ ty.fields $ \fields -> do
+        for_ fields $ \thisField -> do
+          collectTypes thisField.type_
+          for_ thisField.args $ \arg ->
+            collectTypes arg.type_

source/AirGQL/Lib.hs

@@ -7,6 +7,8 @@
 
 module AirGQL.Lib (
   AccessMode (..),
+  canRead,
+  canWrite,
   ColumnEntry (..),
   GqlTypeName (..),
   getEnrichedTable,
@@ -117,6 +119,16 @@ data AccessMode = ReadOnly | WriteOnly | ReadAndWrite
   deriving (Eq, Show)
 
 
+canRead :: AccessMode -> Bool
+canRead WriteOnly = False
+canRead _ = True
+
+
+canWrite :: AccessMode -> Bool
+canWrite ReadOnly = False
+canWrite _ = True
+
+
 data ObjectType = Table | Index | View | Trigger
   deriving (Show, Eq, Generic)
 

source/AirGQL/ServerUtils.hs

@@ -26,7 +26,7 @@ import Language.GraphQL.JSON (graphql)
 import System.FilePath (pathSeparator, (</>))
 
 import AirGQL.GraphQL (getDerivedSchema)
-import AirGQL.Lib (getTables)
+import AirGQL.Lib (getEnrichedTables)
 import AirGQL.Types.SchemaConf (SchemaConf)
 import AirGQL.Types.Types (
   GQLResponse (GQLResponse, data_, errors),
@@ -49,23 +49,32 @@ executeQuery schemaConf dbIdOrPath reqDir query vars opNameMb = do
           else reqDir </> "main.sqlite"
 
   theConn <- SS.open dbFilePath
-  tables <- getTables theConn
+  tablesEither <- getEnrichedTables theConn
-  schema <- getDerivedSchema schemaConf theConn dbIdOrPath tables
+  case tablesEither of
-  result <- graphql schema opNameMb vars query
+    Left err ->
-  SS.close theConn
-
-  case result of
-    Left errMsg -> do
-      errors <- sourceToList errMsg
       pure $
         gqlResponseToObject $
           GQLResponse
             { data_ = Nothing
-            , errors =
+            , errors = Just [String err]
-                Just $
-                  errors
-                    <&> ((\(Response _ errs) -> errs) >>> toList)
-                    & P.concat
-                    <&> (\(Error msg _ _) -> String msg)
             }
-    Right response -> pure response
+    Right tables -> do
+      schema <- getDerivedSchema schemaConf theConn dbIdOrPath tables
+      result <- graphql schema opNameMb vars query
+      SS.close theConn
+
+      case result of
+        Left errMsg -> do
+          errors <- sourceToList errMsg
+          pure $
+            gqlResponseToObject $
+              GQLResponse
+                { data_ = Nothing
+                , errors =
+                    Just $
+                      errors
+                        <&> ((\(Response _ errs) -> errs) >>> toList)
+                        & P.concat
+                        <&> (\(Error msg _ _) -> String msg)
+                }
+        Right response -> pure response