Cleaned up Maybes.lhs

compiler/basicTypes/NameEnv.lhs

@@ -58,7 +58,7 @@ depAnal get_defs get_uses nodes
   = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
   where
     keyed_nodes = nodes `zip` [(1::Int)..]
-    mk_node (node, key) = (node, key, mapCatMaybes (lookupNameEnv key_map) (get_uses node))
+    mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
 
     key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it
     key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]                        

compiler/basicTypes/RdrName.lhs

@@ -586,7 +586,7 @@ pickGREs rdr_name gres
   = ASSERT2( isSrcRdrName rdr_name, ppr rdr_name )
     candidates
   where
-    candidates = mapCatMaybes pick gres
+    candidates = mapMaybe pick gres
     internal_candidates = filter (isInternalName . gre_name) candidates
 
     rdr_is_unqual = isUnqual rdr_name
@@ -700,7 +700,7 @@ shadow_name env name
   = alterOccEnv (fmap alter_fn) env (nameOccName name)
   where
     alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]
-    alter_fn gres = mapCatMaybes (shadow_with name) gres
+    alter_fn gres = mapMaybe (shadow_with name) gres
 
     shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
     shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef })
@@ -719,7 +719,7 @@ shadow_name env name
        | null imp_specs' = Nothing
        | otherwise       = Just (old_gre { gre_prov = Imported imp_specs' })
        where
-         imp_specs' = mapCatMaybes (shadow_is new_name) imp_specs
+         imp_specs' = mapMaybe (shadow_is new_name) imp_specs
 
     shadow_is :: Name -> ImportSpec -> Maybe ImportSpec
     shadow_is new_name is@(ImpSpec { is_decl = id_spec })

compiler/codeGen/StgCmmBind.hs

@@ -46,9 +46,9 @@ import Util
 import BasicTypes
 import Outputable
 import FastString
-import Maybes
 import DynFlags
 
+import Data.Maybe
 import Control.Monad
 
 ------------------------------------------------------------------------
@@ -268,7 +268,7 @@ mkRhsClosure    dflags bndr _cc _bi
                       [(DataAlt _, params, _use_mask,
                             (StgApp selectee [{-no args-}]))])
   |  the_fv == scrutinee                -- Scrutinee is the only free variable
-  && maybeToBool maybe_offset           -- Selectee is a component of the tuple
+  && isJust maybe_offset                -- Selectee is a component of the tuple
   && offset_into_int <= mAX_SPEC_SELECTEE_SIZE dflags -- Offset is small enough
   = -- NOT TRUE: ASSERT(is_single_constructor)
     -- The simplifier may have statically determined that the single alternative

compiler/deSugar/DsCCall.lhs

@@ -32,7 +32,6 @@ import CoreUtils
 import MkCore
 import Var
 import MkId
-import Maybes
 import ForeignCall
 import DataCon
 
@@ -50,6 +49,8 @@ import VarSet
 import DynFlags
 import Outputable
 import Util
+
+import Data.Maybe
 \end{code}
 
 Desugaring of @ccall@s consists of adding some state manipulation,
@@ -177,7 +178,7 @@ unboxArg arg
   --	data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
   | is_product_type &&
     data_con_arity == 3 &&
-    maybeToBool maybe_arg3_tycon &&
+    isJust maybe_arg3_tycon &&
     (arg3_tycon ==  byteArrayPrimTyCon ||
      arg3_tycon ==  mutableByteArrayPrimTyCon)
   = do case_bndr <- newSysLocalDs arg_ty
@@ -192,7 +193,7 @@ unboxArg arg
   where
     arg_ty					= exprType arg
     maybe_product_type 			   	= splitDataProductType_maybe arg_ty
-    is_product_type			   	= maybeToBool maybe_product_type
+    is_product_type			   	= isJust maybe_product_type
     Just (_, _, data_con, data_con_arg_tys)	= maybe_product_type
     data_con_arity				= dataConSourceArity data_con
     (data_con_arg_ty1 : _)			= data_con_arg_tys

compiler/iface/MkIface.lhs

@@ -936,7 +936,7 @@ mk_mod_usage_info :: PackageIfaceTable
               -> NameSet
               -> [Usage]
 mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
-  = mapCatMaybes mkUsage usage_mods
+  = mapMaybe mkUsage usage_mods
   where
     hpt = hsc_HPT hsc_env
     dflags = hsc_dflags hsc_env

compiler/main/GhcMake.hs

@@ -46,7 +46,7 @@ import BasicTypes
 import Digraph
 import Exception        ( tryIO, gbracket, gfinally )
 import FastString
-import Maybes           ( expectJust, mapCatMaybes )
+import Maybes           ( expectJust )
 import MonadUtils       ( allM, MonadIO )
 import Outputable
 import Panic
@@ -1443,7 +1443,7 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l
                 | otherwise          = HsBootFile
 
     out_edge_keys :: HscSource -> [ModuleName] -> [Int]
-    out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
+    out_edge_keys hi_boot ms = mapMaybe (lookup_key hi_boot) ms
         -- If we want keep_hi_boot_nodes, then we do lookup_key with
         -- the IsBootInterface parameter True; else False
 

compiler/main/TidyPgm.lhs

@@ -563,7 +563,7 @@ See CorePrep Note [Data constructor workers].
 
 \begin{code}
 getTyConImplicitBinds :: TyCon -> [CoreBind]
-getTyConImplicitBinds tc = map get_defn (mapCatMaybes dataConWrapId_maybe (tyConDataCons tc))
+getTyConImplicitBinds tc = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
 
 getClassImplicitBinds :: Class -> [CoreBind]
 getClassImplicitBinds cls = map get_defn (classAllSelIds cls)

compiler/rename/RnEnv.lhs

@@ -1103,7 +1103,7 @@ type MiniFixityEnv = FastStringEnv (Located Fixity)
 
 addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
 addLocalFixities mini_fix_env names thing_inside
-  = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
+  = extendFixityEnv (mapMaybe find_fixity names) thing_inside
   where
     find_fixity name
       = case lookupFsEnv mini_fix_env (occNameFS occ) of

compiler/stgSyn/CoreToStg.lhs

@@ -28,7 +28,6 @@ import DataCon
 import CostCentre       ( noCCS )
 import VarSet
 import VarEnv
-import Maybes           ( maybeToBool )
 import Module
 import Name             ( getOccName, isExternalName, nameOccName )
 import OccName          ( occNameString, occNameFS )
@@ -44,6 +43,7 @@ import ForeignCall
 import Demand           ( isSingleUsed )
 import PrimOp           ( PrimCall(..) )
 
+import Data.Maybe    (isJust)
 import Control.Monad (liftM, ap)
 
 -- Note [Live vs free]
@@ -1106,7 +1106,7 @@ minusFVBinder v fv = fv `delVarEnv` v
         -- c.f. CoreFVs.delBinderFV
 
 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
-elementOfFVInfo id fvs = maybeToBool (lookupVarEnv fvs id)
+elementOfFVInfo id fvs = isJust (lookupVarEnv fvs id)
 
 lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
 -- Find how the given Id is used.

compiler/typecheck/TcBinds.lhs

@@ -704,7 +704,7 @@ type PragFun = Name -> [LSig Name]
 mkPragFun :: [LSig Name] -> LHsBinds Name -> PragFun
 mkPragFun sigs binds = \n -> lookupNameEnv prag_env n `orElse` []
   where
-    prs = mapCatMaybes get_sig sigs
+    prs = mapMaybe get_sig sigs
 
     get_sig :: LSig Name -> Maybe (Located Name, LSig Name)
     get_sig (L l (SpecSig nm ty inl)) = Just (nm, L l $ SpecSig  nm ty (add_arity nm inl))

compiler/typecheck/TcClassDcl.lhs

@@ -341,8 +341,9 @@ findMethodBind sel_name binds
 findMinimalDef :: [LSig Name] -> Maybe ClassMinimalDef
 findMinimalDef = firstJusts . map toMinimalDef
   where
+    toMinimalDef :: LSig Name -> Maybe ClassMinimalDef
     toMinimalDef (L _ (MinimalSig bf)) = Just (fmap unLoc bf)
-    toMinimalDef _ = Nothing
+    toMinimalDef _                     = Nothing
 \end{code}
 
 Note [Polymorphic methods]

compiler/typecheck/TcDeriv.lhs

@@ -1218,9 +1218,9 @@ cond_stdOK Nothing (_, rep_tc, _)
   | not (null con_whys) = Just (vcat con_whys $$ suggestion)
   | otherwise           = Nothing
   where
-    suggestion  = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
-    data_cons   = tyConDataCons rep_tc
-    con_whys = mapCatMaybes check_con data_cons
+    suggestion = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
+    data_cons  = tyConDataCons rep_tc
+    con_whys   = mapMaybe check_con data_cons
 
     check_con :: DataCon -> Maybe SDoc
     check_con con

compiler/typecheck/TcErrors.lhs

@@ -38,7 +38,6 @@ import Var
 import VarSet
 import VarEnv
 import Bag
-import Maybes
 import ErrUtils         ( ErrMsg, makeIntoWarning, pprLocErrMsg )
 import BasicTypes 
 import Util
@@ -47,6 +46,8 @@ import Outputable
 import SrcLoc
 import DynFlags
 import ListSetOps       ( equivClasses )
+
+import Data.Maybe
 import Data.List        ( partition, mapAccumL, zip4 )
 \end{code}
 
@@ -1033,7 +1034,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
 
     add_to_ctxt_fixes has_ambig_tvs
       | not has_ambig_tvs && all_tyvars
-      , (orig:origs) <- mapCatMaybes get_good_orig (cec_encl ctxt)
+      , (orig:origs) <- mapMaybe get_good_orig (cec_encl ctxt)
       = [sep [ ptext (sLit "add") <+> pprParendType pred
                <+> ptext (sLit "to the context of")
 	     , nest 2 $ ppr_skol orig $$ 
@@ -1102,7 +1103,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
             ispecs = [ispec | (ispec, _) <- matches]
 
             givens = getUserGivens ctxt
-            matching_givens = mapCatMaybes matchable givens
+            matching_givens = mapMaybe matchable givens
 
             matchable (evvars,skol_info,loc) 
               = case ev_vars_matching of

compiler/typecheck/TcSMonad.lhs

@@ -134,7 +134,7 @@ import TcRnTypes
 import BasicTypes
 import Unique
 import UniqFM
-import Maybes ( orElse, catMaybes, firstJust )
+import Maybes ( orElse, catMaybes, firstJusts )
 import Pair ( pSnd )
 
 import TrieMap
@@ -723,9 +723,9 @@ lookupFlatEqn fam_tc tys
   = do { IS { inert_solved_funeqs = solved_funeqs
             , inert_flat_cache = flat_cache
             , inert_cans = IC { inert_funeqs = inert_funeqs } } <- getTcSInerts
-       ; return (findFunEq solved_funeqs fam_tc tys  `firstJust`
-                 lookup_inerts inert_funeqs          `firstJust`
-                 findFunEq flat_cache fam_tc tys) }
+       ; return (firstJusts [findFunEq solved_funeqs fam_tc tys,
+                             lookup_inerts inert_funeqs,
+                             findFunEq flat_cache fam_tc tys]) }
   where
     lookup_inerts inert_funeqs
       | (ct:_) <- findFunEqs inert_funeqs fam_tc tys

compiler/typecheck/TcTyDecls.lhs

@@ -371,7 +371,7 @@ calcRecFlags boot_details is_boot mrole_env tyclss
         , rti_is_rec     = is_rec }
   where
     rec_tycon_names = mkNameSet (map tyConName all_tycons)
-    all_tycons = mapCatMaybes getTyCon tyclss
+    all_tycons = mapMaybe getTyCon tyclss
                    -- Recursion of newtypes/data types can happen via
                    -- the class TyCon, so tyclss includes the class tycons
 

compiler/typecheck/TcType.lhs

@@ -945,7 +945,7 @@ tcGetTyVar :: String -> Type -> TyVar
 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
 
 tcIsTyVarTy :: Type -> Bool
-tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
+tcIsTyVarTy ty = isJust (tcGetTyVar_maybe ty)
 
 -----------------------
 tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])
@@ -992,7 +992,7 @@ tcInstHeadTyAppAllTyVars ty
         -- and that each is distinct
     ok tys = equalLength tvs tys && hasNoDups tvs
            where
-             tvs = mapCatMaybes get_tv tys
+             tvs = mapMaybe get_tv tys
 
     get_tv (TyVarTy tv)  = Just tv      -- through synonyms
     get_tv _             = Nothing

compiler/typecheck/TcValidity.lhs

@@ -41,7 +41,6 @@ import ErrUtils
 import PrelNames
 import DynFlags
 import Util
-import Maybes
 import ListSetOps
 import SrcLoc
 import Outputable
@@ -49,6 +48,7 @@ import FastString
 import BasicTypes ( Arity )
 
 import Control.Monad
+import Data.Maybe
 import Data.List        ( (\\) )
 \end{code}
  
@@ -1124,7 +1124,7 @@ checkFamInstRhs :: [Type]                  -- lhs
                 -> [(TyCon, [Type])]       -- type family instances
                 -> [MsgDoc]
 checkFamInstRhs lhsTys famInsts
-  = mapCatMaybes check famInsts
+  = mapMaybe check famInsts
   where
    size = sizeTypes lhsTys
    fvs  = fvTypes lhsTys

compiler/types/OptCoercion.lhs

@@ -32,6 +32,7 @@ import Util
 import Unify
 import ListSetOps
 import InstEnv
+import Control.Monad   ( zipWithM )
 \end{code}
 
 %************************************************************************
@@ -534,7 +535,7 @@ matchAxiom sym ax@(CoAxiom { co_ax_tc = tc }) ind co
                     , cab_rhs   = rhs }) = coAxiomNthBranch ax ind in
     case liftCoMatch (mkVarSet qtvs) (if sym then (mkTyConApp tc lhs) else rhs) co of
       Nothing    -> Nothing
-      Just subst -> allMaybes (zipWith (liftCoSubstTyVar subst) roles qtvs)
+      Just subst -> zipWithM (liftCoSubstTyVar subst) roles qtvs
 
 -------------
 compatible_co :: Coercion -> Coercion -> Bool

compiler/utils/Maybes.lhs

@@ -11,12 +11,9 @@ module Maybes (
         failME, isSuccess,
 
         orElse,
-        mapCatMaybes,
-        allMaybes,
         firstJust, firstJusts,
         whenIsJust,
         expectJust,
-        maybeToBool,
 
         MaybeT(..)
     ) where
@@ -34,53 +31,26 @@ infixr 4 `orElse`
 %************************************************************************
 
 \begin{code}
-maybeToBool :: Maybe a -> Bool
-maybeToBool Nothing  = False
-maybeToBool (Just _) = True
-
--- | Collects a list of @Justs@ into a single @Just@, returning @Nothing@ if
--- there are any @Nothings@.
-allMaybes :: [Maybe a] -> Maybe [a]
-allMaybes [] = Just []
-allMaybes (Nothing : _)  = Nothing
-allMaybes (Just x  : ms) = case allMaybes ms of
-                           Nothing -> Nothing
-                           Just xs -> Just (x:xs)
-
 firstJust :: Maybe a -> Maybe a -> Maybe a
-firstJust (Just a) _ = Just a
-firstJust Nothing  b = b
+firstJust a b = firstJusts [a, b]
 
 -- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or
 -- @Nothing@ otherwise.
 firstJusts :: [Maybe a] -> Maybe a
-firstJusts = foldr firstJust Nothing
-\end{code}
+firstJusts = msum
 
-\begin{code}
 expectJust :: String -> Maybe a -> a
 {-# INLINE expectJust #-}
 expectJust _   (Just x) = x
 expectJust err Nothing  = error ("expectJust " ++ err)
-\end{code}
-
-\begin{code}
-mapCatMaybes :: (a -> Maybe b) -> [a] -> [b]
-mapCatMaybes _ [] = []
-mapCatMaybes f (x:xs) = case f x of
-                        Just y  -> y : mapCatMaybes f xs
-                        Nothing -> mapCatMaybes f xs
 
 whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenIsJust (Just x) f = f x
 whenIsJust Nothing  _ = return ()
-\end{code}
 
-\begin{code}
--- | flipped version of @fromMaybe@.
+-- | Flipped version of @fromMaybe@, useful for chaining.
 orElse :: Maybe a -> a -> a
-(Just x) `orElse` _ = x
-Nothing  `orElse` y = y
+orElse = flip fromMaybe
 \end{code}
 
 %************************************************************************