]> gitweb @ CieloNegro.org - pkg-find-outdated-cabal.git/blobdiff - Main.hs
code cleanup
[pkg-find-outdated-cabal.git] / Main.hs
diff --git a/Main.hs b/Main.hs
index bb96adf6913e9cace2d76ab4c7fbd1ee955e642b..c7d498007826de02eb4dbf085e8b979a73e30ac6 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -1,9 +1,88 @@
 module Main (main) where
 
+import qualified Codec.Compression.GZip as GZip
+import Control.Monad
+import qualified Data.ByteString.Lazy as Lazy
+import Data.List
+import Data.List.Utils
+import Data.Version
+import Distribution.Package
+import Distribution.PackageDescription
+import Distribution.Query
+import HSH
 import System.Directory
+import System.FilePath
+import System.FilePath.Glob
+import Text.ParserCombinators.ReadP
+
+indexURL :: String
+indexURL = "http://hackage.haskell.org/packages/archive/00-index.tar.gz"
+
+pkgsrcPath :: String
+pkgsrcPath = "/usr/pkgsrc"
 
 main :: IO ()
 main = do appDir <- getAppUserDataDirectory "pkg-find-outdated-cabal"
           createDirectoryIfMissing False appDir
 
-          putStrLn appDir
+          let indexFile = appDir </> "00-index.tar.gz"
+
+          putStrLn "Downloading the Hackage index..."
+          cwd <- pwd
+          cd appDir
+          runIO ("wget", ["-N", indexURL])
+          cd cwd
+          putStrLn "Done."
+
+          indexBin <- fmap GZip.decompress $ Lazy.readFile indexFile
+          let runQuery q = queryIndex q indexBin
+
+          makefiles <- namesMatching (pkgsrcPath </> "*" </> "*" </> "Makefile")
+          scanPkgs runQuery makefiles
+
+scanPkgs :: (Query -> [PackageDescription]) -> [FilePath] -> IO ()
+scanPkgs runQuery = mapM_ scanPkg
+    where
+      scanPkg :: FilePath -> IO ()
+      scanPkg makPath
+          = do mak <- readFile makPath
+               case grep "mk/haskell.mk" (lines mak) of
+                 [] -> return ()
+                 _  -> checkPkg mak
+
+      checkPkg :: String -> IO ()
+      checkPkg mak
+          = case grep "DISTNAME=" (lines mak) of
+              [l] -> let line     = (trd ' ' . trd '\t') l
+                         distname = cut 1 '=' line
+                         name     = extractPkgName distname
+                         ver      = extractPkgVersion distname
+                         pkgId    = PackageIdentifier name ver
+                         query    = Id ((`isNewerThan` pkgId) . package)
+                     in
+                       case runQuery query of
+                         [] -> putStrLn (distname ++ ": is the LATEST")
+                         xs -> let sorted = sortBy cmpVers xs
+                                   latest = last sorted
+                                   lVer   = (pkgVersion . package) latest
+                               in
+                                 putStrLn (distname ++ ": has a newer version " ++ showVersion lVer)
+              _   -> return ()
+
+      isNewerThan :: PackageIdentifier -> PackageIdentifier -> Bool
+      isNewerThan a b
+          = pkgName    a == pkgName    b &&
+            pkgVersion a >  pkgVersion b
+
+      cmpVers :: PackageDescription -> PackageDescription -> Ordering
+      cmpVers a b = (pkgVersion . package) a `compare` (pkgVersion . package) b
+
+extractPkgName :: String -> PackageName
+extractPkgName = PackageName . head . split "-"
+
+extractPkgVersion :: String -> Version
+extractPkgVersion =  take' . readP_to_S parseVersion . last . split "-"
+    where
+      take' ((v, ""):_ ) = v
+      take' (_      :xs) = take' xs
+      take' []           = error "Unparsable version"