[Pkg-haskell-commits] [tools] 01/02: Interesting Dependencies are no longer liasted in the excuses, but listed with their own excuses (and subexcuses...).

[Sven Bartscher]

This is an automated email from the git hooks/post-receive script.

svenb-guest pushed a commit to branch master
in repository tools.

commit 92f5f345ac3e69dfc1b35df854fc2127cb3ad4c7
Author: Sven Bartscher <sven.bartscher at weltraumschlangen.de>
Date:   Mon Aug 18 14:22:25 2014 +0200

    Interesting Dependencies are no longer liasted in the excuses, but listed with
    their own excuses (and subexcuses...).
---
 reasons.hs | 40 +++++++++++++++++++++++++++++++++-------
 1 file changed, 33 insertions(+), 7 deletions(-)

diff --git a/reasons.hs b/reasons.hs
index 745fb2d..9d14b6c 100644
--- a/reasons.hs
+++ b/reasons.hs
@@ -27,7 +27,8 @@ main = do
                    Left e -> putStrLn packageNotFoundMsg >> exitFailure
                    Right pkgs -> return pkgs
   excuses <- mapM getExcuse srcBlockers
-  let filteredExcuses = filterExcuses (isInteresting srcBlockers) excuses
+  additionalExcuses <- getAdditionalExcuses srcBlockers excuses
+  let filteredExcuses = filterExcuses (isInteresting srcBlockers) $ excuses ++ additionalExcuses
   mapM_ putStrLn $ map excuses2String filteredExcuses
 
 parse :: [String] -> IO (String, String)
@@ -54,15 +55,40 @@ isInteresting :: [String] -> String -> Bool
 isInteresting blockers excuse = "out of date on" `isPrefixOf` excuse 
                                 || "introduces new bugs" `isInfixOf` excuse
                                 || "Too young" `isPrefixOf` excuse
-                                || isInterestingDependency blockers excuse
+                                || isInterestingDependency blockers excuse -- Left here
+                                                                           -- for the case that
+                                                                           -- getAdditionalExcuses
+                                                                           -- misses something.
+                                                                           -- (Can be removed after
+                                                                           -- sufficient testing)
 
 isInterestingDependency :: [String] -> String -> Bool
 isInterestingDependency pkgs excuse = "(not considered)" `isSuffixOf` excuse 
-                                      && dependency `notElem` pkgs
-    where dependency' = excuse =~ "(?<=Depends: ).*(?= \\(not considered\\))"
-          dependency
-              | null dependency' = ""
-              | otherwise = tail $ dropWhile (/= ' ') dependency'
+                                      && (mangleDependency excuse) `notElem` pkgs
+
+mangleDependency :: String -> String
+mangleDependency excuse
+    | null dependency = ""
+    | otherwise = tail $ dropWhile (/= ' ') dependency
+    where dependency = excuse =~ "(?<=Depends: ).*(?= \\(not considered\\))"
+
+-- Takes a list of already fetched excuses and returns the excuses of missing dependencies
+getAdditionalExcuses :: [String] -> [Excuses] -> IO [Excuses]
+getAdditionalExcuses _ [] = return []
+getAdditionalExcuses pkgs excuses = do
+  let interestingDepends = filterExcuses
+                           (isInterestingDependency pkgs)
+                           excuses
+      dependencies = nub $ map mangleDependency $ flattenExcuses interestingDepends
+  excuses <- mapM getExcuse dependencies
+  evenMoreExcuses <- getAdditionalExcuses (pkgs ++ dependencies) excuses
+  return $ excuses ++ evenMoreExcuses
+
+flattenExcuses :: [Excuses] -> [String]
+flattenExcuses excuses = concat $ map unpackExcuses excuses
+
+unpackExcuses :: Excuses -> [String]
+unpackExcuses (Excuses _ excuses) = excuses
 
 maybeTail :: [a] -> Maybe [a]
 maybeTail [] = Nothing

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/tools.git