Upgrade HLint to v3.4.1.

This upgrades CI and anyone using Nix to HLint v3.4.1.

If you're not using Nix, this doesn't actually _do_ anything on your
local machine; it's just a suggestion.

It also applies a bunch of simple HLint refactors, using
`make lint-hs-fix`.

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

nix/shell.nix

@@ -54,8 +54,6 @@ let
     pkgs.haskell.compiler.${pkgs.ghcName}
 
     # We use the default versions of these packages.
-    (versions.ensureVersion pkgs.haskellPackages.hlint)
-    (versions.ensureVersion pkgs.haskellPackages.hpack)
     (versions.ensureVersion pkgs.haskellPackages.ormolu)
 
     # We build these packages using our custom GHC.
@@ -65,6 +63,8 @@ let
     pkgs.haskell.packages.${pkgs.ghcName}.ghcid
     pkgs.haskell.packages.${pkgs.ghcName}.happy
     pkgs.haskell.packages.${pkgs.ghcName}.haskell-language-server
+    (versions.ensureVersion pkgs.haskell.packages.${pkgs.ghcName}.hlint)
+    (versions.ensureVersion pkgs.haskell.packages.${pkgs.ghcName}.hpack)
     pkgs.haskell.packages.${pkgs.ghcName}.hoogle
     pkgs.haskell.packages.${pkgs.ghcName}.hspec-discover
   ];

scripts/make/lint.mk

@@ -116,6 +116,18 @@ lint-hs-changed: check-hlint-version
 		$(HLINT) $(CHANGED_HS_FILES); \
 	fi
 
+.PHONY: lint-hs-fix
+## lint-hs-fix: lint Haskell code using `hlint` and attempt to fix warnings using `apply-refact`
+lint-hs-fix: check-hlint-version
+	@echo running hlint --refactor
+	@echo $(HS_FILES) | xargs -n1 $(HLINT) --refactor --refactor-options='--inplace'
+
+.PHONY: lint-hs-fix-changed
+## lint-hs-fix-changed: lint Haskell code using `hlint` and attempt to fix warnings using `apply-refact` (changed files only)
+lint-hs-fix-changed: check-hlint-version
+	@echo running hlint --refactor
+	@echo $(CHANGED_HS_FILES) | xargs --no-run-if-empty -n1 $(HLINT) --refactor --refactor-options='--inplace'
+
 .PHONY: lint-shell
 ## lint-shell: lint shell scripts using `shellcheck`
 lint-shell:

server/VERSIONS.json

@@ -1,6 +1,6 @@
 {
   "ghc": "9.2.4",
-  "hlint": "3.3.6",
+  "hlint": "3.4.1",
   "hpack": "0.34.7",
   "ormolu": "0.3.1.0"
 }

server/src-lib/Hasura/Backends/DataConnector/Plan.hs

@@ -278,7 +278,7 @@ mkPlan session (SourceConfig {}) ir = do
       CPS.WriterT TableRelationships m FieldsAndAggregates
     translateAnnFields fieldNamePrefix sourceTableName fields = do
       translatedFields <- traverse (traverse (translateAnnField sourceTableName)) fields
-      let translatedFields' = HashMap.fromList . catMaybes $ (\(fieldName, field) -> (applyPrefix fieldNamePrefix fieldName,) <$> field) <$> translatedFields
+      let translatedFields' = HashMap.fromList (mapMaybe (\(fieldName, field) -> (applyPrefix fieldNamePrefix fieldName,) <$> field) translatedFields)
       pure $
         FieldsAndAggregates
           translatedFields'

server/src-lib/Hasura/Backends/Postgres/Schema/Select.hs

@@ -120,7 +120,7 @@ selectFunctionAggregate mkRootFieldName sourceInfo fi@FunctionInfo {..} descript
     tableArgsParser <- tableArguments sourceInfo tableInfo
     functionArgsParser <- customSQLFunctionArgs sourceInfo fi _fiGQLAggregateName _fiGQLArgsName
     aggregateParser <- tableAggregationFields sourceInfo tableInfo
-    selectionName <- mkTypename =<< pure (applyTypeNameCaseIdentifier tCase $ mkTableAggregateTypeName tableGQLName)
+    selectionName <- mkTypename (applyTypeNameCaseIdentifier tCase $ mkTableAggregateTypeName tableGQLName)
     let aggregateFieldName = runMkRootFieldName mkRootFieldName _fiGQLAggregateName
         argsParser = liftA2 (,) functionArgsParser tableArgsParser
         aggregationParser =

server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs

@@ -231,10 +231,7 @@ sendCloseWithMsg ::
   Maybe Word16 ->
   m ()
 sendCloseWithMsg logger wsConn errCode mErrServerMsg mCode = do
-  case mErrServerMsg of
-    Just errServerMsg ->
-      sendMsg wsConn errServerMsg
-    Nothing -> pure ()
+  forM_ mErrServerMsg (sendMsg wsConn)
   logWSEvent logger wsConn EClosed
   liftIO $ WS.sendCloseCode wsc errCloseCode errMsg
   where

server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs

@@ -454,7 +454,7 @@ instance ToJSON GetEventInvocations where
         GIBEvent event ->
           scheduledEventToPairs event
             <> scheduledEventPaginationToPairs _geiPagination
-            <> (bool mempty ["get_rows_count" .= True] $ _geiGetRowsCount == IncludeRowsCount)
+            <> bool mempty ["get_rows_count" .= True] (_geiGetRowsCount == IncludeRowsCount)
 
 data ClearCronEvents
   = -- | Used to delete the cron events only of the specified cron trigger

server/src-lib/Hasura/Server/Auth/JWT.hs

@@ -175,7 +175,7 @@ data JWTCustomClaimsMapValueG v
 instance (J.FromJSON v) => J.FromJSON (JWTCustomClaimsMapValueG v) where
   parseJSON (J.Object obj) = do
     path <- obj J..: "path" >>= (either (fail . T.unpack) pure . parseJSONPath)
-    defaultVal <- obj J..:? "default" >>= pure
+    defaultVal <- obj J..:? "default"
     pure $ JWTCustomClaimsMapJSONPath path defaultVal
   parseJSON v = JWTCustomClaimsMapStatic <$> J.parseJSON v
 

server/src-test/Test/Backend/Postgres/Update.hs

@@ -61,7 +61,7 @@ runTest TestBuilder {..} =
                 }
     case Update.mkUpdateCTE @'Vanilla upd of
       (Update.Update cte) ->
-        (SI.fromText $ toSQLTxt cte) `shouldBe` SI.fromText expectedSQL
+        SI.fromText (toSQLTxt cte) `shouldBe` SI.fromText expectedSQL
       _ -> assertFailure "expected single update, got multiple updates"
 
 -- | Runs a test for /update_many/