It's now working!
authorPHO <pho@cielonegro.org>
Fri, 2 Oct 2009 01:32:06 +0000 (10:32 +0900)
committerPHO <pho@cielonegro.org>
Fri, 2 Oct 2009 01:32:06 +0000 (10:32 +0900)
Main.hs
pkg-find-outdated-cabal.cabal

diff --git a/Main.hs b/Main.hs
index abbbaebc7aa92fc1303c4cb38f1a6139c478f26c..13bc9485d5dd0168889cead1728ccebaf384b5e2 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -1,7 +1,9 @@
 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
@@ -17,7 +19,7 @@ indexURL :: String
 indexURL = "http://hackage.haskell.org/packages/archive/00-index.tar.gz"
 
 pkgsrcPath :: String
-pkgsrcPath = "/usr/pkgsrc" -- FIXME!
+pkgsrcPath = "/usr/pkgsrc"
 
 main :: IO ()
 main = do appDir <- getAppUserDataDirectory "pkg-find-outdated-cabal"
@@ -32,7 +34,7 @@ main = do appDir <- getAppUserDataDirectory "pkg-find-outdated-cabal"
           cd cwd
           putStrLn "Done."
 
-          indexBin <- Lazy.readFile indexFile
+          indexBin <- fmap GZip.decompress $ Lazy.readFile indexFile
           let runQuery q = queryIndex q indexBin
 
           makefiles <- namesMatching (pkgsrcPath </> "*" </> "*" </> "Makefile")
@@ -43,21 +45,38 @@ scanPkgs runQuery = mapM_ scanPkg
     where
       scanPkg :: FilePath -> IO ()
       scanPkg makPath
-          = do isCabalPkg <- run ("fgrep", ["-q", "mk/haskell.mk", makPath])
-               when isCabalPkg
-                    $ checkPkg makPath
-
-      checkPkg :: FilePath -> IO ()
-      checkPkg makPath
           = do mak <- readFile makPath
-               case grep "DISTNAME=" (lines mak) of
-                 [l] -> do let line     = (trd ' ' . trd '\t') l
-                               distname = cut 1 '=' line
-                               pkgName  = extractPkgName distname
-                               pkgVer   = extractPkgVersion distname
-                               pkgId    = PackageIdentifier pkgName pkgVer
-                           putStrLn (distname ++ ": " ++ show pkgId)
-                 _   -> return ()
+               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 (sameName pkgId) :& Id (newerVers pkgId)
+                     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 ()
+
+      sameName :: PackageIdentifier -> PackageIdentifier -> Bool
+      sameName a b = pkgName a == pkgName b
+
+      newerVers :: PackageIdentifier -> PackageIdentifier -> Bool
+      newerVers a 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 "-"
@@ -67,3 +86,4 @@ extractPkgVersion =  take' . readP_to_S parseVersion . last . split "-"
     where
       take' ((v, ""):_ ) = v
       take' (_      :xs) = take' xs
+      take' []           = error "Unparsable version"
index 6effb39ec2445405139c39211414970da8d5ba73..4cad8a965f522d5714c8a7a991f4cac131f4015a 100644 (file)
@@ -19,7 +19,7 @@ Source-Repository head
 Executable pkg-find-outdated-cabal
     Build-Depends:
         Cabal, FileManip, HSH, MissingH, base >= 4 && < 5, bytestring,
-        cabal-query, directory, filepath
+        cabal-query, directory, filepath, zlib
     Main-Is:
         Main.hs
     ghc-options: