Re-enable upgrade functionality for all configurations

Adds a --fail-if-shadowed switch.

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,15 +2627,18 @@ 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 "
-      <> 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)
-      <> " in PATH."
+    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 (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 ]--