haskell-updater 1.2.0.5 → 1.2.0.6
raw patch · 6 files changed
+171/−135 lines, 6 files
Files
- Distribution/Gentoo/GHC.hs +11/−52
- Distribution/Gentoo/PkgManager.hs +0/−5
- Distribution/Gentoo/Util.hs +6/−1
- Main.hs +109/−73
- Output.hs +40/−0
- haskell-updater.cabal +5/−4
Distribution/Gentoo/GHC.hs view
@@ -11,7 +11,6 @@ ( ghcVersion , ghcLoc , ghcLibDir- , libFronts , oldGhcPkgs , brokenPkgs , allInstalledPackages@@ -25,7 +24,7 @@ import Distribution.Verbosity(silent) import Distribution.Package(PackageIdentifier, packageId) import Distribution.InstalledPackageInfo(InstalledPackageInfo_)-import Distribution.Text(display, simpleParse)+import Distribution.Text(simpleParse) -- Other imports import Data.Char(isDigit)@@ -38,8 +37,7 @@ import System.Directory( canonicalizePath , doesDirectoryExist , findExecutable)-import Control.Monad(foldM, liftM, unless)-+import Control.Monad(foldM, liftM) -- ----------------------------------------------------------------------------- -- Common helper utils, etc.@@ -90,20 +88,6 @@ where isConf file = takeExtension file == ".conf" --- Print a list of packages, with a description of what they are.-pkgListPrint :: String -> [Package] -> IO ()-pkgListPrint desc pkgs- = if null pkgs- then putStrLn $ unwords ["No", desc, "packages found!\n"]- else do putStrLn $ unwords ["Found the following"- , desc, "packages:"]- printList printPkg pkgs- putStrLn ""---- Print a bullet list of values with one value per line.-printList :: (a -> String) -> [a] -> IO ()-printList f = mapM_ (putStrLn . (++) " * " . f)- tryMaybe :: (a -> Maybe b) -> a -> Either a b tryMaybe f a = maybe (Left a) Right $ f a @@ -136,47 +120,26 @@ cfNm :: [([InstalledPackageInfo_ String], String)] -> PackageIdentifier cfNm = packageId . head . fst . head -checkPkgs :: String -> String -> ([PackageIdentifier], [FilePath])- -> IO [Package]-checkPkgs msg typ (pns,cnfs)- = do putStrLn $ "Searching for " ++ msg ++ "."- unless (null pns)- $ unknownPackages pns- (nI, pkgs) <- liftM partitionEithers $ mapM hasFile' cnfs- unless (null nI)- $ unknownFiles nI- let pkgs' = notGHC pkgs- pkgListPrint typ pkgs'- return pkgs+checkPkgs :: ([PackageIdentifier], [FilePath])+ -> IO ([Package],[PackageIdentifier],[FilePath])+checkPkgs (pns,cnfs)+ = do (nI, pkgs) <- liftM partitionEithers $ mapM hasFile' cnfs+ return (pkgs, pns, nI) where hasFile' f = do mp <- hasFile f return $ maybe (Left f) Right mp - unknownPackages ps- = do putStrLn "\nThe following packages don't seem \- \to have been installed by your package manager:"- printList display ps-- unknownFiles fs- = do putStrLn "\nThe following files are those corresponding \- \to packages installed by your package manager\n\- \which can't be matched up to the packages that own them."- printList id fs- -- ----------------------------------------------------------------------------- -- Finding packages installed with other versions of GHC oldGhcPkgs :: IO [Package]-oldGhcPkgs = do putStrLn "Searching for packages installed with a \- \different version of GHC."- thisGhc <- ghcLibDir+oldGhcPkgs = do thisGhc <- ghcLibDir let thisGhc' = BS.pack thisGhc -- It would be nice to do this, but we can't assume -- some crazy user hasn't deleted one of these dirs -- libFronts' <- filterM doesDirectoryExist libFronts pkgs <- liftM notGHC $ concatMapM (checkLibDir thisGhc') libFronts- pkgListPrint "old" pkgs return pkgs -- Find packages installed by other versions of GHC in this possible@@ -219,9 +182,8 @@ -- ----------------------------------------------------------------------------- -- Finding broken packages in this install of GHC.-brokenPkgs :: IO [Package]-brokenPkgs = brokenConfs >>=- checkPkgs "Haskell libraries with broken dependencies" "broken"+brokenPkgs :: IO ([Package],[PackageIdentifier],[FilePath])+brokenPkgs = brokenConfs >>= checkPkgs -- .conf files from broken packages of this GHC version brokenConfs :: IO ([PackageIdentifier], [FilePath])@@ -242,11 +204,8 @@ -- ----------------------------------------------------------------------------- allInstalledPackages :: IO [Package]-allInstalledPackages = do putStrLn "Finding all libraries installed with the \- \current version of GHC."- libDir <- ghcLibDir+allInstalledPackages = do libDir <- ghcLibDir let libDir' = BS.pack libDir pkgs <- liftM notGHC $ pkgsHaveContent $ hasDirMatching (==libDir')- pkgListPrint "installed" pkgs return pkgs
Distribution/Gentoo/PkgManager.hs view
@@ -15,7 +15,6 @@ , defaultPM , defaultPMName , nameOfPM- , dummy , PMFlag(..) , buildCmd ) where@@ -38,10 +37,6 @@ | InvalidPM String | CustomPM String deriving (Eq, Ord, Show, Read)---- | A dummy package manager used for testing purposes.-dummy :: PkgManager-dummy = CustomPM "echo" -- | The default package manager. If the environment variable -- @PACKAGE_MANAGER@ exists, use that; otherwise default to
Distribution/Gentoo/Util.hs view
@@ -6,7 +6,12 @@ Common utility functions. -}-module Distribution.Gentoo.Util where+module Distribution.Gentoo.Util+ ( BSFilePath+ , concatMapM+ , breakAll+ , getDirectoryContents'+ ) where import Data.List(groupBy) import Data.ByteString.Char8(ByteString)
Main.hs view
@@ -7,18 +7,19 @@ The executable module of haskell-updater, which finds Haskell packages to rebuild after a dep upgrade or a GHC upgrade. -}-module Main where+module Main (main) where import Distribution.Gentoo.GHC import Distribution.Gentoo.Packages import Distribution.Gentoo.PkgManager import Distribution.Gentoo.Util +import Distribution.Text(display)+ import Data.Either(partitionEithers) import Data.List(foldl1', nub) import Data.Version(showVersion) import qualified Data.Set as Set-import Data.Set(Set) import qualified Paths_haskell_updater as Paths(version) import System.Console.GetOpt import System.Environment(getArgs, getProgName)@@ -27,18 +28,23 @@ import Control.Monad(liftM, unless) import System.Process(rawSystem) +import Output+ -- ----------------------------------------------------------------------------- -- The overall program. main :: IO ()-main = uncurry runAction =<< parseArgs-+main = do args <- getArgs+ defPM <- defaultPM+ case parseArgs defPM args of+ Left err -> die err+ Right a -> uncurry runAction a -- ----------------------------------------------------------------------------- -- The possible actions that haskell-updater can perform. data Action = Help | Version- | Build { targets :: Set BuildTarget }+ | Build { targets :: Set.Set BuildTarget } -- If anything is added here after Build, MAKE SURE YOU -- UPDATE combineActions or it won't always work! deriving (Eq, Ord, Show, Read)@@ -57,16 +63,22 @@ -- the lower of one is a Build that they're both build. combineActions :: Action -> Action -> Action combineActions a1 a2 = case (a1 `min` a2) of+ Help -> Help+ Version -> Version Build{} -> Build $ targets a1 `Set.union` targets a2- a -> a -runAction :: RunModifier -> Action -> IO a-runAction _ Help = help-runAction _ Version = version-runAction rm (Build ts) = do systemInfo rm- ps <- allGetPackages ts- buildPkgs rm ps-+runAction :: RunModifier -> Action -> IO a+runAction rm action =+ case action of+ Help -> help+ Version -> version+ Build ts -> do systemInfo v rm+ ps <- allGetPackages v ts+ if listOnly rm+ then mapM_ (putStrLn . printPkg) ps+ else buildPkgs rm ps+ success v "done!"+ where v = verbosity rm -- ----------------------------------------------------------------------------- -- The possible things to build. @@ -75,14 +87,39 @@ | AllInstalled deriving (Eq, Ord, Show, Read) -getPackages :: BuildTarget -> IO [Package]-getPackages GhcUpgrade = oldGhcPkgs-getPackages DepCheck = brokenPkgs-getPackages AllInstalled = allInstalledPackages+getPackages :: Verbosity -> BuildTarget -> IO [Package]+getPackages v target =+ case target of+ GhcUpgrade -> do say v "Searching for packages installed with a different version of GHC."+ pkgs <- oldGhcPkgs+ pkgListPrint v "old" pkgs+ return pkgs -allGetPackages :: Set BuildTarget -> IO [Package]-allGetPackages = liftM nub- . concatMapM getPackages+ AllInstalled -> do say v "Finding all libraries installed with the current version of GHC."+ pkgs <- allInstalledPackages+ pkgListPrint v "installed" pkgs+ return pkgs++ DepCheck -> do say v "Searching for Haskell libraries with broken dependencies."+ (pkgs, unknown_packages, unknown_files) <- brokenPkgs+ printUnknownPackages unknown_packages+ printUnknownFiles unknown_files+ pkgListPrint v "broken" (notGHC pkgs)+ return pkgs++ where printUnknownPackages [] = return ()+ printUnknownPackages ps =+ do say v "\nThe following packages don't seem to have been installed by your package manager:"+ printList v display ps+ printUnknownFiles [] = return ()+ printUnknownFiles fs =+ do say v $ "\nThe following files are those corresponding to packages installed by your package manager\n" +++ "which can't be matched up to the packages that own them."+ printList v id fs++allGetPackages :: Verbosity -> Set.Set BuildTarget -> IO [Package]+allGetPackages v = liftM nub+ . concatMapM (getPackages v) . Set.toList -- -----------------------------------------------------------------------------@@ -92,6 +129,8 @@ , flags :: [PMFlag] , withCmd :: WithCmd , rawPMArgs :: [String]+ , verbosity :: Verbosity+ , listOnly :: Bool } deriving (Eq, Ord, Show, Read) @@ -104,7 +143,7 @@ runCmd :: WithCmd -> String -> [String] -> IO a runCmd mode cmd args = case mode of RunOnly -> runCommand cmd args- PrintOnly -> success cmd_line+ PrintOnly -> putStrLn cmd_line >> exitWith (ExitSuccess) PrintAndRun -> putStrLn cmd_line >> runCommand cmd args where cmd_line = unwords (cmd:args) @@ -112,7 +151,7 @@ runCommand cmd args = rawSystem cmd args >>= exitWith buildPkgs :: RunModifier -> [Package] -> IO a-buildPkgs _ [] = success "\nNothing to build!"+buildPkgs rm [] = success (verbosity rm) "\nNothing to build!" buildPkgs rm ps = runCmd (withCmd rm) cmd args where (cmd, args) = buildCmd (pkgmgr rm) (flags rm) (rawPMArgs rm) ps@@ -129,24 +168,22 @@ | RebuildAll | Pretend | NoDeep+ | QuietFlag+ | ListOnlyFlag deriving (Eq, Ord, Show, Read) -parseArgs :: IO (RunModifier, Action)-parseArgs = do args <- getArgs- defPM <- defaultPM- argParser defPM $ getOpt' Permute options args+parseArgs :: PkgManager -> [String] -> Either String (RunModifier, Action)+parseArgs defPM args = argParser defPM $ getOpt' Permute options args -argParser :: PkgManager -> ([Flag], [String], [String], [String])- -> IO (RunModifier, Action)-argParser dPM (fls, nonoptions, unrecognized, []) =- do unless (null unrecognized)- $ putErrLn- $ unwords $ "Unknown options:" : unrecognized- unless (null bPms)- $ putErrLn- $ unwords $ "Unknown package managers:" : bPms- return (rm, a)- where+argParser :: PkgManager+ -> ([Flag], [String], [String], [String])+ -> Either String (RunModifier, Action)+argParser dPM (fls, nonoptions, unrecognized, errs)+ | (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+ | otherwise = Right (rm, a)+ where (fls', as) = partitionBy flagToAction fls a = combineAllActions as (opts, pms) = partitionBy flagToPM fls'@@ -161,10 +198,10 @@ -- We need to get Flags that represent this as well. , withCmd = PrintAndRun , rawPMArgs = nonoptions+ , verbosity = bool Normal Quiet (hasFlag QuietFlag)+ , listOnly = hasFlag ListOnlyFlag } -argParser _ (_, _, _, errs) = die $ unwords $ "Errors in arguments:" : errs- flagToAction :: Flag -> Either Flag Action flagToAction HelpFlag = Right Help flagToAction VersionFlag = Right Version@@ -189,15 +226,19 @@ , Option ['P'] ["package-manager"] (ReqArg PM "PM") $ "Use package manager PM, where PM can be one of:\n" ++ pmList ++ defPM- , Option ['C'] ["--custom-pm"] (ReqArg CustomPMFlag "command")+ , Option ['C'] ["custom-pm"] (ReqArg CustomPMFlag "command") "Use custom command as package manager;\n\ \ignores the --pretend and --no-deep flags." , Option ['p'] ["pretend"] (NoArg Pretend) "Only pretend to build packages." , Option [] ["no-deep"] (NoArg NoDeep) "Don't pull deep dependencies (--deep with emerge)."- , Option ['v'] ["version"] (NoArg VersionFlag)+ , Option ['l'] ["list-only"] (NoArg ListOnlyFlag)+ "Output only list of packages for rebuild. One package per line."+ , Option ['V'] ["version"] (NoArg VersionFlag) "Version information."+ , Option ['q'] ["quiet"] (NoArg QuietFlag)+ "Print only fatal errors (to stderr)." , Option ['h', '?'] ["help"] (NoArg HelpFlag) "Print this help message." ]@@ -212,52 +253,47 @@ -- Printing information. help :: IO a-help = progInfo >>= success+help = progInfo >>= success Normal version :: IO a-version = fmap (++ '-' : showVersion Paths.version) getProgName >>= success--err :: String -> IO a-err msg = liftM addMsg progInfo >>= die- where- addMsg str = msg ++ "\n\n"++ str+version = fmap (++ '-' : showVersion Paths.version) getProgName >>= success Normal progInfo :: IO String progInfo = do pName <- getProgName return $ usageInfo (header pName) options where- header pName = pName ++ " -- Find and rebuild packages broken due to either:\n\- \ * GHC upgrade\n\- \ * Haskell dependency upgrade\n\- \ Default action is to do both.\n\- \\n\- \Usage: " ++ pName ++ " [Options [-- [PM options]]\n\- \\n\- \\n\- \Options:"+ header pName = unlines [ pName ++ " -- Find and rebuild packages broken due to either:"+ , " * GHC upgrade"+ , " * Haskell dependency upgrade"+ , " Default action is to do both."+ , ""+ , "Usage: " ++ pName ++ " [Options [-- [PM options]]"+ , ""+ , ""+ , "Options:"] -systemInfo :: RunModifier -> IO ()-systemInfo rm = do ver <- ghcVersion- pName <- getProgName- pLoc <- ghcLoc- libDir <- ghcLibDir- putStrLn $ "Running " ++ pName ++ " using GHC " ++ ver- putStrLn $ " * Executable: " ++ pLoc- putStrLn $ " * Library directory: " ++ libDir- putStrLn $ " * Package manager (PM): " ++ nameOfPM (pkgmgr rm)- unless (null (rawPMArgs rm)) $- putStrLn $ " * PM auxiliary arguments: " ++ unwords (rawPMArgs rm)- putStrLn ""+systemInfo :: Verbosity -> RunModifier -> IO ()+systemInfo v rm = do ver <- ghcVersion+ pName <- getProgName+ pLoc <- ghcLoc+ libDir <- ghcLibDir+ say v $ "Running " ++ pName ++ " using GHC " ++ ver+ say v $ " * Executable: " ++ pLoc+ say v $ " * Library directory: " ++ libDir+ say v $ " * Package manager (PM): " ++ nameOfPM (pkgmgr rm)+ unless (null (rawPMArgs rm)) $+ say v $ " * PM auxiliary arguments: " ++ unwords (rawPMArgs rm)+ say v "" -- ----------------------------------------------------------------------------- -- Utility functions -success :: String -> IO a-success msg = do putStrLn msg- exitWith ExitSuccess+success :: Verbosity -> String -> IO a+success v msg = do say v msg+ exitWith ExitSuccess die :: String -> IO a-die msg = do putErrLn msg+die msg = do putErrLn ("ERROR: " ++ msg) exitWith (ExitFailure 1) putErrLn :: String -> IO ()
+ Output.hs view
@@ -0,0 +1,40 @@+{- |+ Module : Main+ Description : The haskell-updater executable+ License : GPL-2 or later++ Fancy output facility.+-}+module Output (+ pkgListPrint+ , printList+ , say+ , Verbosity(..)+ ) where++import System.IO (hPutStrLn, stderr)++import Distribution.Gentoo.Packages++-- output mode (chattiness)+data Verbosity = Normal+ | Quiet+ deriving (Eq, Ord, Show, Read)++say :: Verbosity -> String -> IO ()+say Normal msg = hPutStrLn stderr msg+say Quiet _msg = return ()++-- Print a bullet list of values with one value per line.+printList :: Verbosity -> (a -> String) -> [a] -> IO ()+printList v f = mapM_ (say v . (++) " * " . f)++-- Print a list of packages, with a description of what they are.+pkgListPrint :: Verbosity -> String -> [Package] -> IO ()+pkgListPrint v desc pkgs+ = if null pkgs+ then say v $ unwords ["No", desc, "packages found!\n"]+ else do say v $ unwords ["Found the following"+ , desc, "packages:"]+ printList v printPkg pkgs+ say v ""
haskell-updater.cabal view
@@ -1,6 +1,6 @@ Name: haskell-updater Homepage: http://haskell.org/haskellwiki/Gentoo#haskell-updater-Version: 1.2.0.5+Version: 1.2.0.6 Synopsis: Rebuild Haskell dependencies in Gentoo Description: haskell-updater rebuilds Haskell packages on Gentoo after a GHC upgrade or a dependency upgrade.@@ -29,16 +29,17 @@ Extra-Source-Files: TODO Source-Repository head- Type: darcs- Location: http://code.haskell.org/gentoo/haskell-updater/+ Type: git+ Location: git://github.com/gentoo-haskell/haskell-updater.git Executable haskell-updater { Main-Is: Main.hs Other-Modules: Distribution.Gentoo.GHC,- Distribution.Gentoo.Util, Distribution.Gentoo.Packages, Distribution.Gentoo.PkgManager,+ Distribution.Gentoo.Util,+ Output, Paths_haskell_updater Ghc-Options: -Wall Ghc-Prof-Options: -auto-all