Add --world-full and --preserved-rebuild

--world-full is an alias for `--world -- --newuse --with-bdeps=y`. This
is added for convenience since these flags often times help portage get
to a state where `emerge --depclean` can be run.

--preserved-rebuild runs basic mode, but appending @preserved-rebuild to
the package list. Also, this mode will loop until the broken list is
unchanged between runs (the same looping behavior as
--mode=reinstall-atoms). This is added for convenience since
@preserved-rebuild often times catches extra breakages, such as haskell
executables with no library.

The hope here is that these options will allow a complete fix of the
system with one command:

    haskell-updater --world-full && \
        emerge --depclean && \
        haskell-updater --preserved-rebuild

Signed-off-by: hololeap <[email protected]>

Author: hololeap

Distribution/Gentoo/CmdLine.hs

@@ -28,13 +28,17 @@ import Distribution.Gentoo.Types
 import qualified Distribution.Gentoo.Types.HUMode as Mode
 import Output
 
+-- | Process arguments from the command line. Returns an error string if the
+--   user provided incorrect or unknown options.
 parseArgs :: PkgManager -> RawPMArgs -> Either String (CmdLineArgs, RawPMArgs)
 parseArgs defPM args = case getOpt' Permute options args of
     (_, _, _, errs@(_:_)) -> Left $ unwords $ "Errors in arguments:" : errs
     (_, _, unk@(_:_), _) -> Left $ unwords $ "Unknown options:" : unk
     (fs, raw, _, _) ->
         (,raw) <$> foldr (>=>) pure fs (defCmdLineArgs defPM)
 
+-- | Parse processed command line arguments into a 'Mode.HUMode'. Returns an
+--   error string if the user supplied non-compatible option combinations.
 mkHUMode :: CmdLineArgs -> RawPMArgs -> Either String Mode.HUMode
 mkHUMode cmdLine raw
     | cmdLineHelp cmdLine = pure Mode.HelpMode
@@ -52,39 +56,73 @@ mkHUMode cmdLine raw
         pm@(InvalidPM _) -> Left $
             "Invalid package manager in mkHUMode: " ++ show pm
 
+    -- Logic for parsing modes for non-portage package managers
     mkMode :: RunMode -> Either String Mode.RunMode
     mkMode = \case
         BasicMode -> Mode.BasicMode <$> mkTarget (cmdLineTarget cmdLine)
         ListMode -> Mode.ListMode <$> mkTarget (cmdLineTarget cmdLine)
         ReinstallAtomsMode -> Left
             "reinstall-atoms mode is only supported by the portage package manager"
 
-    mkPortageMode
-        :: RunMode
-        -> Either String (Either Mode.RunMode Mode.ReinstallAtomsMode)
-    mkPortageMode = \case
-        BasicMode -> Left . Mode.BasicMode <$> mkTarget (cmdLineTarget cmdLine)
-        ListMode -> Left . Mode.ListMode <$> mkTarget (cmdLineTarget cmdLine)
-        ReinstallAtomsMode -> Right . Mode.ReinstallAtomsMode
-            <$> mkRATarget (cmdLineTarget cmdLine)
-
+    -- Logic for parsing targets for non-portage package managers
     mkTarget :: Either CustomTargets BuildTarget -> Either String Mode.Target
     mkTarget = \case
         Right OnlyInvalid -> Right Mode.OnlyInvalid
         Right AllInstalled -> Right Mode.AllInstalled
+        Right PreservedRebuild -> Left $
+            "preserved-rebuild target is only supported by the portage \
+            \package manager"
         Right WorldTarget -> Left
             "world target is only supported in reinstall-atoms mode"
         Left _ -> Left
             "custom targets are only supported in reinstall-atoms mode"
 
-    mkRATarget
+    -- Logic for parsing modes for portage
+    mkPortageMode
+        :: RunMode
+        -> Either String Mode.PortageMode
+    mkPortageMode = \case
+        BasicMode -> Mode.PortageBasicMode
+            <$> mkPortageBasicTarget (cmdLineTarget cmdLine)
+        ListMode -> Mode.PortageListMode
+            <$> mkPortageTarget (cmdLineTarget cmdLine)
+        ReinstallAtomsMode -> Mode.ReinstallAtomsMode
+            <$> mkPortageRATarget (cmdLineTarget cmdLine)
+
+    -- Logic for parsing targets for portage's basic mode
+    mkPortageBasicTarget
+        :: Either CustomTargets BuildTarget
+        -> Either String (Either Mode.PortageBasicTarget Mode.Target)
+    mkPortageBasicTarget = \case
+        Right PreservedRebuild -> Right $ Left Mode.PreservedRebuild
+        targ -> Right <$> mkPortageTarget targ
+
+    -- Logic for parsing targets for portage's reinstall-atoms mode
+    mkPortageRATarget
         :: Either CustomTargets BuildTarget
         -> Either String (Either Mode.Target Mode.ReinstallAtomsTarget)
-    mkRATarget = Right . \case
-        Right OnlyInvalid -> Left Mode.OnlyInvalid
-        Right AllInstalled -> Left Mode.AllInstalled
-        Right WorldTarget -> Right Mode.WorldTarget
-        Left cts -> Right $ Mode.CustomTargets cts
+    mkPortageRATarget = \case
+        Right WorldTarget -> Right $ Right $
+            if cmdLineWorldFull cmdLine
+                then Mode.WorldFullTarget
+                else Mode.WorldTarget
+        Left cts -> Right $ Right $ Mode.CustomTargets cts
+        targ -> Left <$> mkPortageTarget targ
+
+    -- Logic for parsing targets for portage's list mode; also common logic
+    -- for parsing targets, between portage's basic and reinstall-atoms modes
+    mkPortageTarget
+        :: Either CustomTargets BuildTarget
+        -> Either String Mode.Target
+    mkPortageTarget = \case
+        Right OnlyInvalid -> Right Mode.OnlyInvalid
+        Right AllInstalled -> Right Mode.AllInstalled
+        Right PreservedRebuild -> Left
+            "preserved-rebuild target is only supported in basic mode"
+        Right WorldTarget -> Left
+            "world target is only supported in reinstall-atoms mode"
+        Left _ -> Left
+            "custom targets are only supported in reinstall-atoms mode"
 
     runModifier :: RunModifier
     runModifier = RM
@@ -140,6 +178,16 @@ options =
         ) $      "alias for --package-manager=portage"
          ++ " \\\n          --target=" ++ argString WorldTarget
          ++ " \\\n          --mode=" ++ argString ReinstallAtomsMode
+    , Option [] ["world-full"]
+        (naUpdate $ \c -> updateTarget (Right WorldTarget) c
+            { cmdLinePkgManager = Portage
+            , cmdLineMode = ReinstallAtomsMode
+            , cmdLineWorldFull = True
+            }
+        ) $ "alias for --world -- --newuse --with-bdeps=y"
+    , Option [] ["preserved-rebuild"]
+        (naUpdate $ updateTarget (Right PreservedRebuild))
+        $ "alias for --target=" ++ argString PreservedRebuild
     , Option ['T'] ["custom-target"]
         (ReqArg
             (\s c -> pure $ updateTarget (Left s) c

Distribution/Gentoo/CmdLine/Types.hs

@@ -44,6 +44,7 @@ data CmdLineArgs = CmdLineArgs
     , cmdLineMode :: RunMode
     , cmdLineVerbosity :: Verbosity
     , cmdLineHelp :: Bool
+    , cmdLineWorldFull :: Bool
     } deriving (Show, Eq, Ord)
 
 defCmdLineArgs :: PkgManager -> CmdLineArgs
@@ -57,11 +58,13 @@ defCmdLineArgs defPM = CmdLineArgs
     BasicMode
     Normal
     False
+    False
 
 data BuildTarget
     = OnlyInvalid -- ^ Default
     | AllInstalled -- ^ Rebuild every haskell package
     | WorldTarget -- ^ Target @world portage set
+    | PreservedRebuild -- ^ Append @preserved-rebuild set
     deriving (Eq, Ord, Show, Read, Enum, Bounded)
 
 data RunMode
@@ -106,6 +109,11 @@ instance CmdlineOpt BuildTarget where
         , Just $ "@world set (only valid with portage package\n"
               ++ "manager and reinstall-atoms mode)"
         )
+    argInfo PreservedRebuild =
+        ( "preserved-rebuild"
+        , Just $ "Append @preserved-rebuild set (only valid with\n"
+              ++ "portage package manager and basic mode)"
+        )
 
     optName _ = "target"
     optDescription _ =

Distribution/Gentoo/Types/HUMode.hs

@@ -17,7 +17,8 @@ module Distribution.Gentoo.Types.HUMode
     , runMode
     , Target(..)
     , getTarget
-    , ReinstallAtomsMode(..)
+    , PortageMode(..)
+    , PortageBasicTarget(..)
     , ReinstallAtomsTarget(..)
     , getLoopType
     , getExtraRawArgs
@@ -32,7 +33,7 @@ data HUMode
     deriving (Eq, Ord, Show)
 
 data PkgManager
-    = Portage (Either RunMode ReinstallAtomsMode)
+    = Portage PortageMode
     | PkgCore RunMode
     | Paludis RunMode
     | CustomPM String RunMode
@@ -48,17 +49,23 @@ data Target
     | AllInstalled
     deriving (Eq, Ord, Show)
 
-newtype ReinstallAtomsMode
-    = ReinstallAtomsMode (Either Target ReinstallAtomsTarget)
+data PortageMode
+    = PortageBasicMode (Either PortageBasicTarget Target)
+    | PortageListMode Target
+    | ReinstallAtomsMode (Either Target ReinstallAtomsTarget)
+    deriving (Eq, Ord, Show)
+
+data PortageBasicTarget = PreservedRebuild
     deriving (Eq, Ord, Show)
 
 data ReinstallAtomsTarget
     = WorldTarget
+    | WorldFullTarget
     | CustomTargets CustomTargets
     deriving (Eq, Ord, Show)
 
-runMode :: PkgManager -> Either RunMode ReinstallAtomsMode
-runMode (Portage rm) = rm
+runMode :: PkgManager -> Either RunMode PortageMode
+runMode (Portage rm) = Right rm
 runMode (PkgCore rm) = Left rm
 runMode (Paludis rm) = Left rm
 runMode (CustomPM _ rm) = Left rm
@@ -74,23 +81,39 @@ getTarget (ListMode t) = t
 --   sense.
 getLoopType :: PkgManager -> LoopType
 getLoopType = \case
-    -- Even @--mode=reinstall-atoms@ should not loop if @--target=all@ is set
-    Portage (Right (ReinstallAtomsMode (Left AllInstalled))) -> NoLoop
-    Portage (Right (ReinstallAtomsMode _)) -> UntilNoChange
-    Portage (Left mode) -> fromRunMode mode
+    -- @--mode=reinstall-atoms@ should not loop if @--target=all@ is set
+    Portage (ReinstallAtomsMode (Left AllInstalled)) -> NoLoop
+
+    -- otherwise, it should always use UntilNoChange
+    Portage (ReinstallAtomsMode _) -> UntilNoChange
+
+    -- @--target=preserved-rebuild@ should use UntilNoChange
+    Portage (PortageBasicMode (Left PreservedRebuild)) -> UntilNoChange
+
+    -- The rest follow a standard pattern
+    Portage (PortageBasicMode (Right t)) -> fromTarget t
+    Portage (PortageListMode _) -> NoLoop
     PkgCore mode -> fromRunMode mode
     Paludis mode -> fromRunMode mode
     CustomPM _ mode -> fromRunMode mode
   where
     fromRunMode :: RunMode -> LoopType
     fromRunMode = \case
-        BasicMode _ -> UntilNoPending
+        BasicMode t -> fromTarget t
         ListMode _ -> NoLoop
 
+    fromTarget :: Target -> LoopType
+    fromTarget = \case
+        OnlyInvalid -> UntilNoPending
+        AllInstalled -> NoLoop
+
 -- | Convert from the @haskell-updater@ ADT to 'ExtraRawArgs', hard-coded extra
 --   arguments that will be passed to the package manager.
 --
 --   Takes a 'PkgManager' as 'RunMode' is the only mode which runs a package
 --   manager.
 getExtraRawArgs :: PkgManager -> ExtraRawArgs
-getExtraRawArgs _ = ExtraRawArgs [] -- currently unused feature
+getExtraRawArgs = ExtraRawArgs . \case
+    Portage (ReinstallAtomsMode (Right WorldFullTarget)) ->
+        ["--newuse", "--with-bdeps=y"]
+    _ -> []

Main.hs

@@ -84,16 +84,18 @@ runUpdater rm pkgMgr userArgs = do
     systemInfo rm pkgMgr userArgs
     (ps, ts, bps) <- getPackageState v pkgMgr
     case runMode pkgMgr of
-        Left (ListMode _) -> do
-            mapM_ (putStrLn . printPkg) (getPkgs ps)
-            success v "done!"
+        Left (ListMode _) -> listPkgs ps
+        Right (PortageListMode _) -> listPkgs ps
         _ -> case getLoopType pkgMgr of
             UntilNoPending -> loopUntilNoPending ps ts bps Seq.empty
             UntilNoChange -> loopUntilNoChange ps ts bps Seq.empty
             NoLoop -> buildPkgs rm rawArgs ps ts bps >>= exitWith
     success v "done!"
   where
-    v = verbosity rm
+    listPkgs :: PendingPackages -> IO ()
+    listPkgs ps = do
+        mapM_ (putStrLn . printPkg) (getPkgs ps)
+        success v "done!"
 
     loopUntilNoPending :: UpdaterLoop
     loopUntilNoPending ps ts bps hist
@@ -125,6 +127,7 @@ runUpdater rm pkgMgr userArgs = do
         die "Updater stuck in the loop and can't progress"
 
     rawArgs = getExtraRawArgs pkgMgr
+    v = verbosity rm
 
 -- | Determines which function 'buildPkgs' will run to get the package-manager
 --   command.
@@ -141,11 +144,13 @@ getPackageState
     -> IO (PendingPackages, Set.Set Types.Target, BuildPkgs)
 getPackageState v pkgMgr =
     case runMode pkgMgr of
-        Left mode -> do
-            p <- case getTarget mode of
-                OnlyInvalid -> InvalidPending <$> getInvalid
-                AllInstalled -> AllPending <$> getAll
-            pure (p, Set.empty, BuildNormal pkgMgr)
+        Left mode -> fromRunMode mode
+        Right (PortageBasicMode (Left PreservedRebuild)) -> do
+            p <- InvalidPending <$> getInvalid
+            let s = Set.singleton $ CustomTarget "@preserved-rebuild"
+            pure (p, s, BuildNormal pkgMgr)
+        Right (PortageBasicMode (Right targ)) -> fromRunMode (BasicMode targ)
+        Right (PortageListMode targ) -> fromRunMode (ListMode targ)
         Right (ReinstallAtomsMode targ) -> do
             aps <- getAll
             (p,ts) <- case targ of
@@ -158,10 +163,20 @@ getPackageState v pkgMgr =
                     ips <- getInvalid
                     let ts = case t of
                             WorldTarget -> Set.singleton (CustomTarget "@world")
+                            WorldFullTarget -> Set.singleton (CustomTarget "@world")
                             CustomTargets cts -> Set.fromList (CustomTarget <$> cts)
                     pure (InvalidPending ips, ts)
             pure (p, ts, BuildRAMode aps)
   where
+    fromRunMode
+        :: RunMode
+        -> IO (PendingPackages, Set.Set Types.Target, BuildPkgs)
+    fromRunMode mode = do
+        p <- case getTarget mode of
+            OnlyInvalid -> InvalidPending <$> getInvalid
+            AllInstalled -> AllPending <$> getAll
+        pure (p, Set.empty, BuildNormal pkgMgr)
+
     getInvalid = do
         say v "Searching for packages installed with a different version of GHC."
         say v ""
@@ -279,25 +294,37 @@ systemInfo rm pkgMgr rawArgs = do
     v = verbosity rm
 
     (m, ts) = case runMode pkgMgr of
-        Left mode -> case mode of
-            BasicMode OnlyInvalid ->
-                (CmdLine.BasicMode, argString CmdLine.OnlyInvalid)
-            BasicMode AllInstalled ->
-                (CmdLine.BasicMode, argString CmdLine.AllInstalled)
-            ListMode OnlyInvalid ->
-                (CmdLine.ListMode, argString CmdLine.OnlyInvalid)
-            ListMode AllInstalled ->
-                (CmdLine.ListMode, argString CmdLine.AllInstalled)
+        Left mode -> printRunMode mode
+        Right (PortageBasicMode (Left PreservedRebuild)) ->
+            (CmdLine.BasicMode, argString CmdLine.PreservedRebuild)
+        Right (PortageBasicMode (Right targ)) ->
+            printRunMode (BasicMode targ)
+        Right (PortageListMode targ) ->
+            printRunMode (ListMode targ)
         Right (ReinstallAtomsMode targ) -> case targ of
             Left OnlyInvalid ->
                 (CmdLine.ReinstallAtomsMode, argString CmdLine.OnlyInvalid)
             Left AllInstalled ->
                 (CmdLine.ReinstallAtomsMode, argString CmdLine.AllInstalled)
             Right WorldTarget ->
                 (CmdLine.ReinstallAtomsMode, argString CmdLine.WorldTarget)
+            Right WorldFullTarget ->
+                (CmdLine.ReinstallAtomsMode, unwords
+                    [argString CmdLine.WorldTarget, "(full)"])
             Right (CustomTargets cts) ->
                 (CmdLine.ReinstallAtomsMode, unwords cts)
 
+    printRunMode :: RunMode -> (CmdLine.RunMode, String)
+    printRunMode = \case
+        BasicMode OnlyInvalid ->
+            (CmdLine.BasicMode, argString CmdLine.OnlyInvalid)
+        BasicMode AllInstalled ->
+            (CmdLine.BasicMode, argString CmdLine.AllInstalled)
+        ListMode OnlyInvalid ->
+            (CmdLine.ListMode, argString CmdLine.OnlyInvalid)
+        ListMode AllInstalled ->
+            (CmdLine.ListMode, argString CmdLine.AllInstalled)
+
 -- -----------------------------------------------------------------------------
 -- Utility functions