diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 114c60a1add..4d7429f74a6 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -14,7 +14,6 @@ libraries/Cabal/Distribution/Simple.hs:78:0: Deprecated: "Please use the new testing interface instead!" -} {-# OPTIONS_GHC -Wno-deprecations #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | -- Module : Distribution.Simple diff --git a/cabal-install/src/Distribution/Client/BuildReports/Storage.hs b/cabal-install/src/Distribution/Client/BuildReports/Storage.hs index 740a32cd9c3..7bb56affa42 100644 --- a/cabal-install/src/Distribution/Client/BuildReports/Storage.hs +++ b/cabal-install/src/Distribution/Client/BuildReports/Storage.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- @@ -91,13 +89,15 @@ storeAnonymous reports = separate :: [(BuildReport, Maybe Repo)] -> [(Repo, [BuildReport])] - separate = - map (\rs@((_, repo, _) : _) -> (repo, [r | (r, _, _) <- rs])) - . map (concatMap toList) - . L.groupBy (equating (repoName' . head)) - . sortBy (comparing (repoName' . head)) - . groupBy (equating repoName') - . onlyRemote + separate xs = + [ (repo, [r | (r, _, _) <- rs]) + | rs@((_, repo, _) : _) <- + map (concatMap toList) + . L.groupBy (equating (repoName' . head)) + . sortBy (comparing (repoName' . head)) + . groupBy (equating repoName') + $ onlyRemote xs + ] repoName' (_, _, rrepo) = remoteRepoName rrepo @@ -148,10 +148,10 @@ storeLocal cinfo templates reports platform = cinfo platform - groupByFileName = - map (\grp@((filename, _) : _) -> (filename, map snd grp)) - . L.groupBy (equating fst) - . sortBy (comparing fst) + groupByFileName xs = + [ (filename, map snd grp) + | grp@((filename, _) : _) <- L.groupBy (equating fst) $ sortBy (comparing fst) xs + ] -- ------------------------------------------------------------ diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index d35ec41ddca..8f02620c6d8 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -1,7 +1,6 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- @@ -712,22 +711,19 @@ exceptionMessageCabalInstall e = case e of | (thing, _got, alts@(_ : _)) <- nosuch' ] ] - | let groupByContainer = - map - ( \g@((inside, _, _, _) : _) -> - ( inside - , [ (thing, got, alts) - | (_, thing, got, alts) <- g - ] - ) - ) - . groupBy ((==) `on` (\(x, _, _, _) -> x)) - . sortBy (compare `on` (\(x, _, _, _) -> x)) - , (target, nosuch) <- targets + | (target, nosuch) <- targets ] where mungeThing "file" = "file target" mungeThing thing = thing + groupByContainer xs = + [ ( inside + , [ (thing, got, alts) + | (_, thing, got, alts) <- g + ] + ) + | g@((inside, _, _, _) : _) <- groupBy ((==) `on` (\(x, _, _, _) -> x)) $ sortBy (compare `on` (\(x, _, _, _) -> x)) xs + ] TargetSelectorAmbiguousErr targets -> unlines [ "Ambiguous target '" diff --git a/cabal-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs index 56ea25d958e..85438ac5387 100644 --- a/cabal-install/src/Distribution/Client/TargetSelector.hs +++ b/cabal-install/src/Distribution/Client/TargetSelector.hs @@ -1,10 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} --- TODO -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- @@ -765,9 +765,7 @@ disambiguateTargetSelectors matcher matchInput exactMatch matchResults = Left ( originalMatch , [ (forgetFileStatus rendering, matches) - | rendering <- matchRenderings - , let Match m _ matches = - memoisedMatches Map.! rendering + | rendering@((memoisedMatches Map.!?) -> Just (Match m _ matches)) <- matchRenderings , m /= Inexact ] ) @@ -1107,7 +1105,7 @@ syntaxForm1File ps = -- all the other forms we don't require that. syntaxForm1 render $ \str1 fstatus1 -> expecting "file" str1 $ do - (pkgfile, ~KnownPackage{pinfoId, pinfoComponents}) <- + (pkgfile, KnownPackage{pinfoId, pinfoComponents}) <- -- always returns the KnownPackage case matchPackageDirectoryPrefix ps fstatus1 orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do @@ -1722,44 +1720,41 @@ syntaxForm3 :: Renderer -> Match3 -> Syntax syntaxForm4 :: Renderer -> Match4 -> Syntax syntaxForm5 :: Renderer -> Match5 -> Syntax syntaxForm7 :: Renderer -> Match7 -> Syntax -syntaxForm1 render f = - Syntax QL1 match render +syntaxForm1 render f = Syntax QL1 match render where - match = \(TargetStringFileStatus1 str1 fstatus1) -> - f str1 fstatus1 + match = \case + TargetStringFileStatus1 str1 fstatus1 -> f str1 fstatus1 + _ -> mzero -syntaxForm2 render f = - Syntax QL2 match render +syntaxForm2 render f = Syntax QL2 match render where - match = \(TargetStringFileStatus2 str1 fstatus1 str2) -> - f str1 fstatus1 str2 + match = \case + TargetStringFileStatus2 str1 fstatus1 str2 -> f str1 fstatus1 str2 + _ -> mzero -syntaxForm3 render f = - Syntax QL3 match render +syntaxForm3 render f = Syntax QL3 match render where - match = \(TargetStringFileStatus3 str1 fstatus1 str2 str3) -> - f str1 fstatus1 str2 str3 + match = \case + TargetStringFileStatus3 str1 fstatus1 str2 str3 -> f str1 fstatus1 str2 str3 + _ -> mzero -syntaxForm4 render f = - Syntax QLFull match render +syntaxForm4 render f = Syntax QLFull match render where - match (TargetStringFileStatus4 str1 str2 str3 str4) = - f str1 str2 str3 str4 - match _ = mzero + match = \case + TargetStringFileStatus4 str1 str2 str3 str4 -> f str1 str2 str3 str4 + _ -> mzero -syntaxForm5 render f = - Syntax QLFull match render +syntaxForm5 render f = Syntax QLFull match render where - match (TargetStringFileStatus5 str1 str2 str3 str4 str5) = - f str1 str2 str3 str4 str5 - match _ = mzero + match = \case + TargetStringFileStatus5 str1 str2 str3 str4 str5 -> f str1 str2 str3 str4 str5 + _ -> mzero -syntaxForm7 render f = - Syntax QLFull match render +syntaxForm7 render f = Syntax QLFull match render where - match (TargetStringFileStatus7 str1 str2 str3 str4 str5 str6 str7) = - f str1 str2 str3 str4 str5 str6 str7 - match _ = mzero + match = \case + TargetStringFileStatus7 str1 str2 str3 str4 str5 str6 str7 -> f str1 str2 str3 str4 str5 str6 str7 + _ -> mzero dispP :: Package p => p -> String dispP = prettyShow . packageName @@ -2391,6 +2386,9 @@ instance MonadPlus Match where mzero = empty mplus = matchPlus +instance MonadFail Match where + fail _ = mzero + () :: Match a -> Match a -> Match a () = matchPlusShadowing