Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package cabal-plan for openSUSE:Factory
checked in at 2025-01-27 20:50:42
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/cabal-plan (Old)
and /work/SRC/openSUSE:Factory/.cabal-plan.new.2316 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "cabal-plan"
Mon Jan 27 20:50:42 2025 rev:17 rq:1239810 version:0.7.5.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/cabal-plan/cabal-plan.changes 2024-12-20
23:10:03.871099570 +0100
+++ /work/SRC/openSUSE:Factory/.cabal-plan.new.2316/cabal-plan.changes
2025-01-27 20:50:45.095491285 +0100
@@ -1,0 +2,10 @@
+Mon Jan 13 20:40:37 UTC 2025 - Peter Simons <psim...@suse.com>
+
+- Update cabal-plan to version 0.7.5.0.
+ ## 0.7.5.0
+
+ * No changes in the library
+ * Add `-f` filter flag to `tred` command to only show parts of the graph to
given package(s).
+ This essentially answers "why that package" is in the build plan.
+
+-------------------------------------------------------------------
Old:
----
cabal-plan-0.7.4.0.tar.gz
New:
----
cabal-plan-0.7.5.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ cabal-plan.spec ++++++
--- /var/tmp/diff_new_pack.MimNNK/_old 2025-01-27 20:50:45.679515396 +0100
+++ /var/tmp/diff_new_pack.MimNNK/_new 2025-01-27 20:50:45.679515396 +0100
@@ -1,7 +1,7 @@
#
# spec file for package cabal-plan
#
-# Copyright (c) 2024 SUSE LLC
+# Copyright (c) 2025 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name cabal-plan
%global pkgver %{pkg_name}-%{version}
Name: %{pkg_name}
-Version: 0.7.4.0
+Version: 0.7.5.0
Release: 0
Summary: Library and utility for processing cabal's plan.json file
License: GPL-2.0-or-later
++++++ cabal-plan-0.7.4.0.tar.gz -> cabal-plan-0.7.5.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cabal-plan-0.7.4.0/ChangeLog.md
new/cabal-plan-0.7.5.0/ChangeLog.md
--- old/cabal-plan-0.7.4.0/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200
+++ new/cabal-plan-0.7.5.0/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200
@@ -1,5 +1,11 @@
# Revision history for `cabal-plan`
+## 0.7.5.0
+
+* No changes in the library
+* Add `-f` filter flag to `tred` command to only show parts of the graph to
given package(s).
+ This essentially answers "why that package" is in the build plan.
+
## 0.7.4.0
* Use Cabal-syntax-3.12
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cabal-plan-0.7.4.0/cabal-plan.cabal
new/cabal-plan-0.7.5.0/cabal-plan.cabal
--- old/cabal-plan-0.7.4.0/cabal-plan.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/cabal-plan-0.7.5.0/cabal-plan.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: cabal-plan
-version: 0.7.4.0
+version: 0.7.5.0
synopsis: Library and utility for processing cabal's plan.json file
description:
This package provides a library (see "Cabal.Plan") for decoding @plan.json@
files as
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cabal-plan-0.7.4.0/src-exe/cabal-plan.hs
new/cabal-plan-0.7.5.0/src-exe/cabal-plan.hs
--- old/cabal-plan-0.7.4.0/src-exe/cabal-plan.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/cabal-plan-0.7.5.0/src-exe/cabal-plan.hs 2001-09-09
03:46:40.000000000 +0200
@@ -86,7 +86,7 @@
data Command
= InfoCommand (Maybe SearchPlanJson)
| ShowCommand (Maybe SearchPlanJson)
- | TredCommand (Maybe SearchPlanJson)
+ | TredCommand (Maybe SearchPlanJson) [Pattern]
| FingerprintCommand (Maybe SearchPlanJson) (Flag ShowCabSha)
| ListBinsCommand (Maybe SearchPlanJson) MatchCount [Pattern]
| DotCommand (Maybe SearchPlanJson) (Flag DotTred) (Flag
DotTredWght) [Highlight] [Pattern] FilePath (Maybe RunDot)
@@ -277,9 +277,9 @@
(mProjRoot, plan) <- findPlan s
mapM_ print mProjRoot
print plan
- TredCommand s -> do
+ TredCommand s patterns -> do
(_, plan) <- findPlan s
- doTred optsUseColors optsUseAscii plan
+ doTred optsUseColors optsUseAscii patterns plan
DiffCommand old new -> do
(_, oldPlan) <- findPlan (Just old)
(_, newPlan) <- findPlan (Just new)
@@ -331,8 +331,6 @@
<*> useAsciiParser
<*> (cmdParser <|> defaultCommand)
-
-
useColorsParser :: Parser UseColors
useColorsParser = option (eitherReader parseColor) $ mconcat
[ long "color", metavar "always|never|auto"
@@ -370,6 +368,7 @@
<$> planParser
, subCommand "tred" "Transitive reduction" $ TredCommand
<$> planParser
+ <*> many (patternOption [ short 'f', long "filter", metavar
"PATTERN", help "Filter packages", completer $ patternCompleter True ])
, subCommand "diff" "Compare two plans" $ DiffCommand
<$> planParser'
<*> planParser'
@@ -535,7 +534,7 @@
for_ (M.toList $ uComps pitem) $ \(ct,ci) -> do
print ct
for_ (S.toList $ ciLibDeps ci) $ \dep -> do
- let Just dep' = M.lookup dep pm
+ let dep' = M.findWithDefault (error "panic!") dep pm
pid = uPId dep'
putStrLn (" " ++ T.unpack (dispPkgId pid))
putStrLn ""
@@ -546,23 +545,37 @@
-- tred - Transitive reduction
-------------------------------------------------------------------------------
-doTred :: UseColors -> UseAscii -> PlanJson -> IO ()
-doTred useColors useAscii plan = runCWriterIO useColors useAscii (dumpTred
plan)
+doTred :: UseColors -> UseAscii -> [Pattern] -> PlanJson -> IO ()
+doTred useColors useAscii patterns plan = runCWriterIO useColors useAscii
(dumpTred patterns plan)
-dumpTred :: PlanJson -> CWriter ()
-dumpTred plan = case fst <$> reductionClosureAM plan of
+dumpTred :: [Pattern] -> PlanJson -> CWriter ()
+dumpTred patterns plan = case reductionClosureAM plan of
Left xs -> loopGraph xs
- Right am -> do
+ Right (am, amC) -> do
let nonRoots :: Set DotUnitId
nonRoots = mconcat $ M.elems am
roots :: Set DotUnitId
roots = M.keysSet am `S.difference` nonRoots
- evalStateT (mapM_ (go1 am) roots) S.empty
+ evalStateT (mapM_ (go1 am amC) roots) S.empty
where
pm = pjUnits plan
+ showUnit :: DotUnitId -> Any
+ showUnit
+ | null patterns = \_ -> Any True
+ | otherwise = \u -> foldMap (\p -> checkPatternDotUnit p u)
patterns
+
+ checkPatternDotUnit :: Pattern -> DotUnitId -> Any
+ checkPatternDotUnit p (DU unitId mcname) = case M.lookup unitId pm of
+ Nothing -> Any False
+ Just unit -> case mcname of
+ Just cname -> checkPattern p pname cname
+ Nothing -> foldMap (checkPattern p pname) (M.keys (uComps unit))
+ where
+ PkgId pname _ = uPId unit
+
directDepsOfLocalPackages :: Set UnitId
directDepsOfLocalPackages = S.fromList
[ depUid
@@ -578,72 +591,79 @@
mapM_ (putCTextLn . fromString . show) xs
go1 :: Map DotUnitId (Set DotUnitId)
+ -> Map DotUnitId (Set DotUnitId)
-> DotUnitId
-> StateT (Set DotUnitId) CWriter ()
- go1 am = go2 [] where
- ccol :: Maybe CompName -> CText -> CText
- ccol Nothing = recolorify White
- ccol (Just comp) = ccol' comp
-
- ccol' CompNameLib = recolorify White
- ccol' (CompNameExe _) = recolorify Green
- ccol' CompNameSetup = recolorify Red
- ccol' (CompNameTest _) = recolorify Yellow
- ccol' (CompNameBench _) = recolorify Cyan
- ccol' (CompNameSubLib _) = recolorify Blue
- ccol' (CompNameFLib _) = recolorify Magenta
+ go1 am amC = go2 [] where
+ showUnit' :: DotUnitId -> Bool
+ showUnit' u = getAny $ showUnit u <> foldMap showUnit
(M.findWithDefault (error "non-existing UnitId") u amC)
go2 :: [(Maybe CompName, Bool)]
-> DotUnitId
-> StateT (Set DotUnitId) CWriter ()
go2 lvl duid@(DU uid comp) = do
- let unit = M.findWithDefault (error "non-existing UnitId") uid pm
- let deps = M.findWithDefault S.empty duid am
- let pid = uPId unit
-
- let emphasise' | uType unit == UnitTypeLocal =
underline
- | uid `S.member` directDepsOfLocalPackages =
emphasise
- | otherwise = id
-
seen <- gets (S.member duid)
modify' (S.insert duid)
+ let unit = M.findWithDefault (error "non-existing UnitId") uid pm
+ let pid = uPId unit
+
+ let emphasise'
+ | uType unit == UnitTypeLocal = underline
+ | uid `S.member` directDepsOfLocalPackages = emphasise
+ | otherwise = id
+
let pid_label = emphasise' $ ccol comp (prettyCompTy pid comp)
if seen
then putCTextLn $ linepfx lvl <> pid_label <> fromT Rest
else do
+ let deps' = M.findWithDefault S.empty duid am
+ let deps = S.filter showUnit' deps'
+
putCTextLn $ linepfx lvl <> pid_label
for_ (lastAnn $ S.toList deps) $ \(l, depDuid) ->
go2 (lvl ++ [(comp, not l)]) depDuid
- linepfx :: [(Maybe CompName, Bool)] -> CText
- linepfx lvl = case unsnoc lvl of
- Nothing -> ""
- Just (xs,(zt,z)) -> mconcat [ if x then ccol xt (fromT Vert) else
fromT Spac | (xt,x) <- xs ]
- <> (ccol zt $ fromT $ if z then Junc else Corn)
-
- prettyPid = T.unpack . dispPkgId
-
- prettyCompTy :: PkgId -> Maybe CompName -> CText
- prettyCompTy pid Nothing = fromString $ "[" ++ prettyPid pid ++
":all]"
- prettyCompTy pid (Just c) = prettyCompTy' pid c
-
- prettyCompTy' :: PkgId -> CompName -> CText
- prettyCompTy' pid CompNameLib = fromString $ prettyPid pid
- prettyCompTy' _pid CompNameSetup = fromString $ "[setup]"
- prettyCompTy' pid (CompNameExe n) = fromString $ "[" ++ prettyPid
pid ++ ":exe:" ++ show n ++ "]"
- prettyCompTy' pid (CompNameTest n) = fromString $ "[" ++ prettyPid
pid ++ ":test:" ++ show n ++ "]"
- prettyCompTy' pid (CompNameBench n) = fromString $ "[" ++ prettyPid
pid ++ ":bench:" ++ show n ++ "]"
- prettyCompTy' pid (CompNameSubLib n) = fromString $ "[" ++ prettyPid
pid ++ ":lib:" ++ show n ++ "]"
- prettyCompTy' pid (CompNameFLib n) = fromString $ "[" ++ prettyPid
pid ++ ":flib:" ++ show n ++ "]"
+ ccol :: Maybe CompName -> CText -> CText
+ ccol Nothing = recolorify White
+ ccol (Just comp) = ccol' comp
+
+ ccol' CompNameLib = recolorify White
+ ccol' (CompNameExe _) = recolorify Green
+ ccol' CompNameSetup = recolorify Red
+ ccol' (CompNameTest _) = recolorify Yellow
+ ccol' (CompNameBench _) = recolorify Cyan
+ ccol' (CompNameSubLib _) = recolorify Blue
+ ccol' (CompNameFLib _) = recolorify Magenta
+
+ linepfx :: [(Maybe CompName, Bool)] -> CText
+ linepfx lvl = case unsnoc lvl of
+ Nothing -> ""
+ Just (xs,(zt,z)) -> mconcat [ if x then ccol xt (fromT Vert) else
fromT Spac | (xt,x) <- xs ]
+ <> (ccol zt $ fromT $ if z then Junc else Corn)
+
+ prettyPid = T.unpack . dispPkgId
+
+ prettyCompTy :: PkgId -> Maybe CompName -> CText
+ prettyCompTy pid Nothing = fromString $ "[" ++ prettyPid pid ++ ":all]"
+ prettyCompTy pid (Just c) = prettyCompTy' pid c
+
+ prettyCompTy' :: PkgId -> CompName -> CText
+ prettyCompTy' pid CompNameLib = fromString $ prettyPid pid
+ prettyCompTy' _pid CompNameSetup = fromString $ "[setup]"
+ prettyCompTy' pid (CompNameExe n) = fromString $ "[" ++ prettyPid pid
++ ":exe:" ++ show n ++ "]"
+ prettyCompTy' pid (CompNameTest n) = fromString $ "[" ++ prettyPid pid
++ ":test:" ++ show n ++ "]"
+ prettyCompTy' pid (CompNameBench n) = fromString $ "[" ++ prettyPid pid
++ ":bench:" ++ show n ++ "]"
+ prettyCompTy' pid (CompNameSubLib n) = fromString $ "[" ++ prettyPid pid
++ ":lib:" ++ show n ++ "]"
+ prettyCompTy' pid (CompNameFLib n) = fromString $ "[" ++ prettyPid pid
++ ":flib:" ++ show n ++ "]"
reductionClosureAM
:: PlanJson
-> Either [DotUnitId] (Map DotUnitId (Set DotUnitId), Map DotUnitId (Set
DotUnitId))
reductionClosureAM plan = TG.runG am $ \g ->
- (TG.adjacencyMap (TG.reduction g), am)
+ (TG.adjacencyMap (TG.reduction g), TG.adjacencyMap (TG.closure g))
where
am = planJsonDotUnitGraph plan
@@ -1294,7 +1314,7 @@
return ()
where
- Just x' = M.lookup pid pm
+ x' = M.findWithDefault (error "panic!") pid pm
preExists = uType x' == UnitTypeBuiltin
