haskell-updater 1.2.10 → 1.2.11
raw patch · 4 files changed
+110/−117 lines, 4 files
Files
- Distribution/Gentoo/GHC.hs +1/−1
- Distribution/Gentoo/PkgManager.hs +0/−3
- Main.hs +106/−110
- haskell-updater.cabal +3/−3
Distribution/Gentoo/GHC.hs view
@@ -334,7 +334,7 @@ -- 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)+-- 3. user upgrades 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
Distribution/Gentoo/PkgManager.hs view
@@ -120,7 +120,6 @@ data PMFlag = PretendBuild | UpdateDeep | UpdateAsNeeded- | PMQuiet deriving (Eq, Ord, Show, Read) flagRep :: PkgManager -> PMFlag -> Maybe String@@ -134,7 +133,6 @@ portagePMFlag PretendBuild = Just "--pretend" portagePMFlag UpdateDeep = Just "--deep" portagePMFlag UpdateAsNeeded = Nothing-portagePMFlag PMQuiet = Just "--quiet" pkgcorePMFlag :: PMFlag -> Maybe String pkgcorePMFlag = portagePMFlag -- The options are the same for the 3@@ -144,4 +142,3 @@ cavePMFlag PretendBuild = Just "--no-execute" cavePMFlag UpdateDeep = Just "--complete" cavePMFlag UpdateAsNeeded = Just "--lazy"-cavePMFlag PMQuiet = Nothing -- Just "--quiet"
Main.hs view
@@ -12,13 +12,13 @@ import Distribution.Gentoo.GHC import Distribution.Gentoo.Packages import Distribution.Gentoo.PkgManager-import Distribution.Gentoo.Util -import Control.Monad (liftM, unless)+import Control.Monad (unless)+import qualified Control.Monad as CM import Data.Char (toLower) import Data.Either (partitionEithers)-import Data.List (foldl1', nub) import Data.Map (Map)+import qualified Data.List as L import qualified Data.Map as M import Data.Maybe (fromJust) import qualified Data.Set as Set@@ -32,86 +32,89 @@ import Output --- -------------------------------------------------------------------------------- The overall program.- main :: IO () 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.+ Right a -> runAction a -data Action = Help- | Version- | 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)+runAction :: RunModifier -> IO a+runAction rm+ | showHelp rm = help+ | showVer rm = version+ | otherwise = runDriver rm -defaultAction :: Action-defaultAction = Build $ Set.fromList [GhcUpgrade, DepCheck]+-- set of packages to rebuild at pass number+type DriverHistory = M.Map (Set.Set Package) Int --- Combine all the actions together. If the list is empty, use the--- defaultAction.-combineAllActions :: [Action] -> Action-combineAllActions = emptyElse defaultAction (foldl1' combineActions)+initialHistory :: DriverHistory+initialHistory = M.empty --- Combine two actions together. If they're both Build blah, merge--- them; otherwise, pick the lower of the two (i.e. more important).--- Note that it's safe (at the moment at least) to assume that when--- 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+dumpHistory :: Verbosity -> DriverHistory -> IO ()+dumpHistory v historyMap = do+ say v "Updater's past history:"+ CM.forM_ historyList $ \(n, entry) ->+ say v $ unwords $ ["Pass", show n, " : "] ++ map printPkg (Set.toList entry)+ where historyList :: [(Int, Set.Set Package)]+ historyList = L.sort [ (n, entry) | (entry, n) <- M.toList historyMap ] -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!"+runDriver :: RunModifier -> IO a+runDriver rm = do+ systemInfo v rm t+ updaterPass 1 initialHistory+ success v "done!" where v = verbosity rm--- -------------------------------------------------------------------------------- The possible things to build.+ t = target rm+ updaterPass :: Int -> DriverHistory -> IO ()+ updaterPass n pastHistory = do+ ps <- getTargetPackages v t+ CM.when (listOnly rm) $ do+ mapM_ (putStrLn . printPkg) ps+ success v "done!"+ CM.when (null ps) $+ success (verbosity rm) "\nNothing to build!"+ CM.when (Set.fromList ps `M.member` pastHistory) $ do+ say v "Updater stuck in the loop and can't progress"+ dumpHistory v pastHistory -data BuildTarget = GhcUpgrade- | DepCheck- | AllInstalled+ exitCode <- buildPkgs rm ps++ -- don't try rerun rebuilder for cases where there+ -- is no chance to converge to empty set+ CM.when (target rm == AllInstalled) $+ exitWith exitCode++ -- continue rebuild attempts+ updaterPass (n + 1) $ M.insert (Set.fromList ps) n pastHistory++data BuildTarget = OnlyInvalid+ | AllInstalled -- Rebuild every haskell package deriving (Eq, Ord, Show, Read) -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."- say v ""- pkgs <- oldGhcPkgs v- pkgListPrintLn v "old" pkgs- return pkgs+getTargetPackages :: Verbosity -> BuildTarget -> IO [Package]+getTargetPackages v t =+ case t of+ OnlyInvalid -> do say v "Searching for packages installed with a different version of GHC."+ say v ""+ old <- oldGhcPkgs v+ pkgListPrintLn v "old" old + say v "Searching for Haskell libraries with broken dependencies."+ say v ""+ (broken, unknown_packages, unknown_files) <- brokenPkgs v+ printUnknownPackagesLn (map unCPV unknown_packages)+ printUnknownFilesLn unknown_files+ pkgListPrintLn v "broken" (notGHC broken)++ return $ Set.toList $ Set.fromList $ old ++ broken+ AllInstalled -> do say v "Searching for packages installed with the current version of GHC." say v "" pkgs <- allInstalledPackages pkgListPrintLn v "installed" pkgs return pkgs - DepCheck -> do say v "Searching for Haskell libraries with broken dependencies."- say v ""- (pkgs, unknown_packages, unknown_files) <- brokenPkgs v- printUnknownPackagesLn (map unCPV unknown_packages)- printUnknownFilesLn unknown_files- pkgListPrintLn v "broken" (notGHC pkgs)- return pkgs- where printUnknownPackagesLn [] = return () printUnknownPackagesLn ps = do say v "The following packages are orphan (not installed by your package manager):"@@ -124,29 +127,24 @@ say v $ "It is strongly advised to remove orphans:" 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 $ " # rm -v -- `qfile -o $(ghc --print-libdir)/package.conf.d/*.conf $(ghc --print-libdir)/gentoo/*.conf`" say v $ " # ghc-pkg recache" say v $ " It will likely need one more 'haskell-updater' run." say v "" -allGetPackages :: Verbosity -> Set.Set BuildTarget -> IO [Package]-allGetPackages v = liftM nub- . concatMapM (getPackages v)- . Set.toList---- -------------------------------------------------------------------------------- How to build packages.-+-- Full haskell-updater state data RunModifier = RM { pkgmgr :: PkgManager , flags :: [PMFlag] , withCmd :: WithCmd , rawPMArgs :: [String] , verbosity :: Verbosity , listOnly :: Bool+ , showHelp :: Bool+ , showVer :: Bool+ , target :: BuildTarget } deriving (Eq, Ord, Show, Read) --- At the moment, PrintAndRun is the only option available. data WithCmd = RunOnly | PrintOnly | PrintAndRun@@ -163,18 +161,17 @@ defaultWithCmd :: String defaultWithCmd = "print-and-run" -runCmd :: WithCmd -> String -> [String] -> IO a+runCmd :: WithCmd -> String -> [String] -> IO ExitCode runCmd mode cmd args = case mode of RunOnly -> runCommand cmd args PrintOnly -> putStrLn cmd_line >> exitSuccess PrintAndRun -> putStrLn cmd_line >> runCommand cmd args where cmd_line = unwords (cmd:args) -runCommand :: String -> [String] -> IO a-runCommand cmd args = rawSystem cmd args >>= exitWith+runCommand :: String -> [String] -> IO ExitCode+runCommand cmd args = rawSystem cmd args -buildPkgs :: RunModifier -> [Package] -> IO a-buildPkgs rm [] = success (verbosity rm) "\nNothing to build!"+buildPkgs :: RunModifier -> [Package] -> IO ExitCode buildPkgs rm ps = runCmd (withCmd rm) cmd args where (cmd, args) = buildCmd (pkgmgr rm) (flags rm) (rawPMArgs rm) ps@@ -186,8 +183,7 @@ | VersionFlag | PM String | CustomPMFlag String- | Check- | Upgrade+ | FixInvalid | RebuildAll | Pretend | NoDeep@@ -197,21 +193,20 @@ | Cmd String deriving (Eq, Ord, Show, Read) -parseArgs :: PkgManager -> [String] -> Either String (RunModifier, Action)+parseArgs :: PkgManager -> [String] -> Either String RunModifier parseArgs defPM args = argParser defPM $ getOpt' Permute options args argParser :: PkgManager -> ([Flag], [String], [String], [String])- -> Either String (RunModifier, Action)+ -> Either String RunModifier 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 | (not . null) bCmds = Left $ unwords $ "Unknown action:" : bCmds- | otherwise = Right (rm, a)+ | otherwise = Right rm where- (fls', as) = partitionBy flagToAction fls- a = combineAllActions as+ (fls', ts) = partitionBy flagToTarget fls (fls'', pms) = partitionBy flagToPM fls' (bPms, pms') = partitionBy isValidPM pms (opts, cmds') = partitionBy flagToCmd fls''@@ -220,8 +215,7 @@ 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)+ pmFlags = bool id (PretendBuild:) (hasFlag Pretend) . return $ bool UpdateDeep UpdateAsNeeded (hasFlag NoDeep) rm = RM { pkgmgr = pm , flags = pmFlags@@ -232,15 +226,15 @@ _ | hasFlag QuietFlag -> Quiet _ -> Normal , listOnly = hasFlag ListOnlyFlag+ , showVer = hasFlag VersionFlag+ , showHelp = hasFlag HelpFlag+ , target = last $ OnlyInvalid : ts } -flagToAction :: Flag -> Either Flag Action-flagToAction HelpFlag = Right Help-flagToAction VersionFlag = Right Version-flagToAction Check = Right . Build $ Set.singleton DepCheck-flagToAction Upgrade = Right . Build $ Set.singleton GhcUpgrade-flagToAction RebuildAll = Right . Build $ Set.singleton AllInstalled-flagToAction f = Left f+flagToTarget :: Flag -> Either Flag BuildTarget+flagToTarget FixInvalid = Right OnlyInvalid+flagToTarget RebuildAll = Right AllInstalled+flagToTarget f = Left f flagToPM :: Flag -> Either Flag PkgManager flagToPM (CustomPMFlag pm) = Right $ stringToCustomPM pm@@ -265,9 +259,10 @@ options :: [OptDescr Flag] options =- [ Option ['c'] ["dep-check"] (NoArg Check)+ [ Option ['c'] ["dep-check"] (NoArg FixInvalid) "Check dependencies of Haskell packages."- , Option ['u'] ["upgrade"] (NoArg Upgrade)+ -- deprecated alias for 'dep-check'+ , Option ['u'] ["upgrade"] (NoArg FixInvalid) "Rebuild Haskell packages after a GHC upgrade." , Option ['a'] ["all"] (NoArg RebuildAll) "Rebuild all Haskell libraries built with current GHC."@@ -318,29 +313,30 @@ progInfo = do pName <- getProgName return $ usageInfo (header pName) options where- header pName = unlines [ pName ++ " -- Find and rebuild packages broken due to either:"+ header pName = unlines [ pName ++ " -- Find and rebuild packages broken due to any of:" , " * GHC upgrade" , " * Haskell dependency upgrade"- , " Default action is to do both." , "" , "Usage: " ++ pName ++ " [Options [-- [PM options]]" , "" , "" , "Options:"] -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 ++ "-" ++ pVer ++ " 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 ""+systemInfo :: Verbosity -> RunModifier -> BuildTarget -> IO ()+systemInfo v rm t = do+ ver <- ghcVersion+ pName <- getProgName+ let pVer = showVersion Paths.version+ pLoc <- ghcLoc+ libDir <- ghcLibDir+ 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)+ unless (null (rawPMArgs rm)) $+ say v $ " * PM auxiliary arguments: " ++ unwords (rawPMArgs rm)+ say v $ " * Mode: " ++ show t+ say v "" -- ----------------------------------------------------------------------------- -- Utility functions
haskell-updater.cabal view
@@ -1,6 +1,6 @@ Name: haskell-updater-Homepage: http://haskell.org/haskellwiki/Gentoo#haskell-updater-Version: 1.2.10+Homepage: https://haskell.org/haskellwiki/Gentoo#haskell-updater+Version: 1.2.11 Synopsis: Rebuild Haskell dependencies in Gentoo Description: haskell-updater rebuilds Haskell packages on Gentoo after a GHC upgrade or a dependency upgrade.@@ -33,7 +33,7 @@ Source-Repository head Type: git- Location: git://github.com/gentoo-haskell/haskell-updater.git+ Location: https://github.com/gentoo-haskell/haskell-updater.git Executable haskell-updater Main-Is: Main.hs