Implement querying by PK

- I realised by PK querying doesn't need arguments like filter, limit or
offset, so I removed the argument name collision logic I added in the
last commit
- I implemented the actual logic for querying by PK. The code is a lot
shorter due to the new introspection system
- I moved the normal queries to the new introspection system for
consistency.
- I moved the logic of "coerce columns without a datatype" away from the
resolver and into the "sql -> gql" converter as to be able to reuse the
default introspection resolver which simply looks up fields into the
parent resolver's result.
- I added some comments documenting the Introspection.Resolver stuff and
it's behaviour

source/AirGQL/GraphQL.hs

@@ -75,7 +75,7 @@ import Language.GraphQL.Type as GQL (
   EnumValue (EnumValue),
   InputField (InputField),
   Resolver (EventStreamResolver, ValueResolver),
-  ScalarType,
+  ScalarType (ScalarType),
   Schema,
   Value (Boolean, Enum, Float, Int, List, Null, Object, String),
   boolean,
@@ -101,12 +101,15 @@ import AirGQL.GQLWrapper (
   inArgumentToArgument,
   outFieldToField,
  )
+
 import AirGQL.Introspection (getSchemaResolver, typeNameResolver)
+import AirGQL.Introspection qualified as Introspection
+import AirGQL.Introspection.Resolver qualified as Introspection
 import AirGQL.Lib (
   AccessMode (ReadAndWrite, ReadOnly, WriteOnly),
   ColumnEntry (column_name, datatype, datatype_gql),
   GqlTypeName (root),
-  TableEntry (name),
+  TableEntry (columns, name),
   column_name_gql,
   getColumns,
  )
@@ -120,10 +123,14 @@ import AirGQL.Types.SchemaConf (
  )
 import AirGQL.Types.Utils (encodeToText)
 import AirGQL.Utils (colToFileUrl, collectErrorList, quoteKeyword, quoteText)
+import Data.Either.Extra qualified as Either
 
 
 typeNameToScalarType :: Maybe GqlTypeName -> ScalarType
-typeNameToScalarType Nothing = string
+typeNameToScalarType Nothing =
+  ScalarType
+    "any"
+    (Just "A type that could result to any kind of GQL scalar")
 typeNameToScalarType (Just typeName) =
   case typeName.root of
     "Int" -> int
@@ -195,13 +202,7 @@ colNamesWithValResolver columnEntries =
           Object obj ->
             case obj & HashMap.lookup colEntry.column_name_gql of
               Nothing -> String "Error: Field does not exist"
-              Just val ->
+              Just val -> val
-                case colEntry.datatype of
-                  -- Coerce value to nullable String
-                  -- if no datatype is set.
-                  -- This happens for columns in views.
-                  "" -> gqlValueToNullableString val
-                  _ -> val
           _ -> String "Error: Value could not be retrieved"
     in
       ( colEntry.column_name_gql
@@ -441,141 +442,15 @@ queryType connection accessMode dbId tables = do
     documentation =
       "Available queries for database \"" <> dbId <> "\""
 
-    getOutField :: Text -> IO (Out.Field IO)
+    getOutField :: TableEntry -> IO (Out.Field IO)
-    getOutField tableName = do
+    getOutField table =
-      columnEntries <- liftIO $ getColumns dbId connection tableName
+      case Introspection.makeField $ Introspection.tableQueryField table of
+        Left err -> P.throwIO $ userError $ T.unpack err
+        Right result -> pure result
 
-      let
+    getDbEntries :: TableEntry -> Out.Resolve IO
-        colNamesWithOrderingTerm :: [(Text, InputField)]
+    getDbEntries table = do
-        colNamesWithOrderingTerm =
-          columnEntries <&> \colEntry ->
-            ( colEntry.column_name_gql
-            , InputField
-                (Just $ "Ordering term for " <> colEntry.column_name_gql)
-                ( In.NamedEnumType $
-                    EnumType
-                      "OrderingTerm"
-                      (Just "Ordering object for the column")
-                      ( HashMap.fromList
-                          [ ("ASC", EnumValue (Just "ASC"))
-                          , ("asc", EnumValue (Just "ASC"))
-                          , ("DESC", EnumValue (Just "DESC"))
-                          , ("desc", EnumValue (Just "DESC"))
-                          ]
-                      )
-                )
-                Nothing -- Default value
-            )
-
-        typeNameField :: Text -> [(Text, Resolver IO)]
-        typeNameField nameOfTable =
-          let
-            typeNameOutField =
-              outFieldToField $
-                OutField
-                  { descriptionMb = Just $ "The type name of " <> nameOfTable
-                  , fieldType = Out.NonNullScalarType string
-                  , arguments = HashMap.empty
-                  }
-          in
-            [
-              ( "__typename"
-              , ValueResolver typeNameOutField $
-                  pure $
-                    String $
-                      doubleXEncodeGql nameOfTable <> "_row"
-              )
-            ]
-
-      pure $
-        outFieldToField $
-          OutField
-            { descriptionMb = Just $ "Provides entries from " <> tableName
-            , fieldType =
-                Out.ListType $
-                  Out.NamedObjectType $
-                    Out.ObjectType
-                      tableName
-                      (Just "short desc")
-                      []
-                      ( HashMap.fromList $
-                          colNamesWithValResolver columnEntries
-                            <> typeNameField tableName
-                      )
-            , arguments =
-                HashMap.fromList
-                  [
-                    ( "filter"
-                    , inArgumentToArgument $
-                        InArgument
-                          { argDescMb = Just "Filter objects"
-                          , argType =
-                              NamedInputObjectType $
-                                InputObjectType
-                                  (doubleXEncodeGql tableName <> "_filter")
-                                  ( Just
-                                      "Filter objects for the specified columns"
-                                  )
-                                  (HashMap.fromList (colNamesWithFilterField tableName columnEntries))
-                          , valueMb = Nothing
-                          }
-                    )
-                  ,
-                    ( "order_by"
-                    , inArgumentToArgument $
-                        InArgument
-                          { argDescMb = Just "Order by the specified columns"
-                          , argType =
-                              In.ListType $
-                                In.NamedInputObjectType $
-                                  InputObjectType
-                                    (doubleXEncodeGql tableName <> "_order_by")
-                                    (Just "Options for ordering by columns")
-                                    (HashMap.fromList colNamesWithOrderingTerm)
-                          , valueMb = Nothing
-                          }
-                    )
-                  ,
-                    ( "limit"
-                    , inArgumentToArgument $
-                        InArgument
-                          { argDescMb =
-                              Just "Limit the number of returned rows."
-                          , argType = In.NamedScalarType int
-                          , valueMb = Nothing
-                          }
-                    )
-                  ,
-                    ( "offset"
-                    , inArgumentToArgument $
-                        InArgument
-                          { argDescMb =
-                              Just
-                                "Change the index rows \
-                                \start being returned from"
-                          , argType = In.NamedScalarType int
-                          , valueMb = Nothing
-                          }
-                    )
-                  ]
-            }
-    -- -- TODO: Use for retrieving record by primary key
-    -- , arguments = HashMap.fromList $ columnEntries
-    --     <&> (\colEntry ->
-    --           ( colEntry.column_name_gql :: Text
-    --           , inArgumentToArgument $ InArgument
-    --               { argDescMb = Just "Retrieve object by primary key"
-    --               , argType = In.NamedScalarType $
-    --                   typeNameToScalarType $ colEntry.datatype
-    --               , valueMb = Nothing
-    --               }
-    --           )
-    --         )
-
-    getDbEntries :: Text -> Out.Resolve IO
-    getDbEntries tableName = do
       context <- ask
-      colEntries <- liftIO $ getColumns dbId connection tableName
 
       rows :: [[SQLData]] <- case context.arguments of
         Arguments args -> do
@@ -647,7 +522,7 @@ queryType connection accessMode dbId tables = do
               Query $
                 P.fold
                   [ "SELECT COUNT() FROM"
-                  , quoteKeyword tableName
+                  , quoteKeyword table.name
                   , "\n"
                   , getWhereClause filterElements
                   ]
@@ -682,68 +557,105 @@ queryType connection accessMode dbId tables = do
                   , show numRows
                   , " rows. "
                   , "Consider setting the `limit` argument on your query: `{ "
-                  , T.unpack tableName
+                  , T.unpack table.name
                   , " (limit: 50) { ... } }`"
                   ]
 
           liftIO $
             executeSqlQuery
               connection
-              tableName
+              table.name
-              colEntries
+              table.columns
               filterElements
               orderElements
               paginationMb
 
-      rowsToList dbId tableName colEntries rows
+      colErrorsToUserError $ rowsToGraphQL dbId table.name table.columns rows
+
+    getOutByPKField :: TableEntry -> IO (Maybe (Out.Field IO))
+    getOutByPKField tableEntry = do
+      let fieldMb = Introspection.tableQueryByPKField tableEntry
+      P.for fieldMb $ \field -> do
+        let fieldEither = Introspection.makeField field
+
+        case fieldEither of
+          Left err -> P.throwIO $ userError $ T.unpack err
+          Right result -> pure result
+
+    getDbEntriesByPK :: TableEntry -> Out.Resolve IO
+    getDbEntriesByPK tableEntry = do
+      context <- ask
+
+      let
+        Arguments args = context.arguments
+        filterElements = do
+          (key, value) <- HashMap.toList args
+          pure (key, Object $ HashMap.singleton "eq" value)
+
+      -- This query can return at most one row, so we don't worry checking for
+      -- COUNT() and asserting it's within the set limits.
+      queryResult <-
+        liftIO $
+          executeSqlQuery
+            connection
+            tableEntry.name
+            tableEntry.columns
+            filterElements
+            []
+            Nothing
+
+      case P.head queryResult of
+        Nothing -> pure Null
+        Just row ->
+          colErrorsToUserError $
+            rowToGraphQL
+              dbId
+              tableEntry.name
+              tableEntry.columns
+              row
 
     getResolvers :: IO (HashMap.HashMap Text (Resolver IO))
     getResolvers = do
       let
+        -- Exceptions must be converted to ResolverExceptions
+        -- to be picked up by GQL query executor
+        wrapResolver :: Out.Resolve IO -> Out.Resolve IO
+        wrapResolver resolver =
+          catchAll
+            resolver
+            (throw . ResolverException)
+
         getTableTuple :: TableEntry -> IO (Text, Resolver IO)
         getTableTuple table = do
-          outField <- getOutField table.name
+          outField <- getOutField table
           pure
             ( doubleXEncodeGql table.name
             , ValueResolver
                 outField
-                ( -- Exceptions must be converted to ResolverExceptions
+                $ wrapResolver
-                  -- to be picked up by GQL query executor
+                $ getDbEntries table
-                  catchAll
-                    (getDbEntries table.name)
-                    (throw . ResolverException)
-                )
             )
 
-        getTableTuples :: IO [(Text, Resolver IO)]
+        getTableByPKTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
-        getTableTuples =
+        getTableByPKTuple table = do
-          P.for tables getTableTuple
+          fieldMb <- getOutByPKField table
+          P.for fieldMb $ \outField -> do
+            pure
+              ( doubleXEncodeGql $ table.name <> "_by_pk"
+              , ValueResolver
+                  outField
+                  $ wrapResolver
+                  $ getDbEntriesByPK table
+              )
 
-      getTableTuples <&> HashMap.fromList
+      queryMany <- P.for tables getTableTuple
-
+      queryByPKMbs <- P.for tables getTableByPKTuple
-  -- -- TODO: Add support for retriving record by ID
+      let queryByPK = P.catMaybes queryByPKMbs
-  -- getResolversPrimaryKey :: IO (HashMap.HashMap Text (Resolver IO))
+      pure $ HashMap.fromList $ queryMany <> queryByPK
-  -- getResolversPrimaryKey = do
-  --   let
-  --     getTableTuple table = do
-  --       outField <- getOutField $ table.name
-  --       pure
-  --         ( table.name) <> "_by_pk"
-  --         , ValueResolver
-  --             outField
-  --             (getDbEntries $ table.name)
-  --         )
-
-  --     getTableTuples :: IO [(Text, Resolver IO)]
-  --     getTableTuples =
-  --       sequence $ tables <&> getTableTuple
-
-  --   getTableTuples <&> HashMap.fromList
 
   resolvers <- getResolvers
   schemaResolver <- getSchemaResolver accessMode tables
 
-  -- resolversPrimaryKey <- getResolversPrimaryKey
   let
     -- Resolve = ReaderT Context m Value
     wrapResolve resolve = do
@@ -923,8 +835,64 @@ getMutationResponse accessMode tableName columnEntries =
         }
 
 
-rowsToList :: (MonadIO m) => Text -> Text -> [ColumnEntry] -> [[SQLData]] -> m Value
+rowToGraphQL :: Text -> Text -> [ColumnEntry] -> [SQLData] -> Either [(Text, Text)] Value
-rowsToList dbId tableName columnEntries updatedRows =
+rowToGraphQL dbId tableName columnEntries row =
+  let
+    buildMetadataJson :: Text -> Text -> Text
+    buildMetadataJson colName rowid =
+      object ["url" .= colToFileUrl dbId tableName colName rowid]
+        & encodeToText
+
+    parseSqlData :: (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value)
+    parseSqlData (colEntry, colVal) =
+      if "BLOB" `T.isPrefixOf` colEntry.datatype
+        then
+          pure
+            ( colEntry.column_name_gql
+            , case colVal of
+                SQLNull -> Null
+                SQLInteger id ->
+                  String $
+                    buildMetadataJson colEntry.column_name (show id)
+                SQLText id ->
+                  String $
+                    buildMetadataJson colEntry.column_name id
+                _ -> Null
+            )
+        else case sqlDataToGQLValue colEntry.datatype colVal of
+          Left err ->
+            Left
+              (colEntry.column_name_gql, err)
+          Right gqlData ->
+            Right
+              ( colEntry.column_name_gql
+              , case colEntry.datatype of
+                  -- Coerce value to nullable String
+                  -- if no datatype is set.
+                  -- This happens for columns in views.
+                  "" -> gqlValueToNullableString gqlData
+                  _ -> gqlData
+              )
+  in
+    -- => [(ColumnEntry, SQLData)]
+    P.zip columnEntries row
+      -- => [Either (Text, Text) (Text, Value)]
+      <&> parseSqlData
+      -- => Either [(Text, Text)] (Text, Value)
+      & collectErrorList
+      -- => Either [(Text, Text)] (HashMap Text Value)
+      <&> HashMap.fromList
+      -- => Either [(Text, Text)] Value
+      <&> Object
+
+
+rowsToGraphQL
+  :: Text
+  -> Text
+  -> [ColumnEntry]
+  -> [[SQLData]]
+  -> Either [(Text, Text)] Value
+rowsToGraphQL dbId tableName columnEntries updatedRows =
   let
     buildMetadataJson :: Text -> Text -> Text
     buildMetadataJson colName rowid =
@@ -970,18 +938,26 @@ rowsToList dbId tableName columnEntries updatedRows =
           )
       -- => Either [[(Text, Text)]] [Value]
       & collectErrorList
-      & \case
+      -- => Either [(Text, Text)] [Value]
-        Right values -> pure $ List values
+      & Either.mapLeft P.join
-        Left errors ->
+      -- => Either [(Text, Text)] Value
-          let
+      <&> List
-            errorLines =
+
-              P.join errors
+
-                <&> \(column, err) -> "On column " <> show column <> ": " <> err
+-- | Formats errors from `row(s)ToGraphQL` and throws them.
-          in
+colErrorsToUserError :: forall m a. (MonadIO m) => Either [(Text, Text)] a -> m a
-            P.throwIO $
+colErrorsToUserError = \case
-              userError $
+  Right v -> pure v
-                T.unpack $
+  Left errors ->
-                  "Multiple errors occurred:\n" <> P.unlines errorLines
+    let
+      errorLines =
+        errors
+          <&> \(column, err) -> "On column " <> show column <> ": " <> err
+    in
+      P.throwIO $
+        userError $
+          T.unpack $
+            "Multiple errors occurred:\n" <> P.unlines errorLines
 
 
 executeSqlMutation
@@ -1403,7 +1379,9 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
           pure (P.length sqlDataRows, returnedRows & P.concat)
 
       (numOfChanges, returnedRows) <- insertInDb context.arguments
-      returning <- rowsToList dbId tableName columnEntries returnedRows
+      returning <-
+        colErrorsToUserError $
+          rowsToGraphQL dbId tableName columnEntries returnedRows
 
       pure $
         Object $
@@ -1434,7 +1412,9 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
                 filterElements
         _ -> pure (0, [])
 
-      returning <- rowsToList dbId tableName columnEntries updatedRows
+      returning <-
+        colErrorsToUserError $
+          rowsToGraphQL dbId tableName columnEntries updatedRows
 
       pure $
         Object $
@@ -1491,7 +1471,9 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
             _ -> pure (0, [])
           Nothing -> pure (0, [])
 
-      returning <- rowsToList dbId tableName columnEntries deletedRows
+      returning <-
+        colErrorsToUserError $
+          rowsToGraphQL dbId tableName columnEntries deletedRows
 
       pure $
         Object $

source/AirGQL/Introspection.hs

@@ -1,6 +1,8 @@
 module AirGQL.Introspection (
   typeNameResolver,
   getSchemaResolver,
+  tableQueryField,
+  tableQueryByPKField,
 )
 where
 
@@ -131,8 +133,8 @@ tableRowType table = do
   Type.object (doubleXEncodeGql table.name <> "_row") fields
 
 
-tableQueryCommonArgs :: TableEntry -> [Type.InputValue]
+tableQueryField :: TableEntry -> Type.Field
-tableQueryCommonArgs table =
+tableQueryField table =
   let
     fieldsWithOrderingTerm =
       table.columns <&> \columnEntry -> do
@@ -149,62 +151,47 @@ tableQueryCommonArgs table =
               <> "\"."
           )
   in
-    [ Type.inputValue "filter" (filterType table)
+    Type.field
-        & Type.inputValueWithDescription "Filter to select specific rows"
+      (doubleXEncodeGql table.name)
-    , Type.inputValue "order_by" (Type.list orderType)
+      (Type.nonNull $ Type.list $ Type.nonNull $ tableRowType table)
-        & Type.inputValueWithDescription "Columns used to sort the data"
+      & Type.fieldWithDescription ("Rows from the table \"" <> table.name <> "\"")
-    , Type.inputValue "limit" Type.typeInt
+      & Type.withArguments
-        & Type.inputValueWithDescription "Limit the number of returned rows"
+        [ Type.inputValue "filter" (filterType table)
-    , Type.inputValue "offset" Type.typeInt
+            & Type.inputValueWithDescription "Filter to select specific rows"
-        & Type.inputValueWithDescription "The index to start returning rows from"
+        , Type.inputValue "order_by" (Type.list orderType)
-    ]
+            & Type.inputValueWithDescription "Columns used to sort the data"
+        , Type.inputValue "limit" Type.typeInt
+            & Type.inputValueWithDescription "Limit the number of returned rows"
+        , Type.inputValue "offset" Type.typeInt
+            & Type.inputValueWithDescription "The index to start returning rows from"
+        ]
 
 
-tableQueryField :: TableEntry -> Type.Field
+tableQueryByPKField :: TableEntry -> Maybe Type.Field
-tableQueryField table =
+tableQueryByPKField table = do
-  Type.field
-    (doubleXEncodeGql table.name)
-    (Type.nonNull $ Type.list $ Type.nonNull $ tableRowType table)
-    & Type.fieldWithDescription ("Rows from the table \"" <> table.name <> "\"")
-    & Type.withArguments (tableQueryCommonArgs table)
-
-
-restrictedArgNames :: [Text]
-restrictedArgNames = ["limit", "offset", "order_by", "filter"]
-
-
-mkArgName :: Text -> Text
-mkArgName name = do
-  let encoded = doubleXEncodeGql name
-  if P.elem encoded restrictedArgNames
-    then encoded <> "_"
-    else encoded
-
-
-tableQueryByPk :: TableEntry -> Type.Field
-tableQueryByPk table = do
   let pks = List.filter (\col -> col.primary_key) table.columns
 
   -- We filter out the rowid column, unless it is the only one
-  let withoutRowid = case pks of
+  withoutRowid <- case pks of
-        [first] | first.isRowid -> [first]
+    [] -> Nothing
-        _ -> List.filter (\col -> P.not col.isRowid) pks
+    [first] | first.isRowid -> Just [first]
+    _ -> Just $ List.filter (\col -> P.not col.isRowid) pks
 
   let pkArguments =
         withoutRowid <&> \column -> do
-          let name = mkArgName column.column_name_gql
+          let name = doubleXEncodeGql column.column_name_gql
           Type.inputValue name $ Type.nonNull $ columnType column
 
-  Type.field
+  pure $
-    (doubleXEncodeGql table.name <> "_by_pk")
+    Type.field
-    (tableRowType table)
+      (doubleXEncodeGql table.name <> "_by_pk")
-    & Type.fieldWithDescription
+      (tableRowType table)
-      ( "Rows from the table \""
+      & Type.fieldWithDescription
-          <> table.name
+        ( "Rows from the table \""
-          <> "\", accessible by their primary key"
+            <> table.name
-      )
+            <> "\", accessible by their primary key"
-    & Type.withArguments (tableQueryCommonArgs table)
+        )
-    & Type.withArguments pkArguments
+      & Type.withArguments pkArguments
 
 
 mutationResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType
@@ -363,7 +350,7 @@ getSchema accessMode tables = do
         then
           P.fold
             [ tables <&> tableQueryField
-            , tables <&> tableQueryByPk
+            , tables & P.mapMaybe tableQueryByPKField
             ]
         else []
 

source/AirGQL/Introspection/Resolver.hs

@@ -1,4 +1,8 @@
-module AirGQL.Introspection.Resolver (makeType, makeConstField) where
+module AirGQL.Introspection.Resolver (
+  makeType,
+  makeConstField,
+  makeField,
+) where
 
 import Protolude (
   Either (Left),
@@ -7,7 +11,6 @@ import Protolude (
   MonadReader (ask),
   Text,
   fromMaybe,
-  mempty,
   pure,
   show,
   ($),
@@ -29,6 +32,12 @@ import Language.GraphQL.Type.Out qualified as Out
 type Result = Either Text
 
 
+{-| Turns a type descriptor into a graphql output type, erroring out on input
+types. Child resolvers look up their respective fields in the value produced by
+their parent.
+
+Lookups for `__Type` objects are memoized, and a maximum depth of 30 is enforced.
+-}
 makeType :: IType.IntrospectionType -> Result (Out.Type IO)
 makeType =
   let
@@ -91,8 +100,7 @@ makeType =
             $ Out.NamedObjectType
             $ Type.ObjectType
               name
-              -- ty.description
+              ty.description
-              P.Nothing
               []
             $ HashMap.fromList
             $ ("__typename", typenameResolver) : resolvers
@@ -131,13 +139,29 @@ makeType =
     makeTypeWithDepth 0
 
 
+{-| Turns a field descriptor into a graphql field. See the documentation
+for `makeType` for details about the behaviour of child resolvers.
+-}
+makeField :: IType.Field -> Result (Out.Field IO)
+makeField field = do
+  args <- P.for field.args $ \arg -> do
+    ty <- makeInType arg.type_
+    pure (arg.name, In.Argument arg.description ty arg.defaultValue)
+  ty <- makeType field.type_
+  pure $ Out.Field field.description ty $ HashMap.fromList args
+
+
+-- | Create a resolver by calling which always returns a constant value.
 makeConstField :: IType.Field -> Type.Value -> Result (Out.Resolver IO)
 makeConstField field value = do
-  ty <- makeType field.type_
+  gqlField <- makeField field
-  let gqlField = Out.Field field.description ty mempty
   pure $ Out.ValueResolver gqlField $ pure value
 
 
+{-| The input-type version of `makeOutType`. No maximum depth is enforced, nor
+is any memoization used. This is the case because input types are usually pretty
+shallow.
+-}
 makeInType :: IType.IntrospectionType -> Result In.Type
 makeInType ty = do
   case ty.kind of