summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-11-14 19:30:50 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-11-16 14:50:06 -0500
commit37cfe3c0f4fb16189bbe3bb735f758cd6e3d9157 (patch)
treef4084bab4c1d5a71a24d8b67677bef5061a6b08a
parent08bf28819b78e740550a73a90eda62cce8d21c90 (diff)
downloadhaskell-37cfe3c0f4fb16189bbe3bb735f758cd6e3d9157.tar.gz
Misc cleanup
* Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI
-rw-r--r--compiler/GHC/CmmToAsm.hs2
-rw-r--r--compiler/GHC/CmmToAsm/BlockLayout.hs2
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs3
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs3
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs4
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs7
-rw-r--r--compiler/GHC/Data/Graph/Color.hs3
-rw-r--r--compiler/GHC/Data/Graph/Ops.hs2
-rw-r--r--compiler/GHC/Driver/Backpack.hs2
-rw-r--r--compiler/GHC/Driver/GenerateCgIPEStub.hs7
-rw-r--r--compiler/GHC/Llvm/Ppr.hs4
-rw-r--r--compiler/GHC/Parser.y2
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs2
-rw-r--r--compiler/GHC/Types/CostCentre.hs6
-rw-r--r--compiler/GHC/Types/Name/Occurrence.hs12
-rw-r--r--compiler/GHC/Types/RepType.hs9
-rw-r--r--compiler/GHC/Utils/Json.hs2
-rw-r--r--compiler/GHC/Utils/Lexeme.hs18
-rw-r--r--compiler/GHC/Wasm/ControlFlow/FromCmm.hs3
-rw-r--r--docs/users_guide/expected-undocumented-flags.txt1
-rw-r--r--docs/users_guide/separate_compilation.rst2
-rw-r--r--ghc/GHCi/UI.hs26
-rw-r--r--hadrian/src/Hadrian/Haskell/Cabal/Parse.hs2
23 files changed, 56 insertions, 68 deletions
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 5de914fcc9..d4da4dc51b 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -807,7 +807,7 @@ generateJumpTables
generateJumpTables ncgImpl xs = concatMap f xs
where f p@(CmmProc _ _ _ (ListGraph xs)) = p : concatMap g xs
f p = [p]
- g (BasicBlock _ xs) = catMaybes (map (generateJumpTableForInstr ncgImpl) xs)
+ g (BasicBlock _ xs) = mapMaybe (generateJumpTableForInstr ncgImpl) xs
-- -----------------------------------------------------------------------------
-- Shortcut branches
diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
index 1a5aec2f51..56afdfb668 100644
--- a/compiler/GHC/CmmToAsm/BlockLayout.hs
+++ b/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -657,7 +657,7 @@ sequenceChain _info _weights [] = []
sequenceChain _info _weights [x] = [x]
sequenceChain info weights blocks@((BasicBlock entry _):_) =
let directEdges :: [CfgEdge]
- directEdges = sortBy (flip compare) $ catMaybes . map relevantWeight $ (infoEdgeList weights)
+ directEdges = sortBy (flip compare) $ mapMaybe relevantWeight (infoEdgeList weights)
where
-- Apply modifiers to turn edge frequencies into useable weights
-- for computing code layout.
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
index 9f66793a03..b2965013a0 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
@@ -147,8 +147,7 @@ regSpill_top platform regSlotMap cmm
$ mapLookup blockId slotMap
moreSlotsLive = IntSet.fromList
- $ catMaybes
- $ map (lookupUFM regSlotMap)
+ $ mapMaybe (lookupUFM regSlotMap)
$ nonDetEltsUniqSet regsLive
-- See Note [Unique Determinism and code generation]
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
index 60757544be..cb13e62137 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
@@ -390,8 +390,7 @@ cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
= do
let slotsReloadedByTargets
= IntSet.unions
- $ catMaybes
- $ map (flip mapLookup liveSlotsOnEntry)
+ $ mapMaybe (flip mapLookup liveSlotsOnEntry)
$ targets
let noReloads'
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
index 9375122567..fabe5b1d75 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
@@ -130,8 +130,8 @@ slurpSpillCostInfo platform cfg cmm
-- Increment counts for what regs were read/written from.
let (RU read written) = regUsageOfInstr platform instr
- mapM_ (incUses scale) $ catMaybes $ map takeVirtualReg $ nub read
- mapM_ (incDefs scale) $ catMaybes $ map takeVirtualReg $ nub written
+ mapM_ (incUses scale) $ mapMaybe takeVirtualReg $ nub read
+ mapM_ (incDefs scale) $ mapMaybe takeVirtualReg $ nub written
-- Compute liveness for entry to next instruction.
let liveDieRead_virt = takeVirtuals (liveDieRead live)
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
index ab63e18bbd..f15f9ff4ba 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
@@ -31,6 +31,8 @@ import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
+import GHC.Utils.Outputable
+
-- | For a jump instruction at the end of a block, generate fixup code so its
-- vregs are in the correct regs for its destination.
--
@@ -375,6 +377,5 @@ makeMove delta vreg src dst
-- we don't handle memory to memory moves.
-- they shouldn't happen because we don't share
-- stack slots between vregs.
- panic ("makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
- ++ show dst ++ ")"
- ++ " we don't handle mem->mem moves.")
+ pprPanic "makeMove: we don't handle mem->mem moves"
+ (ppr vreg <+> parens (ppr src) <+> parens (ppr dst))
diff --git a/compiler/GHC/Data/Graph/Color.hs b/compiler/GHC/Data/Graph/Color.hs
index 496f98b205..7429ad3317 100644
--- a/compiler/GHC/Data/Graph/Color.hs
+++ b/compiler/GHC/Data/Graph/Color.hs
@@ -328,8 +328,7 @@ selectColor colors graph u
-- See Note [Unique Determinism and code generation]
colors_conflict = mkUniqSet
- $ catMaybes
- $ map nodeColor nsConflicts
+ $ mapMaybe nodeColor nsConflicts
-- the prefs of our neighbors
colors_neighbor_prefs
diff --git a/compiler/GHC/Data/Graph/Ops.hs b/compiler/GHC/Data/Graph/Ops.hs
index d2671f252d..dc90b9e5ad 100644
--- a/compiler/GHC/Data/Graph/Ops.hs
+++ b/compiler/GHC/Data/Graph/Ops.hs
@@ -633,7 +633,7 @@ checkNode graph node
$ nonDetEltsUniqSet $ nodeConflicts node
-- See Note [Unique Determinism and code generation]
- , neighbourColors <- catMaybes $ map nodeColor neighbors
+ , neighbourColors <- mapMaybe nodeColor neighbors
, elem color neighbourColors
= False
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 93422e4161..cf94e0cf1d 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -939,4 +939,4 @@ hsModuleToModSummary home_keys pn hsc_src modname
newUnitId :: UnitId -> Maybe FastString -> UnitId
newUnitId uid mhash = case mhash of
Nothing -> uid
- Just hash -> UnitId (unitIdFS uid `appendFS` mkFastString "+" `appendFS` hash)
+ Just hash -> UnitId (concatFS [unitIdFS uid, fsLit "+", hash])
diff --git a/compiler/GHC/Driver/GenerateCgIPEStub.hs b/compiler/GHC/Driver/GenerateCgIPEStub.hs
index be478f1bdb..40927bbc6e 100644
--- a/compiler/GHC/Driver/GenerateCgIPEStub.hs
+++ b/compiler/GHC/Driver/GenerateCgIPEStub.hs
@@ -3,7 +3,7 @@
module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub) where
import qualified Data.Map.Strict as Map
-import Data.Maybe (catMaybes, listToMaybe)
+import Data.Maybe (mapMaybe, listToMaybe)
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel)
import GHC.Cmm.Dataflow (Block, C, O)
@@ -210,7 +210,7 @@ generateCgIPEStub hsc_env this_mod denv s = do
collectNothing _ cmmGroupSRTs = pure ([], cmmGroupSRTs)
collectInfoTables :: CmmGroupSRTs -> [(Label, CmmInfoTable)]
- collectInfoTables cmmGroup = concat $ catMaybes $ map extractInfoTables cmmGroup
+ collectInfoTables cmmGroup = concat $ mapMaybe extractInfoTables cmmGroup
extractInfoTables :: GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Maybe [(Label, CmmInfoTable)]
extractInfoTables (CmmProc h _ _ _) = Just $ mapToList (info_tbls h)
@@ -249,8 +249,7 @@ generateCgIPEStub hsc_env this_mod denv s = do
lastTickInBlock block =
listToMaybe $
- catMaybes $
- map maybeTick $ (reverse . blockToList) block
+ mapMaybe maybeTick $ (reverse . blockToList) block
maybeTick :: CmmNode O O -> Maybe IpeSourceLocation
maybeTick (CmmTick (SourceNote span name)) = Just (span, name)
diff --git a/compiler/GHC/Llvm/Ppr.hs b/compiler/GHC/Llvm/Ppr.hs
index f48e7aa034..787b6efcf7 100644
--- a/compiler/GHC/Llvm/Ppr.hs
+++ b/compiler/GHC/Llvm/Ppr.hs
@@ -517,8 +517,8 @@ ppName opts v = case v of
ppPlainName :: LlvmCgConfig -> LlvmVar -> SDoc
ppPlainName opts v = case v of
(LMGlobalVar x _ _ _ _ _) -> ftext x
- (LMLocalVar x LMLabel ) -> text (show x)
- (LMLocalVar x _ ) -> text ('l' : show x)
+ (LMLocalVar x LMLabel ) -> pprUniqueAlways x
+ (LMLocalVar x _ ) -> char 'l' <> pprUniqueAlways x
(LMNLocalVar x _ ) -> ftext x
(LMLitVar x ) -> ppLit opts x
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index beff8acf64..dda119bafd 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -825,7 +825,7 @@ HYPHEN :: { [AddEpAnn] }
litpkgname :: { Located FastString }
: litpkgname_segment { $1 }
-- a bit of a hack, means p - b is parsed same as p-b, enough for now.
- | litpkgname_segment HYPHEN litpkgname { sLL $1 $> $ appendFS (unLoc $1) (consFS '-' (unLoc $3)) }
+ | litpkgname_segment HYPHEN litpkgname { sLL $1 $> $ concatFS [unLoc $1, fsLit "-", (unLoc $3)] }
mayberns :: { Maybe [LRenaming] }
: {- empty -} { Nothing }
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index e430584931..cf2cac142b 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -675,7 +675,7 @@ funBindTicks loc fun_id mod sigs
= sl_fs $ unLoc cc_str
| otherwise
= getOccFS (Var.varName fun_id)
- cc_name = moduleNameFS (moduleName mod) `appendFS` consFS '.' cc_str
+ cc_name = concatFS [moduleNameFS (moduleName mod), fsLit ".", cc_str]
= do
flavour <- DeclCC <$> getCCIndexTcM cc_name
let cc = mkUserCC cc_name mod loc flavour
diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs
index 75b500694e..e20a4977ec 100644
--- a/compiler/GHC/Types/CostCentre.hs
+++ b/compiler/GHC/Types/CostCentre.hs
@@ -161,9 +161,9 @@ mkAutoCC id mod
-- Unique.
-- See bug #249, tests prof001, prof002, also #2411
str | isExternalName name = occNameFS (getOccName id)
- | otherwise = occNameFS (getOccName id)
- `appendFS`
- mkFastString ('_' : show (getUnique name))
+ | otherwise = concatFS [occNameFS (getOccName id),
+ fsLit "_",
+ mkFastString (show (getUnique name))]
mkAllCafsCC :: Module -> SrcSpan -> CostCentre
mkAllCafsCC m loc = AllCafsCC { cc_mod = m, cc_loc = loc }
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index 51045066d6..bfc3b8aa95 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -519,9 +519,9 @@ parenSymOcc occ doc | isSymOcc occ = parens doc
startsWithUnderscore :: OccName -> Bool
-- ^ Haskell 98 encourages compilers to suppress warnings about unused
-- names in a pattern if they start with @_@: this implements that test
-startsWithUnderscore occ = case unconsFS (occNameFS occ) of
- Just ('_', _) -> True
- _ -> False
+startsWithUnderscore occ = case unpackFS (occNameFS occ) of
+ '_':_ -> True
+ _ -> False
{-
************************************************************************
@@ -860,13 +860,13 @@ tidyOccName env occ@(OccName occ_sp fs)
base1 = mkFastString (base ++ "1")
find !k !n
- = case lookupUFM env new_fs of
- Just {} -> find (k+1 :: Int) (n+k)
+ = case elemUFM new_fs env of
+ True -> find (k+1 :: Int) (n+k)
-- By using n+k, the n argument to find goes
-- 1, add 1, add 2, add 3, etc which
-- moves at quadratic speed through a dense patch
- Nothing -> (new_env, OccName occ_sp new_fs)
+ False -> (new_env, OccName occ_sp new_fs)
where
new_fs = mkFastString (base ++ show n)
new_env = addToUFM (addToUFM env new_fs 1) base1 (n+1)
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index d7f0f75219..9c394771cf 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -302,11 +302,10 @@ instance Outputable SlotTy where
ppr (VecSlot n e) = text "VecSlot" <+> ppr n <+> ppr e
typeSlotTy :: UnaryType -> Maybe SlotTy
-typeSlotTy ty
- | isZeroBitTy ty
- = Nothing
- | otherwise
- = Just (primRepSlot (typePrimRep1 ty))
+typeSlotTy ty = case typePrimRep ty of
+ [] -> Nothing
+ [rep] -> Just (primRepSlot rep)
+ reps -> pprPanic "typeSlotTy" (ppr ty $$ ppr reps)
primRepSlot :: PrimRep -> SlotTy
primRepSlot VoidRep = pprPanic "primRepSlot" (text "No slot for VoidRep")
diff --git a/compiler/GHC/Utils/Json.hs b/compiler/GHC/Utils/Json.hs
index acccc88658..47f599c950 100644
--- a/compiler/GHC/Utils/Json.hs
+++ b/compiler/GHC/Utils/Json.hs
@@ -24,7 +24,7 @@ renderJSON :: JsonDoc -> SDoc
renderJSON d =
case d of
JSNull -> text "null"
- JSBool b -> text $ if b then "true" else "false"
+ JSBool b -> if b then text "true" else text "false"
JSInt n -> ppr n
JSString s -> doubleQuotes $ text $ escapeJsonString s
JSArray as -> brackets $ pprList renderJSON as
diff --git a/compiler/GHC/Utils/Lexeme.hs b/compiler/GHC/Utils/Lexeme.hs
index f71bf1674a..ef7a076faf 100644
--- a/compiler/GHC/Utils/Lexeme.hs
+++ b/compiler/GHC/Utils/Lexeme.hs
@@ -67,17 +67,17 @@ isLexId cs = isLexConId cs || isLexVarId cs
isLexSym cs = isLexConSym cs || isLexVarSym cs
-------------
-isLexConId cs = case unconsFS cs of -- Prefix type or data constructors
- Nothing -> False -- e.g. "Foo", "[]", "(,)"
- Just (c, _) -> cs == fsLit "[]" || startsConId c
+isLexConId cs = case unpackFS cs of -- Prefix type or data constructors
+ [] -> False -- e.g. "Foo", "[]", "(,)"
+ c:_ -> cs == fsLit "[]" || startsConId c
-isLexVarId cs = case unconsFS cs of -- Ordinary prefix identifiers
- Nothing -> False -- e.g. "x", "_x"
- Just (c, _) -> startsVarId c
+isLexVarId cs = case unpackFS cs of -- Ordinary prefix identifiers
+ [] -> False -- e.g. "x", "_x"
+ c:_ -> startsVarId c
-isLexConSym cs = case unconsFS cs of -- Infix type or data constructors
- Nothing -> False -- e.g. ":-:", ":", "->"
- Just (c, _) -> cs == fsLit "->" || startsConSym c
+isLexConSym cs = case unpackFS cs of -- Infix type or data constructors
+ [] -> False -- e.g. ":-:", ":", "->"
+ c:_ -> cs == fsLit "->" || startsConSym c
isLexVarSym fs -- Infix identifiers e.g. "+"
| fs == (fsLit "~R#") = True
diff --git a/compiler/GHC/Wasm/ControlFlow/FromCmm.hs b/compiler/GHC/Wasm/ControlFlow/FromCmm.hs
index e003fff96a..8235b59ed6 100644
--- a/compiler/GHC/Wasm/ControlFlow/FromCmm.hs
+++ b/compiler/GHC/Wasm/ControlFlow/FromCmm.hs
@@ -29,7 +29,6 @@ import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Outputable ( Outputable, text, (<+>), ppr
, pprWithCommas
- , showSDocUnsafe
)
import GHC.Wasm.ControlFlow
@@ -338,7 +337,7 @@ instance Outputable ContainingSyntax where
findLabelIn :: HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn lbl = mapFindWithDefault failed lbl
where failed =
- panic $ "label " ++ showSDocUnsafe (ppr lbl) ++ " not found in control-flow graph"
+ pprPanic "label not found in control-flow graph" (ppr lbl)
infixl 4 <$~>
diff --git a/docs/users_guide/expected-undocumented-flags.txt b/docs/users_guide/expected-undocumented-flags.txt
index 33958b1578..1e8cd4f4cc 100644
--- a/docs/users_guide/expected-undocumented-flags.txt
+++ b/docs/users_guide/expected-undocumented-flags.txt
@@ -26,7 +26,6 @@
-dsource-stats
-dstg-stats
-dsuppress-stg-exts
--exclude-module
-fallow-incoherent-instances
-fallow-overlapping-instances
-fallow-undecidable-instances
diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst
index 84ec626a17..abcc2f3e31 100644
--- a/docs/users_guide/separate_compilation.rst
+++ b/docs/users_guide/separate_compilation.rst
@@ -1483,7 +1483,7 @@ generation are:
on ``.hi``, ``.a_hs`` on ``.a_hi``, and ``.b_hs`` on ``.b_hi``.
If you do not use this flag then the empty suffix is used.
-.. ghc-flag:: --exclude-module=⟨file⟩
+.. ghc-flag:: -exclude-module=⟨file⟩
:shortdesc: Regard ``⟨file⟩`` as "stable"; i.e., exclude it from having
dependencies on it.
:type: dynamic
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 3e1bc227d1..9327ac6da7 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -3864,7 +3864,7 @@ continueCmd argLine = withSandboxOnly ":continue" $
where
contSwitch :: [String] -> Either SDoc (Maybe Int)
contSwitch [ ] = Right Nothing
- contSwitch [x] = getIgnoreCount x
+ contSwitch [x] = Just <$> getIgnoreCount x
contSwitch _ = Left $
text "After ':continue' only one ignore count is allowed"
@@ -3992,30 +3992,24 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
result <- ignoreSwitch (words argLine)
case result of
Left sdoc -> printForUser sdoc
- Right (loc, mbCount) -> do
+ Right (loc, count) -> do
let breakInfo = GHC.BreakInfo (breakModule loc) (breakTick loc)
- count = fromMaybe 0 mbCount
setupBreakpoint breakInfo count
-ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Maybe Int))
+ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
sdoc_loc <- getBreakLoc break
pure $ (,) <$> sdoc_loc <*> getIgnoreCount count
ignoreSwitch _ = pure $ Left $ text "Syntax: :ignore <breaknum> <count>"
-getIgnoreCount :: String -> Either SDoc (Maybe Int)
+getIgnoreCount :: String -> Either SDoc Int
getIgnoreCount str =
- let checkJust :: Maybe Int -> Either SDoc (Maybe Int)
- checkJust mbCnt
- | (isJust mbCnt) = Right mbCnt
- | otherwise = Left $ sdocIgnore <+> text "is not numeric"
- checkPositive :: Maybe Int -> Either SDoc (Maybe Int)
- checkPositive mbCnt
- | isJust mbCnt && fromJust mbCnt >= 0 = Right mbCnt
- | otherwise = Left $ sdocIgnore <+> text "must be >= 0"
- mbCnt :: Maybe Int = readMaybe str
- sdocIgnore = (text "Ignore count") <+> quotes (text str)
- in Right mbCnt >>= checkJust >>= checkPositive
+ case readMaybe str of
+ Nothing -> Left $ sdocIgnore <+> "is not numeric"
+ Just cnt | cnt < 0 -> Left $ sdocIgnore <+> "must be >= 0"
+ | otherwise -> Right cnt
+ where
+ sdocIgnore = text "Ignore count" <+> quotes (text str)
setupBreakpoint :: GhciMonad m => GHC.BreakInfo -> Int -> m()
setupBreakpoint loc count = do
diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
index 8cff6729bf..eea23de1c7 100644
--- a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
+++ b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
@@ -89,7 +89,7 @@ parsePackageData pkg = do
allDeps = concat (libDeps : exeDeps)
sorted = sort [ C.unPackageName p | C.Dependency p _ _ <- allDeps ]
deps = nubOrd sorted \\ [name]
- depPkgs = catMaybes $ map findPackageByName deps
+ depPkgs = mapMaybe findPackageByName deps
return $ PackageData name version
(C.fromShortText (C.synopsis pd))
(C.fromShortText (C.description pd))