Skip to content

Commit f70e076

Browse files
hololeaphololeap
committed
Implement custom targets for --reinstall-atoms
Add the option to specify custom targets using -T or --custom-target on the command line. This option may be given multiple times and it will override any non-custom targets that are given. It automatically enables --package-manager=portage and --mode=reinstall-targets. Signed-off-by: hololeap <[email protected]>
1 parent 95d67dc commit f70e076

File tree

6 files changed

+90
-33
lines changed

6 files changed

+90
-33
lines changed

‎Distribution/Gentoo/CmdLine.hs

+60-22
Original file line numberDiff line numberDiff line change
@@ -63,28 +63,40 @@ mkHUMode :: CmdLineArgs -> RawPMArgs -> Either String Mode.HUMode
6363
mkHUMode cmdLine raw
6464
| cmdLineHelp cmdLine = pure Mode.HelpMode
6565
| cmdLineVersion cmdLine = pure Mode.VersionMode
66-
| otherwise = fmap (Mode.RunMode runModifier)
67-
$ go $ maybe
68-
(cmdLinePkgManager cmdLine)
69-
CustomPM
70-
(cmdLineCustomPM cmdLine)
66+
| otherwise = do
67+
let pkgMgr = maybe
68+
(cmdLinePkgManager cmdLine)
69+
CustomPM
70+
(cmdLineCustomPM cmdLine)
71+
mPkgMgr <- go pkgMgr
72+
pure $ Mode.RunMode runModifier mPkgMgr
7173
where
7274
go :: PkgManager -> Either String Mode.PkgManager
7375
go pkgMgr = case (pkgMgr, cmdLineMode cmdLine, cmdLineTarget cmdLine) of
74-
(Portage, ReinstallAtomsMode, WorldTarget) -> pure
76+
(Portage, ReinstallAtomsMode, Right WorldTarget) -> pure
7577
$ Mode.Portage $ Right $ Mode.ReinstallAtomsMode
7678
$ Right $ Mode.WorldTarget
77-
(Portage, _, WorldTarget) -> Left
79+
(Portage, ReinstallAtomsMode, Left targs) -> pure
80+
$ Mode.Portage $ Right $ Mode.ReinstallAtomsMode
81+
$ Right $ Mode.CustomTargets targs
82+
(Portage, _, Right WorldTarget) -> Left
7883
"\"world\" target is only valid with reinstall-atoms mode"
79-
(Portage, ReinstallAtomsMode, targ) -> pure
84+
(Portage, _, Left _) -> Left
85+
"custom targets are only valid with reinstall-atoms mode"
86+
(Portage, ReinstallAtomsMode, Right targ) -> pure
8087
$ Mode.Portage $ Right $ Mode.ReinstallAtomsMode
8188
$ Left $ convTarget targ
82-
(_, ReinstallAtomsMode, WorldTarget) -> Left
89+
(_, ReinstallAtomsMode, Right WorldTarget) -> Left
8390
"\"world\" target is only valid with portage package manager"
84-
(_, ReinstallAtomsMode, _) -> Left $ unwords
85-
["\"world\" target is only valid with reinstall-atoms mode and portage"
91+
(_, _, Right WorldTarget) -> Left $ unwords
92+
[ "\"world\" target is only valid with reinstall-atoms mode and portage"
93+
, "package manager"]
94+
(_, _, Left _) -> Left $ unwords
95+
[ "custom targets are only valid with reinstall-atoms mode and portage"
8696
, "package manager"]
87-
(_, mode, targ) -> pure $ convPkgMgr pkgMgr mode targ
97+
(_, ReinstallAtomsMode, _) -> Left
98+
"reinstall-atoms mode is only valid with portage package manager"
99+
(_, mode, Right targ) -> pure $ convPkgMgr pkgMgr mode targ
88100

89101
convPkgMgr :: PkgManager -> RunMode -> BuildTarget -> Mode.PkgManager
90102
convPkgMgr Portage mode targ = Mode.Portage $ Left $ convMode mode targ
@@ -138,7 +150,7 @@ options =
138150
, Option ['C'] ["custom-pm"]
139151
(ReqArg (\s c -> pure $ c { cmdLineCustomPM = Just s }) "command")
140152
$ "Use custom command as package manager;\n"
141-
++ "ignores the --pretend and --no-deep flags."
153+
++ " ignores the --pretend and --no-deep flags."
142154
, Option ['p'] ["pretend"]
143155
(naUpdate $ \c -> c { cmdLinePretend = True } )
144156
"Only pretend to build packages."
@@ -152,27 +164,37 @@ options =
152164
(ReqArg (fromCmdline (\a c -> c { cmdLineAction = a })) "action")
153165
(argHelp (Proxy @WithCmd))
154166
, Option [] ["target"]
155-
(ReqArg (fromCmdline (\a c -> c { cmdLineTarget = a })) "target")
167+
(ReqArg (fromCmdline (\a -> updateTarget (Right a))) "target")
156168
(argHelp (Proxy @BuildTarget))
157169
, Option ['c'] ["dep-check"]
158-
(naUpdate $ \c -> c { cmdLineTarget = OnlyInvalid })
170+
(naUpdate $ updateTarget (Right OnlyInvalid))
159171
$ "alias for --target=" ++ argString OnlyInvalid
160172
-- deprecated alias for 'dep-check'
161173
, Option ['u'] ["upgrade"]
162-
(naUpdate $ \c -> c { cmdLineTarget = OnlyInvalid })
174+
(naUpdate $ updateTarget (Right OnlyInvalid))
163175
$ "alias for --target=" ++ argString OnlyInvalid
164176
, Option ['a'] ["all"]
165-
(naUpdate $ \c -> c { cmdLineTarget = AllInstalled })
177+
(naUpdate $ updateTarget (Right AllInstalled))
166178
$ "alias for --target=" ++ argString AllInstalled
167179
, Option ['W'] ["world"]
168-
(naUpdate $ \r -> r
180+
(naUpdate $ \c -> updateTarget (Right WorldTarget) c
169181
{ cmdLinePkgManager = Portage
170-
, cmdLineTarget = WorldTarget
171182
, cmdLineMode = ReinstallAtomsMode
172183
}
173184
) $ "alias for --package-manager=portage"
174185
++ " \\\n --target=" ++ argString WorldTarget
175186
++ " \\\n --mode=" ++ argString ReinstallAtomsMode
187+
, Option ['T'] ["custom-target"]
188+
(ReqArg
189+
(\s c -> pure $ updateTarget (Left s) c
190+
{ cmdLinePkgManager = Portage
191+
, cmdLineMode = ReinstallAtomsMode
192+
}
193+
)
194+
"target")
195+
$ "Use a custom target. May be given multiple times.\n"
196+
++ " Enables portage PM and reinstall-targets mode.\n"
197+
++ " Will override any non-custom targets."
176198
, Option [] ["mode"]
177199
(ReqArg (fromCmdline (\a c -> c { cmdLineMode = a })) "mode")
178200
(argHelp (Proxy @RunMode))
@@ -207,9 +229,25 @@ options =
207229

208230
pmList = unlines . map (" * " ++) $ definedPMs
209231
defPM = "The last valid value of PM specified is chosen.\n\
210-
\The default package manager is: " ++ defaultPMName ++ ",\n\
211-
\which can be overriden with the \"PACKAGE_MANAGER\"\n\
212-
\environment variable."
232+
\ The default package manager is: " ++ defaultPMName ++ ",\n\
233+
\ which can be overriden with the \"PACKAGE_MANAGER\"\n\
234+
\ environment variable."
235+
236+
-- Custom targets always override BuildTargets
237+
-- New custom targets are appended to old custom targets
238+
-- New BuildTargets override old BuildTargets
239+
updateTarget :: Either String BuildTarget -> CmdLineArgs -> CmdLineArgs
240+
updateTarget new old =
241+
let newT = case (new, cmdLineTarget old) of
242+
-- Override old BuildTargets with new BuildTargets
243+
(Right t, Right _) -> Right t
244+
-- Append new custom target
245+
(Left s, Left ss) -> Left $ ss ++ [s]
246+
-- Drop old BuildTargets for new custom target
247+
(Left s, Right _) -> Left [s]
248+
-- Drop new BuildTargets in favor of old custom targets
249+
(Right _, Left ss) -> Left ss
250+
in old { cmdLineTarget = newT }
213251

214252

215253

‎Distribution/Gentoo/CmdLine/Types.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ data CmdLineArgs = CmdLineArgs
1414
, cmdLineNoDeep :: Bool
1515
, cmdLineVersion :: Bool
1616
, cmdLineAction :: WithCmd
17-
, cmdLineTarget :: BuildTarget
17+
, cmdLineTarget :: Either CustomTargets BuildTarget
1818
, cmdLineMode :: RunMode
1919
, cmdLineVerbosity :: Verbosity
2020
, cmdLineHelp :: Bool
@@ -28,7 +28,7 @@ defCmdLineArgs defPM = CmdLineArgs
2828
False
2929
False
3030
PrintAndRun
31-
OnlyInvalid
31+
(Right OnlyInvalid)
3232
BasicMode
3333
Normal
3434
False

‎Distribution/Gentoo/PkgManager.hs

+2
Original file line numberDiff line numberDiff line change
@@ -176,6 +176,8 @@ buildAltCmd fs rawPmFlags raPS allPs =
176176
(raArgs (getPkgs allPs), printPkg <$> Set.toList (getPkgs allPs))
177177
RAModeWorld p ->
178178
(raArgs (getPkgs p), ["@world"])
179+
RAModeCustom ts p ->
180+
(raArgs (getPkgs p), ts)
179181

180182
-- | Generate strings using portage's @--usepkg-exclude@ flag. This filters out
181183
-- dev-haskell/* packages which can be specified using a wildcard, in order

‎Distribution/Gentoo/Types.hs

+5
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module Distribution.Gentoo.Types
55
, RawPMArgs
66
, WithCmd(..)
77
, WithUserCmd
8+
, CustomTargets
89
, PackageState(..)
910
, DefaultModePkgs(..)
1011
, ListModePkgs(..)
@@ -39,6 +40,8 @@ data WithCmd = PrintAndRun
3940

4041
type WithUserCmd = Either String WithCmd
4142

43+
type CustomTargets = [String]
44+
4245
-- | The current package list(s) organized by mode and build target
4346
data PackageState
4447
= DefaultModeState (Maybe DefaultModePkgs)
@@ -60,6 +63,7 @@ data RAModePkgs
6063
= RAModeInvalid InvalidPkgs
6164
| RAModeAll
6265
| RAModeWorld InvalidPkgs
66+
| RAModeCustom CustomTargets InvalidPkgs
6367
deriving (Show, Eq, Ord)
6468

6569
class HasTargets t where
@@ -71,6 +75,7 @@ instance HasTargets PackageState where
7175
targetPkgs (RAModeState _ (RAModeInvalid ps)) = getPkgs ps
7276
targetPkgs (RAModeState ps RAModeAll) = getPkgs ps
7377
targetPkgs (RAModeState _ (RAModeWorld _)) = Set.empty
78+
targetPkgs (RAModeState _ (RAModeCustom _ _)) = Set.empty
7479

7580
instance HasTargets DefaultModePkgs where
7681
targetPkgs (DefaultInvalid ps) = getPkgs ps

‎Distribution/Gentoo/Types/HUMode.hs

+1
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ newtype ReinstallAtomsMode
4040

4141
data ReinstallAtomsTarget
4242
= WorldTarget
43+
| CustomTargets CustomTargets
4344
deriving (Eq, Ord, Show)
4445

4546
runMode :: PkgManager -> Either RunMode ReinstallAtomsMode

‎Main.hs

+20-9
Original file line numberDiff line numberDiff line change
@@ -107,6 +107,11 @@ runDriver rm pkgMgr rawArgs = do
107107
(\ps -> Right (RAModeWorld ps, allPs))
108108
UpdateTargets
109109
ts
110+
RAModeState allPs (RAModeCustom cts ts) ->
111+
continuePass
112+
(\ps -> Right (RAModeCustom cts ps, allPs))
113+
UpdateTargets
114+
ts
110115

111116
where
112117

@@ -162,6 +167,10 @@ getPackageState v pkgMgr =
162167
is <- getInvalid
163168
allPs <- getAll
164169
pure $ RAModeState allPs $ RAModeWorld is
170+
Right (CustomTargets cts) -> do
171+
is <- getInvalid
172+
allPs <- getAll
173+
pure $ RAModeState allPs $ RAModeCustom cts is
165174
Left OnlyInvalid -> do
166175
is <- getInvalid
167176
allPs <- getAll
@@ -281,29 +290,31 @@ systemInfo rm pkgMgr rawArgs = do
281290
say v $ " * Package manager (PM): " ++ nameOfPM (toPkgManager pkgMgr)
282291
unless (null rawArgs) $
283292
say v $ " * PM auxiliary arguments: " ++ unwords rawArgs
284-
say v $ " * Target: " ++ argString t
293+
say v $ " * Targets: " ++ ts
285294
say v $ " * Mode: " ++ argString m
286295
say v ""
287296
where
288297
v = verbosity rm
289298

290-
(m, t) = case runMode pkgMgr of
299+
(m, ts) = case runMode pkgMgr of
291300
Left mode -> case mode of
292301
BasicMode OnlyInvalid ->
293-
(CmdLine.BasicMode, CmdLine.OnlyInvalid)
302+
(CmdLine.BasicMode, argString CmdLine.OnlyInvalid)
294303
BasicMode AllInstalled ->
295-
(CmdLine.BasicMode, CmdLine.AllInstalled)
304+
(CmdLine.BasicMode, argString CmdLine.AllInstalled)
296305
ListMode OnlyInvalid ->
297-
(CmdLine.ListMode, CmdLine.OnlyInvalid)
306+
(CmdLine.ListMode, argString CmdLine.OnlyInvalid)
298307
ListMode AllInstalled ->
299-
(CmdLine.ListMode, CmdLine.AllInstalled)
308+
(CmdLine.ListMode, argString CmdLine.AllInstalled)
300309
Right (ReinstallAtomsMode targ) -> case targ of
301310
Left OnlyInvalid ->
302-
(CmdLine.ReinstallAtomsMode, CmdLine.OnlyInvalid)
311+
(CmdLine.ReinstallAtomsMode, argString CmdLine.OnlyInvalid)
303312
Left AllInstalled ->
304-
(CmdLine.ReinstallAtomsMode, CmdLine.AllInstalled)
313+
(CmdLine.ReinstallAtomsMode, argString CmdLine.AllInstalled)
305314
Right WorldTarget ->
306-
(CmdLine.ReinstallAtomsMode, CmdLine.WorldTarget)
315+
(CmdLine.ReinstallAtomsMode, argString CmdLine.WorldTarget)
316+
Right (CustomTargets cts) ->
317+
(CmdLine.ReinstallAtomsMode, unwords cts)
307318

308319
-- -----------------------------------------------------------------------------
309320
-- Utility functions

0 commit comments

Comments
 (0)