haskell-updater 1.2.8 → 1.2.9
raw patch · 6 files changed
+213/−49 lines, 6 files
Files
- Distribution/Gentoo/GHC.hs +69/−28
- Distribution/Gentoo/Packages.hs +9/−1
- Main.hs +59/−16
- TODO +0/−2
- haskell-updater.cabal +3/−2
- man/haskell-updater.1 +73/−0
Distribution/Gentoo/GHC.hs view
@@ -15,6 +15,7 @@ , oldGhcPkgs , brokenPkgs , allInstalledPackages+ , unCPV ) where import Distribution.Gentoo.Util@@ -33,7 +34,6 @@ 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 import System.FilePath((</>), takeExtension, pathSeparator) import System.Directory( canonicalizePath@@ -89,10 +89,20 @@ ghcPkgLoc :: IO FilePath ghcPkgLoc = liftM fromJust $ findExecutable "ghc-pkg" +data ConfSubdir = GHCConfs+ | GentooConfs++subdirToDirname :: ConfSubdir -> FilePath+subdirToDirname subdir =+ case subdir of+ GHCConfs -> "package.conf.d"+ GentooConfs -> "gentoo"+ -- Return the Gentoo .conf files found in this GHC libdir-confFiles :: FilePath -> FilePath -> IO [FilePath]-confFiles subdir dir = do- let gDir = dir </> subdir+listConfFiles :: ConfSubdir -> IO [FilePath]+listConfFiles subdir = do+ dir <- ghcLibDir+ let gDir = dir </> subdirToDirname subdir exists <- doesDirectoryExist gDir if exists then do conts <- getDirectoryContents' gDir@@ -105,18 +115,24 @@ tryMaybe :: (a -> Maybe b) -> a -> Either a b tryMaybe f a = maybe (Left a) Right $ f a -type CabalPV = String -- serialized 'PackageIdentifier'-type ConfMap = Map CabalPV FilePath+newtype CabalPV = CPV { unCPV :: String } -- serialized 'PackageIdentifier'+ deriving (Ord, Eq) -- for ConfMap, can be removed once ConfMap goes away +-- Unique (normal) or multiple (broken) mapping+type ConfMap = Map.Map CabalPV [FilePath]++pushConf :: ConfMap -> CabalPV -> FilePath -> ConfMap+pushConf m k v = Map.insertWith (++) k [v] m+ -- Attempt to match the provided broken package to one of the -- installed packages.-matchConf :: ConfMap -> CabalPV -> Either CabalPV FilePath+matchConf :: ConfMap -> CabalPV -> Either CabalPV [FilePath] matchConf = tryMaybe . flip Map.lookup --- Read in all Gentoo .conf files from the current GHC version and+-- Fold Gentoo .conf files from the current GHC version and -- create a Map-readConf :: Verbosity -> FilePath -> IO ConfMap-readConf v conf_subdir = ghcLibDir >>= confFiles conf_subdir >>= foldM (addConf v) Map.empty+foldConf :: Verbosity -> [FilePath] -> IO ConfMap+foldConf v = foldM (addConf v) Map.empty -- cabal package text format -- "[InstalledPackageInfo {installedPackageId = Insta..."@@ -128,7 +144,7 @@ -- for this version of GHC will have a .conf -- file containing just [] [([],_)] -> Nothing- rd -> Just $ display $ cfNm rd+ rd -> Just $ CPV $ display $ cfNm rd where -- It's not InstalledPackageInfo, as it can't read the modules cfNm :: [([InstalledPackageInfo_ String], String)] -> PackageIdentifier@@ -143,7 +159,7 @@ case (map BS.words . BS.lines) cont of ( [name_key, bn] : [ver_key, bv] : _) | name_key == BS.pack "name:" && ver_key == BS.pack "version:"- -> Just $ BS.unpack bn ++ "-" ++ BS.unpack bv+ -> Just $ CPV $ BS.unpack bn ++ "-" ++ BS.unpack bv _ -> Nothing -- Add this .conf file to the Map@@ -153,10 +169,10 @@ case ( parse_as_ghc_package cont , parse_as_cabal_package (BS.unpack cont) ) of- (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+ (Just dn, _) -> do vsay v $ unwords [conf, "resolved as ghc package:", unCPV dn]+ return $ pushConf cmp dn conf+ (_, Just dn) -> do vsay v $ unwords [conf, "resolved as cabal package:", unCPV dn]+ return $ pushConf cmp dn conf -- empty files are created for -- phony packages like CABAL_CORE_LIB_GHC_PV -- and binary-only packages.@@ -244,40 +260,49 @@ brokenConfs v = do vsay v "brokenConfs: getting broken output from 'ghc-pkg'" ghc_pkg_brokens <- getBroken- -- Check if we actually have to go look up files and- -- do IO. vsay v $ unwords ["brokenConfs: resolving package names to gentoo equivalents." , show (length ghc_pkg_brokens) , "are broken:"- , L.intercalate " " ghc_pkg_brokens+ , L.intercalate " " (map unCPV 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+ , L.intercalate " " (map unCPV orphan_broken) ] installed_but_not_registered <- getNotRegistered v vsay v $ unwords [ "checkPkgs: ghc .conf not registered:" , show (length installed_but_not_registered) , "are not registered:"- , L.intercalate " " installed_but_not_registered+ , L.intercalate " " (map unCPV installed_but_not_registered) ] - let all_broken = ghc_pkg_brokens ++ orphan_broken ++ installed_but_not_registered+ registered_twice <- getRegisteredTwice v+ vsay v $ unwords [ "checkPkgs: ghc .conf registered twice:"+ , show (length registered_twice)+ , "are registered twice:"+ , L.intercalate " " (map unCPV registered_twice)+ ] + let all_broken = concat [ ghc_pkg_brokens+ , orphan_broken+ , installed_but_not_registered+ , registered_twice+ ]+ vsay v "brokenConfs: reading '*.conf' files"- cnfs <- readConf v "gentoo"+ cnfs <- listConfFiles GentooConfs >>= foldConf 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 (known_broken, orphan_confs ++ L.concat orphans) -- Return the closure of all packages affected by breakage -- in format of ["name-version", ... ] getBroken :: IO [CabalPV]-getBroken = liftM words+getBroken = liftM (map CPV . words) $ ghcPkgRawOut ["check", "--simple-output"] getOrphanBroken :: IO ([CabalPV], [FilePath])@@ -285,7 +310,7 @@ -- 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"+ registered_confs <- listConfFiles GHCConfs confs_to_pkgs <- resolveFiles registered_confs let (conf_files, _conf_pkgs) = unzip confs_to_pkgs orphan_conf_files = registered_confs L.\\ conf_files@@ -301,9 +326,25 @@ -- due to unregistration bugs in old eclass. getNotRegistered :: Verbosity -> IO [CabalPV] getNotRegistered v = do- installed_confs <- readConf v "gentoo"- registered_confs <- readConf v "package.conf.d"+ installed_confs <- listConfFiles GentooConfs >>= foldConf v+ registered_confs <- listConfFiles GHCConfs >>= foldConf v return $ Map.keys installed_confs L.\\ Map.keys registered_confs++-- Return packages, that seem to have+-- been installed more, than once.+-- It usually happens this way:+-- 1. user installs dev-lang/ghc-7.8.4-r0 (comes with bundled transformers-3.0.0.0-ghc-7.8.4-{abi}.conf)+-- 2. user installs dev-haskell/transformers-0.4.3.0 (registered as transformers-0.4.3.0-{abi}.conf)+-- 3. user upgrade up to dev-lang/ghc-7.8.4-r4 (comes with bundled transformers-0.4.3.0-ghc-7.8.4-{abi}.conf)+-- this way we have single package registered twice:+-- transformers-0.4.3.0-ghc-7.8.4-{abi}.conf+-- transformers-0.4.3.0-{abi}.conf+-- It's is easy to fix just by reinstalling transformers.+getRegisteredTwice :: Verbosity -> IO [CabalPV]+getRegisteredTwice v = do+ registered_confs <- listConfFiles GHCConfs >>= foldConf v+ let registered_twice = Map.filter (\fs -> length fs > 1) registered_confs+ return $ Map.keys registered_twice -- -----------------------------------------------------------------------------
Distribution/Gentoo/Packages.hs view
@@ -1,3 +1,4 @@+{-# Language TupleSections #-} {- | Module : Distribution.Gentoo.Packages Description : Dealing with installed packages on Gentoo.@@ -18,6 +19,7 @@ ) where import Data.Char(isDigit, isAlphaNum)+import Data.List(isPrefixOf) import Data.Maybe import qualified Data.ByteString.Char8 as BS import Data.ByteString.Char8(ByteString)@@ -186,12 +188,18 @@ liftM catMaybes $ do (flip concatMapM) categories $ \cat -> do maybe_pkgs <- getDirectoryContents' (pkgDBDir </> cat)- packages <- filterM (\pn' -> doesDirectoryExist $ pkgPath (cat, pn')) maybe_pkgs+ packages <- filterM (isPackage . (cat,)) maybe_pkgs forM packages $ \pkg -> do let cp = (cat, pkg) cpn <- toPackage cp cont <- parseContents cp return $ p cpn cont+ where+ isPackage :: VCatPkg -> IO Bool+ isPackage vcp@(_, vp) = do+ c1 <- doesDirectoryExist $ pkgPath vcp+ let c2 = not $ "-MERGING-" `isPrefixOf` vp+ return $ c1 && c2 -- Find which packages have Content information that matches the -- provided predicate; to be used with the searching predicates
Main.hs view
@@ -14,17 +14,21 @@ import Distribution.Gentoo.PkgManager import Distribution.Gentoo.Util -import Data.Either(partitionEithers)-import Data.List(foldl1', nub)-import Data.Version(showVersion)-import qualified Data.Set as Set-import qualified Paths_haskell_updater as Paths(version)-import System.Console.GetOpt-import System.Environment(getArgs, getProgName)-import System.Exit(ExitCode(..), exitSuccess, exitWith)-import System.IO(hPutStrLn, stderr)-import Control.Monad(liftM, unless)-import System.Process(rawSystem)+import Control.Monad (liftM, unless)+import Data.Char (toLower)+import Data.Either (partitionEithers)+import Data.List (foldl1', nub)+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe (fromJust)+import qualified Data.Set as Set+import Data.Version (showVersion)+import qualified Paths_haskell_updater as Paths (version)+import System.Console.GetOpt+import System.Environment (getArgs, getProgName)+import System.Exit (ExitCode (..), exitSuccess, exitWith)+import System.IO (hPutStrLn, stderr)+import System.Process (rawSystem) import Output @@ -103,7 +107,7 @@ DepCheck -> do say v "Searching for Haskell libraries with broken dependencies." say v "" (pkgs, unknown_packages, unknown_files) <- brokenPkgs v- printUnknownPackagesLn unknown_packages+ printUnknownPackagesLn (map unCPV unknown_packages) printUnknownFilesLn unknown_files pkgListPrintLn v "broken" (notGHC pkgs) return pkgs@@ -121,6 +125,7 @@ say v $ " One of known sources of orphans is packages installed before 01 Jan 2015." say v $ " If you know it's your case you can easily remove such files:" say v $ " # rm -v -- `qfile -o $(ghc --print-libdir)/package.conf.d/*.conf`"+ say v $ " # ghc-pkg recache" say v $ " It will likely need one more 'haskell-updater' run." say v "" @@ -147,6 +152,17 @@ | PrintAndRun deriving (Eq, Ord, Show, Read) +type WithUserCmd = Either String WithCmd++withCmdMap :: Map String WithCmd+withCmdMap = M.fromList [ ("print", PrintOnly)+ , ("run", RunOnly)+ , ("print-and-run", PrintAndRun)+ ]++defaultWithCmd :: String+defaultWithCmd = "print-and-run"+ runCmd :: WithCmd -> String -> [String] -> IO a runCmd mode cmd args = case mode of RunOnly -> runCommand cmd args@@ -178,6 +194,7 @@ | QuietFlag | VerboseFlag | ListOnlyFlag+ | Cmd String deriving (Eq, Ord, Show, Read) parseArgs :: PkgManager -> [String] -> Either String (RunModifier, Action)@@ -190,22 +207,25 @@ | (not . null) errs = Left $ unwords $ "Errors in arguments:" : errs | (not . null) unrecognized = Left $ unwords $ "Unknown options:" : unrecognized | (not . null) bPms = Left $ unwords $ "Unknown package managers:" : bPms+ | (not . null) bCmds = Left $ unwords $ "Unknown action:" : bCmds | otherwise = Right (rm, a) where (fls', as) = partitionBy flagToAction fls a = combineAllActions as- (opts, pms) = partitionBy flagToPM fls'+ (fls'', pms) = partitionBy flagToPM fls' (bPms, pms') = partitionBy isValidPM pms+ (opts, cmds') = partitionBy flagToCmd fls''+ (bCmds, cmds) = partitionBy isValidCmd cmds' pm = emptyElse dPM last pms' opts' = Set.fromList opts+ cmd = emptyElse (fromJust $ M.lookup defaultWithCmd withCmdMap) last cmds hasFlag = flip Set.member opts' pmFlags = bool (PMQuiet:) id (hasFlag QuietFlag) . bool id (PretendBuild:) (hasFlag Pretend) . return $ bool UpdateDeep UpdateAsNeeded (hasFlag NoDeep) rm = RM { pkgmgr = pm , flags = pmFlags- -- We need to get Flags that represent this as well.- , withCmd = PrintAndRun+ , withCmd = cmd , rawPMArgs = nonoptions , verbosity = case () of _ | hasFlag VerboseFlag -> Verbose@@ -227,6 +247,22 @@ flagToPM (PM pm) = Right $ choosePM pm flagToPM f = Left f +flagToCmd :: Flag -> Either Flag WithUserCmd+flagToCmd (Cmd cmd) = Right $ chooseCmd cmd+flagToCmd f = Left f++chooseCmd :: String -> WithUserCmd+chooseCmd cmd = chooseCmd' $ map toLower cmd+ where+ chooseCmd' :: String -> WithUserCmd+ chooseCmd' "run" = Right RunOnly+ chooseCmd' "print" = Right PrintOnly+ chooseCmd' "print-and-run" = Right PrintAndRun+ chooseCmd' c = Left c++isValidCmd :: WithUserCmd -> Either String WithCmd+isValidCmd = id+ options :: [OptDescr Flag] options = [ Option ['c'] ["dep-check"] (NoArg Check)@@ -249,6 +285,9 @@ "Output only list of packages for rebuild. One package per line." , Option ['V'] ["version"] (NoArg VersionFlag) "Version information."+ , Option [] ["action"] (ReqArg Cmd "action")+ $ "Specify whether to run the PM command or just print it\n"+ ++ actionList ++ defAction , Option ['q'] ["quiet"] (NoArg QuietFlag) "Print only fatal errors (to stderr)." , Option ['v'] ["verbose"] (NoArg VerboseFlag)@@ -262,6 +301,9 @@ \The default package manager is: " ++ defaultPMName ++ ",\n\ \which can be overriden with the \"PACKAGE_MANAGER\"\n\ \environment variable."+ actionList = unlines . map (" * " ++) $ M.keys withCmdMap+ defAction = "The last specified action is chosen.\n\+ \The default action is: " ++ defaultWithCmd -- ----------------------------------------------------------------------------- -- Printing information.@@ -289,9 +331,10 @@ systemInfo :: Verbosity -> RunModifier -> IO () systemInfo v rm = do ver <- ghcVersion pName <- getProgName+ let pVer = showVersion Paths.version pLoc <- ghcLoc libDir <- ghcLibDir- say v $ "Running " ++ pName ++ " using GHC " ++ ver+ say v $ "Running " ++ pName ++ "-" ++ pVer ++ " using GHC " ++ ver say v $ " * Executable: " ++ pLoc say v $ " * Library directory: " ++ libDir say v $ " * Package manager (PM): " ++ nameOfPM (pkgmgr rm)
TODO view
@@ -1,5 +1,3 @@-* Have the option to spit out the PM command to be used instead of using it.- * Pretty colours in output? * Detect packages that are installed but not registered with GHC.
haskell-updater.cabal view
@@ -1,6 +1,6 @@ Name: haskell-updater Homepage: http://haskell.org/haskellwiki/Gentoo#haskell-updater-Version: 1.2.8+Version: 1.2.9 Synopsis: Rebuild Haskell dependencies in Gentoo Description: haskell-updater rebuilds Haskell packages on Gentoo after a GHC upgrade or a dependency upgrade.@@ -28,7 +28,8 @@ Maintainer: haskell@gentoo.org Cabal-Version: >= 1.6 Build-Type: Simple-Extra-Source-Files: TODO+Extra-Source-Files: TODO,+ man/haskell-updater.1 Source-Repository head Type: git
+ man/haskell-updater.1 view
@@ -0,0 +1,73 @@+.TH HASKELL-UPDATER "1" "May 2014" "haskell-updater-1.2.1" "User Commands"+.SH NAME+haskell-updater \- Version 1.2.1+.SH SYNOPSIS+.B haskell-updater+[\fIOptions \fR[\fI-- \fR[\fIPM options\fR]]+.SH DESCRIPTION+.SS "haskell-updater \fB\-\-\fR Find and rebuild packages broken due to either:"+.IP+\(bu GHC upgrade+.IP+\(bu Haskell dependency upgrade+.TP+Default action is to do both.+.SH OPTIONS++.TP+\fB\-c\fR \fB\-\-dep\-check\fR+Check dependencies of Haskell packages.+.TP+\fB\-u\fR \fB\-\-upgrade\fR+Rebuild Haskell packages after a GHC upgrade.+.TP+\fB\-a\fR \fB\-\-all\fR+Rebuild all Haskell libraries built with current GHC.+.TP+\fB\-P\fR PM \fB\-\-package\-manager\fR=\fIPM\fR+Use package manager PM, where PM can be one of:+* paludis+* pkgcore+* portage+.IP+The last valid value of PM specified is chosen.+The default package manager is: portage,+which can be overriden with the "PACKAGE_MANAGER"+environment variable.+.TP+\fB\-C\fR command \fB\-\-custom\-pm\fR=\fIcommand\fR+Use custom command as package manager;+ignores the \fB\-\-pretend\fR and \fB\-\-no\-deep\fR flags.+.TP+\fB\-p\fR \fB\-\-pretend\fR+Only pretend to build packages.+.TP+\fB\-\-no\-deep\fR+Don't pull deep dependencies (\fB\-\-deep\fR with emerge).+.TP+\fB\-l\fR \fB\-\-list\-only\fR+Output only list of packages for rebuild. One package per line.+.TP+\fB\-V\fR \fB\-\-version\fR+Version information.+.TP+\fB\-q\fR \fB\-\-quiet\fR+Print only fatal errors (to stderr).+.TP+\fB\-v\fR \fB\-\-verbose\fR+Be more elaborate (to stderr).+.TP+\fB\-h\fR, \-? \fB\-\-help\fR+Print this help message.+.SH EXAMPLES+\(bu Look for broken packages and rebuild them:+.IP+ $> haskell-updater+.TP+\(bu Rebuild all packages:+.IP+ $> haskell-updater --all+.TP+\(bu Run haskell-updater and set an emerge flag, color.+.IP+ $> haskell-updater -- --color=n