diff --git a/lib-opt/GHCup/OptParse/Compile.hs b/lib-opt/GHCup/OptParse/Compile.hs index bc6d221a..15bb1cc5 100644 --- a/lib-opt/GHCup/OptParse/Compile.hs +++ b/lib-opt/GHCup/OptParse/Compile.hs @@ -81,6 +81,7 @@ data GHCCompileOptions = GHCCompileOptions , buildFlavour :: Maybe String , buildSystem :: Maybe BuildSystem , isolateDir :: Maybe FilePath + , installTargets :: T.Text } deriving (Eq, Show) @@ -166,7 +167,7 @@ Examples: ghcCompileOpts :: Parser GHCCompileOptions ghcCompileOpts = - (\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir -> GHCCompileOptions {..}) + (\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir installTargets -> GHCCompileOptions {..}) <$> ((GHC.SourceDist <$> option (eitherReader (first (const "Not a valid version") . version . T.pack) @@ -315,6 +316,13 @@ ghcCompileOpts = <> completer (bashCompleter "directory") ) ) + <*> strOption + ( long "install-targets" + <> metavar "TARGETS" + <> help "Space separated list of install targets (default: install)" + <> completer (listCompleter ["install", "install_bin", "install_lib", "install_extra", "install_man", "install_docs", "install_data", "update_package_db"]) + <> value "install" + ) hlsCompileOpts :: Parser HLSCompileOptions hlsCompileOpts = @@ -632,6 +640,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do buildFlavour buildSystem (maybe GHCupInternal IsolateDir isolateDir) + installTargets GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo let vi = getVersionInfo targetVer GHC dls when setCompile $ void $ liftE $ diff --git a/lib-opt/GHCup/OptParse/Install.hs b/lib-opt/GHCup/OptParse/Install.hs index 0110de97..d07af3d4 100644 --- a/lib-opt/GHCup/OptParse/Install.hs +++ b/lib-opt/GHCup/OptParse/Install.hs @@ -71,6 +71,7 @@ data InstallOptions = InstallOptions , instSet :: Bool , isolateDir :: Maybe FilePath , forceInstall :: Bool + , installTargets :: T.Text , addConfArgs :: [T.Text] } deriving (Eq, Show) @@ -207,6 +208,13 @@ installOpts tool = ) <*> switch (short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)") + <*> strOption + ( long "install-targets" + <> metavar "TARGETS" + <> help "Space separated list of install targets (default: install)" + <> completer (listCompleter ["install", "install_bin", "install_lib", "install_extra", "install_man", "install_docs", "install_data", "update_package_db"]) + <> value "install" + ) <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to bindist configure, prefix with '-- ' (longopts)")) where setDefault = case tool of @@ -345,6 +353,7 @@ install installCommand settings getAppState' runLogger = case installCommand of (maybe GHCupInternal IsolateDir isolateDir) forceInstall addConfArgs + installTargets ) $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing pure vi @@ -362,6 +371,7 @@ install installCommand settings getAppState' runLogger = case installCommand of (maybe GHCupInternal IsolateDir isolateDir) forceInstall addConfArgs + installTargets ) $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing pure vi diff --git a/lib-opt/GHCup/OptParse/Run.hs b/lib-opt/GHCup/OptParse/Run.hs index 0c562589..d216c8cb 100644 --- a/lib-opt/GHCup/OptParse/Run.hs +++ b/lib-opt/GHCup/OptParse/Run.hs @@ -382,6 +382,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do GHCupInternal False [] + (T.pack "install") setGHC' v tmp _ -> pure () case cabalVer of diff --git a/lib-tui/GHCup/Brick/Actions.hs b/lib-tui/GHCup/Brick/Actions.hs index f89394e9..9b033caa 100644 --- a/lib-tui/GHCup/Brick/Actions.hs +++ b/lib-tui/GHCup/Brick/Actions.hs @@ -193,6 +193,7 @@ installWithOptions opts (_, ListResult {..}) = do shouldForce = opts ^. AdvanceInstall.forceInstallL shouldSet = opts ^. AdvanceInstall.instSetL extraArgs = opts ^. AdvanceInstall.addConfArgsL + installTargets = opts ^. AdvanceInstall.installTargetsL v = fromMaybe (GHCTargetVersion lCross lVer) (opts ^. AdvanceInstall.instVersionL) toolV = _tvVersion v let run = @@ -242,7 +243,7 @@ installWithOptions opts (_, ListResult {..}) = do Nothing -> do liftE $ runBothE' - (installGHCBin v shouldIsolate shouldForce extraArgs) + (installGHCBin v shouldIsolate shouldForce extraArgs installTargets) (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing)) pure (vi, dirs, ce) Just uri -> do @@ -253,7 +254,9 @@ installWithOptions opts (_, ListResult {..}) = do v shouldIsolate shouldForce - extraArgs) + extraArgs + installTargets + ) (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing)) pure (vi, dirs, ce) @@ -340,7 +343,7 @@ installWithOptions opts (_, ListResult {..}) = do install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) => (Int, ListResult) -> m (Either String ()) -install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing Nothing False []) +install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing Nothing False [] "install") set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) => (Int, ListResult) @@ -537,6 +540,7 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do (compopts ^. CompileGHC.buildFlavour) (compopts ^. CompileGHC.buildSystem) (maybe GHCupInternal IsolateDir $ compopts ^. CompileGHC.isolateDir) + (compopts ^. CompileGHC.installTargets) AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask let vi2 = getVersionInfo targetVer GHC dls2 when diff --git a/lib-tui/GHCup/Brick/Common.hs b/lib-tui/GHCup/Brick/Common.hs index fcc392d4..9b5747d7 100644 --- a/lib-tui/GHCup/Brick/Common.hs +++ b/lib-tui/GHCup/Brick/Common.hs @@ -48,7 +48,7 @@ module GHCup.Brick.Common ( , BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton , CompileGHCButton, CompileHLSButton, CabalProjectEditBox , CabalProjectLocalEditBox, UpdateCabalCheckBox, GitRefEditBox - , BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox + , BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox, GHCInstallTargets ) ) where import GHCup.List ( ListResult ) @@ -136,6 +136,9 @@ pattern HadrianGhcSelectBox = ResourceId 22 pattern ToolVersionBox :: ResourceId pattern ToolVersionBox = ResourceId 23 +pattern GHCInstallTargets :: ResourceId +pattern GHCInstallTargets = ResourceId 24 + -- | Name data type. Uniquely identifies each widget in the TUI. -- some constructors might end up unused, but still is a good practise -- to have all of them defined, just in case diff --git a/lib-tui/GHCup/Brick/Widgets/Menu.hs b/lib-tui/GHCup/Brick/Widgets/Menu.hs index 9c5289af..fedfaac9 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menu.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menu.hs @@ -248,8 +248,8 @@ createCheckBoxField name access = MenuField access createCheckBoxInput "" Valid type EditableField = MenuField -createEditableInput :: (Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (EditState n) n -createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit handler +createEditableInput :: (Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (EditState n) n +createEditableInput initText name validator = FieldInput initEdit validateEditContent "" drawEdit handler where drawEdit focus errMsg help label (EditState edi overlayOpen) amp = (field, mOverlay) where @@ -258,6 +258,8 @@ createEditableInput name validator = FieldInput initEdit validateEditContent "" borderBox w = amp (Brick.vLimit 1 $ Border.vBorder <+> Brick.padRight Brick.Max w <+> Border.vBorder) editorContents = Brick.txt $ T.unlines $ Edit.getEditContents edi isEditorEmpty = Edit.getEditContents edi == [mempty] + || Edit.getEditContents edi == [initText] + in case errMsg of Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help | otherwise -> borderBox editorContents @@ -287,12 +289,15 @@ createEditableInput name validator = FieldInput initEdit validateEditContent "" VtyEvent (Vty.EvKey Vty.KEnter []) -> editStateOverlayOpenL .= True _ -> pure () validateEditContent = validator . T.init . T.unlines . Edit.getEditContents . editState - initEdit = EditState (Edit.editorText name (Just 1) "") False + initEdit = EditState (Edit.editorText name (Just 1) initText) False -createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n -createEditableField name validator access = MenuField access input "" Valid name +createEditableField' :: (Eq n, Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n +createEditableField' initText name validator access = MenuField access input "" Valid name where - input = createEditableInput name validator + input = createEditableInput initText name validator + +createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n +createEditableField = createEditableField' "" {- ***************** Button widget diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs b/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs index b11d331e..571bd801 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs @@ -26,6 +26,7 @@ module GHCup.Brick.Widgets.Menus.AdvanceInstall ( isolateDirL, forceInstallL, addConfArgsL, + installTargetsL, ) where import GHCup.Types (GHCTargetVersion(..)) @@ -55,6 +56,7 @@ data InstallOptions = InstallOptions , isolateDir :: Maybe FilePath , forceInstall :: Bool , addConfArgs :: [T.Text] + , installTargets :: T.Text } deriving (Eq, Show) makeLensesFor [ @@ -64,6 +66,7 @@ makeLensesFor [ , ("isolateDir", "isolateDirL") , ("forceInstall", "forceInstallL") , ("addConfArgs", "addConfArgsL") + , ("installTargets", "installTargetsL") ] ''InstallOptions @@ -72,7 +75,8 @@ type AdvanceInstallMenu = Menu InstallOptions Name create :: MenuKeyBindings -> AdvanceInstallMenu create k = Menu.createMenu AdvanceInstallBox initialState "Advance Install" validator k [ok] fields where - initialState = InstallOptions Nothing False Nothing Nothing False [] + initialInstallTargets = "install" + initialState = InstallOptions Nothing False Nothing Nothing False [] initialInstallTargets validator InstallOptions {..} = case (instSet, isolateDir) of (True, Just _) -> Just "Cannot set active when doing an isolated install" _ -> Nothing @@ -105,6 +109,9 @@ create k = Menu.createMenu AdvanceInstallBox initialState "Advance Install" vali , Menu.createEditableField (Common.MenuElement Common.ToolVersionBox) toolVersionValidator instVersionL & Menu.fieldLabelL .~ "version" & Menu.fieldHelpMsgL .~ "Specify a custom version" + , Menu.createEditableField' initialInstallTargets (Common.MenuElement Common.GHCInstallTargets) Right installTargetsL + & Menu.fieldLabelL .~ "install-targets" + & Menu.fieldHelpMsgL .~ "Specify space separated list of make install targets" , Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathValidator isolateDirL & Menu.fieldLabelL .~ "isolated" & Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one" diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs b/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs index 705110f6..2f476fc6 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs @@ -33,6 +33,7 @@ module GHCup.Brick.Widgets.Menus.CompileGHC ( buildSystem, isolateDir, gitRef, + installTargets, ) where import GHCup.Brick.Widgets.Menu (Menu, MenuKeyBindings) @@ -77,6 +78,7 @@ data CompileGHCOptions = CompileGHCOptions , _buildSystem :: Maybe BuildSystem , _isolateDir :: Maybe FilePath , _gitRef :: Maybe String + , _installTargets :: T.Text } deriving (Eq, Show) makeLenses ''CompileGHCOptions @@ -86,6 +88,7 @@ type CompileGHCMenu = Menu CompileGHCOptions Name create :: MenuKeyBindings -> [Version] -> CompileGHCMenu create k availableGHCs = Menu.createMenu CompileGHCBox initialState "Compile GHC" validator k buttons fields where + initialInstallTargets = "install" initialState = CompileGHCOptions (Right "") @@ -101,6 +104,7 @@ create k availableGHCs = Menu.createMenu CompileGHCBox initialState "Compile GHC Nothing Nothing Nothing + initialInstallTargets validator CompileGHCOptions {..} = case (_setCompile, _isolateDir) of (True, Just _) -> Just "Cannot set active when doing an isolated install" _ -> case (_buildConfig, _buildSystem) of @@ -223,6 +227,9 @@ create k availableGHCs = Menu.createMenu CompileGHCBox initialState "Compile GHC , Menu.createEditableField (Common.MenuElement Common.GitRefEditBox) (Right . Just . T.unpack) gitRef & Menu.fieldLabelL .~ "git-ref" & Menu.fieldHelpMsgL .~ "The git commit/branch/ref to build from" + , Menu.createEditableField' initialInstallTargets (Common.MenuElement Common.GHCInstallTargets) Right installTargets + & Menu.fieldLabelL .~ "install-targets" + & Menu.fieldHelpMsgL .~ "Specify space separated list of make install targets" ] buttons = [ diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs index 09f067a9..d489dfff 100644 --- a/lib/GHCup/GHC.hs +++ b/lib/GHCup/GHC.hs @@ -295,6 +295,7 @@ installGHCBindist :: ( MonadFail m -> InstallDir -> Bool -- ^ Force install -> [T.Text] -- ^ additional configure args for bindist + -> T.Text -> Excepts '[ AlreadyInstalled , BuildFailed @@ -315,7 +316,7 @@ installGHCBindist :: ( MonadFail m ] m () -installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do +installGHCBindist dlinfo tver installDir forceInstall addConfArgs installTargets = do lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver regularGHCInstalled <- lift $ ghcInstalled tver @@ -343,12 +344,12 @@ installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do case installDir of IsolateDir isoDir -> do -- isolated install lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir - liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs + liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs installTargets GHCupInternal -> do -- regular install -- prepare paths ghcdir <- lift $ ghcupGHCDir tver - liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs + liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs installTargets -- make symlinks & stuff when regular install, liftE $ postGHCInstall tver @@ -385,6 +386,7 @@ installPackedGHC :: ( MonadMask m -> GHCTargetVersion -- ^ The GHC version -> Bool -- ^ Force install -> [T.Text] -- ^ additional configure args for bindist + -> T.Text -> Excepts '[ BuildFailed , UnknownArchive @@ -394,7 +396,7 @@ installPackedGHC :: ( MonadMask m , ProcessError , MergeFileTreeError ] m () -installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do +installPackedGHC dl msubdir inst ver forceInstall addConfArgs installTargets = do PlatformRequest {..} <- lift getPlatformReq unless forceInstall @@ -411,7 +413,7 @@ installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do msubdir liftE $ runBuildAction tmpUnpack - (installUnpackedGHC workdir inst ver forceInstall addConfArgs) + (installUnpackedGHC workdir inst ver forceInstall addConfArgs installTargets) -- | Install an unpacked GHC distribution. This only deals with the GHC @@ -433,8 +435,9 @@ installUnpackedGHC :: ( MonadReader env m -> GHCTargetVersion -- ^ The GHC version -> Bool -- ^ Force install -> [T.Text] -- ^ additional configure args for bindist + -> T.Text -> Excepts '[ProcessError, MergeFileTreeError] m () -installUnpackedGHC path inst tver forceInstall addConfArgs +installUnpackedGHC path inst tver forceInstall addConfArgs installTargets | isWindows = do lift $ logInfo "Installing GHC (this may take a while)" -- Windows bindists are relocatable and don't need @@ -460,7 +463,7 @@ installUnpackedGHC path inst tver forceInstall addConfArgs "ghc-configure" Nothing tmpInstallDest <- lift withGHCupTmpDir - lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path) + lEM $ make (["DESTDIR=" <> fromGHCupPath tmpInstallDest] <> (words . T.unpack $ installTargets)) (Just $ fromGHCupPath path) liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest) liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall pure () @@ -525,6 +528,7 @@ installGHCBin :: ( MonadFail m -> InstallDir -> Bool -- ^ force install -> [T.Text] -- ^ additional configure args for bindist + -> T.Text -> Excepts '[ AlreadyInstalled , BuildFailed @@ -550,9 +554,9 @@ installGHCBin :: ( MonadFail m ] m () -installGHCBin tver installDir forceInstall addConfArgs = do +installGHCBin tver installDir forceInstall addConfArgs installTargets = do dlinfo <- liftE $ getDownloadInfo' GHC tver - liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs + liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs installTargets @@ -806,6 +810,7 @@ compileGHC :: ( MonadMask m -> Maybe String -- ^ build flavour -> Maybe BuildSystem -> InstallDir + -> T.Text -> Excepts '[ AlreadyInstalled , BuildFailed @@ -834,7 +839,7 @@ compileGHC :: ( MonadMask m ] m GHCTargetVersion -compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir +compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir installTargets = do pfreq@PlatformRequest { .. } <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo @@ -1028,6 +1033,7 @@ compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs installVer False -- not a force install, since we already overwrite when compiling. [] + installTargets case installDir of -- set and make symlinks for regular (non-isolated) installs diff --git a/test/optparse-test/CompileTest.hs b/test/optparse-test/CompileTest.hs index f0151e6d..67665e02 100644 --- a/test/optparse-test/CompileTest.hs +++ b/test/optparse-test/CompileTest.hs @@ -40,6 +40,7 @@ mkDefaultGHCCompileOptions target boot = Nothing Nothing Nothing + "install" mkDefaultHLSCompileOptions :: HLSVer -> [ToolVersion] -> HLSCompileOptions mkDefaultHLSCompileOptions target ghcs = diff --git a/test/optparse-test/InstallTest.hs b/test/optparse-test/InstallTest.hs index 20961c65..803cd276 100644 --- a/test/optparse-test/InstallTest.hs +++ b/test/optparse-test/InstallTest.hs @@ -32,15 +32,15 @@ installTests = testGroup "install" ] defaultOptions :: InstallOptions -defaultOptions = InstallOptions Nothing Nothing False Nothing False [] +defaultOptions = InstallOptions Nothing Nothing False Nothing False "install" [] -- | Don't set as active version mkInstallOptions :: ToolVersion -> InstallOptions -mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False [] +mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False "install" [] -- | Set as active version mkInstallOptions' :: ToolVersion -> InstallOptions -mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False [] +mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False "install" [] oldStyleCheckList :: [(String, Either InstallCommand InstallOptions)] oldStyleCheckList =