merge queue: checking master (7ecb16b), #11828 and #12057 together

Cabal-syntax/src/Distribution/Compat/Graph.hs

@@ -96,10 +96,10 @@ import Distribution.Utils.Structured (Structure (..), Structured (..))
 import qualified Data.Array as Array
 import qualified Data.Foldable as Foldable
 import qualified Data.Graph as G
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Tree as Tree
-import qualified Distribution.Compat.Prelude as Prelude
 
 -- | A graph of nodes @a@.  The nodes are expected to have instance
 -- of class 'IsNode'.
@@ -110,7 +110,7 @@ data Graph a = Graph
   , graphAdjoint :: G.Graph
   , graphVertexToNode :: G.Vertex -> a
   , graphKeyToVertex :: Key a -> Maybe G.Vertex
-  , graphBroken :: [(a, [Key a])]
+  , graphBroken :: [(a, NonEmpty (Key a))]
   }
 
 -- NB: Not a Functor! (or Traversable), because you need
@@ -280,7 +280,7 @@ cycles g = [vs | CyclicSCC vs <- stronglyConnComp g]
 -- | /O(1)/.  Return a list of nodes paired with their broken
 -- neighbors (i.e., neighbor keys which are not in the graph).
 -- Requires amortized construction of graph.
-broken :: Graph a -> [(a, [Key a])]
+broken :: Graph a -> [(a, NonEmpty (Key a))]
 broken g = graphBroken g
 
 -- | Lookup the immediate neighbors from a key in the graph.
@@ -339,7 +339,7 @@ revTopSort g = map (graphVertexToNode g) $ G.topSort (graphAdjoint g)
 -- if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@
 -- instead.  The values of the map are assumed to already
 -- be in WHNF.
-fromMap :: IsNode a => Map (Key a) a -> Graph a
+fromMap :: forall a. IsNode a => Map (Key a) a -> Graph a
 fromMap m =
   Graph
     { graphMap = m
@@ -348,17 +348,25 @@ fromMap m =
     , graphAdjoint = G.transposeG g
     , graphVertexToNode = vertex_to_node
     , graphKeyToVertex = key_to_vertex
-    , graphBroken = broke
+    , graphBroken =
+        map (\ns'' -> (fst (NE.head ns''), NE.map snd ns'')) $
+          NE.groupWith (nodeKey . fst) brokenEdges'
     }
   where
-    try_key_to_vertex k = maybe (Left k) Right (key_to_vertex k)
+    brokenEdges' :: [(a, Key a)]
+    brokenEdges' = concat brokenEdges
 
+    brokenEdges :: [[(a, Key a)]]
     (brokenEdges, edges) =
-      unzip $
-        [ partitionEithers (map try_key_to_vertex (nodeNeighbors n))
+      unzip
+        [ partitionEithers
+          [ case key_to_vertex n' of
+            Just v -> Right v
+            Nothing -> Left (n, n')
+          | n' <- nodeNeighbors n
+          ]
         | n <- ns
         ]
-    broke = filter (not . Prelude.null . snd) (zip ns brokenEdges)
 
     g = Array.listArray bounds edges
 

Cabal-syntax/src/Distribution/Parsec.hs

@@ -56,7 +56,6 @@ module Distribution.Parsec
 
 import Data.ByteString (ByteString)
 import Data.Char (digitToInt, intToDigit)
-import Data.Functor (($>))
 import Data.List (transpose)
 import Distribution.CabalSpecVersion
 import Distribution.Compat.Prelude
@@ -247,15 +246,11 @@ instance Parsec Bool where
   parsec = P.munch1 isAlpha >>= postprocess
     where
       postprocess str
-        | str == "True" = pure True
-        | str == "False" = pure False
-        | lstr == "true" = parsecWarning PWTBoolCase caseWarning $> True
-        | lstr == "false" = parsecWarning PWTBoolCase caseWarning $> False
+        | lstr == "true" = pure True
+        | lstr == "false" = pure False
         | otherwise = fail $ "Not a boolean: " ++ str
         where
           lstr = map toLower str
-          caseWarning =
-            "Boolean values are case sensitive, use 'True' or 'False'."
 
 instance Parsec a => Parsec (Last a) where
   parsec = parsecLast

Cabal-syntax/src/Distribution/Parsec/Warning.hs

@@ -22,8 +22,6 @@ data PWarnType
     PWTOther
   | -- | Invalid UTF encoding
     PWTUTF
-  | -- | @true@ or @false@, not @True@ or @False@
-    PWTBoolCase
   | -- | there are version with tags
     PWTVersionTag
   | -- | New syntax used, but no @cabal-version: >= 1.2@ specified

Cabal-tests/tests/ParserTests.hs

@@ -68,7 +68,6 @@ warningTests = testGroup "warnings triggered"
     , warningTest PWTLexNBSP           "nbsp.cabal"
     , warningTest PWTLexTab            "tab.cabal"
     , warningTest PWTUTF               "utf8.cabal"
-    , warningTest PWTBoolCase          "bool.cabal"
     , warningTest PWTVersionTag        "versiontag.cabal"
     , warningTest PWTNewSyntax         "newsyntax.cabal"
     , warningTest PWTOldSyntax         "oldsyntax.cabal"

Cabal/src/Distribution/Backpack/Configure.hs

@@ -293,7 +293,7 @@ toComponentLocalBuildInfos
                         (text "installed package" <+> pretty (packageId pkg))
                         4
                         ( text "is broken due to missing package"
-                            <+> hsep (punctuate comma (map pretty deps))
+                            <+> hsep (punctuate comma (map pretty (toList deps)))
                         )
                       | (Left pkg, deps) <- broken
                       ]
@@ -303,7 +303,7 @@ toComponentLocalBuildInfos
                             ( vcat $
                                 text "is broken due to missing package"
                                   : [ nest 2 (dispMissingDep installedPackageSet depPkgMap dep)
-                                    | dep <- deps
+                                    | dep <- toList deps
                                     ]
                             )
                            | (Right pkg, deps) <- broken

cabal-install/src/Distribution/Client/Config.hs

@@ -134,7 +134,6 @@ import Distribution.Compiler
 import Distribution.Deprecated.ParseUtils
   ( FieldDescr (..)
   , PError (..)
-  , PWarning (..)
   , ParseResult (..)
   , liftField
   , lineNo
@@ -1202,24 +1201,14 @@ configFieldDescriptions src =
                   )
                   ( \line str _ -> case () of
                       _
-                        | str == "False" -> ParseOk [] (Flag NoOptimisation)
-                        | str == "True" -> ParseOk [] (Flag NormalOptimisation)
                         | str == "0" -> ParseOk [] (Flag NoOptimisation)
                         | str == "1" -> ParseOk [] (Flag NormalOptimisation)
                         | str == "2" -> ParseOk [] (Flag MaximumOptimisation)
-                        | lstr == "false" -> ParseOk [caseWarning] (Flag NoOptimisation)
-                        | lstr == "true" ->
-                            ParseOk
-                              [caseWarning]
-                              (Flag NormalOptimisation)
+                        | lstr == "false" -> ParseOk [] (Flag NoOptimisation)
+                        | lstr == "true" -> ParseOk [] (Flag NormalOptimisation)
                         | otherwise -> ParseFailed (NoParse name line)
                         where
                           lstr = lowercase str
-                          caseWarning =
-                            PWarning $
-                              "The '"
-                                ++ name
-                                ++ "' field is case sensitive, use 'True' or 'False'."
                   )
       , liftField configDebugInfo (\v flags -> flags{configDebugInfo = v}) $
           let name = "debug-info"
@@ -1234,22 +1223,15 @@ configFieldDescriptions src =
                 )
                 ( \line str _ -> case () of
                     _
-                      | str == "False" -> ParseOk [] (Flag NoDebugInfo)
-                      | str == "True" -> ParseOk [] (Flag NormalDebugInfo)
                       | str == "0" -> ParseOk [] (Flag NoDebugInfo)
                       | str == "1" -> ParseOk [] (Flag MinimalDebugInfo)
                       | str == "2" -> ParseOk [] (Flag NormalDebugInfo)
                       | str == "3" -> ParseOk [] (Flag MaximalDebugInfo)
-                      | lstr == "false" -> ParseOk [caseWarning] (Flag NoDebugInfo)
-                      | lstr == "true" -> ParseOk [caseWarning] (Flag NormalDebugInfo)
+                      | lstr == "false" -> ParseOk [] (Flag NoDebugInfo)
+                      | lstr == "true" -> ParseOk [] (Flag NormalDebugInfo)
                       | otherwise -> ParseFailed (NoParse name line)
                       where
                         lstr = lowercase str
-                        caseWarning =
-                          PWarning $
-                            "The '"
-                              ++ name
-                              ++ "' field is case sensitive, use 'True' or 'False'."
                 )
       ]
     ++ toSavedConfig

cabal-install/src/Distribution/Client/Install.hs

@@ -712,7 +712,7 @@ pruneInstallPlan pkgSpecifiers =
           ordNub
             [ depid
             | SolverInstallPlan.PackageMissingDeps _ depids <- problems
-            , depid <- depids
+            , depid <- toList depids
             , packageName depid `elem` targetnames
             ]
 

cabal-install/src/Distribution/Client/InstallPlan.hs

@@ -115,6 +115,7 @@ import Control.Exception
   ( assert
   )
 import qualified Data.Foldable as Foldable (all, toList)
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Distribution.Compat.Graph (Graph, IsNode (..))
@@ -1014,7 +1015,7 @@ valid loc graph =
     ps -> internalError loc ('\n' : unlines (map showPlanProblem ps))
 
 data PlanProblem ipkg srcpkg
-  = PackageMissingDeps (GenericPlanPackage ipkg srcpkg) [UnitId]
+  = PackageMissingDeps (GenericPlanPackage ipkg srcpkg) (NonEmpty UnitId)
   | PackageCycle [GenericPlanPackage ipkg srcpkg]
   | PackageStateInvalid
       (GenericPlanPackage ipkg srcpkg)
@@ -1028,7 +1029,7 @@ showPlanProblem (PackageMissingDeps pkg missingDeps) =
   "Package "
     ++ prettyShow (nodeKey pkg)
     ++ " depends on the following packages which are missing from the plan: "
-    ++ intercalate ", " (map prettyShow missingDeps)
+    ++ intercalate ", " (map prettyShow (NE.toList missingDeps))
 showPlanProblem (PackageCycle cycleGroup) =
   "The following packages are involved in a dependency cycle "
     ++ intercalate ", " (map (prettyShow . nodeKey) cycleGroup)
@@ -1053,10 +1054,7 @@ problems
 problems graph =
   [ PackageMissingDeps
     pkg
-    ( mapMaybe
-        (fmap nodeKey . flip Graph.lookup graph)
-        missingDeps
-    )
+    missingDeps
   | (pkg, missingDeps) <- Graph.broken graph
   ]
     ++ [ PackageCycle cycleGroup

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -153,7 +153,6 @@ import Distribution.Client.ParseUtils
 import Distribution.Client.ReplFlags (multiReplOption)
 import Distribution.Deprecated.ParseUtils
   ( PError (..)
-  , PWarning (..)
   , ParseResult (..)
   , commaNewLineListFieldParsec
   , newLineListField
@@ -1688,10 +1687,8 @@ legacyPackageConfigFieldDescrs =
                 )
                 ( \line str _ -> case () of
                     _
-                      | str == "False" -> ParseOk [] (Flag NoDumpBuildInfo)
-                      | str == "True" -> ParseOk [] (Flag DumpBuildInfo)
-                      | lstr == "false" -> ParseOk [caseWarning name] (Flag NoDumpBuildInfo)
-                      | lstr == "true" -> ParseOk [caseWarning name] (Flag DumpBuildInfo)
+                      | lstr == "false" -> ParseOk [] (Flag NoDumpBuildInfo)
+                      | lstr == "true" -> ParseOk [] (Flag DumpBuildInfo)
                       | otherwise -> ParseFailed (NoParse name line)
                       where
                         lstr = lowercase str
@@ -1717,13 +1714,11 @@ legacyPackageConfigFieldDescrs =
                 )
                 ( \line str _ -> case () of
                     _
-                      | str == "False" -> ParseOk [] (Flag NoOptimisation)
-                      | str == "True" -> ParseOk [] (Flag NormalOptimisation)
                       | str == "0" -> ParseOk [] (Flag NoOptimisation)
                       | str == "1" -> ParseOk [] (Flag NormalOptimisation)
                       | str == "2" -> ParseOk [] (Flag MaximumOptimisation)
-                      | lstr == "false" -> ParseOk [caseWarning name] (Flag NoOptimisation)
-                      | lstr == "true" -> ParseOk [caseWarning name] (Flag NormalOptimisation)
+                      | lstr == "false" -> ParseOk [] (Flag NoOptimisation)
+                      | lstr == "true" -> ParseOk [] (Flag NormalOptimisation)
                       | otherwise -> ParseFailed (NoParse name line)
                       where
                         lstr = lowercase str
@@ -1743,23 +1738,17 @@ legacyPackageConfigFieldDescrs =
               )
               ( \line str _ -> case () of
                   _
-                    | str == "False" -> ParseOk [] (Flag NoDebugInfo)
-                    | str == "True" -> ParseOk [] (Flag NormalDebugInfo)
                     | str == "0" -> ParseOk [] (Flag NoDebugInfo)
                     | str == "1" -> ParseOk [] (Flag MinimalDebugInfo)
                     | str == "2" -> ParseOk [] (Flag NormalDebugInfo)
                     | str == "3" -> ParseOk [] (Flag MaximalDebugInfo)
-                    | lstr == "false" -> ParseOk [caseWarning name] (Flag NoDebugInfo)
-                    | lstr == "true" -> ParseOk [caseWarning name] (Flag NormalDebugInfo)
+                    | lstr == "false" -> ParseOk [] (Flag NoDebugInfo)
+                    | lstr == "true" -> ParseOk [] (Flag NormalDebugInfo)
                     | otherwise -> ParseFailed (NoParse name line)
                     where
                       lstr = lowercase str
               )
 
-    caseWarning name =
-      PWarning $
-        "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'."
-
     prefixTest name
       | "test-" `isPrefixOf` name = name
       | otherwise = "test-" ++ name

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -3900,7 +3900,7 @@ pruneInstallPlanToDependencies pkgTargets installPlan =
             CannotPruneDependencies
               [ (pkg, missingDeps)
               | (pkg, missingDepIds) <- brokenPackages
-              , let missingDeps = mapMaybe lookupDep missingDepIds
+              , let missingDeps = mapMaybe lookupDep (toList missingDepIds)
               ]
           where
             -- lookup in the original unpruned graph

cabal-install/src/Distribution/Client/SolverInstallPlan.hs

@@ -75,6 +75,7 @@ import Distribution.Solver.Types.SolverPackage
 import Data.Array ((!))
 import qualified Data.Foldable as Foldable
 import qualified Data.Graph as OldGraph
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
 import Distribution.Compat.Graph (Graph, IsNode (..))
 import qualified Distribution.Compat.Graph as Graph
@@ -178,7 +179,7 @@ valid indepGoals index =
 data SolverPlanProblem
   = PackageMissingDeps
       SolverPlanPackage
-      [PackageIdentifier]
+      (NonEmpty PackageIdentifier)
   | PackageCycle [SolverPlanPackage]
   | PackageInconsistency PackageName [(PackageIdentifier, Version)]
   | PackageStateInvalid SolverPlanPackage SolverPlanPackage
@@ -188,7 +189,7 @@ showPlanProblem (PackageMissingDeps pkg missingDeps) =
   "Package "
     ++ prettyShow (packageId pkg)
     ++ " depends on the following packages which are missing from the plan: "
-    ++ intercalate ", " (map prettyShow missingDeps)
+    ++ intercalate ", " (map prettyShow (NE.toList missingDeps))
 showPlanProblem (PackageCycle cycleGroup) =
   "The following packages are involved in a dependency cycle "
     ++ intercalate ", " (map (prettyShow . packageId) cycleGroup)
@@ -228,10 +229,10 @@ problems
 problems indepGoals index =
   [ PackageMissingDeps
     pkg
-    ( mapMaybe
-        (fmap packageId . flip Graph.lookup index)
-        missingDeps
-    )
+    -- The missing deps are the neighbour 'SolverId's that are not in the
+    -- index; each 'SolverId' already carries its 'PackageId', so there is
+    -- no need to look it up (it could not be found in the index anyway).
+    (NE.map packageId missingDeps)
   | (pkg, missingDeps) <- Graph.broken index
   ]
     ++ [ PackageCycle cycleGroup

cabal-testsuite/PackageTests/ProjectConfig/FlagsBools/cabal.out

@@ -0,0 +1,8 @@
+# cabal build
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - test-0.1 (lib) (first run)
+Configuring library for test-0.1...
+Preprocessing library for test-0.1...
+Building library for test-0.1...

cabal-testsuite/PackageTests/ProjectConfig/FlagsBools/cabal.project

@@ -0,0 +1,8 @@
+packages: .
+
+build-info: true
+optimization: tRuE
+
+package test
+  flags: -bar
+  flags: -baz

cabal-testsuite/PackageTests/ProjectConfig/FlagsBools/cabal.test.hs

@@ -0,0 +1,4 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+  cabal "build" []