Implement install targets, fixes #1210

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 $

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

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

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

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

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

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"

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 = [

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