Merge pull request #6968 from phadej/combine-stragety-skip

Add active-repositories merge strategy: skip
haskell · Jul 15, 2020 · d8f890b · d8f890b
2 parents 66e96d9 + 8497743
commit d8f890b
Show file tree

Hide file tree

Showing 5 changed files with 28 additions and 6 deletions.
diff --git a/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal-install/Distribution/Client/CmdFreeze.hs
@@ -17,7 +17,7 @@ import Distribution.Client.ProjectPlanning
 import Distribution.Client.ProjectConfig
          ( ProjectConfig(..), ProjectConfigShared(..)
          , writeProjectLocalFreezeConfig )
-import Distribution.Client.IndexUtils (TotalIndexState, ActiveRepos)
+import Distribution.Client.IndexUtils (TotalIndexState, ActiveRepos, filterSkippedActiveRepos)
 import Distribution.Client.Targets
          ( UserQualifier(..), UserConstraintScope(..), UserConstraint(..) )
 import Distribution.Solver.Types.PackageConstraint
@@ -143,14 +143,17 @@ projectFreezeConfig
     -> TotalIndexState
     -> ActiveRepos
     -> ProjectConfig
-projectFreezeConfig elaboratedPlan totalIndexState activeRepos = mempty
+projectFreezeConfig elaboratedPlan totalIndexState activeRepos0 = mempty
     { projectConfigShared = mempty
         { projectConfigConstraints =
           concat (Map.elems (projectFreezeConstraints elaboratedPlan))
         , projectConfigIndexState  = Flag totalIndexState
         , projectConfigActiveRepos = Flag activeRepos
         }
     }
+  where
+    activeRepos :: ActiveRepos
+    activeRepos = filterSkippedActiveRepos activeRepos0
 
 -- | Given the install plan, produce solver constraints that will ensure the
 -- solver picks the same solution again in future in different environments.

diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs
@@ -29,6 +29,7 @@ module Distribution.Client.IndexUtils (
   TotalIndexState,
   getSourcePackagesAtIndexState,
   ActiveRepos,
+  filterSkippedActiveRepos,
 
   Index(..),
   RepoIndexState (..),
@@ -316,6 +317,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
           :: PackageIndex UnresolvedSourcePackage
           -> (RepoData, CombineStrategy)
           -> PackageIndex UnresolvedSourcePackage
+      addIndex acc (RepoData _ _ _   _, CombineStrategySkip)     = acc
       addIndex acc (RepoData _ _ idx _, CombineStrategyMerge)    = PackageIndex.merge acc idx
       addIndex acc (RepoData _ _ idx _, CombineStrategyOverride) = PackageIndex.override acc idx
 

diff --git a/cabal-install/Distribution/Client/IndexUtils/ActiveRepos.hs b/cabal-install/Distribution/Client/IndexUtils/ActiveRepos.hs
@@ -4,6 +4,7 @@
 module Distribution.Client.IndexUtils.ActiveRepos (
     ActiveRepos (..),
     defaultActiveRepos,
+    filterSkippedActiveRepos,
     ActiveRepoEntry (..),
     CombineStrategy (..),
     organizeByRepos,
@@ -32,6 +33,18 @@ newtype ActiveRepos = ActiveRepos [ActiveRepoEntry]
 defaultActiveRepos :: ActiveRepos
 defaultActiveRepos = ActiveRepos [ ActiveRepoRest CombineStrategyMerge ]
 
+-- | Note, this does nothing if 'ActiveRepoRest' is present.
+filterSkippedActiveRepos :: ActiveRepos -> ActiveRepos
+filterSkippedActiveRepos repos@(ActiveRepos entries)
+    | any isActiveRepoRest entries = repos
+    | otherwise                    = ActiveRepos (filter notSkipped entries)
+  where
+    isActiveRepoRest (ActiveRepoRest _) = True
+    isActiveRepoRest _                  = False
+
+    notSkipped (ActiveRepo _ CombineStrategySkip) = False
+    notSkipped _                                  = True
+
 instance Binary ActiveRepos
 instance Structured ActiveRepos
 instance NFData ActiveRepos
@@ -97,7 +110,8 @@ instance Parsec ActiveRepoEntry where
         strategyP = P.option CombineStrategyMerge (P.char ':' *> parsec)
 
 data CombineStrategy
-    = CombineStrategyMerge    -- ^ merge existing versions
+    = CombineStrategySkip     -- ^ skip this repository
+    | CombineStrategyMerge    -- ^ merge existing versions
     | CombineStrategyOverride -- ^ if later repository specifies a package,
                               --   all package versions are replaced
   deriving (Eq, Show, Enum, Bounded, Generic)
@@ -107,12 +121,14 @@ instance Structured CombineStrategy
 instance NFData CombineStrategy
 
 instance Pretty CombineStrategy where
+    pretty CombineStrategySkip     = Disp.text "skip"
     pretty CombineStrategyMerge    = Disp.text "merge"
     pretty CombineStrategyOverride = Disp.text "override"
 
 instance Parsec CombineStrategy where
     parsec = P.choice
-        [ CombineStrategyMerge    <$ P.string "merge"
+        [ CombineStrategySkip     <$ P.string "skip"
+        , CombineStrategyMerge    <$ P.string "merge"
         , CombineStrategyOverride <$ P.string "override"
         ]
 

diff --git a/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs
@@ -139,7 +139,8 @@ instance Described ActiveRepoEntry where
 
 instance Described CombineStrategy where
     describe _ = REUnion
-        [ "merge"
+        [ "skip"
+        , "merge"
         , "override"
         ]
 

diff --git a/changelog.d/active-repositories b/changelog.d/active-repositories
@@ -1,6 +1,6 @@
 synopsis: Add active-repositories configuration
 packages: cabal-install
-prs: #6724 #6868
+prs: #6724 #6868 #6968
 issues: #6819
 significance: significant