Use witherable, remove catMaybes/mapMaybe

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5250
GitOrigin-RevId: 5f0a582b3a853d2dbcce20e88c17970290625fc6

server/graphql-engine.cabal

@@ -207,6 +207,7 @@ common lib-depends
                      , vector-instances
                      , wai
                      , witch
+                     , witherable >= 0.4
 
                      -- Encoder related
                      , uuid
@@ -405,7 +406,6 @@ 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

server/src-lib/Data/HashMap/Strict/Extended.hs

@@ -1,6 +1,5 @@
 module Data.HashMap.Strict.Extended
   ( module M,
-    catMaybes,
     fromListOn,
     groupOn,
     groupOnNE,
@@ -24,11 +23,8 @@ import Data.List qualified as L
 import Data.List.NonEmpty (NonEmpty (..))
 import Prelude
 
-catMaybes :: HashMap k (Maybe v) -> HashMap k v
-catMaybes = M.mapMaybe id
-
 fromListOn :: (Eq k, Hashable k) => (v -> k) -> [v] -> HashMap k v
-fromListOn f = fromList . Prelude.map (\v -> (f v, v))
+fromListOn f = M.fromList . Prelude.map (\v -> (f v, v))
 
 -- | Given a 'Foldable' sequence of values and a function that extracts a key from each value,
 -- returns a 'HashMap' that maps each key to a list of all values in the sequence for which the
@@ -95,23 +91,23 @@ unionWithM ::
   HashMap k v ->
   HashMap k v ->
   m (HashMap k v)
-unionWithM f m1 m2 = foldM step m1 (toList m2)
+unionWithM f m1 m2 = foldM step m1 (M.toList m2)
   where
     step m (k, new) = case M.lookup k m of
-      Nothing -> pure $ insert k new m
+      Nothing -> pure $ M.insert k new m
       Just old -> do
         combined <- f k new old
-        pure $ insert k combined m
+        pure $ M.insert k combined m
 
 -- | Like 'M.unions', but keeping all elements in the result.
 unionsAll ::
   (Eq k, Hashable k, Foldable t) => t (HashMap k v) -> HashMap k (NonEmpty v)
-unionsAll = F.foldl' (\a b -> unionWith (<>) a (fmap (:| []) b)) M.empty
+unionsAll = F.foldl' (\a b -> M.unionWith (<>) a (fmap (:| []) b)) M.empty
 
 -- | Homogenise maps, such that all maps range over the full set of
 -- keys, inserting a default value as needed.
 homogenise :: (Hashable a, Eq a) => b -> [HashMap a b] -> (HashSet a, [HashMap a b])
 homogenise defaultValue maps =
-  let ks = S.unions $ L.map keysSet maps
-      defaults = fromList [(k, defaultValue) | k <- S.toList ks]
+  let ks = S.unions $ L.map M.keysSet maps
+      defaults = M.fromList [(k, defaultValue) | k <- S.toList ks]
    in (ks, L.map (<> defaults) maps)

server/src-lib/Data/IntMap/Strict/Extended.hs

@@ -1,11 +0,0 @@
-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

server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs

@@ -12,7 +12,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.Extended qualified as IntMap
+import Data.IntMap.Strict qualified as IntMap
 import Data.Text qualified as T
 import Data.Tuple (swap)
 import Hasura.Base.Error
@@ -135,7 +135,7 @@ foldJoinTreeWith ::
   m (f JO.Value)
 foldJoinTreeWith callSource callRemoteSchema userInfo lhs joinTree = do
   (compositeValue, joins) <- collectJoinArguments (assignJoinIds joinTree) lhs
-  joinIndices <- fmap IntMap.catMaybes $
+  joinIndices <- fmap catMaybes $
     for joins $ \JoinArguments {..} -> do
       let joinArguments = IntMap.fromList $ map swap $ Map.toList _jalArguments
       previousStep <- case _jalJoin of

server/src-lib/Hasura/GraphQL/Parser/Directives.hs

@@ -26,17 +26,16 @@ module Hasura.GraphQL.Parser.Directives
 where
 
 import Control.Monad (guard, unless)
-import Control.Monad.Identity (Identity (..))
 import Data.Aeson.Key qualified as K
 import Data.Aeson.Types (JSONPathElement (Key))
 import Data.Dependent.Map qualified as DM
 import Data.Dependent.Sum (DSum (..))
 import Data.Foldable (for_)
+import Data.Functor.Identity (Identity (..))
 import Data.GADT.Compare.Extended
 import Data.HashMap.Strict qualified as M
 import Data.HashSet qualified as S
 import Data.List qualified as L
-import Data.Maybe (catMaybes)
 import Data.Traversable (for)
 import Data.Typeable (eqT)
 import Hasura.Base.ToErrorValue
@@ -48,6 +47,7 @@ import Hasura.GraphQL.Parser.Schema
 import Hasura.GraphQL.Parser.Variable
 import Language.GraphQL.Draft.Syntax qualified as G
 import Type.Reflection (Typeable, typeRep, (:~:) (..))
+import Witherable (catMaybes)
 import Prelude
 
 -- Disable custom prelude warnings in preparation for extracting this module into a separate package.

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

@@ -15,7 +15,7 @@ where
 
 import Control.Arrow ((&&&))
 import Control.Monad (unless, when, (>=>))
-import Control.Monad.Except (MonadError (..))
+import Control.Monad.Except (MonadError (throwError))
 import Data.Aeson qualified as A
 import Data.Aeson.Key qualified as K
 import Data.Aeson.Types (JSONPathElement (Key))
@@ -44,6 +44,7 @@ import Hasura.GraphQL.Parser.Schema
 import Hasura.GraphQL.Parser.Variable
 import Language.GraphQL.Draft.Syntax hiding (Definition)
 import Language.GraphQL.Draft.Syntax qualified as G
+import Witherable (catMaybes, mapMaybe)
 import Prelude
 
 infixl 1 `bind`
@@ -198,7 +199,7 @@ safeSelectionSet name description fields
     duplicates = M.filter ((> 1) . length) namesOrigins
     uniques = S.toList . S.fromList
     printEntry (fieldName, originsM) =
-      let origins = uniques $ Maybe.catMaybes originsM
+      let origins = uniques $ catMaybes originsM
        in if
               | null origins -> toErrorValue fieldName
               | any Maybe.isNothing originsM ->
@@ -266,7 +267,7 @@ selectionSetObject name description parsers implementsInterfaces =
       parsers
         & map (\FieldParser {fDefinition, fParser} -> (getName fDefinition, fParser))
         & M.fromList
-    interfaces = Maybe.mapMaybe (getInterfaceInfo . pType) implementsInterfaces
+    interfaces = mapMaybe (getInterfaceInfo . pType) implementsInterfaces
     parsedInterfaceNames = fmap getName interfaces
 
 selectionSetInterface ::
@@ -297,7 +298,7 @@ selectionSetInterface name description fields objectImplementations =
       -- fragments on the other types.
     }
   where
-    objects = Maybe.catMaybes $ toList $ fmap (getObjectInfo . pType) objectImplementations
+    objects = catMaybes $ toList $ fmap (getObjectInfo . pType) objectImplementations
 
 selectionSetUnion ::
   (MonadParse n, Traversable t) =>
@@ -315,7 +316,7 @@ selectionSetUnion name description objectImplementations =
       pParser = \input -> for objectImplementations (($ input) . pParser)
     }
   where
-    objects = Maybe.catMaybes $ toList $ fmap (getObjectInfo . pType) objectImplementations
+    objects = catMaybes $ toList $ fmap (getObjectInfo . pType) objectImplementations
 
 -- | Builds a 'FieldParser' for a field that does not take a subselection set,
 -- i.e. a field that returns a scalar or enum. The field’s type is taken from

server/src-lib/Hasura/GraphQL/RemoteServer.hs

@@ -532,7 +532,7 @@ getCustomizer IntrospectionResult {..} (Just RemoteSchemaCustomization {..}) = R
 
     typeFieldMap :: HashMap G.Name [G.Name] -- typeName -> fieldNames
     typeFieldMap =
-      Map.mapMaybe getFieldsNames typeDefinitions
+      mapMaybe getFieldsNames typeDefinitions
       where
         getFieldsNames = \case
           G.TypeDefinitionObject G.ObjectTypeDefinition {..} -> Just $ G._fldName <$> _otdFieldsDefinition

server/src-lib/Hasura/Prelude.hs

@@ -5,10 +5,12 @@ module Hasura.Prelude
   ( module M,
     alphabet,
     alphaNumerics,
+    catMaybes,
     onNothing,
     onNothingM,
     onJust,
     withJust,
+    mapMaybe,
     maybeToEither,
     eitherToMaybe,
     onLeft,
@@ -119,12 +121,10 @@ import Data.List as M
   )
 import Data.List.NonEmpty as M (NonEmpty (..), nonEmpty)
 import Data.Maybe as M
-  ( catMaybes,
-    fromMaybe,
+  ( fromMaybe,
     isJust,
     isNothing,
     listToMaybe,
-    mapMaybe,
     maybeToList,
   )
 import Data.Monoid as M (getAlt)
@@ -150,6 +150,7 @@ import GHC.Generics as M (Generic)
 import System.IO.Unsafe (unsafePerformIO) -- for custom trace functions
 import Text.Pretty.Simple qualified as PS
 import Text.Read as M (readEither, readMaybe)
+import Witherable (catMaybes, mapMaybe)
 import Prelude as M hiding (fail, init, lookup)
 
 alphabet :: String

server/src-lib/Hasura/RQL/DDL/RemoteRelationship/Validate.hs

@@ -218,7 +218,7 @@ stripInMap ::
     (Either ValidationError)
     (HM.HashMap G.Name RemoteSchemaInputValueDefinition)
 stripInMap relName lhsIdentifier types schemaArguments providedArguments =
-  fmap HM.catMaybes $
+  fmap catMaybes $
     HM.traverseWithKey
       ( \name remoteInpValDef@(RemoteSchemaInputValueDefinition inpValInfo _preset) ->
           case HM.lookup name providedArguments of

server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs

@@ -567,7 +567,7 @@ buildSchemaCacheRule logger env = proc (metadata, invalidationKeys) -> do
                         |) metadataObject
                   )
               |)
-          >-> (\infos -> M.catMaybes infos >- returnA)
+          >-> (\infos -> catMaybes infos >- returnA)
 
       returnA -< AB.mkAnyBackend $ SourceInfo sourceName tableCache functionCache sourceConfig queryTagsConfig sourceCustomization
 
@@ -702,7 +702,7 @@ buildSchemaCacheRule logger env = proc (metadata, invalidationKeys) -> do
                     (exists, (invalidationKeys, defaultNC, isNamingConventionEnabled))
             )
         |) (M.fromList $ OMap.toList backendConfigAndSourceMetadata)
-          >-> (\infos -> M.catMaybes infos >- returnA)
+          >-> (\infos -> catMaybes infos >- returnA)
 
       -- then we can build the entire source output
       -- we need to have the table cache of all sources to build cross-sources relationships
@@ -804,7 +804,7 @@ buildSchemaCacheRule logger env = proc (metadata, invalidationKeys) -> do
                       returnA
                         -<
                           ( remoteSchemaCtx
-                              { _rscPermissions = M.catMaybes $ M.fromList resolvedPermissions,
+                              { _rscPermissions = catMaybes $ M.fromList resolvedPermissions,
                                 _rscRemoteRelationships = OMap.catMaybes <$> OMap.fromList resolvedRelationships
                               },
                             metadataObj
@@ -961,7 +961,7 @@ buildSchemaCacheRule logger env = proc (metadata, invalidationKeys) -> do
           Inc.keyed
             (\remoteSchemaName infos -> combine -< (remoteSchemaName, infos))
           |) (align baseInfo extraInfo)
-      returnA -< M.catMaybes combinedInfo
+      returnA -< catMaybes combinedInfo
       where
         combine :: (RemoteSchemaName, These a [b]) `arr` Maybe (a, [b])
         combine = proc (remoteSchemaName, infos) -> case infos of

server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs

@@ -312,7 +312,7 @@ buildInfoMap extractKey mkMetadataObject buildInfo = proc (e, infos) ->
                   >-> (\info -> join info >- returnA)
             )
         |)
-    >-> (\infoMap -> M.catMaybes infoMap >- returnA)
+    >-> (\infoMap -> catMaybes infoMap >- returnA)
 {-# INLINEABLE buildInfoMap #-}
 
 -- | Like 'buildInfo', but includes each processed info’s associated 'MetadataObject' in the result.

server/src-lib/Hasura/RQL/DDL/Schema/Cache/Fields.hs

@@ -145,14 +145,14 @@ addNonColumnFields =
     (align relationshipFields computedFieldFields >- returnA)
       >-> (| Inc.keyed (\fieldName fields -> (fieldName, fields) >- noFieldConflicts FIRelationship FIComputedField) |)
       -- Second, align with remote relationship fields
-      >-> (\fields -> align (M.catMaybes fields) remoteRelationshipFields >- returnA)
+      >-> (\fields -> align (catMaybes fields) remoteRelationshipFields >- returnA)
       >-> (| Inc.keyed (\fieldName fields -> (fieldName, fields) >- noFieldConflicts id FIRemoteRelationship) |)
       -- Next, check for conflicts with custom field names. This is easiest to do before merging with
       -- the column info itself because we have access to the information separately, and custom field
       -- names are not currently stored as a separate map (but maybe should be!).
-      >-> (\fields -> (columns, M.catMaybes fields) >- noCustomFieldConflicts)
+      >-> (\fields -> (columns, catMaybes fields) >- noCustomFieldConflicts)
       -- Finally, check for conflicts with the columns themselves.
-      >-> (\fields -> align columns (M.catMaybes fields) >- returnA)
+      >-> (\fields -> align columns (catMaybes fields) >- returnA)
       >-> (| Inc.keyed (\_ fields -> fields >- noColumnConflicts) |)
   where
     noFieldConflicts this that = proc (fieldName, fields) -> case fields of

server/src-lib/Hasura/RQL/DDL/Schema/Table.hs

@@ -433,15 +433,15 @@ buildTableCache = Inc.cache proc (source, sourceConfig, dbTablesMeta, tableBuild
             )
         |)
       |) (withSourceInKey source $ Map.groupOnNE _tbiName tableBuildInputs)
-  let rawTableCache = removeSourceInKey $ Map.catMaybes rawTableInfos
-      enumTables = flip Map.mapMaybe rawTableCache \rawTableInfo ->
+  let rawTableCache = removeSourceInKey $ catMaybes rawTableInfos
+      enumTables = flip mapMaybe rawTableCache \rawTableInfo ->
         (,,) <$> _tciPrimaryKey rawTableInfo <*> pure (_tciCustomConfig rawTableInfo) <*> _tciEnumValues rawTableInfo
   tableInfos <-
     (|
       Inc.keyed
         (| withTable (\table -> processTableInfo -< (enumTables, table, tCase)) |)
       |) (withSourceInKey source rawTableCache)
-  returnA -< removeSourceInKey (Map.catMaybes tableInfos)
+  returnA -< removeSourceInKey (catMaybes tableInfos)
   where
     withSourceInKey :: (Eq k, Hashable k) => SourceName -> HashMap k v -> HashMap (SourceName, k) v
     withSourceInKey source = mapKeys (source,)

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

@@ -750,7 +750,7 @@ instance (Backend b) => ToJSON (TableConfig b) where
           -- custom_column_names is a deprecated property that has been replaced by column_config.
           -- We are retaining it here, sourcing its values from column_config, for backwards-compatibility
           -- custom_column_names can be removed once the deprecation period has expired and we get rid of it
-          "custom_column_names" .= M.mapMaybe _ccfgCustomName _tcColumnConfig,
+          "custom_column_names" .= mapMaybe _ccfgCustomName _tcColumnConfig,
           "column_config" .= M.filter (/= mempty) _tcColumnConfig,
           "custom_name" .= _tcCustomName,
           "comment" .= _tcComment

server/src-lib/Hasura/Server/Rest.hs

@@ -136,7 +136,7 @@ runCustomEndpoint env execCtx requestId userInfo reqHeaders ipAddress RestReques
 
               resolvedVariablesMaybe <- joinedVars `onLeft` throw400 BadRequest
 
-              let resolvedVariables = M.catMaybes resolvedVariablesMaybe
+              let resolvedVariables = catMaybes resolvedVariablesMaybe
 
               -- Construct a graphql query by pairing the resolved variables
               -- with the query string from the schema cache, and pass it