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
This commit is contained in:
Samir Talwar 2023-12-07 10:15:05 +01:00 committed by hasura-bot
parent 94f01cfbb0
commit ae5279ccda
18 changed files with 29 additions and 28 deletions

View File

@ -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

View File

@ -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 ()
}

View File

@ -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 ()
}

View File

@ -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

View File

@ -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 ()

View File

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

View File

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

View File

@ -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

View File

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

View File

@ -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
<&> (\columnScalarType -> HashMap.member columnScalarType operatorUsages)
& fromMaybe False
maybe False (\columnScalarType -> HashMap.member columnScalarType operatorUsages) (extractColumnScalarType columnInfo)
-- Prepend the operator name with underscore
operatorGraphqlFieldIdentifier :: GQLNameIdentifier

View File

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

View File

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

View File

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

View File

@ -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.

View File

@ -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 ->

View File

@ -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

View File

@ -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

View File

@ -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