Implement ghcup unset

This commit is contained in:
Julian Ospald 2021-09-19 13:50:51 +02:00
parent 709658462c
commit 4767f3db5b
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
5 changed files with 183 additions and 8 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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