Skip to content

Commit c4605a1

Browse files
hasufellhasufell
committed
Merge branch 'issue-1210'
2 parents 03e7986 + 811e2ca commit c4605a1

File tree

11 files changed

+78
-25
lines changed

11 files changed

+78
-25
lines changed

‎lib-opt/GHCup/OptParse/Compile.hs

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,7 @@ data GHCCompileOptions = GHCCompileOptions
8181
, buildFlavour :: Maybe String
8282
, buildSystem :: Maybe BuildSystem
8383
, isolateDir :: Maybe FilePath
84+
, installTargets :: T.Text
8485
} deriving (Eq, Show)
8586

8687

@@ -166,7 +167,7 @@ Examples:
166167

167168
ghcCompileOpts :: Parser GHCCompileOptions
168169
ghcCompileOpts =
169-
(\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir -> GHCCompileOptions {..})
170+
(\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir installTargets -> GHCCompileOptions {..})
170171
<$> ((GHC.SourceDist <$> option
171172
(eitherReader
172173
(first (const "Not a valid version") . version . T.pack)
@@ -315,6 +316,13 @@ ghcCompileOpts =
315316
<> completer (bashCompleter "directory")
316317
)
317318
)
319+
<*> strOption
320+
( long "install-targets"
321+
<> metavar "TARGETS"
322+
<> help "Space separated list of install targets (default: install)"
323+
<> completer (listCompleter ["install", "install_bin", "install_lib", "install_extra", "install_man", "install_docs", "install_data", "update_package_db"])
324+
<> value "install"
325+
)
318326

319327
hlsCompileOpts :: Parser HLSCompileOptions
320328
hlsCompileOpts =
@@ -632,6 +640,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
632640
buildFlavour
633641
buildSystem
634642
(maybe GHCupInternal IsolateDir isolateDir)
643+
installTargets
635644
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
636645
let vi = getVersionInfo targetVer GHC dls
637646
when setCompile $ void $ liftE $

‎lib-opt/GHCup/OptParse/Install.hs

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,7 @@ data InstallOptions = InstallOptions
7171
, instSet :: Bool
7272
, isolateDir :: Maybe FilePath
7373
, forceInstall :: Bool
74+
, installTargets :: T.Text
7475
, addConfArgs :: [T.Text]
7576
} deriving (Eq, Show)
7677

@@ -207,6 +208,13 @@ installOpts tool =
207208
)
208209
<*> switch
209210
(short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)")
211+
<*> strOption
212+
( long "install-targets"
213+
<> metavar "TARGETS"
214+
<> help "Space separated list of install targets (default: install)"
215+
<> completer (listCompleter ["install", "install_bin", "install_lib", "install_extra", "install_man", "install_docs", "install_data", "update_package_db"])
216+
<> value "install"
217+
)
210218
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to bindist configure, prefix with '-- ' (longopts)"))
211219
where
212220
setDefault = case tool of
@@ -345,6 +353,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
345353
(maybe GHCupInternal IsolateDir isolateDir)
346354
forceInstall
347355
addConfArgs
356+
installTargets
348357
)
349358
$ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
350359
pure vi
@@ -362,6 +371,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
362371
(maybe GHCupInternal IsolateDir isolateDir)
363372
forceInstall
364373
addConfArgs
374+
installTargets
365375
)
366376
$ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
367377
pure vi

‎lib-opt/GHCup/OptParse/Run.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -382,6 +382,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
382382
GHCupInternal
383383
False
384384
[]
385+
(T.pack "install")
385386
setGHC' v tmp
386387
_ -> pure ()
387388
case cabalVer of

‎lib-tui/GHCup/Brick/Actions.hs

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -193,6 +193,7 @@ installWithOptions opts (_, ListResult {..}) = do
193193
shouldForce = opts ^. AdvanceInstall.forceInstallL
194194
shouldSet = opts ^. AdvanceInstall.instSetL
195195
extraArgs = opts ^. AdvanceInstall.addConfArgsL
196+
installTargets = opts ^. AdvanceInstall.installTargetsL
196197
v = fromMaybe (GHCTargetVersion lCross lVer) (opts ^. AdvanceInstall.instVersionL)
197198
toolV = _tvVersion v
198199
let run =
@@ -242,7 +243,7 @@ installWithOptions opts (_, ListResult {..}) = do
242243
Nothing -> do
243244
liftE $
244245
runBothE'
245-
(installGHCBin v shouldIsolate shouldForce extraArgs)
246+
(installGHCBin v shouldIsolate shouldForce extraArgs installTargets)
246247
(when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
247248
pure (vi, dirs, ce)
248249
Just uri -> do
@@ -253,7 +254,9 @@ installWithOptions opts (_, ListResult {..}) = do
253254
v
254255
shouldIsolate
255256
shouldForce
256-
extraArgs)
257+
extraArgs
258+
installTargets
259+
)
257260
(when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
258261
pure (vi, dirs, ce)
259262

@@ -340,7 +343,7 @@ installWithOptions opts (_, ListResult {..}) = do
340343

341344
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
342345
=> (Int, ListResult) -> m (Either String ())
343-
install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing Nothing False [])
346+
install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing Nothing False [] "install")
344347

345348
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
346349
=> (Int, ListResult)
@@ -538,6 +541,7 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do
538541
(compopts ^. CompileGHC.buildFlavour)
539542
(compopts ^. CompileGHC.buildSystem)
540543
(maybe GHCupInternal IsolateDir $ compopts ^. CompileGHC.isolateDir)
544+
(compopts ^. CompileGHC.installTargets)
541545
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask
542546
let vi2 = getVersionInfo targetVer GHC dls2
543547
when

‎lib-tui/GHCup/Brick/Common.hs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@ module GHCup.Brick.Common (
4848
, BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
4949
, CompileGHCButton, CompileHLSButton, CabalProjectEditBox
5050
, CabalProjectLocalEditBox, UpdateCabalCheckBox, GitRefEditBox
51-
, BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox
51+
, BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox, GHCInstallTargets
5252
) ) where
5353

5454
import GHCup.List ( ListResult )
@@ -136,6 +136,9 @@ pattern HadrianGhcSelectBox = ResourceId 22
136136
pattern ToolVersionBox :: ResourceId
137137
pattern ToolVersionBox = ResourceId 23
138138

139+
pattern GHCInstallTargets :: ResourceId
140+
pattern GHCInstallTargets = ResourceId 24
141+
139142
-- | Name data type. Uniquely identifies each widget in the TUI.
140143
-- some constructors might end up unused, but still is a good practise
141144
-- to have all of them defined, just in case

‎lib-tui/GHCup/Brick/Widgets/Menu.hs

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -248,8 +248,8 @@ createCheckBoxField name access = MenuField access createCheckBoxInput "" Valid
248248

249249
type EditableField = MenuField
250250

251-
createEditableInput :: (Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (EditState n) n
252-
createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit handler
251+
createEditableInput :: (Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (EditState n) n
252+
createEditableInput initText name validator = FieldInput initEdit validateEditContent "" drawEdit handler
253253
where
254254
drawEdit focus errMsg help label (EditState edi overlayOpen) amp = (field, mOverlay)
255255
where
@@ -258,6 +258,8 @@ createEditableInput name validator = FieldInput initEdit validateEditContent ""
258258
borderBox w = amp (Brick.vLimit 1 $ Border.vBorder <+> Brick.padRight Brick.Max w <+> Border.vBorder)
259259
editorContents = Brick.txt $ T.unlines $ Edit.getEditContents edi
260260
isEditorEmpty = Edit.getEditContents edi == [mempty]
261+
|| Edit.getEditContents edi == [initText]
262+
261263
in case errMsg of
262264
Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help
263265
| otherwise -> borderBox editorContents
@@ -287,12 +289,15 @@ createEditableInput name validator = FieldInput initEdit validateEditContent ""
287289
VtyEvent (Vty.EvKey Vty.KEnter []) -> editStateOverlayOpenL .= True
288290
_ -> pure ()
289291
validateEditContent = validator . T.init . T.unlines . Edit.getEditContents . editState
290-
initEdit = EditState (Edit.editorText name (Just 1) "") False
292+
initEdit = EditState (Edit.editorText name (Just 1) initText) False
291293

292-
createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n
293-
createEditableField name validator access = MenuField access input "" Valid name
294+
createEditableField' :: (Eq n, Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n
295+
createEditableField' initText name validator access = MenuField access input "" Valid name
294296
where
295-
input = createEditableInput name validator
297+
input = createEditableInput initText name validator
298+
299+
createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n
300+
createEditableField = createEditableField' ""
296301

297302
{- *****************
298303
Button widget

‎lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ module GHCup.Brick.Widgets.Menus.AdvanceInstall (
2626
isolateDirL,
2727
forceInstallL,
2828
addConfArgsL,
29+
installTargetsL,
2930
) where
3031

3132
import GHCup.Types (GHCTargetVersion(..))
@@ -55,6 +56,7 @@ data InstallOptions = InstallOptions
5556
, isolateDir :: Maybe FilePath
5657
, forceInstall :: Bool
5758
, addConfArgs :: [T.Text]
59+
, installTargets :: T.Text
5860
} deriving (Eq, Show)
5961

6062
makeLensesFor [
@@ -64,6 +66,7 @@ makeLensesFor [
6466
, ("isolateDir", "isolateDirL")
6567
, ("forceInstall", "forceInstallL")
6668
, ("addConfArgs", "addConfArgsL")
69+
, ("installTargets", "installTargetsL")
6770
]
6871
''InstallOptions
6972

@@ -72,7 +75,8 @@ type AdvanceInstallMenu = Menu InstallOptions Name
7275
create :: MenuKeyBindings -> AdvanceInstallMenu
7376
create k = Menu.createMenu AdvanceInstallBox initialState "Advance Install" validator k [ok] fields
7477
where
75-
initialState = InstallOptions Nothing False Nothing Nothing False []
78+
initialInstallTargets = "install"
79+
initialState = InstallOptions Nothing False Nothing Nothing False [] initialInstallTargets
7680
validator InstallOptions {..} = case (instSet, isolateDir) of
7781
(True, Just _) -> Just "Cannot set active when doing an isolated install"
7882
_ -> Nothing
@@ -105,6 +109,9 @@ create k = Menu.createMenu AdvanceInstallBox initialState "Advance Install" vali
105109
, Menu.createEditableField (Common.MenuElement Common.ToolVersionBox) toolVersionValidator instVersionL
106110
& Menu.fieldLabelL .~ "version"
107111
& Menu.fieldHelpMsgL .~ "Specify a custom version"
112+
, Menu.createEditableField' initialInstallTargets (Common.MenuElement Common.GHCInstallTargets) Right installTargetsL
113+
& Menu.fieldLabelL .~ "install-targets"
114+
& Menu.fieldHelpMsgL .~ "Specify space separated list of make install targets"
108115
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathValidator isolateDirL
109116
& Menu.fieldLabelL .~ "isolated"
110117
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"

‎lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ module GHCup.Brick.Widgets.Menus.CompileGHC (
3333
buildSystem,
3434
isolateDir,
3535
gitRef,
36+
installTargets,
3637
) where
3738

3839
import GHCup.Brick.Widgets.Menu (Menu, MenuKeyBindings)
@@ -77,6 +78,7 @@ data CompileGHCOptions = CompileGHCOptions
7778
, _buildSystem :: Maybe BuildSystem
7879
, _isolateDir :: Maybe FilePath
7980
, _gitRef :: Maybe String
81+
, _installTargets :: T.Text
8082
} deriving (Eq, Show)
8183

8284
makeLenses ''CompileGHCOptions
@@ -86,6 +88,7 @@ type CompileGHCMenu = Menu CompileGHCOptions Name
8688
create :: MenuKeyBindings -> [Version] -> CompileGHCMenu
8789
create k availableGHCs = Menu.createMenu CompileGHCBox initialState "Compile GHC" validator k buttons fields
8890
where
91+
initialInstallTargets = "install"
8992
initialState =
9093
CompileGHCOptions
9194
(Right "")
@@ -101,6 +104,7 @@ create k availableGHCs = Menu.createMenu CompileGHCBox initialState "Compile GHC
101104
Nothing
102105
Nothing
103106
Nothing
107+
initialInstallTargets
104108
validator CompileGHCOptions {..} = case (_setCompile, _isolateDir) of
105109
(True, Just _) -> Just "Cannot set active when doing an isolated install"
106110
_ -> case (_buildConfig, _buildSystem) of
@@ -223,6 +227,9 @@ create k availableGHCs = Menu.createMenu CompileGHCBox initialState "Compile GHC
223227
, Menu.createEditableField (Common.MenuElement Common.GitRefEditBox) (Right . Just . T.unpack) gitRef
224228
& Menu.fieldLabelL .~ "git-ref"
225229
& Menu.fieldHelpMsgL .~ "The git commit/branch/ref to build from"
230+
, Menu.createEditableField' initialInstallTargets (Common.MenuElement Common.GHCInstallTargets) Right installTargets
231+
& Menu.fieldLabelL .~ "install-targets"
232+
& Menu.fieldHelpMsgL .~ "Specify space separated list of make install targets"
226233
]
227234

228235
buttons = [

‎lib/GHCup/GHC.hs

Lines changed: 16 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -295,6 +295,7 @@ installGHCBindist :: ( MonadFail m
295295
-> InstallDir
296296
-> Bool -- ^ Force install
297297
-> [T.Text] -- ^ additional configure args for bindist
298+
-> T.Text
298299
-> Excepts
299300
'[ AlreadyInstalled
300301
, BuildFailed
@@ -315,7 +316,7 @@ installGHCBindist :: ( MonadFail m
315316
]
316317
m
317318
()
318-
installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
319+
installGHCBindist dlinfo tver installDir forceInstall addConfArgs installTargets = do
319320
lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver
320321

321322
regularGHCInstalled <- lift $ ghcInstalled tver
@@ -343,12 +344,12 @@ installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
343344
case installDir of
344345
IsolateDir isoDir -> do -- isolated install
345346
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
346-
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs
347+
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs installTargets
347348
GHCupInternal -> do -- regular install
348349
-- prepare paths
349350
ghcdir <- lift $ ghcupGHCDir tver
350351

351-
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs
352+
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs installTargets
352353

353354
-- make symlinks & stuff when regular install,
354355
liftE $ postGHCInstall tver
@@ -385,6 +386,7 @@ installPackedGHC :: ( MonadMask m
385386
-> GHCTargetVersion -- ^ The GHC version
386387
-> Bool -- ^ Force install
387388
-> [T.Text] -- ^ additional configure args for bindist
389+
-> T.Text
388390
-> Excepts
389391
'[ BuildFailed
390392
, UnknownArchive
@@ -394,7 +396,7 @@ installPackedGHC :: ( MonadMask m
394396
, ProcessError
395397
, MergeFileTreeError
396398
] m ()
397-
installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do
399+
installPackedGHC dl msubdir inst ver forceInstall addConfArgs installTargets = do
398400
PlatformRequest {..} <- lift getPlatformReq
399401

400402
unless forceInstall
@@ -411,7 +413,7 @@ installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do
411413
msubdir
412414

413415
liftE $ runBuildAction tmpUnpack
414-
(installUnpackedGHC workdir inst ver forceInstall addConfArgs)
416+
(installUnpackedGHC workdir inst ver forceInstall addConfArgs installTargets)
415417

416418

417419
-- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -433,8 +435,9 @@ installUnpackedGHC :: ( MonadReader env m
433435
-> GHCTargetVersion -- ^ The GHC version
434436
-> Bool -- ^ Force install
435437
-> [T.Text] -- ^ additional configure args for bindist
438+
-> T.Text
436439
-> Excepts '[ProcessError, MergeFileTreeError] m ()
437-
installUnpackedGHC path inst tver forceInstall addConfArgs
440+
installUnpackedGHC path inst tver forceInstall addConfArgs installTargets
438441
| isWindows = do
439442
lift $ logInfo "Installing GHC (this may take a while)"
440443
-- Windows bindists are relocatable and don't need
@@ -460,7 +463,7 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
460463
"ghc-configure"
461464
Nothing
462465
tmpInstallDest <- lift withGHCupTmpDir
463-
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
466+
lEM $ make (["DESTDIR=" <> fromGHCupPath tmpInstallDest] <> (words . T.unpack $ installTargets)) (Just $ fromGHCupPath path)
464467
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
465468
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall
466469
pure ()
@@ -525,6 +528,7 @@ installGHCBin :: ( MonadFail m
525528
-> InstallDir
526529
-> Bool -- ^ force install
527530
-> [T.Text] -- ^ additional configure args for bindist
531+
-> T.Text
528532
-> Excepts
529533
'[ AlreadyInstalled
530534
, BuildFailed
@@ -550,9 +554,9 @@ installGHCBin :: ( MonadFail m
550554
]
551555
m
552556
()
553-
installGHCBin tver installDir forceInstall addConfArgs = do
557+
installGHCBin tver installDir forceInstall addConfArgs installTargets = do
554558
dlinfo <- liftE $ getDownloadInfo' GHC tver
555-
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
559+
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs installTargets
556560

557561

558562

@@ -806,6 +810,7 @@ compileGHC :: ( MonadMask m
806810
-> Maybe String -- ^ build flavour
807811
-> Maybe BuildSystem
808812
-> InstallDir
813+
-> T.Text
809814
-> Excepts
810815
'[ AlreadyInstalled
811816
, BuildFailed
@@ -834,7 +839,7 @@ compileGHC :: ( MonadMask m
834839
]
835840
m
836841
GHCTargetVersion
837-
compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
842+
compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir installTargets
838843
= do
839844
pfreq@PlatformRequest { .. } <- lift getPlatformReq
840845
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -1028,6 +1033,7 @@ compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs
10281033
installVer
10291034
False -- not a force install, since we already overwrite when compiling.
10301035
[]
1036+
installTargets
10311037

10321038
case installDir of
10331039
-- set and make symlinks for regular (non-isolated) installs

0 commit comments

Comments
 (0)