haskell-updater 1.2.5 → 1.2.6
raw patch · 3 files changed
+98/−74 lines, 3 files
Files
- Distribution/Gentoo/GHC.hs +62/−24
- Distribution/Gentoo/Packages.hs +35/−49
- haskell-updater.cabal +1/−1
Distribution/Gentoo/GHC.hs view
@@ -30,7 +30,8 @@ -- Other imports import Data.Char(isDigit) import Data.Either(partitionEithers)-import Data.Maybe(fromJust)+import Data.Maybe+import qualified Data.List as L import qualified Data.Map as Map import Data.Map(Map) import qualified Data.ByteString.Char8 as BS@@ -38,7 +39,7 @@ import System.Directory( canonicalizePath , doesDirectoryExist , findExecutable)-import Control.Monad(foldM, liftM)+import Control.Monad import Output @@ -89,14 +90,15 @@ ghcPkgLoc = liftM fromJust $ findExecutable "ghc-pkg" -- Return the Gentoo .conf files found in this GHC libdir-confFiles :: FilePath -> IO [FilePath]-confFiles dir = do let gDir = dir </> "gentoo"- exists <- doesDirectoryExist gDir- if exists- then do conts <- getDirectoryContents' gDir- return $ map (gDir </>)- $ filter isConf conts- else return []+confFiles :: FilePath -> FilePath -> IO [FilePath]+confFiles subdir dir = do+ let gDir = dir </> subdir+ exists <- doesDirectoryExist gDir+ if exists+ then do conts <- getDirectoryContents' gDir+ return $ map (gDir </>)+ $ filter isConf conts+ else return [] where isConf file = takeExtension file == ".conf" @@ -114,7 +116,7 @@ -- Read in all Gentoo .conf files from the current GHC version and -- create a Map readConf :: Verbosity -> IO ConfMap-readConf v = ghcLibDir >>= confFiles >>= foldM (addConf v) Map.empty+readConf v = ghcLibDir >>= confFiles "gentoo" >>= foldM (addConf v) Map.empty -- cabal package text format -- "[InstalledPackageInfo {installedPackageId = Insta..."@@ -151,8 +153,10 @@ case ( parse_as_ghc_package cont , parse_as_cabal_package (BS.unpack cont) ) of- (Just dn, _) -> return $ Map.insert dn conf cmp- (_, Just dn) -> return $ Map.insert dn conf cmp+ (Just dn, _) -> do vsay v $ unwords [conf, "resolved as ghc package:", dn]+ return $ Map.insert dn conf cmp+ (_, Just dn) -> do vsay v $ unwords [conf, "resolved as cabal package:", dn]+ return $ Map.insert dn conf cmp -- empty files are created for -- phony packages like CABAL_CORE_LIB_GHC_PV -- and binary-only packages.@@ -168,9 +172,16 @@ checkPkgs :: Verbosity -> ([CabalPV], [FilePath]) -> IO ([Package],[CabalPV],[FilePath])-checkPkgs _v (pns,cnfs)- = do pkgs <- haveFiles cnfs- return (pkgs, pns, [])+checkPkgs v (pns, gentoo_cnfs) = do+ files_to_pkgs <- resolveFiles gentoo_cnfs+ let (gentoo_files, pkgs) = unzip files_to_pkgs+ orphan_gentoo_files = gentoo_cnfs L.\\ gentoo_files+ vsay v $ unwords [ "checkPkgs: searching for gentoo .conf orphans"+ , show (length orphan_gentoo_files)+ , "of"+ , show (length gentoo_cnfs)+ ]+ return (pkgs, pns, orphan_gentoo_files) -- ----------------------------------------------------------------------------- @@ -232,22 +243,49 @@ brokenConfs :: Verbosity -> IO ([CabalPV], [FilePath]) brokenConfs v = do vsay v "brokenConfs: getting broken output from 'ghc-pkg'"- brkn <- getBroken+ ghc_pkg_brokens <- getBroken -- Check if we actually have to go look up files and -- do IO.- vsay v $ "brokenConfs: resolving package names to gentoo equivalents. " ++ show (length brkn) ++ " are broken"- if null brkn- then return ([], [])- else do vsay v "brokenConfs: reading '*.conf' files"- cnfs <- readConf v- vsay v $ "brokenConfs: got " ++ show (Map.size cnfs) ++ " '*.conf' files"- return $ partitionEithers $ map (matchConf cnfs) brkn+ vsay v $ unwords ["brokenConfs: resolving package names to gentoo equivalents."+ , show (length ghc_pkg_brokens)+ , "are broken:"+ , L.intercalate " " ghc_pkg_brokens+ ] + (orphan_broken, orphan_confs) <- getOrphanBroken+ vsay v $ unwords [ "checkPkgs: ghc .conf orphans:"+ , show (length orphan_broken)+ , "are orphan:"+ , L.intercalate " " orphan_broken+ ]++ let all_broken = ghc_pkg_brokens ++ orphan_broken++ vsay v "brokenConfs: reading '*.conf' files"+ cnfs <- readConf v+ vsay v $ "brokenConfs: got " ++ show (Map.size cnfs) ++ " '*.conf' files"+ let (known_broken, orphans) = partitionEithers $ map (matchConf cnfs) all_broken+ return (known_broken, orphan_confs ++ orphans)+ -- Return the closure of all packages affected by breakage -- in format of ["name-version", ... ] getBroken :: IO [CabalPV] getBroken = liftM words $ ghcPkgRawOut ["check", "--simple-output"]++getOrphanBroken :: IO ([CabalPV], [FilePath])+getOrphanBroken = do+ -- Around Jan 2015 we have started to install+ -- all the .conf files in 'src_install()' phase.+ -- Here we pick orphan ones and notify user about it.+ registered_confs <- ghcLibDir >>= confFiles "package.conf.d"+ confs_to_pkgs <- resolveFiles registered_confs+ let (conf_files, _conf_pkgs) = unzip confs_to_pkgs+ orphan_conf_files = registered_confs L.\\ conf_files+ orphan_packages <- liftM catMaybes $+ forM orphan_conf_files $+ liftM parse_as_ghc_package . BS.readFile+ return (orphan_packages, orphan_conf_files) -- -----------------------------------------------------------------------------
Distribution/Gentoo/Packages.hs view
@@ -12,26 +12,23 @@ , Content , notGHC , printPkg- , haveFiles+ , resolveFiles , pkgsHaveContent- , hasContentMatching , hasDirMatching- , hasObjMatching ) where -import Distribution.Gentoo.Util- import Data.Char(isDigit, isAlphaNum)-import Data.List(delete)-import Data.Maybe(mapMaybe, listToMaybe)+import Data.Maybe import qualified Data.ByteString.Char8 as BS import Data.ByteString.Char8(ByteString) import qualified Data.Set as S import System.Directory( doesDirectoryExist , doesFileExist) import System.FilePath((</>))-import Control.Monad(filterM, liftM)+import Control.Monad +import Distribution.Gentoo.Util+ -- ----------------------------------------------------------------------------- -- Representation of a cat/pkgname in Gentoo. Note that this is@@ -107,7 +104,7 @@ isVerFront _ = False pkgPath :: VCatPkg -> FilePath-pkgPath (c,vp) = pkgDBDir </> c </> vp+pkgPath (c, vp) = pkgDBDir </> c </> vp pkgDBDir :: FilePath pkgDBDir = "/var/db/pkg"@@ -119,16 +116,12 @@ -- Representation of individual lines in a CONTENTS file. data Content = Dir BSFilePath | Obj BSFilePath- deriving (Eq, Show)+ deriving (Eq, Show, Ord) isDir :: Content -> Bool isDir (Dir _) = True isDir _ = False -isObj :: Content -> Bool-isObj (Obj _) = True-isObj _ = False- pathOf :: Content -> BSFilePath pathOf (Dir dir) = dir pathOf (Obj obj) = obj@@ -141,9 +134,6 @@ hasDirMatching :: (BSFilePath -> Bool) -> [Content] -> Bool hasDirMatching p = hasContentMatching p . filter isDir -hasObjMatching :: (BSFilePath -> Bool) -> [Content] -> Bool-hasObjMatching p = hasContentMatching p . filter isObj- -- Parse the CONTENTS file. parseContents :: VCatPkg -> IO [Content] parseContents cp = do ex <- doesFileExist cFile@@ -177,20 +167,40 @@ -- ----------------------------------------------------------------------------- --- Find all the packages that contain any of the given files.-haveFiles :: [FilePath] -> IO [Package]-haveFiles fps = pkgsHaveContent p+-- Find all the packages that contain given files.+resolveFiles :: [FilePath] -> IO [(FilePath, Package)]+resolveFiles fps = liftM expand $ forPkg grep where- fps' = S.fromList $ map BS.pack fps- p = hasObjMatching (`S.member` fps')+ fps' = S.fromList $ map (Obj . BS.pack) fps+ expand pfs = [ (BS.unpack fn, pn)+ | (pn, conts) <- pfs+ , Obj fn <- conts+ ]+ grep pn cont = Just (pn, filter (\e -> S.member e fps') cont) +-- | Run predecate 'p' for each installed package+-- and gather all 'Just' values+forPkg :: (Package -> [Content] -> Maybe a) -> IO [a]+forPkg p = do+ categories <- installedCats+ liftM catMaybes $ do+ (flip concatMapM) categories $ \cat -> do+ maybe_pkgs <- getDirectoryContents' (pkgDBDir </> cat)+ packages <- filterM (\pn' -> doesDirectoryExist $ pkgPath (cat, pn')) maybe_pkgs+ forM packages $ \pkg -> do+ let cp = (cat, pkg)+ cpn <- toPackage cp+ cont <- parseContents cp+ return $ p cpn cont+ -- Find which packages have Content information that matches the -- provided predicate; to be used with the searching predicates -- above. pkgsHaveContent :: ([Content] -> Bool) -> IO [Package]-pkgsHaveContent p = do cs <- installedCats'- cps <- concatMapM (catHasContent p) cs- mapM toPackage cps+pkgsHaveContent p = forPkg p'+ where p' pn cont = if p cont+ then Just pn+ else Nothing -- Determine if this is a valid Category (such that at least one -- package in that category has been installed).@@ -205,27 +215,3 @@ -- Return all Categories known in this system. installedCats :: IO [Category] installedCats = filterM isCat =<< getDirectoryContents' pkgDBDir---- We are most likely to need to look in dev-haskell, so put that--- first in our list.-installedCats' :: IO [Category]-installedCats' = do cats <- installedCats- return $ if haskCat `elem` cats- then haskCat : delete haskCat cats- else cats- where- haskCat = "dev-haskell"---- Return all packages in this category whose contents match the--- provided predicate.-catHasContent :: ([Content] -> Bool) -> Category -> IO [VCatPkg]-catHasContent p c = do inDir <- getDirectoryContents' cfp- let psbl = map ((,) c) inDir- pkgs <- filterM (doesDirectoryExist . pkgPath) psbl- filterM (hasContent p) pkgs- where- cfp = pkgDBDir </> c---- Determine if this package matches the predicate.-hasContent :: ([Content] -> Bool) -> VCatPkg -> IO Bool-hasContent p = liftM p . parseContents
haskell-updater.cabal view
@@ -1,6 +1,6 @@ Name: haskell-updater Homepage: http://haskell.org/haskellwiki/Gentoo#haskell-updater-Version: 1.2.5+Version: 1.2.6 Synopsis: Rebuild Haskell dependencies in Gentoo Description: haskell-updater rebuilds Haskell packages on Gentoo after a GHC upgrade or a dependency upgrade.