Replace all occurrences of mapMaybe id by catMaybes.

### Description Several libraries define `catMaybes` as `mapMaybe id`. We had it defined in `Data.HashMap.Strict.Extended` already. This small PR also defines it in `Extended` modules for other containers and replaces every occurrence of `mapMaybe id` accordingly. PR-URL: hasura/graphql-engine-mono#3884 GitOrigin-RevId: d222a2ca2f4eb9b725b20450a62a626d3886dbf4
QiaoXingLi · Mar 3, 2022 · f96b889 · f96b889
1 parent 2abe02c
commit f96b889
Show file tree

Hide file tree

Showing 9 changed files with 47 additions and 27 deletions.
diff --git a/.hlint.yaml b/.hlint.yaml
@@ -122,6 +122,13 @@
     - warn: {lhs: "MaybeT (return x)",       rhs: "hoistMaybe x"}
     - warn: {lhs: "MaybeT (pure Nothing)",   rhs: "Control.Applicative.empty"}
     - warn: {lhs: "MaybeT (return Nothing)", rhs: "Control.Applicative.empty"}
+    # catMaybes
+    - warn: {lhs: "Data.HashMap.Strict.mapMaybe id", rhs: "Data.HashMap.Strict.Extended.catMaybes"}
+    - warn: {lhs: "Data.HashMap.Strict.Extended.mapMaybe id", rhs: "Data.HashMap.Strict.Extended.catMaybes"}
+    - warn: {lhs: "Data.HashMap.Strict.InsOrd.mapMaybe id", rhs: "Data.HashMap.Strict.InsOrd.Extended.catMaybes"}
+    - warn: {lhs: "Data.HashMap.Strict.InsOrd.Extended.mapMaybe id", rhs: "Data.HashMap.Strict.InsOrd.Extended.catMaybes"}
+    - warn: {lhs: "Data.IntMap.Strict.mapMaybe id", rhs: "Data.HashMap.Strict.Extended.catMaybes"}
+    - warn: {lhs: "Data.IntMap.Strict.Extended.mapMaybe id", rhs: "Data.HashMap.Strict.Extended.catMaybes"}
 
 - group:
     name: data-text-extended

diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal
@@ -335,6 +335,7 @@ library
                      , Data.HashMap.Strict.Multi
                      , Data.HashMap.Strict.NonEmpty
                      , Data.HashMap.Strict.InsOrd.Extended
+                     , Data.IntMap.Strict.Extended
                      , Data.List.Extended
                      , Data.Parser.CacheControl
                      , Data.Parser.Expires

diff --git a/server/src-lib/Data/HashMap/Strict/InsOrd/Extended.hs b/server/src-lib/Data/HashMap/Strict/InsOrd/Extended.hs
@@ -1,5 +1,6 @@
 module Data.HashMap.Strict.InsOrd.Extended
   ( module OMap,
+    catMaybes,
     groupTuples,
     groupListWith,
     partition,
@@ -13,6 +14,9 @@ import Data.List qualified as L
 import Data.Sequence.NonEmpty qualified as NE
 import Prelude
 
+catMaybes :: InsOrdHashMap k (Maybe v) -> InsOrdHashMap k v
+catMaybes = OMap.mapMaybe id
+
 groupTuples ::
   (Eq k, Hashable k, Foldable t) =>
   t (k, v) ->

diff --git a/server/src-lib/Data/IntMap/Strict/Extended.hs b/server/src-lib/Data/IntMap/Strict/Extended.hs
@@ -0,0 +1,11 @@
+module Data.IntMap.Strict.Extended
+  ( module M,
+    catMaybes,
+  )
+where
+
+import Data.IntMap.Strict as M
+import Prelude
+
+catMaybes :: IntMap (Maybe v) -> IntMap v
+catMaybes = M.mapMaybe id
diff --git a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs
@@ -10,7 +10,7 @@ import Data.HashMap.Strict.Extended qualified as Map
 import Data.HashMap.Strict.InsOrd qualified as OMap
 import Data.HashMap.Strict.NonEmpty qualified as NEMap
 import Data.HashSet qualified as HS
-import Data.IntMap.Strict qualified as IntMap
+import Data.IntMap.Strict.Extended qualified as IntMap
 import Data.List.NonEmpty qualified as NE
 import Data.Scientific qualified as Scientific
 import Data.Text qualified as T
@@ -99,7 +99,7 @@ processRemoteJoins_ ::
   m (f JO.Value)
 processRemoteJoins_ requestId logger env manager reqHdrs userInfo lhs joinTree gqlreq = do
   (compositeValue, joins) <- collectJoinArguments (assignJoinIds joinTree) lhs
-  joinIndices <- fmap (IntMap.mapMaybe id) $
+  joinIndices <- fmap IntMap.catMaybes $
     for joins $ \JoinArguments {..} -> do
       let joinArguments = IntMap.fromList $ map swap $ Map.toList _jalArguments
       case _jalJoin of

diff --git a/server/src-lib/Hasura/GraphQL/Schema/Select.hs b/server/src-lib/Hasura/GraphQL/Schema/Select.hs
@@ -1647,7 +1647,7 @@ nodePG = memoizeOn 'nodePG () do
         sourceConfig <- maybeToList $ unsafeSourceConfiguration @('Postgres 'Vanilla) sourceInfo
         pure (tableName, (source, sourceConfig, AB.runBackend sourceInfo _siCustomization))
   tables <-
-    Map.mapMaybe id <$> flip Map.traverseWithKey allTables \table (source, sourceConfig, sourceCustomization) -> runMaybeT do
+    Map.catMaybes <$> flip Map.traverseWithKey allTables \table (source, sourceConfig, sourceCustomization) -> runMaybeT do
       tableInfo <- lift $ askTableInfo source table
       tablePkeyColumns <- hoistMaybe $ tableInfo ^? tiCoreInfo . tciPrimaryKey . _Just . pkColumns
       selectPermissions <- MaybeT $ tableSelectPermissions tableInfo

diff --git a/server/src-lib/Hasura/RQL/DDL/RemoteRelationship/Validate.hs b/server/src-lib/Hasura/RQL/DDL/RemoteRelationship/Validate.hs
@@ -7,7 +7,7 @@ module Hasura.RQL.DDL.RemoteRelationship.Validate
   )
 where
 
-import Data.HashMap.Strict qualified as HM
+import Data.HashMap.Strict.Extended qualified as HM
 import Data.HashSet qualified as HS
 import Data.List.NonEmpty qualified as NE
 import Data.Text.Extended
@@ -215,25 +215,22 @@ stripInMap ::
     (Either ValidationError)
     (HM.HashMap G.Name RemoteSchemaInputValueDefinition)
 stripInMap relName lhsIdentifier types schemaArguments providedArguments =
-  fmap
-    (HM.mapMaybe id)
-    ( HM.traverseWithKey
-        ( \name remoteInpValDef@(RemoteSchemaInputValueDefinition inpValInfo _preset) ->
-            case HM.lookup name providedArguments of
-              Nothing -> pure $ Just remoteInpValDef
-              Just value -> do
-                maybeNewGType <- stripValue relName lhsIdentifier types (G._ivdType inpValInfo) value
-                pure
-                  ( fmap
-                      ( \newGType ->
-                          let newInpValInfo = inpValInfo {G._ivdType = newGType}
-                           in RemoteSchemaInputValueDefinition newInpValInfo Nothing
-                      )
-                      maybeNewGType
+  fmap HM.catMaybes $
+    HM.traverseWithKey
+      ( \name remoteInpValDef@(RemoteSchemaInputValueDefinition inpValInfo _preset) ->
+          case HM.lookup name providedArguments of
+            Nothing -> pure $ Just remoteInpValDef
+            Just value -> do
+              maybeNewGType <- stripValue relName lhsIdentifier types (G._ivdType inpValInfo) value
+              pure $
+                fmap
+                  ( \newGType ->
+                      let newInpValInfo = inpValInfo {G._ivdType = newGType}
+                       in RemoteSchemaInputValueDefinition newInpValInfo Nothing
                   )
-        )
-        schemaArguments
-    )
+                  maybeNewGType
+      )
+      schemaArguments
 
 -- | Strip a value type completely, or modify it, if the given value
 -- is atomic-ish.

diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs
@@ -30,7 +30,7 @@ import Data.Dependent.Map qualified as DMap
 import Data.Either (isLeft)
 import Data.Environment qualified as Env
 import Data.HashMap.Strict.Extended qualified as M
-import Data.HashMap.Strict.InsOrd qualified as OMap
+import Data.HashMap.Strict.InsOrd.Extended qualified as OMap
 import Data.HashSet qualified as HS
 import Data.Proxy
 import Data.Set qualified as S
@@ -778,8 +778,8 @@ buildSchemaCacheRule logger env = proc (metadata, invalidationKeys) -> do
                       returnA
                         -<
                           ( remoteSchemaCtx
-                              { _rscPermissions = M.mapMaybe id $ M.fromList resolvedPermissions,
-                                _rscRemoteRelationships = OMap.mapMaybe id <$> OMap.fromList resolvedRelationships
+                              { _rscPermissions = M.catMaybes $ M.fromList resolvedPermissions,
+                                _rscRemoteRelationships = OMap.catMaybes <$> OMap.fromList resolvedRelationships
                               },
                             metadataObj
                           )

diff --git a/server/src-lib/Hasura/Server/Rest.hs b/server/src-lib/Hasura/Server/Rest.hs
@@ -9,7 +9,7 @@ import Data.Aeson hiding (json)
 import Data.Aeson qualified as J
 import Data.Align qualified as Align
 import Data.Environment qualified as Env
-import Data.HashMap.Strict qualified as M
+import Data.HashMap.Strict.Extended qualified as M
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
 import Data.Text.Extended
@@ -155,7 +155,7 @@ runCustomEndpoint env execCtx requestId userInfo reqHeaders ipAddress RestReques
 
               resolvedVariablesMaybe <- joinedVars `onLeft` throw400 BadRequest
 
-              let resolvedVariables = M.mapMaybe id resolvedVariablesMaybe
+              let resolvedVariables = M.catMaybes resolvedVariablesMaybe
 
               -- Construct a graphql query by pairing the resolved variables
               -- with the query string from the schema cache, and pass it