Apply review suggestions

Co-authored-by: Kristen Kozak <[email protected]>
haskell · Jul 15, 2024 · 12b23db · 12b23db
1 parent 0f17eff
commit 12b23db
Show file tree

Hide file tree

Showing 12 changed files with 34 additions and 34 deletions.
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs
@@ -511,25 +511,20 @@ finalizePD
       , flagVals
       )
     where
-      appBounds :: L.HasBuildInfo a => a -> a
-      appBounds = maybe id applyDefaultBoundsToBuildInfo defBounds
-
-      appBoundsConstrs
-        :: [CondTree v [Dependency] a]
-        -> [CondTree v [Dependency] a]
-      appBoundsConstrs = case defBounds of
-        Nothing -> id
-        Just db -> map (mapTreeConstrs (applyDefaultBoundsToDependencies db))
+      appBounds
+        :: L.HasBuildInfo a
+        => CondTree v [Dependency] a
+        -> CondTree v [Dependency] a
+      appBounds = applyDefaultBoundsToCondTree defBounds
 
       -- Combine lib, exes, and tests into one list of @CondTree@s with tagged data
       condTrees =
-        appBoundsConstrs $
-          maybeToList (fmap (mapTreeData (Lib . appBounds)) mb_lib0)
-            ++ map (\(name, tree) -> mapTreeData (SubComp name . CLib . appBounds) tree) sub_libs0
-            ++ map (\(name, tree) -> mapTreeData (SubComp name . CFLib . appBounds) tree) flibs0
-            ++ map (\(name, tree) -> mapTreeData (SubComp name . CExe . appBounds) tree) exes0
-            ++ map (\(name, tree) -> mapTreeData (SubComp name . CTest . appBounds) tree) tests0
-            ++ map (\(name, tree) -> mapTreeData (SubComp name . CBench . appBounds) tree) bms0
+        maybeToList (fmap (mapTreeData Lib . appBounds) mb_lib0)
+          ++ map (\(name, tree) -> mapTreeData (SubComp name . CLib)   $ appBounds tree) sub_libs0
+          ++ map (\(name, tree) -> mapTreeData (SubComp name . CFLib)  $ appBounds tree) flibs0
+          ++ map (\(name, tree) -> mapTreeData (SubComp name . CExe)   $ appBounds tree) exes0
+          ++ map (\(name, tree) -> mapTreeData (SubComp name . CTest)  $ appBounds tree) tests0
+          ++ map (\(name, tree) -> mapTreeData (SubComp name . CBench) $ appBounds tree) bms0
 
       flagChoices = map (\(MkPackageFlag n _ d manual) -> (n, d2c manual n d)) flags
       d2c manual n b = case lookupFlagAssignment n userflags of
@@ -688,4 +683,4 @@ transformDefaultBuildDepends
   -> GenericPackageDescription
   -> GenericPackageDescription
 transformDefaultBuildDepends f =
-  over (L.genDefaultPackageBounds . traverse . L.defaultTargetBuildDepends . traverse) f
+  over (L.genDefaultPackageBounds . L.defaultTargetBuildDepends . traverse) f
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs
@@ -398,8 +398,8 @@ goSections specVer = traverse_ process
       | name == "default-package-bounds" =
           if specVer >= CabalSpecV3_14
             then do
-              sbi <- lift $ parseFields specVer fields defaultPackageBoundsFieldGrammar
-              stateGpd . L.genDefaultPackageBounds .= Just sbi
+              dpb <- lift $ parseFields specVer fields defaultPackageBoundsFieldGrammar
+              stateGpd . L.genDefaultPackageBounds .= dpb
             else lift $ parseWarning pos PWTUnknownSection $ "Ignoring section: default-package-bounds. You should set cabal-version: 3.14 or larger to use default-package-bounds."
       | name == "custom-setup" && null args = do
           sbi <- lift $ parseFields specVer fields (setupBInfoFieldGrammar False)

diff --git a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs
@@ -231,7 +231,7 @@ pdToGpd pd =
     { packageDescription = pd
     , gpdScannedVersion = Nothing
     , genPackageFlags = []
-    , genDefaultPackageBounds = Nothing
+    , genDefaultPackageBounds = emptyDefaultBounds
     , condLibrary = mkCondTree <$> library pd
     , condSubLibraries = mkCondTreeL <$> subLibraries pd
     , condForeignLibs = mkCondTree' foreignLibName <$> foreignLibs pd

diff --git a/Cabal-syntax/src/Distribution/Types/DefaultBounds.hs b/Cabal-syntax/src/Distribution/Types/DefaultBounds.hs
@@ -3,10 +3,8 @@
 
 module Distribution.Types.DefaultBounds
   ( DefaultBounds (..)
-  , applyDefaultBoundsToBuildInfo
-  , applyDefaultBoundsToDependencies
-  , applyDefaultBoundsToExeDependencies
   , applyDefaultBoundsToCondTree
+  , emptyDefaultBounds
   ) where
 
 import Distribution.Compat.Lens
@@ -28,13 +26,17 @@ instance Binary DefaultBounds
 instance Structured DefaultBounds
 instance NFData DefaultBounds where rnf = genericRnf
 
+emptyDefaultBounds :: DefaultBounds
+emptyDefaultBounds = DefaultBounds [] []
+
 applyDefaultBoundsToCondTree
   :: L.HasBuildInfo a
   => DefaultBounds
   -> CondTree cv [Dependency] a
   -> CondTree cv [Dependency] a
 applyDefaultBoundsToCondTree db =
-  mapTreeData (applyDefaultBoundsToBuildInfo db) . mapTreeConstrs (applyDefaultBoundsToDependencies db)
+  mapTreeData (applyDefaultBoundsToBuildInfo db)
+    . mapTreeConstrs (applyDefaultBoundsToDependencies db)
 
 applyDefaultBoundsToBuildInfo :: L.HasBuildInfo a => DefaultBounds -> a -> a
 applyDefaultBoundsToBuildInfo db bi =
@@ -43,6 +45,7 @@ applyDefaultBoundsToBuildInfo db bi =
     & L.buildToolDepends %~ applyDefaultBoundsToExeDependencies db
 
 applyDefaultBoundsToDependencies :: DefaultBounds -> [Dependency] -> [Dependency]
+applyDefaultBoundsToDependencies (DefaultBounds [] _) = id
 applyDefaultBoundsToDependencies (DefaultBounds bd _) =
   map
     ( \dep@(Dependency pkg vorig l) ->
@@ -52,6 +55,7 @@ applyDefaultBoundsToDependencies (DefaultBounds bd _) =
     )
 
 applyDefaultBoundsToExeDependencies :: DefaultBounds -> [ExeDependency] -> [ExeDependency]
+applyDefaultBoundsToExeDependencies (DefaultBounds _ []) = id
 applyDefaultBoundsToExeDependencies (DefaultBounds _ btd) =
   map
     ( \dep@(ExeDependency pkg comp vorig) ->

diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs
@@ -44,7 +44,7 @@ data GenericPackageDescription = GenericPackageDescription
   --   Perfectly, PackageIndex should have sum type, so we don't need to
   --   have dummy GPDs.
   , genPackageFlags :: [PackageFlag]
-  , genDefaultPackageBounds :: Maybe DefaultBounds
+  , genDefaultPackageBounds :: DefaultBounds
   , condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
   , condSubLibraries
       :: [ ( UnqualComponentName
@@ -82,7 +82,7 @@ instance Structured GenericPackageDescription
 instance NFData GenericPackageDescription where rnf = genericRnf
 
 emptyGenericPackageDescription :: GenericPackageDescription
-emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing Nothing [] [] [] [] []
+emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] emptyDefaultBounds Nothing [] [] [] [] []
 
 -- -----------------------------------------------------------------------------
 -- Traversal Instances

diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs
@@ -50,7 +50,7 @@ genPackageFlags :: Lens' GenericPackageDescription [PackageFlag]
 genPackageFlags f s = fmap (\x -> s{T.genPackageFlags = x}) (f (T.genPackageFlags s))
 {-# INLINE genPackageFlags #-}
 
-genDefaultPackageBounds :: Lens' GenericPackageDescription (Maybe DefaultBounds)
+genDefaultPackageBounds :: Lens' GenericPackageDescription DefaultBounds
 genDefaultPackageBounds f s = fmap (\x -> s{T.genDefaultPackageBounds = x}) (f (T.genDefaultPackageBounds s))
 {-# INLINE genDefaultPackageBounds #-}
 

diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
@@ -35,7 +35,7 @@ md5CheckGenericPackageDescription proxy = md5Check proxy
 #if MIN_VERSION_base(4,19,0)
     0xbcb29fedd00cda89586faf963028e31d
 #else
-    0xbb48247a1d86d5b514ffc4d6df853c74
+    0xb853c69731d382446f1ae86485f953ac
 #endif
 
 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion

diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -274,7 +274,7 @@ checkGenericPackageDescription
       -- Flag names.
       mapM_ checkFlagName genPackageFlags_
       -- default package bounds
-      mapM_ checkDefaultBounds genDefaultPackageBounds_
+      checkDefaultBounds genDefaultPackageBounds_
 
       -- § Feature checks.
       checkSpecVer
@@ -301,7 +301,7 @@ checkGenericPackageDescription
       let ads =
             maybe [] ((: []) . extractAssocDeps pName) condLibrary_
               ++ map (uncurry extractAssocDeps) condSubLibraries_
-              ++ maybe [] ((: []) . Left . defaultTargetBuildDepends) genDefaultPackageBounds_
+              ++ ((: []) . Left . defaultTargetBuildDepends) genDefaultPackageBounds_
 
       case condLibrary_ of
         Just cl ->

diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -183,7 +183,7 @@ convGPD os arch cinfo constraints strfl solveExes pn
 
     appBounds :: HasBuildInfo a => CondTree cv [Dependency] a
                       -> CondTree cv [Dependency] a
-    appBounds = maybe id applyDefaultBoundsToCondTree defBounds
+    appBounds = applyDefaultBoundsToCondTree defBounds
 
     conv :: Monoid a => Component -> (a -> BuildInfo) -> DependencyReason PN ->
             CondTree ConfVar [Dependency] a -> FlaggedDeps PN

diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -79,6 +79,7 @@ import Distribution.Package
 import Distribution.PackageDescription
   ( GenericPackageDescription (..)
   , PackageDescription (..)
+  , emptyDefaultBounds
   , emptyPackageDescription
   )
 import Distribution.Simple.Compiler
@@ -1075,7 +1076,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach
                   }
             , gpdScannedVersion = Just specVer -- tells index scanner to skip this file.
             , genPackageFlags = []
-            , genDefaultPackageBounds = Nothing
+            , genDefaultPackageBounds = emptyDefaultBounds
             , condLibrary = Nothing
             , condSubLibraries = []
             , condForeignLibs = []

diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
@@ -467,7 +467,7 @@ testTargetSelectorAmbiguous reportSubCase = do
           packageDescription = emptyPackageDescription { package = pkgid },
           gpdScannedVersion  = Nothing,
           genPackageFlags    = [],
-          genDefaultPackageBounds = Nothing,
+          genDefaultPackageBounds = emptyDefaultBounds,
           condLibrary        = Nothing,
           condSubLibraries   = [],
           condForeignLibs    = [],

diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs
@@ -455,7 +455,7 @@ exAvSrcPkg ex =
                       }
                 , C.gpdScannedVersion = Nothing
                 , C.genPackageFlags = flags
-                , C.genDefaultPackageBounds = Nothing
+                , C.genDefaultPackageBounds = C.emptyDefaultBounds
                 , C.condLibrary =
                     let mkLib v bi = mempty{C.libVisibility = v, C.libBuildInfo = bi}
                         -- Avoid using the Monoid instance for [a] when getting