Rename a few fields to match the Hasura api

source/AirGQL/GraphQL.hs

@@ -40,6 +40,7 @@ import Protolude (
   (<=),
   (>),
   (>=),
+  (||),
  )
 import Protolude qualified as P
 
@@ -213,33 +214,36 @@ getColNamesQuoted columnEntries =
 opAndValToSql :: HashMap.HashMap Text Value -> [Text]
 opAndValToSql operatorAndValue =
   case HashMap.toList operatorAndValue of
-    [("eq", value)] ->
+    [(op, value)]
-      pure $
+      | op == "eq" || op == "_eq" ->
-        if value == Null
+          pure $
-          then " IS NULL"
+            if value == Null
-          else " == " <> gqlValueToSQLText value
+              then " IS NULL"
-    [("neq", value)] ->
+              else " == " <> gqlValueToSQLText value
-      if value == Null
+      | op == "neq" || op == "_neq" ->
-        then pure " IS NOT NULL"
+          if value == Null
-        else
+            then pure " IS NOT NULL"
-          [ " != " <> gqlValueToSQLText value
+            else
-          , " IS NULL"
+              [ " != " <> gqlValueToSQLText value
-          ]
+              , " IS NULL"
-    [("in", List values)] ->
+              ]
-      let listValues = values <&> gqlValueToSQLText & intercalate ","
+      | op == "in" || op == "_in"
-      in  [" IN (" <> listValues <> ")"]
+      , List values <- value ->
-    [("nin", List values)] ->
+          let listValues = values <&> gqlValueToSQLText & intercalate ","
-      let listValues = values <&> gqlValueToSQLText & intercalate ","
+          in  [" IN (" <> listValues <> ")"]
-      in  [" NOT IN (" <> listValues <> ")"]
+      | op == "nin" || op == "_nin"
-            <> if P.elem Null values
+      , List values <- value ->
-              then []
+          let listValues = values <&> gqlValueToSQLText & intercalate ","
-              else [" IS NULL"]
+          in  [" NOT IN (" <> listValues <> ")"]
-    [("gt", value)] -> [" > " <> gqlValueToSQLText value]
+                <> if P.elem Null values
-    [("gte", value)] -> [" >= " <> gqlValueToSQLText value]
+                  then []
-    [("lt", value)] -> [" < " <> gqlValueToSQLText value]
+                  else [" IS NULL"]
-    [("lte", value)] -> [" <= " <> gqlValueToSQLText value]
+      | op == "gt" || op == "_gt" -> [" > " <> gqlValueToSQLText value]
-    [("like", value)] -> [" like " <> gqlValueToSQLText value]
+      | op == "gte" || op == "_gte" -> [" >= " <> gqlValueToSQLText value]
-    [("ilike", value)] -> [" like " <> gqlValueToSQLText value]
+      | op == "lt" || op == "_lt" -> [" < " <> gqlValueToSQLText value]
+      | op == "lte" || op == "_lte" -> [" <= " <> gqlValueToSQLText value]
+      | op == "like" || op == "_like" -> [" like " <> gqlValueToSQLText value]
+      | op == "ilike" || op == "_ilike" -> [" like " <> gqlValueToSQLText value]
     filter -> do
       throw $
         userError $
@@ -451,16 +455,21 @@ rowsToGraphQL dbId table updatedRows =
     & List
 
 
+-- Attempts to find and decode an argument, given its current name, and a list
+-- of deprecated older names.
 tryGetArg
   :: forall m a
    . (FromGraphQL a)
   => (MonadIO m)
   => Text
+  -> [Text]
   -> HashMap Text Value
   -> m (Maybe a)
-tryGetArg name args = do
+tryGetArg name alts args = do
   case HashMap.lookup name args of
-    Nothing -> pure Nothing
+    Nothing -> case alts of
+      alt : others -> tryGetArg alt others args
+      [] -> pure Nothing
     Just value ->
       case fromGraphQL value of
         Just decoded -> pure $ Just decoded
@@ -470,15 +479,17 @@ tryGetArg name args = do
               "Argument " <> T.unpack name <> " has invalid format"
 
 
+-- Similar to `tryGetArg`, but will error out on failure.
 getArg
   :: forall m a
    . (FromGraphQL a)
   => (MonadIO m)
   => Text
+  -> [Text]
   -> HashMap Text Value
   -> m a
-getArg name args = do
+getArg name alts args = do
-  result <- tryGetArg name args
+  result <- tryGetArg name alts args
   case result of
     Just value -> pure value
     Nothing ->
@@ -487,16 +498,18 @@ getArg name args = do
           "Argument " <> T.unpack name <> " not found"
 
 
+-- Similar to `tryGetArg`, but will return a custom value on failure.
 getArgWithDefault
   :: forall m a
    . (FromGraphQL a)
   => (MonadIO m)
   => Text
+  -> [Text]
   -> HashMap Text Value
   -> a
   -> m a
-getArgWithDefault name args def =
+getArgWithDefault name alts args def =
-  tryGetArg name args <&> P.fromMaybe def
+  tryGetArg name alts args <&> P.fromMaybe def
 
 
 executeUpdateMutation
@@ -608,13 +621,8 @@ queryType connection accessMode dbId tables = do
 
       rows :: [[SQLData]] <- case context.arguments of
         Arguments args -> do
-          filterElements <- case args & HashMap.lookup "filter" of
+          filterElements :: HashMap Text Value <-
-            Nothing -> pure []
+            getArgWithDefault "where" ["filter"] args HashMap.empty
-            Just colToFilter -> case colToFilter of
-              Object filterObj -> case HashMap.toList filterObj of
-                [] -> P.throwIO $ userError "Error: Filter must not be empty"
-                filterElements -> pure filterElements
-              _ -> pure []
 
           orderElements :: [(Name, Value)] <-
             case args & HashMap.lookup "order_by" of
@@ -678,7 +686,7 @@ queryType connection accessMode dbId tables = do
                   [ "SELECT COUNT() FROM"
                   , quoteKeyword table.name
                   , "\n"
-                  , getWhereClause filterElements
+                  , getWhereClause $ HashMap.toList filterElements
                   ]
 
           -- Will be equal `Just numRows` when the number of
@@ -720,7 +728,7 @@ queryType connection accessMode dbId tables = do
               connection
               table.name
               table.columns
-              filterElements
+              (HashMap.toList filterElements)
               orderElements
               paginationMb
 
@@ -849,7 +857,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
           --   [ { name: "John", email: "john@example.com" }
           --   , { name: "Eve",  email: "eve@example.com" }
           --   ]
-          values :: [HashMap Text Value] <- getArg "objects" argMap
+          values :: [HashMap Text Value] <- getArg "objects" [] argMap
           let
             -- All colums that are contained in the entries
             containedColumns :: [Text]
@@ -866,12 +874,12 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
                 <&> (\name -> ":" <> doubleXEncodeGql name)
 
           onConflictArg :: [HashMap Text Value] <-
-            getArgWithDefault "on_conflict" argMap []
+            getArgWithDefault "on_conflict" [] argMap []
 
           onConflictClauses <- P.for onConflictArg $ \fields -> do
             let
               getColumnList fieldName =
-                getArgWithDefault fieldName fields []
+                getArgWithDefault fieldName [] fields []
                   <&> P.mapMaybe
                     ( \case
                         Enum columnName -> Just columnName
@@ -895,7 +903,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
                   <> " = :"
                   <> doubleXEncodeGql column
 
-            filterElements <- getArgWithDefault "where" fields mempty
+            filterElements <- getArgWithDefault "where" ["filter"] fields mempty
 
             pure $
               "ON CONFLICT ("
@@ -983,8 +991,8 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
       context <- ask
       let Arguments args = context.arguments
       liftIO $ do
-        filterObj <- getArg "filter" args
+        filterObj <- getArg "where" ["filter"] args
-        pairsToSet <- getArg "set" args
+        pairsToSet <- getArg "set" [] args
         (numOfChanges, updatedRows) <- case HashMap.toList filterObj of
           [] -> P.throwIO $ userError "Error: Filter must not be empty"
           filterElements ->
@@ -1002,11 +1010,16 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
       let Arguments args = context.arguments
       let filterElements =
             args
-              & HashMap.delete "set"
+              & HashMap.delete (encodeOutsidePKNames table "_set")
+              & HashMap.delete (encodeOutsidePKNames table "set")
               & getByPKFilterElements
 
       liftIO $ do
-        pairsToSet <- getArg (encodeOutsidePKNames table "set") args
+        pairsToSet <-
+          getArg
+            (encodeOutsidePKNames table "_set")
+            [encodeOutsidePKNames table "set"]
+            args
         (numOfChanges, updatedRows) <-
           executeUpdateMutation
             connection
@@ -1023,7 +1036,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
       let Arguments args = context.arguments
 
       liftIO $ do
-        filterElements <- getArg "filter" args
+        filterElements <- getArg "where" ["filter"] args
         let sqlQuery =
               Query $
                 P.unlines

source/AirGQL/Introspection.hs

@@ -114,22 +114,30 @@ filterType table = do
         let colName = columnEntry.column_name_gql
         let typeName = columnTypeName columnEntry
         let type_ = columnType columnEntry
-        Type.inputValue colName $
+
-          Type.withDescription ("Compare to a(n) " <> typeName) $
+        let comparisonField name ty =
-            Type.inputObject
+              [ Type.deprecatedInputValue "Unify naming with Hasura" $
-              (typeName <> "Comparison")
+                  Type.inputValue name ty
-              [ Type.inputValue "eq" type_
+              , Type.inputValue ("_" <> name) ty
-              , Type.inputValue "neq" type_
-              , Type.inputValue "gt" type_
-              , Type.inputValue "gte" type_
-              , Type.inputValue "lt" type_
-              , Type.inputValue "lte" type_
-              , Type.inputValue "like" type_
-              , Type.inputValue "ilike" type_
-              , Type.inputValue "in" $ Type.list type_
-              , Type.inputValue "nin" $ Type.list type_
               ]
 
+        Type.inputValue colName
+          $ Type.withDescription ("Compare to a(n) " <> typeName)
+          $ Type.inputObject
+            (typeName <> "Comparison")
+          $ P.fold
+            [ comparisonField "eq" type_
+            , comparisonField "neq" type_
+            , comparisonField "gt" type_
+            , comparisonField "gte" type_
+            , comparisonField "lt" type_
+            , comparisonField "lte" type_
+            , comparisonField "like" type_
+            , comparisonField "ilike" type_
+            , comparisonField "in" $ Type.list type_
+            , comparisonField "nin" $ Type.list type_
+            ]
+
   Type.inputObject
     (doubleXEncodeGql table.name <> "_filter")
     fieldsWithComparisonExp
@@ -175,9 +183,12 @@ tableQueryField table =
       (Type.nonNull $ Type.list $ Type.nonNull $ tableRowType table)
       & Type.fieldWithDescription ("Rows from the table \"" <> table.name <> "\"")
       & Type.withArguments
-        [ Type.inputValue "filter" (filterType table)
+        ( Type.inputValue "filter" (filterType table)
             & Type.inputValueWithDescription "Filter to select specific rows"
-        , Type.inputValue "order_by" (Type.list orderType)
+            & Type.renameInputValue "where" "Unify naming with Hasura"
+        )
+      & Type.withArguments
+        [ 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"
@@ -359,15 +370,19 @@ tableUpdateField accessMode table = do
     & Type.fieldWithDescription
       ("Update rows in table \"" <> table.name <> "\"")
     & Type.withArguments
-      [ Type.inputValue
+      ( Type.inputValue
           "set"
           (Type.nonNull $ tableSetInput table)
           & Type.inputValueWithDescription "Fields to be updated"
-      , Type.inputValue
+          & Type.renameInputValue "_set" "Unify naming with Hasura"
+      )
+    & Type.withArguments
+      ( Type.inputValue
           "filter"
           (Type.nonNull $ filterType table)
           & Type.inputValueWithDescription "Filter to select rows to be updated"
-      ]
+          & Type.renameInputValue "where" "Unify naming with Hasura"
+      )
 
 
 tableUpdateFieldByPk
@@ -409,11 +424,12 @@ tableDeleteField accessMode table = do
     & Type.fieldWithDescription
       ("Delete rows in table \"" <> table.name <> "\"")
     & Type.withArguments
-      [ Type.inputValue
+      ( Type.inputValue
           "filter"
           (Type.nonNull $ filterType table)
           & Type.inputValueWithDescription "Filter to select rows to be deleted"
-      ]
+          & Type.renameInputValue "where" "Unify naming with Hasura"
+      )
 
 
 tableDeleteFieldByPK

source/AirGQL/Introspection/Resolver.hs

@@ -30,6 +30,7 @@ import Control.Exception qualified as Exception
 import Data.HashMap.Strict qualified as HashMap
 import Data.Text qualified as T
 import GHC.IO.Exception (userError)
+import Language.GraphQL.Class (ToGraphQL (toGraphQL))
 import Language.GraphQL.Error (ResolverException (ResolverException))
 import Language.GraphQL.Type qualified as Type
 import Language.GraphQL.Type.In qualified as In
@@ -120,7 +121,7 @@ makeType =
             $ HashMap.fromList
             $ ("__typename", typenameResolver) : resolvers
         _ -> do
-          Left $ "invalid type in out position: " <> show ty.kind
+          Left $ "invalid type in out position: " <> show (toGraphQL ty)
 
     -- Creates a field which looks up it's value in the object returned by the
     -- parent resolver.
@@ -152,7 +153,7 @@ makeType =
               _ -> pure ()
 
             case HashMap.lookup field.name obj of
-              Just value -> pure value
+              Just value -> field.customResolver value
               Nothing -> defaultValue
           _ -> defaultValue
   in
@@ -219,4 +220,4 @@ makeInType ty = do
           ty.description
         $ HashMap.fromList gqlFields
     _ -> do
-      Left $ "invalid type in input position: " <> show ty.kind
+      Left $ "invalid type in input position: " <> show (toGraphQL ty)

source/AirGQL/Introspection/Types.hs

@@ -16,9 +16,12 @@ module AirGQL.Introspection.Types (
   enumValueWithDescription,
   field,
   fieldWithDescription,
+  deprecatedField,
   inputObject,
   inputValue,
   inputValueWithDescription,
+  deprecatedInputValue,
+  renameInputValue,
   list,
   nonNull,
   object,
@@ -40,13 +43,15 @@ module AirGQL.Introspection.Types (
 import Protolude (
   Bool (False, True),
   Generic,
+  IO,
   Maybe (Just, Nothing),
+  MonadReader (ask),
   MonadState (get, put),
   Monoid (mempty),
-  Show,
   State,
   Text,
   execState,
+  filter,
   for_,
   not,
   pure,
@@ -54,8 +59,10 @@ import Protolude (
   when,
   ($),
   (&),
+  (/=),
   (<$>),
   (<>),
+  (==),
  )
 
 import Data.HashMap.Strict (HashMap)
@@ -71,7 +78,7 @@ data Schema = Schema
   , mutationType :: Maybe IntrospectionType
   , directives :: [Directive]
   }
-  deriving (Show, Generic)
+  deriving (Generic)
 
 
 instance ToGraphQL Schema where
@@ -98,14 +105,14 @@ data TypeKind
   | InputObject Name [InputValue]
   | List IntrospectionType
   | NonNull IntrospectionType
-  deriving (Show, Generic)
+  deriving (Generic)
 
 
 data IntrospectionType = IType
   { kind :: TypeKind
   , description :: Maybe Text
   }
-  deriving (Show, Generic)
+  deriving (Generic)
 
 
 instance ToGraphQL IntrospectionType where
@@ -214,8 +221,11 @@ data Field = Field
   , type_ :: IntrospectionType
   , isDeprecated :: Bool
   , deprecationReason :: Maybe Text
+  , -- Allows injecting custom logic into the resulting resolver. The function
+    -- is given the value of the field in the parent object.
+    customResolver :: Value.Value -> Value.Resolve IO
   }
-  deriving (Show, Generic)
+  deriving (Generic)
 
 
 instance ToGraphQL Field where
@@ -231,14 +241,6 @@ instance ToGraphQL Field where
         ]
 
 
-fieldWithDescription :: Text -> Field -> Field
-fieldWithDescription newDesc (Field{..}) =
-  Field
-    { description = Just newDesc
-    , ..
-    }
-
-
 field :: Text -> IntrospectionType -> Field
 field fieldName fieldType =
   Field
@@ -248,6 +250,24 @@ field fieldName fieldType =
     , type_ = fieldType
     , isDeprecated = False
     , deprecationReason = Nothing
+    , customResolver = pure
+    }
+
+
+fieldWithDescription :: Text -> Field -> Field
+fieldWithDescription newDesc (Field{..}) =
+  Field
+    { description = Just newDesc
+    , ..
+    }
+
+
+deprecatedField :: Text -> Field -> Field
+deprecatedField reason (Field{..}) =
+  Field
+    { isDeprecated = True
+    , deprecationReason = Just reason
+    , ..
     }
 
 
@@ -260,8 +280,10 @@ data InputValue = InputValue
   , description :: Maybe Text
   , type_ :: IntrospectionType
   , defaultValue :: Maybe Value.Value
+  , isDeprecated :: Bool
+  , deprecationReason :: Maybe Text
   }
-  deriving (Show, Generic)
+  deriving (Generic)
 
 
 instance ToGraphQL InputValue where
@@ -278,6 +300,8 @@ instance ToGraphQL InputValue where
               Nothing -> Value.Null
               Just s -> Value.String $ show s
           )
+        , ("isDeprecated", toGraphQL value.isDeprecated)
+        , ("deprecationReason", toGraphQL value.deprecationReason)
         ]
 
 
@@ -288,6 +312,8 @@ inputValue fieldName fieldType =
     , description = Nothing
     , type_ = fieldType
     , defaultValue = Nothing
+    , isDeprecated = False
+    , deprecationReason = Nothing
     }
 
 
@@ -307,13 +333,37 @@ withDefaultValue newValue (InputValue{..}) =
     }
 
 
+deprecatedInputValue :: Text -> InputValue -> InputValue
+deprecatedInputValue reason (InputValue{..}) =
+  InputValue
+    { isDeprecated = True
+    , deprecationReason = Just reason
+    , ..
+    }
+
+
+-- Rename an input value, deprecating the old version.
+renameInputValue :: Text -> Text -> InputValue -> [InputValue]
+renameInputValue to reason (InputValue{..}) =
+  [ InputValue
+      { name = to
+      , ..
+      }
+  , InputValue
+      { isDeprecated = True
+      , deprecationReason = Just reason
+      , ..
+      }
+  ]
+
+
 data EnumValue = EnumValue
   { name :: Text
   , description :: Maybe Text
   , isDeprecated :: Bool
   , deprecationReason :: Maybe Text
   }
-  deriving (Show, Generic)
+  deriving (Generic)
 
 
 instance ToGraphQL EnumValue where
@@ -358,7 +408,7 @@ data Directive = Directive
   , args :: [InputValue]
   , isRepeatable :: Bool
   }
-  deriving (Generic, Show)
+  deriving (Generic)
 
 
 instance ToGraphQL Directive where
@@ -486,7 +536,8 @@ typeField =
     "__Field"
     [ field "name" $ nonNull typeString
     , field "description" typeString
-    , field "args" $ nonNull $ list $ nonNull typeInputValue
+    , field "args" (nonNull $ list $ nonNull typeInputValue)
+        & typeWithDeprecatedFilter
     , field "type" $ nonNull typeIntrospectionType
     , field "isDeprecated" $ nonNull typeBool
     , field "deprecationReason" typeString
@@ -507,6 +558,8 @@ typeInputValue =
         & fieldWithDescription
           "A GraphQL-formatted string representing \
           \the default value for this input value."
+    , field "isDeprecated" $ nonNull typeBool
+    , field "deprecationReason" typeString
     ]
     & withDescription
       "Arguments provided to Fields or Directives and the input \
@@ -574,16 +627,11 @@ typeIntrospectionType =
     , field "interfaces" $ list $ nonNull typeIntrospectionType
     , field "possibleTypes" $ list $ nonNull typeIntrospectionType
     , field "fields" (list $ nonNull typeField)
-        & withArguments
+        & typeWithDeprecatedFilter
-          [ inputValue "includeDeprecated" typeBool
-              & withDefaultValue (toGraphQL False)
-          ]
     , field "enumValues" (list $ nonNull typeEnumValue)
-        & withArguments
+        & typeWithDeprecatedFilter
-          [ inputValue "includeDeprecated" typeBool
+    , field "inputFields" (list $ nonNull typeInputValue)
-              & withDefaultValue (toGraphQL False)
+        & typeWithDeprecatedFilter
-          ]
-    , field "inputFields" $ list $ nonNull typeInputValue
     , field "ofType" typeIntrospectionType
     ]
     & withDescription
@@ -636,7 +684,11 @@ typeDirective =
     "__Directive"
     [ field "name" $ nonNull typeString
     , field "description" typeString
-    , field "args" $ nonNull $ list $ nonNull typeInputValue
+    , field "args" (nonNull $ list $ nonNull typeInputValue)
+        & withArguments
+          [ inputValue "includeDeprecated" typeBool
+              & withDefaultValue (toGraphQL False)
+          ]
     , field "isRepeatable" $ nonNull typeBool
     , field "locations" $ nonNull $ list $ nonNull typeDirectiveLocation
     ]
@@ -700,3 +752,38 @@ typeDirectiveLocation =
     & withDescription
       "A Directive can be adjacent to many parts of the GraphQL language, \
       \a __DirectiveLocation describes one such possible adjacencies."
+
+
+-- Internal helper which adds custom logic to a resolver for handling the
+-- `includeDeprecated` filter.
+typeWithDeprecatedFilter :: Field -> Field
+typeWithDeprecatedFilter Field{..} =
+  Field
+    { args =
+        args
+          <> [ inputValue "includeDeprecated" typeBool
+                & withDefaultValue (toGraphQL False)
+             ]
+    , customResolver = \case
+        Value.List values -> do
+          context <- ask
+          let
+            Value.Arguments gqlArgs = context.arguments
+            includeDeprecated = HashMap.lookup "includeDeprecated" gqlArgs
+            filtered =
+              if includeDeprecated == Just (Value.Boolean True)
+                then values
+                else
+                  filter
+                    ( \case
+                        Value.Object fields ->
+                          HashMap.lookup "isDeprecated" fields
+                            /= Just (Value.Boolean True)
+                        _ -> True
+                    )
+                    values
+
+          customResolver $ Value.List filtered
+        o -> customResolver o
+    , ..
+    }