Merge branch 'reenable-upgrade'

app/ghcup/BrickMain.hs

@@ -437,6 +437,7 @@ install' _ (_, ListResult {..}) = do
               , TarDirDoesNotExist
               , FileAlreadyExistsError
               , ProcessError
+              , GHCupShadowed
               ]
 
   run (do
@@ -452,7 +453,7 @@ install' _ (_, ListResult {..}) = do
           liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce)
         GHCup -> do
           let vi = snd <$> getLatest dls GHCup
-          liftE $ upgradeGHCup Nothing False $> (vi, dirs, ce)
+          liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
         HLS   -> do
           let vi = getVersionInfo lVer HLS dls
           liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce)

app/ghcup/GHCup/OptParse.hs

@@ -96,7 +96,7 @@ data Command
   | Config ConfigCommand
   | Whereis WhereisOptions WhereisCommand
 #ifndef DISABLE_UPGRADE
-  | Upgrade UpgradeOpts Bool
+  | Upgrade UpgradeOpts Bool Bool
 #endif
   | ToolRequirements ToolReqOpts
   | ChangeLog ChangeLogOptions
@@ -222,18 +222,18 @@ com =
            (info (List <$> listOpts <**> helper)
                  (progDesc "Show available GHCs and other tools")
            )
-#ifndef DISABLE_UPGRADE
       <> command
            "upgrade"
            (info
              (    (Upgrade <$> upgradeOptsP <*> switch
                     (short 'f' <> long "force" <> help "Force update")
+                    <*> switch
+                    (long "fail-if-shadowed" <> help "Fails after upgrading if the upgraded ghcup binary is shadowed by something else in PATH (useful for CI)")
                   )
              <**> helper
              )
              (progDesc "Upgrade ghcup")
            )
-#endif
       <> command
            "compile"
            (   Compile

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -65,9 +65,10 @@ upgradeOptsP =
   flag'
       UpgradeInplace
       (short 'i' <> long "inplace" <> help
-        "Upgrade ghcup in-place (wherever it's at)"
+        "Upgrade ghcup in-place"
       )
-    <|> (   UpgradeAt
+    <|>
+      (   UpgradeAt
         <$> option
               str
               (short 't' <> long "target" <> metavar "TARGET_DIR" <> help
@@ -92,6 +93,7 @@ type UpgradeEffects = '[ DigestError
                        , FileDoesNotExistError
                        , CopyError
                        , DownloadFailed
+                       , GHCupShadowed
                        ]
 
 
@@ -120,18 +122,19 @@ upgrade :: ( Monad m
            )
         => UpgradeOpts
         -> Bool
+        -> Bool
         -> Dirs
         -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
         -> (ReaderT LeanAppState m () -> m ())
         -> m ExitCode
-upgrade uOpts force' Dirs{..} runAppState runLogger = do
+upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
   target <- case uOpts of
     UpgradeInplace  -> Just <$> liftIO getExecutablePath
     (UpgradeAt p)   -> pure $ Just p
     UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
 
   runUpgrade runAppState (do
-    v' <- liftE $ upgradeGHCup target force'
+    v' <- liftE $ upgradeGHCup target force' fatal
     GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
     pure (v', dls)
     ) >>= \case

app/ghcup/Main.hs

@@ -141,9 +141,7 @@ main = do
         )
   let listCommands = infoOption
         ("install set rm install-cabal list"
-#ifndef DISABLE_UPGRADE
           <> " upgrade"
-#endif
           <> " compile debug-info tool-requirements changelog"
         )
         (  long "list-commands"
@@ -245,14 +243,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                              alreadyInstalling' <- alreadyInstalling optCommand newTool
                              when (not alreadyInstalling') $
                                case t of
-#ifdef DISABLE_UPGRADE
-                                 GHCup -> pure ()
-#else
                                  GHCup -> runLogger $
                                             logWarn ("New GHCup version available: "
                                               <> prettyVer l
                                               <> ". To upgrade, run 'ghcup upgrade'")
-#endif
                                  _ -> runLogger $
                                         logWarn ("New "
                                           <> T.pack (prettyShow t)
@@ -307,9 +301,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Config configCommand       -> config configCommand settings keybindings runLogger
             Whereis whereisOptions
                     whereisCommand     -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
-#ifndef DISABLE_UPGRADE
-            Upgrade uOpts force'     -> upgrade uOpts force' dirs runAppState runLogger
-#endif
+            Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
             ToolRequirements topts     -> toolRequirements topts runAppState runLogger
             ChangeLog changelogOpts    -> changelog changelogOpts runAppState runLogger
             Nuke                       -> nuke appState runLogger
@@ -353,9 +345,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
     (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
   alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
     (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
-#ifndef DISABLE_UPGRADE
-  alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
-#endif
+  alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
   alreadyInstalling _ _ = pure False
 
   cmp' :: ( HasLog env

docs/guide.md

@@ -57,6 +57,13 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
 and make sure your bashrc sources the startup script
 (`/usr/share/bash-completion/bash_completion` on some distros).
 
+## Portability
+
+`ghcup` is very portable. There are a few exceptions though:
+
+1. `ghcup tui` is only available on non-windows platforms
+2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
+
 # Configuration
 
 A configuration file can be put in `~/.ghcup/config.yaml`. The default config file

ghcup.cabal

@@ -48,13 +48,6 @@ flag no-exe
   default:     False
   manual:      True
 
-flag disable-upgrade
-  description:
-    Disable upgrade functionality. This is mainly to support brew packagers.
-
-  default:     False
-  manual:      True
-
 library
   exposed-modules:
     GHCup
@@ -204,6 +197,7 @@ executable ghcup
     GHCup.OptParse.Set
     GHCup.OptParse.ToolRequirements
     GHCup.OptParse.UnSet
+    GHCup.OptParse.Upgrade
     GHCup.OptParse.Whereis
 
   hs-source-dirs:     app/ghcup
@@ -277,11 +271,6 @@ executable ghcup
   if flag(no-exe)
     buildable: False
 
-  if flag(disable-upgrade)
-    cpp-options: -DDISABLE_UPGRADE
-
-  else
-    other-modules: GHCup.OptParse.Upgrade
 
 test-suite ghcup-test
   type:               exitcode-stdio-1.0

lib/GHCup.hs

@@ -2587,6 +2587,7 @@ upgradeGHCup :: ( MonadMask m
              => Maybe FilePath    -- ^ full file destination to write ghcup into
              -> Bool              -- ^ whether to force update regardless
                                   --   of currently installed version
+             -> Bool              -- ^ whether to throw an error if ghcup is shadowed
              -> Excepts
                   '[ CopyError
                    , DigestError
@@ -2595,10 +2596,11 @@ upgradeGHCup :: ( MonadMask m
                    , DownloadFailed
                    , NoDownload
                    , NoUpdate
+                   , GHCupShadowed
                    ]
                   m
                   Version
-upgradeGHCup mtarget force' = do
+upgradeGHCup mtarget force' fatal = do
   Dirs {..} <- lift getDirs
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
 
@@ -2625,14 +2627,17 @@ upgradeGHCup mtarget force' = do
     lift $ logWarn $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
   liftIO (isShadowed destFile) >>= \case
     Nothing -> pure ()
-    Just pa -> lift $ logWarn $ "ghcup is shadowed by "
+    Just pa
+      | fatal -> throwE (GHCupShadowed pa destFile latestVer)
+      | otherwise ->
+        lift $ logWarn $ "ghcup is shadowed by "
           <> T.pack pa
           <> ". The upgrade will not be in effect, unless you remove "
           <> T.pack pa
           <> " or make sure "
           <> T.pack destDir
           <> " comes before "
-      <> T.pack (takeFileName pa)
+          <> T.pack (takeDirectory pa)
           <> " in PATH."
 
   pure latestVer

lib/GHCup/Errors.hs

@@ -27,6 +27,7 @@ import           Data.CaseInsensitive           ( CI )
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Haskus.Utils.Variant
+import           System.FilePath
 import           Text.PrettyPrint               hiding ( (<>) )
 import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           URI.ByteString
@@ -291,6 +292,24 @@ instance Pretty HadrianNotFound where
   pPrint HadrianNotFound =
     text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
 
+data GHCupShadowed = GHCupShadowed
+                       FilePath  -- shadow binary
+                       FilePath  -- upgraded binary
+                       Version   -- upgraded version
+  deriving Show
+
+instance Pretty GHCupShadowed where
+  pPrint (GHCupShadowed sh up _) =
+    text ("ghcup is shadowed by "
+         <> sh
+         <> ". The upgrade will not be in effect, unless you remove "
+         <> sh
+         <> " or make sure "
+         <> takeDirectory up
+         <> " comes before "
+         <> takeDirectory sh
+         <> " in PATH."
+         )
 
     -------------------------
     --[ High-level errors ]--