extract PackageIdentifier from Makefile's
authorPHO <pho@cielonegro.org>
Thu, 1 Oct 2009 10:26:37 +0000 (19:26 +0900)
committerPHO <pho@cielonegro.org>
Thu, 1 Oct 2009 10:26:37 +0000 (19:26 +0900)
Main.hs
pkg-find-outdated-cabal.cabal

diff --git a/Main.hs b/Main.hs
index bb96adf6913e9cace2d76ab4c7fbd1ee955e642b..abbbaebc7aa92fc1303c4cb38f1a6139c478f26c 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -1,9 +1,69 @@
 module Main (main) where
 
+import Control.Monad
+import qualified Data.ByteString.Lazy as Lazy
+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" -- FIXME!
 
 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 <- 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 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 ()
+
+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
index 9bb92f1a91c7c5b60e06f14a3d510fe186bd4077..6effb39ec2445405139c39211414970da8d5ba73 100644 (file)
@@ -18,7 +18,8 @@ Source-Repository head
 
 Executable pkg-find-outdated-cabal
     Build-Depends:
-        Cabal, HTTP, base >= 4 && < 5, directory
+        Cabal, FileManip, HSH, MissingH, base >= 4 && < 5, bytestring,
+        cabal-query, directory, filepath
     Main-Is:
         Main.hs
     ghc-options: