Merge branch 'unset'
This commit is contained in:
commit
ba4b45f7fb
GPG Key ID:
3786C5262ECB4A3F
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
54
lib/GHCup.hs
54
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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user