Implement ghcup unset

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
-          , MonadReader env m
+setHLS :: ( 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