[Pkg-haskell-commits] [package-plan] 01/01: Added lts-diff.hs. It compares the tracked LTS release with the current package-plan and outputs three categories of packages: - Packages in the LTS but not in Debian - Packages that have different version in Debian and the LTS - Packages that are in Debian but not in the LTS

[Sven Bartscher]

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

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

commit ee31f9dd3be1ad00260fdac98db0d2e7655f3107
Author: Sven Bartscher <sven.bartscher at weltraumschlangen.de>
Date:   Thu Jul 9 14:42:00 2015 +0200

    Added lts-diff.hs. It compares the tracked LTS release with the
    current package-plan and outputs three categories of packages:
    - Packages in the LTS but not in Debian
    - Packages that have different version in Debian and the LTS
    - Packages that are in Debian but not in the LTS
---
 lts-diff.hs | 147 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 147 insertions(+)

diff --git a/lts-diff.hs b/lts-diff.hs
new file mode 100644
index 0000000..dea8085
--- /dev/null
+++ b/lts-diff.hs
@@ -0,0 +1,147 @@
+import Control.Applicative ((<$>))
+import Control.Monad (void)
+import Data.Maybe (mapMaybe)
+import Data.List (intercalate)
+import Data.List.Split (splitOn)
+import Data.Char (isAlpha)
+import qualified Data.Foldable as F
+import qualified Data.Set as S
+import qualified Data.Map as M
+import Distribution.Package ( PackageId
+                            , PackageName(PackageName)
+                            , PackageIdentifier(PackageIdentifier)
+                            , pkgName
+                            , pkgVersion
+                            , unPackageName
+                            )
+import Distribution.Version ( Version(Version)
+                            , versionBranch
+                            )
+import Safe (readMay)
+
+main :: IO ()
+main = do
+  debian <- getDebianPackages
+  lts <- getLtsPackages
+  let (missing, different, more) = packageDiff debian lts
+  printMissings missing
+  printDifferences different
+  printMore more
+
+getDebianPackages :: IO (S.Set PackageId)
+getDebianPackages = S.fromList . mapMaybe parseDebianPackage
+                    <$> getLines debianPackagesFile
+
+getLines :: FilePath -> IO [String]
+getLines = fmap lines .  readFile
+
+debianPackagesFile :: FilePath
+debianPackagesFile = "packages.txt"
+
+parseDebianPackage :: String -> Maybe PackageId
+parseDebianPackage line = do
+  (rawName:rawVersion:_) <- return $ words line
+  let name = PackageName rawName
+  version <- parseVersion rawVersion
+  return PackageIdentifier { pkgName = name
+                           , pkgVersion = version
+                           }
+
+getLtsPackages :: IO (S.Set PackageId)
+getLtsPackages = S.fromList . mapMaybe parseLtsPackage
+                 <$> getLines ltsFile
+
+ltsFile :: FilePath
+ltsFile = "lts.config"
+
+parseLtsPackage :: String -> Maybe PackageId
+parseLtsPackage line = case line of
+                         ('-':'-':_) -> Nothing
+                         ('c':'o':'n':'s':'t':'r':'a':'i':'n':'t':'s':':':rest)
+                             -> parseLtsPackage rest
+                         packageLine -> do
+                                   [rawName, rawVersion] <- return
+                                        $ splitOn "==" packageLine
+                                       -- Throws eventual whitespaces
+                                       -- from the end and the
+                                       -- beginning of the name
+                                   let name = PackageName
+                                              $ filter isAlpha
+                                                       rawName
+                                       -- Throw the trailing comma away.
+                                   version <- parseVersion $
+                                              stripComma rawVersion
+                                   return PackageIdentifier
+                                              { pkgName = name
+                                              , pkgVersion = version
+                                              }
+
+packageDiff :: S.Set PackageId
+            -> S.Set PackageId
+            -> ( S.Set PackageName
+               , M.Map PackageName (Version, Version)
+               , S.Set PackageName
+               )
+packageDiff debian lts = (missing, different, more)
+    where missing = S.difference ltsPkgs debianPkgs
+          different = mergeCommonPackages debianMap ltsMap
+          more = S.difference debianPkgs ltsPkgs
+          ltsMap = packages2packageMap lts
+          debianMap = packages2packageMap debian
+          ltsPkgs = S.map pkgName lts
+          debianPkgs = S.map pkgName debian
+
+mergeCommonPackages :: M.Map PackageName Version
+                    -> M.Map PackageName Version
+                    -> M.Map PackageName (Version, Version)
+mergeCommonPackages = M.mergeWithKey
+                      (\_ debianV ltsV -> if debianV /= ltsV
+                                          then Just (debianV, ltsV)
+                                          else Nothing
+                      )
+                      (const M.empty)
+                      (const M.empty)
+
+packages2packageMap :: S.Set PackageId -> M.Map PackageName Version
+packages2packageMap = indexSet pkgName pkgVersion
+
+indexSet :: (Ord k) => (a -> k) -> (a -> v) -> S.Set a -> M.Map k v
+indexSet key value = F.foldr (\x -> M.insert (key x) (value x)) M.empty
+
+printMissings :: S.Set PackageName -> IO ()
+printMissings missing = do
+  putStrLn "\nPackages in LTS but not in Debian:\n"
+  F.traverse_ printPackage missing
+
+printDifferences :: M.Map PackageName (Version, Version) -> IO ()
+printDifferences different = do
+  putStrLn "\nPackages that have different versions in LTS and Debian:\n"
+  void $ M.traverseWithKey printDifference different
+
+printDifference :: PackageName -> (Version, Version) -> IO ()
+printDifference name (debianV, ltsV) =
+    putStrLn $ unPackageName name ++ " has version " ++
+             showVersion debianV ++ " in Debian but " ++ showVersion
+             ltsV ++ " in LTS."
+
+printMore :: S.Set PackageName -> IO ()
+printMore more = do
+  putStrLn "\nPackages in Debian but not in LTS:\n"
+  F.traverse_ printPackage more
+
+printPackage :: PackageName -> IO ()
+printPackage = putStrLn . unPackageName
+
+parseVersion :: String -> Maybe Version
+parseVersion raw = do
+  let parts = splitOn "." raw
+  numericParts <- mapM readMay parts
+  return $ Version numericParts []
+
+stripComma :: String -> String
+stripComma s
+    | last s == ',' = init s
+    | otherwise = s
+
+showVersion :: Version -> String
+showVersion = intercalate "." . map show . versionBranch

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