Apply HLint's new proposed fixes.

Upgrading HLint brought in a bunch of new suggestions for improvements to the code.

I thought I'd go through them quickly and get them in.

This is not all of them, just the ones I thought were reasonable.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/10505
GitOrigin-RevId: cefd661e9dcb973843b421fd0e31a5c5ffe4720f

server/lib/api-tests/src/Test/DataConnector/MetadataApiSpec.hs

@@ -41,6 +41,8 @@ import Hasura.Backends.DataConnector.API qualified as API
 import Hasura.Prelude
 import Test.Hspec (SpecWith, describe, it, pendingWith)
 
+{-# ANN module ("HLint: ignore Functor law" :: String) #-}
+
 --------------------------------------------------------------------------------
 -- DataConnector Agent Query Tests
 

server/lib/api-tests/src/Test/Mutations/Insert/ValidationSpec.hs

@@ -91,7 +91,7 @@ createInsertPermissions testEnvironment server =
               { insertPermissionTable = "user",
                 insertPermissionRole = "user_1",
                 insertPermissionColumns = (["id", "name", "email", "phone_number"] :: [Text]),
-                insertPermissionValidationWebhook = Just $ (T.pack $ serverUrl server) <> "/validateUser"
+                insertPermissionValidationWebhook = Just $ T.pack (serverUrl server) <> "/validateUser"
               }
 
         GraphqlEngine.postMetadata_ testEnvironment
@@ -104,7 +104,7 @@ createInsertPermissions testEnvironment server =
               { insertPermissionTable = "tweet",
                 insertPermissionRole = "user_1",
                 insertPermissionColumns = (["id", "user_id", "content"] :: [Text]),
-                insertPermissionValidationWebhook = Just $ (T.pack $ serverUrl server) <> "/validateTweet"
+                insertPermissionValidationWebhook = Just $ T.pack (serverUrl server) <> "/validateTweet"
               },
       Fixture.teardownAction = \_ -> pure ()
     }

server/lib/api-tests/src/Test/Mutations/Update/ValidationSpec.hs

@@ -148,7 +148,7 @@ createUpdatePermissions testEnvironment server =
               { updatePermissionTable = "user",
                 updatePermissionRole = "user",
                 updatePermissionColumns = ["id", "name", "email", "phone_number"],
-                updatePermissionValidationWebhook = Just $ (T.pack $ serverUrl server) <> "/validateUpdateUser"
+                updatePermissionValidationWebhook = Just $ T.pack (serverUrl server) <> "/validateUpdateUser"
               }
 
         GraphqlEngine.postMetadata_ testEnvironment
@@ -173,7 +173,7 @@ createUpdatePermissions testEnvironment server =
               { updatePermissionTable = "tweet",
                 updatePermissionRole = "user",
                 updatePermissionColumns = ["id", "user_id", "content", "email"],
-                updatePermissionValidationWebhook = Just $ (T.pack $ serverUrl server) <> "/validateUpdateTweet"
+                updatePermissionValidationWebhook = Just $ T.pack (serverUrl server) <> "/validateUpdateTweet"
               },
       Fixture.teardownAction = \_ -> pure ()
     }

server/lib/dc-api/test/Test/Specs/QuerySpec/RedactionSpec.hs

@@ -22,6 +22,10 @@ import Test.Sandwich (describe)
 import Test.TestHelpers (AgentDatasetTestSpec, it)
 import Prelude
 
+{-# ANN module ("HLint: ignore Functor law" :: String) #-}
+
+{-# ANN module ("HLint: ignore Redundant <&>" :: String) #-}
+
 spec :: TestData -> Capabilities -> AgentDatasetTestSpec
 spec TestData {..} Capabilities {..} = describe "Data Redaction in Queries" $ do
   describe "Column Field Redaction" $ do

server/lib/graphql-parser/bench/Benchmark.hs

@@ -5,6 +5,7 @@ where
 
 -------------------------------------------------------------------------------
 
+import Control.Monad (replicateM)
 import Data.Bifunctor (second)
 import Data.ByteString.Builder qualified as BS
 import Data.Function ((&))
@@ -31,7 +32,7 @@ genDocs num =
 genTexts :: Int -> IO [(Int, [Text])]
 genTexts num =
   for [1 .. num] $ \n -> do
-    texts <- for [1 .. 500 :: Int] \_ -> generate genText
+    texts <- replicateM (500 :: Int) (generate genText)
     pure (n, texts)
 
 main :: IO ()

server/lib/graphql-parser/src/Language/GraphQL/Draft/Syntax.hs

@@ -1,6 +1,6 @@
 {-# HLINT ignore "Use onLeft" #-}
 {-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 -- | Description: The GraphQL AST

server/lib/graphql-parser/src/Language/GraphQL/Draft/Syntax/Internal.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
 -- | Internal GraphQL AST functionality.

server/lib/pg-client/src/Database/PG/Query/Connection.hs

@@ -245,7 +245,7 @@ initPQConn ci logger = do
   -- Retry if postgres connection error occurs
   pgRetrying host resetFn retryP logger $ do
     -- Initialise the connection
-    conn <- PQ.connectdb =<< (pgConnString $ ciDetails ci)
+    conn <- PQ.connectdb =<< pgConnString (ciDetails ci)
 
     -- Check the status of the connection
     s <- liftIO $ PQ.status conn

server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Internal/Parser.hs

@@ -228,10 +228,7 @@ safeSelectionSet name description fields =
   where
     namesOrigins :: InsOrdHashMap Name [Maybe origin]
     namesOrigins =
-      foldr
+      foldr (uncurry (InsOrdHashMap.insertWith (<>)) . (dName &&& (pure . dOrigin)) . fDefinition) InsOrdHashMap.empty fields
-        (uncurry (InsOrdHashMap.insertWith (<>)))
-        InsOrdHashMap.empty
-        ((dName &&& (pure . dOrigin)) . fDefinition <$> fields)
     duplicates :: InsOrdHashMap Name [Maybe origin]
     duplicates = InsOrdHashMap.filter ((> 1) . length) namesOrigins
     uniques = S.toList . S.fromList

server/src-lib/Hasura/Backends/DataConnector/Adapter/Schema.hs

@@ -418,9 +418,7 @@ updateCustomOp (API.UpdateColumnOperatorName operatorName) operatorUsages = GS.U
     updateOperatorApplicableColumn :: RQL.ColumnInfo 'DataConnector -> Bool
     updateOperatorApplicableColumn columnInfo =
       -- ColumnEnumReferences are not supported at this time
-      extractColumnScalarType columnInfo
+      maybe False (\columnScalarType -> HashMap.member columnScalarType operatorUsages) (extractColumnScalarType columnInfo)
-        <&> (\columnScalarType -> HashMap.member columnScalarType operatorUsages)
-        & fromMaybe False
 
     -- Prepend the operator name with underscore
     operatorGraphqlFieldIdentifier :: GQLNameIdentifier

server/src-lib/Hasura/Backends/MSSQL/DDL/RunSQL.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
 
 -- | MSSQL DDL RunSQL
 --

server/src-lib/Hasura/Backends/MSSQL/SQL/Error.hs

@@ -182,9 +182,10 @@ mkMSSQLTxErrorHandler isExpectedError = \case
                       "exception" .= odbcExceptionToJSONValue exception
                     ]
             }
-     in fromMaybe unexpectedQueryError
+     in maybe
-          $ asExpectedError exception
+          unexpectedQueryError
-          <&> \err -> err {Error.qeInternal = Just $ Error.ExtraInternal $ object ["query" .= ODBC.renderQuery query]}
+          (\err -> err {Error.qeInternal = Just $ Error.ExtraInternal $ object ["query" .= ODBC.renderQuery query]})
+          (asExpectedError exception)
   MSSQLConnError exception ->
     let unexpectedConnError =
           (Error.internalError "mssql connection error")

server/src-lib/Hasura/Backends/Postgres/Instances/Execute.hs

@@ -415,10 +415,9 @@ convertFunction sourceName modelSourceType userInfo jsonAggSelect unpreparedQuer
   modelNames <- irToModelInfoGen sourceName modelSourceType $ queryResultFn preparedQuery
   let preparedSQLWithQueryTags = appendPreparedSQLWithQueryTags rootFieldPlan queryTags
   pure
-    $! ( fst
+    ( fst (mkCurPlanTx userInfo preparedSQLWithQueryTags), -- forget (Maybe PreparedSql)
-           $ mkCurPlanTx userInfo preparedSQLWithQueryTags, -- forget (Maybe PreparedSql)
+      modelNames
-         modelNames
+    )
-       )
 
 pgDBMutationPlan ::
   forall pgKind m.

server/src-lib/Hasura/GraphQL/Schema/BoolExp/AggregationPredicates.hs

@@ -168,7 +168,7 @@ defaultAggregationPredicatesParser aggFns ti = runMaybeT do
 
     -- Collect all the non-failed branches, failing if all branches failed.
     succeedingBranchesNE :: forall f a. (Applicative f) => NonEmpty (MaybeT f a) -> MaybeT f (NonEmpty a)
-    succeedingBranchesNE xs = MaybeT $ NE.nonEmpty . catMaybes . NE.toList <$> sequenceA (xs <&> runMaybeT)
+    succeedingBranchesNE xs = MaybeT $ NE.nonEmpty . catMaybes . NE.toList <$> traverse runMaybeT xs
 
     -- Collect a non-empty list of input field parsers into one input field
     -- parser parsing a non-empty list of the specified values.

server/src-lib/Hasura/GraphQL/Schema/Remote.hs

@@ -947,7 +947,7 @@ remoteField sdoc remoteRelationships parentTypeName fieldName description argsDe
       remoteSchemaObjFields <- remoteSchemaObject sdoc remoteRelationships objTypeDefn
       -- converting [Field NoFragments Name] to (SelectionSet NoFragments G.Name)
       let remoteSchemaObjSelSet = IR.SelectionSetObject <$> remoteSchemaObjFields
-      pure remoteSchemaObjSelSet <&> mkFieldParserWithSelectionSet customizedFieldName argsParser
+      pure $ mkFieldParserWithSelectionSet customizedFieldName argsParser remoteSchemaObjSelSet
     G.TypeDefinitionScalar scalarTypeDefn ->
       pure $ mkFieldParserWithoutSelectionSet customizedFieldName argsParser $ void $ remoteFieldScalarParser customizeTypename scalarTypeDefn
     G.TypeDefinitionEnum enumTypeDefn ->

server/src-lib/Hasura/RQL/Types/Roles/Internal.hs

@@ -263,7 +263,7 @@ instance OnlyRelevantEq G.Name where
 instance (OnlyRelevantEq a) => OnlyRelevantEq [a] where
   l ==~ r =
     (length r == length r)
-      && (all (== True) (zipWith (==~) l r))
+      && and (zipWith (==~) l r)
 
 instance OnlyRelevantEq G.ScalarTypeDefinition where
   G.ScalarTypeDefinition _descL nameL directivesL

server/src-lib/Hasura/Server/API/PGDump.hs

@@ -53,7 +53,7 @@ execPGDump b ci = do
     throwException text err = throwError (RTE.err500 RTE.Unexpected text) {RTE.qeInternal = Just (RTE.ExtraInternal (toJSON err))}
 
     execProcess = do
-      connString <- T.unpack . bsToTxt <$> (PG.pgConnString $ PG.ciDetails ci)
+      connString <- T.unpack . bsToTxt <$> PG.pgConnString (PG.ciDetails ci)
       let opts = connString : "--encoding=utf8" : prbOpts b
       (exitCode, stdOut, stdErr) <- readProcessWithExitCode "pg_dump" opts ""
       return $ case exitCode of

server/src-test/Control/Monad/MemoizationSpecDefinition.hs

@@ -122,7 +122,7 @@ checkMemoization = do
                 _ -> (+) <$> fibo (n - 2) <*> fibo (n - 1)
         traverse fibo [0 .. 20]
     fibos !! 20 `shouldBe` (6765 :: Int)
-    count `shouldBe` HashMap.fromList (zip [0 .. 20] (repeat 1))
+    count `shouldBe` HashMap.fromList (map (,1) [0 .. 20])
 
 --------------------------------------------------------------------------------
 -- Failure