Merge branch 'unset'

.gitlab/ghcup_env

@@ -1,9 +1,11 @@
 if [ "${OS}" = "WINDOWS" ] ; then
 	export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
-	export PATH="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin:$CI_PROJECT_DIR/.local/bin:$PATH"
+	export GHCUP_BIN="$CI_PROJECT_DIR/ghcup/bin"
+	export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
 	export TMPDIR="$CI_PROJECT_DIR/tmp"
 else
 	export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
-	export PATH="$CI_PROJECT_DIR/.ghcup/bin:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
+	export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
+	export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
 	export TMPDIR="$CI_PROJECT_DIR/tmp"
 fi

.gitlab/script/ghcup_version.sh

@@ -101,6 +101,10 @@ eghcup install ghc ${GHC_VERSION}
 eghcup set ghc ${GHC_VERSION}
 eghcup install cabal ${CABAL_VERSION}
 [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
+eghcup unset cabal
+"$GHCUP_BIN"/cabal --version && exit || echo yes
+eghcup set cabal ${CABAL_VERSION}
+[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
 
 cabal --version
 
@@ -151,9 +155,13 @@ else
 	[ "$(ghc --numeric-version)" = "8.10.3" ]
 	eghcup set ${GHC_VERSION}
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+	eghcup unset ghc
+    "$GHCUP_BIN"/ghc --numeric-version && exit || echo yes
+	eghcup set ${GHC_VERSION}
 	eghcup --offline rm 8.10.3
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 
+
 	if [ "${OS}" = "DARWIN" ] ; then
 		eghcup install hls
 		$(eghcup whereis hls) --version
@@ -164,9 +172,13 @@ else
 		if [ "${ARCH}" = "64" ] ; then
 			eghcup install hls
 			haskell-language-server-wrapper --version
+			eghcup unset hls
+			"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit || echo yes
 
 			eghcup install stack
 			stack --version
+			eghcup unset hls
+			"$GHCUP_BIN"/stack --version && exit || echo yes
 		fi
 	fi
 fi

app/ghcup/Main.hs

@@ -103,6 +103,7 @@ data Command
   = Install (Either InstallCommand InstallOptions)
   | InstallCabalLegacy InstallOptions
   | Set (Either SetCommand SetOptions)
+  | UnSet UnsetCommand
   | List ListOptions
   | Rm (Either RmCommand RmOptions)
   | DInfo
@@ -150,6 +151,11 @@ data SetCommand = SetGHC SetOptions
                 | SetHLS SetOptions
                 | SetStack SetOptions
 
+data UnsetCommand = UnsetGHC   UnsetOptions
+                  | UnsetCabal UnsetOptions
+                  | UnsetHLS   UnsetOptions
+                  | UnsetStack UnsetOptions
+
 -- a superset of ToolVersion
 data SetToolVersion = SetToolVersion GHCTargetVersion
                     | SetToolTag Tag
@@ -160,6 +166,10 @@ data SetOptions = SetOptions
   { sToolVer :: SetToolVersion
   }
 
+data UnsetOptions = UnsetOptions
+  { sToolVer :: Maybe Text -- target platform triple
+  }
+
 data ListOptions = ListOptions
   { loTool     :: Maybe Tool
   , lCriteria  :: Maybe ListCriteria
@@ -357,6 +367,14 @@ com =
              <> footerDoc (Just $ text setFooter)
              )
            )
+      <> command
+           "unset"
+           (info
+             (UnSet <$> unsetParser <**> helper)
+             (  progDesc "Unset currently active GHC/cabal version"
+             <> footerDoc (Just $ text unsetFooter)
+             )
+           )
       <> command
            "rm"
            (info
@@ -470,6 +488,10 @@ com =
   is given, sets GHC to 'recommended' version).
   It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
 
+  unsetFooter :: String
+  unsetFooter = [s|Discussion:
+  Unsets the currently active GHC or cabal version.|]
+
   rmFooter :: String
   rmFooter = [s|Discussion:
   Remove the given GHC or cabal version. When no command is given,
@@ -715,12 +737,74 @@ setParser =
   setHLSFooter = [s|Discussion:
     Sets the the current haskell-language-server version.|]
 
+unsetParser :: Parser UnsetCommand
+unsetParser =
+  (subparser
+      (  command
+          "ghc"
+          (   UnsetGHC
+          <$> info
+                (unsetOpts <**> helper)
+                (  progDesc "Unset GHC version"
+                <> footerDoc (Just $ text unsetGHCFooter)
+                )
+          )
+      <> command
+           "cabal"
+           (   UnsetCabal
+           <$> info
+                (unsetOpts <**> helper)
+                 (  progDesc "Unset Cabal version"
+                 <> footerDoc (Just $ text unsetCabalFooter)
+                 )
+           )
+      <> command
+           "hls"
+           (   UnsetHLS
+           <$> info
+                 (unsetOpts <**> helper)
+                 (  progDesc "Unset haskell-language-server version"
+                 <> footerDoc (Just $ text unsetHLSFooter)
+                 )
+           )
+      <> command
+           "stack"
+           (   UnsetStack
+           <$> info
+                 (unsetOpts <**> helper)
+                 (  progDesc "Unset stack version"
+                 <> footerDoc (Just $ text unsetStackFooter)
+                 )
+           )
+      )
+    )
+ where
+  unsetGHCFooter :: String
+  unsetGHCFooter = [s|Discussion:
+    Unsets the the current GHC version. That means there won't
+    be a ~/.ghcup/bin/ghc anymore.|]
+
+  unsetCabalFooter :: String
+  unsetCabalFooter = [s|Discussion:
+    Unsets the the current Cabal version.|]
+
+  unsetStackFooter :: String
+  unsetStackFooter = [s|Discussion:
+    Unsets the the current Stack version.|]
+
+  unsetHLSFooter :: String
+  unsetHLSFooter = [s|Discussion:
+    Unsets the the current haskell-language-server version.|]
+
 
 setOpts :: Maybe Tool -> Parser SetOptions
 setOpts tool = SetOptions <$>
     (fromMaybe SetRecommended <$>
       optional (setVersionArgument (Just ListInstalled) tool))
 
+unsetOpts :: Parser UnsetOptions
+unsetOpts = UnsetOptions . fmap T.pack <$> optional (argument str (metavar "TRIPLE"))
+
 listOpts :: Parser ListOptions
 listOpts =
   ListOptions
@@ -1629,6 +1713,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     , NoToolVersionSet
                     ]
 
+            runUnsetGHC =
+                runAppState
+                . runE
+                  @'[ NotInstalled ]
+
           let
             runLeanSetCabal =
                 runLeanAppState
@@ -2089,6 +2178,27 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Set (Left (SetHLS sopts)) -> setHLS' sopts
             Set (Left (SetStack sopts)) -> setStack' sopts
 
+            UnSet (UnsetGHC (UnsetOptions triple)) -> runUnsetGHC (unsetGHC triple)
+                  >>= \case
+                        VRight _ -> do
+                          runLogger $ logInfo "GHC successfully unset"
+                          pure ExitSuccess
+                        VLeft  e -> do
+                          runLogger $ logError $ T.pack $ prettyShow e
+                          pure $ ExitFailure 14
+            UnSet (UnsetCabal (UnsetOptions _)) -> do
+              runAppState unsetCabal
+              runLogger $ logInfo "Cabal successfully unset"
+              pure ExitSuccess
+            UnSet (UnsetHLS (UnsetOptions _)) -> do
+              runAppState unsetHLS
+              runLogger $ logInfo "HLS successfully unset"
+              pure ExitSuccess
+            UnSet (UnsetStack (UnsetOptions _)) -> do
+              runAppState unsetStack
+              runLogger $ logInfo "Stack successfully unset"
+              pure ExitSuccess
+
             List ListOptions {..} ->
               runListGHC (do
                   l <- listVersions loTool lCriteria

lib/GHCup.hs

@@ -968,6 +968,17 @@ setGHC ver sghc = do
             $ createDirectoryLink targetF fullF
       _ -> pure ()
 
+unsetGHC :: ( MonadReader env m
+            , HasDirs env
+            , HasLog env
+            , MonadThrow m
+            , MonadFail m
+            , MonadIO m
+            , MonadMask m
+            )
+         => Maybe Text
+         -> Excepts '[NotInstalled] m ()
+unsetGHC = rmPlain
 
 
 -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
@@ -975,7 +986,6 @@ setCabal :: ( MonadMask m
             , MonadReader env m
             , HasDirs env
             , HasLog env
-            , MonadThrow m
             , MonadFail m
             , MonadIO m
             , MonadUnliftIO m)
@@ -999,18 +1009,24 @@ setCabal ver = do
 
   pure ()
 
-
+unsetCabal :: ( MonadMask m
+              , MonadReader env m
+              , HasDirs env
+              , MonadIO m)
+           => m ()
+unsetCabal = do
+  Dirs {..} <- getDirs
+  let cabalbin = binDir </> "cabal" <> exeExt
+  hideError doesNotExistErrorType $ rmLink cabalbin
 
 
 -- | Set the haskell-language-server symlinks.
-setHLS :: ( MonadCatch m
+setHLS :: ( MonadReader env m
-          , MonadReader env m
           , HasDirs env
           , HasLog env
-          , MonadThrow m
-          , MonadFail m
           , MonadIO m
           , MonadMask m
+          , MonadFail m
           , MonadUnliftIO m
           )
        => Version
@@ -1045,6 +1061,21 @@ setHLS ver = do
   pure ()
 
 
+unsetHLS :: ( MonadMask m
+            , MonadReader env m
+            , HasDirs env
+            , MonadIO m)
+         => m ()
+unsetHLS = do
+  Dirs {..} <- getDirs
+  let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
+  bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles'
+    binDir
+    (MP.chunk "haskell-language-server-" <* pvp' <* MP.chunk (T.pack exeExt) <* MP.eof)
+  forM_ bins (hideError doesNotExistErrorType . rmLink . (binDir </>))
+  hideError doesNotExistErrorType $ rmLink wrapper
+
+
 -- | Set the @~\/.ghcup\/bin\/stack@ symlink.
 setStack :: ( MonadMask m
             , MonadReader env m
@@ -1074,6 +1105,17 @@ setStack ver = do
   pure ()
 
 
+unsetStack :: ( MonadMask m
+              , MonadReader env m
+              , HasDirs env
+              , MonadIO m)
+           => m ()
+unsetStack = do
+  Dirs {..} <- getDirs
+  let stackbin = binDir </> "stack" <> exeExt
+  hideError doesNotExistErrorType $ rmLink stackbin
+
+
 -- | Warn if the installed and set HLS is not compatible with the installed and
 -- set GHC version.
 warnAboutHlsCompatibility :: ( MonadReader env m

lib/GHCup/Utils/File/Common.hs

@@ -9,6 +9,8 @@ import           GHCup.Utils.Prelude
 
 import           Control.Monad.Reader
 import           Data.Maybe
+import           Data.Text               ( Text )
+import           Data.Void
 import           GHC.IO.Exception
 import           Optics                  hiding ((<|), (|>))
 import           System.Directory
@@ -16,7 +18,9 @@ import           System.FilePath
 import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 
+import qualified Data.Text                     as T
 import qualified Data.ByteString.Lazy          as BL
+import qualified Text.Megaparsec               as MP
 
 
 
@@ -101,6 +105,11 @@ findFiles path regex = do
   contents <- listDirectory path
   pure $ filter (match regex) contents
 
+findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
+findFiles' path parser = do
+  contents <- listDirectory path
+  pure $ filter (\fp -> either (const False) (const True) $ MP.parse parser "" (T.pack fp)) contents
+
 
 checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
 checkFileAlreadyExists fp = liftIO $ doesFileExist fp