[Pkg-haskell-commits] [tools] 02/02: Download the britney output automatically and cache it if possible.

[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 60e1e2abfce7c06dbc3f66fc69d7d38f1348a527
Author: Sven Bartscher <sven.bartscher at weltraumschlangen.de>
Date:   Mon Aug 18 15:05:10 2014 +0200

    Download the britney output automatically and cache it if possible.
---
 reasons.hs | 40 +++++++++++++++++++++++++++++++++++-----
 1 file changed, 35 insertions(+), 5 deletions(-)

diff --git a/reasons.hs b/reasons.hs
index 9d14b6c..717ee01 100644
--- a/reasons.hs
+++ b/reasons.hs
@@ -8,6 +8,9 @@ import Data.List
 import Data.Char
 import qualified Data.Set as S
 import Control.Exception
+import System.IO.Error
+import System.Directory
+import Debug.Trace
 
 data Excuses = Excuses String [String]
 
@@ -19,8 +22,8 @@ excuses2String :: Excuses -> String
 excuses2String (Excuses pkg excuses) = unlines $ (pkg ++ ":"):(map ("    " ++) excuses)
 
 main = do
-  (britneyout, package) <- getArgs >>= parse
-  output <- fmap lines $ readFile britneyout
+  package <- getArgs >>= parse
+  output <- fmap lines acquireBritneyOut
   let bins = getBinBlockers output package
   result <- try (fmap nub $ mapM getSrcPackage bins) :: IO (Either ErrorCall [String])
   srcBlockers <- case result of
@@ -31,14 +34,41 @@ main = do
   let filteredExcuses = filterExcuses (isInteresting srcBlockers) $ excuses ++ additionalExcuses
   mapM_ putStrLn $ map excuses2String filteredExcuses
 
-parse :: [String] -> IO (String, String)
-parse [britneyout, package] = return (britneyout, package)
+acquireBritneyOut :: IO String
+acquireBritneyOut = do
+  cachePath <- chooseCachePath
+  case cachePath of 
+    Nothing -> readProcess "/usr/bin/wget" ["-q", "-O", "-", outputUrl] ""
+    Just path -> do
+      createDirectoryIfMissing False path
+      setCurrentDirectory path
+      readProcess "/usr/bin/wget" ["-q", "-N", outputUrl] ""
+      readFile "update_output.txt"
+
+chooseCachePath :: IO (Maybe String)
+chooseCachePath = do
+  result <- tryJust shouldCatch $ getAppUserDataDirectory "reasons"
+  hasHome <- getHomeDirectory >>= doesDirectoryExist
+  return $ case result of
+             Right dir -> if hasHome
+                          then Just dir
+                          else Nothing
+             Left _ -> Nothing
+      where shouldCatch e = if isDoesNotExistError e
+                            then Just e
+                            else Nothing
+
+outputUrl :: String
+outputUrl = "release.debian.org/britney/update_output.txt"
+
+parse :: [String] -> IO String
+parse [package] = return package
 parse _ = printUsage >> exitFailure
 
 printUsage :: IO ()
 printUsage = do
   progName <- getProgName
-  putStrLn $ "Usage: " ++ progName ++ " britney-output package-name"
+  putStrLn $ "Usage: " ++ progName ++ " package-name"
 
 packageNotFoundMsg :: String
 packageNotFoundMsg

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