From 5943e739f8060bcc9867ef048a462f2c465fde00 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sat, 19 Nov 2022 11:59:03 +0000 Subject: Assorted fixes to avoid Data.List.{head,tail} --- utils/ghc-pkg/Main.hs | 7 ++++--- utils/hpc/HpcUtils.hs | 4 +++- 2 files changed, 7 insertions(+), 4 deletions(-) (limited to 'utils') diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 7bc14094d1..5e91d905e6 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -390,7 +390,7 @@ runit verbosity cli nonopts = do splitFields fields = unfoldr splitComma (',':fields) where splitComma "" = Nothing - splitComma fs = Just $ break (==',') (tail fs) + splitComma (_ : fs) = Just $ break (==',') fs -- | Parses a glob into a predicate which tests if a string matches -- the glob. Returns Nothing if the string in question is not a glob. @@ -1962,10 +1962,11 @@ checkUnitId ipi db_stack update = do checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Bool-> Validate () -checkDuplicates db_stack pkg multi_instance update = do +checkDuplicates [] _ _ _ = pure () +checkDuplicates (hd : _) pkg multi_instance update = do let pkgid = mungedId pkg - pkgs = packages (head db_stack) + pkgs = packages hd -- -- Check whether this package id already exists in this DB -- diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs index da62f4a364..a5d93fccce 100644 --- a/utils/hpc/HpcUtils.hs +++ b/utils/hpc/HpcUtils.hs @@ -13,8 +13,10 @@ dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) [] grabHpcPos :: Map.Map Int String -> HpcPos -> String grabHpcPos hsMap srcspan = case lns of + [] -> error "grabHpcPos: invalid source span" [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln) - _ -> let lns1 = drop (c1 -1) (head lns) : tail lns + hd : tl -> + let lns1 = drop (c1 -1) hd : tl lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ] in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2 where (l1,c1,l2,c2) = fromHpcPos srcspan -- cgit v1.2.1