Compare commits

..

42 Commits

Author SHA1 Message Date
4767f3db5b Implement ghcup unset 2021-09-19 14:17:55 +02:00
709658462c Merge branch 'gpg' 2021-09-19 12:28:46 +02:00
c431c0ae00 Implement GPG verification wrt #236 2021-09-18 21:51:19 +02:00
6f61b5dbef Make hlint shut up 2021-09-18 15:47:54 +02:00
c42c4b64f9 Improve logging 2021-09-18 15:46:53 +02:00
d3a36c2c9a Merge remote-tracking branch 'origin/merge-requests/156' 2021-09-18 15:19:06 +02:00
6799e9616e Merge remote-tracking branch 'origin/merge-requests/177' 2021-09-17 22:14:33 +02:00
Emily Pillmore
e8d962ac44 Add language fixes per issue #237 2021-09-17 14:11:00 -06:00
ac1e145028 Update README 2021-09-17 12:00:07 +02:00
2fdf121167 Update readme 2021-09-17 11:54:43 +02:00
dcca8b0bf2 Merge branch 'issue-231' 2021-09-17 11:51:33 +02:00
b1f891b005 Add supported platforms to README 2021-09-17 11:50:26 +02:00
648dcc7287 Update HLS 2021-09-16 21:41:05 +02:00
2175f7dd3d Warn when installing 8.10.5/8.10.6 2021-09-16 16:01:51 +02:00
aff90a52f1 Merge branch 'hls-1.4.0' 2021-09-15 23:08:48 +02:00
0f14dee72a Bump HLS to 1.4.0 2021-09-15 22:41:57 +02:00
ae2031174e Improve warnAboutHlsCompatibility 2021-09-14 12:36:14 +02:00
c163278c64 Merge remote-tracking branch 'origin/merge-requests/172' 2021-09-14 12:26:41 +02:00
d10133f06f Clean up toolRequirements 2021-09-13 22:33:46 +02:00
4377fc663e Merge branch 'opencollective' 2021-09-13 08:43:10 +02:00
Arjun Kathuria
8fc128e89b move some code around for better consistency 2021-09-12 09:25:09 +05:30
Chris Smith
737f72f90f Lint fix. 2021-09-11 23:35:39 -04:00
Chris Smith
c3aab65521 Rewording 2021-09-11 23:24:21 -04:00
Chris Smith
972474f79a Add version numbers to error message.
Fixes after formatting changes.
2021-09-11 23:17:14 -04:00
bc64d2ade0 Apply 3 suggestion(s) to 1 file(s) 2021-09-12 03:09:36 +00:00
Chris Smith
eddda55fe6 Fix hlint warnings 2021-09-11 19:57:42 -04:00
Chris Smith
13aca91231 Add a warning when the installed HLS and GHC versions are not compatible.
This is triggered when:

1. The user has just set either the GHC or HLS version.
2. There is an HLS version set (so some GHC version is compatible).
3. There is a GHC version.
4. The HLS version doesn't support that GHC version.

Fixes #234
2021-09-11 19:33:27 -04:00
Arjun Kathuria
6011242eae minor cleanup 2021-09-11 23:23:58 +05:30
Arjun Kathuria
cadb5086e1 Implements --force install for GHC 2021-09-11 23:20:06 +05:30
Arjun Kathuria
10a30bbf38 Implements --force install for Stack 2021-09-11 22:04:54 +05:30
Arjun Kathuria
6ac7a75bab Implements --force install for HLS 2021-09-11 22:04:40 +05:30
Arjun Kathuria
d60f58cf43 simplify checkIfToolInstalled for Cabal 2021-09-07 14:22:21 +05:30
Arjun Kathuria
7a6a119829 Patch for MonadLogger deletion since new rebase 2021-09-07 14:21:24 +05:30
Arjun Kathuria
f0fb019c70 Merge branch 'feat-force' of gitlab.haskell.org:arjun/ghcup-hs into feat-force 2021-09-07 11:29:33 +05:30
Arjun Kathuria
0f98ec6b78 factor out checkIfCabalInstalled to checkIfToolInstalled 2021-09-07 11:24:28 +05:30
Arjun Kathuria
107fed6e60 refactor nested case statements when installing cabal 2021-09-07 11:23:30 +05:30
Arjun Kathuria
59a9a770a5 implements --force option for cabal installs. 2021-09-07 11:23:26 +05:30
Arjun Kathuria
20bcb26e3d Adds the --force option in install commands 2021-09-07 11:17:10 +05:30
Arjun Kathuria
be82565775 factor out checkIfCabalInstalled to checkIfToolInstalled 2021-08-30 15:20:33 +05:30
Arjun Kathuria
f8d0243146 refactor nested case statements when installing cabal 2021-08-30 15:18:43 +05:30
Arjun Kathuria
d7f82d643c implements --force option for cabal installs. 2021-08-27 13:06:18 +05:30
Arjun Kathuria
15560a06b1 Adds the --force option in install commands 2021-08-27 13:05:54 +05:30
19 changed files with 873 additions and 260 deletions

View File

@@ -1,9 +1,11 @@
if [ "${OS}" = "WINDOWS" ] ; then if [ "${OS}" = "WINDOWS" ] ; then
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR" 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" export TMPDIR="$CI_PROJECT_DIR/tmp"
else else
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR" 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" export TMPDIR="$CI_PROJECT_DIR/tmp"
fi fi

View File

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

View File

@@ -13,11 +13,12 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
<a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a> <a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a>
* [Installation](#installation) * [Installation](#installation)
* [Simple bootstrap](#simple-bootstrap) * [Supported platforms](#supported-platforms)
* [Manual install](#manual-install) * [Manual install](#manual-install)
* [Vim integration](#vim-integration) * [Vim integration](#vim-integration)
* [Usage](#usage) * [Usage](#usage)
* [Configuration](#configuration) * [Configuration](#configuration)
* [GPG verification](#gpg-verification)
* [Manpages](#manpages) * [Manpages](#manpages)
* [Shell-completion](#shell-completion) * [Shell-completion](#shell-completion)
* [Compiling GHC from source](#compiling-ghc-from-source) * [Compiling GHC from source](#compiling-ghc-from-source)
@@ -35,9 +36,59 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
## Installation ## Installation
### Simple bootstrap Most users should follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/).
Advanced users may want to perform a [manual installation](#manual-install).
Follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/) ### Supported platforms
This list may not be exhaustive and specifies support for bindists only.
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2022 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows WSL1 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
| Windows WSL2 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| MacOS >=13 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| MacOS <13 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
| MacOS | aarch64 | ✅ | ✅ | ✅ | ⚠️ | ❌ |
| FreeBSD | amd64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
| Linux generic | x86 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Linux generic | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
#### Windows 7
May or may not work, several issues:
* https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140
* https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197
#### WSL1
Unsupported. GHC may or may not work. Upgrade to WSL2.
#### MacOS <13
Not supported. Would require separate binaries, since >=13 binaries are incompatible.
Please upgrade.
#### MacOS aarch64
HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet.
#### FreeBSD
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
HLS bindists are experimental.
#### Linux ARMv7/AARCH64
Lower availability of bindists. HLS only has experimental ones. Stack not supported currently.
### Manual install ### Manual install
@@ -96,6 +147,34 @@ explaining all possible configurations can be found in this repo: [config.yaml](
Partial configuration is fine. Command line options always override the config file settings. Partial configuration is fine. Command line options always override the config file settings.
### GPG verification
GHCup supports verifying the GPG signature of the metadata file. The metadata file then contains SHA256 hashes of all downloads, so
this is cryptographically secure.
First, obtain the gpg key:
```sh
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
```
Then verify the gpg key in one of these ways:
1. find out where I live and visit me to do offline key signing
2. figure out my mobile phone number and call me to verify the fingerprint
3. more boring: contact me on Libera IRC (`maerwald`) and verify the fingerprint
Once you've verified the key, you have to figure out if you trust me.
If you trust me, then you can configure gpg in `~/.ghcup/config.yaml`:
```yml
gpg-setting: GPGLax # GPGStrict | GPGLax | GPGNone
```
In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning.
You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
### Manpages ### Manpages
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc. For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
@@ -156,6 +235,7 @@ This is the complete list of env variables that change GHCup behavior:
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`) * `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl * `GHCUP_CURL_OPTS`: additional options that can be passed to curl
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget * `GHCUP_WGET_OPTS`: additional options that can be passed to wget
* `GHCUP_GPG_OPTS`: additional options that can be passed to gpg
* `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command * `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command
* `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup * `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup

View File

@@ -119,7 +119,7 @@ main = do
, rawOutter = \_ -> pure () , rawOutter = \_ -> pure ()
} }
dirs <- liftIO getAllDirs dirs <- liftIO getAllDirs
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings loggerConfig let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone) dirs defaultKeyBindings loggerConfig
pfreq <- ( pfreq <- (
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
@@ -129,7 +129,7 @@ main = do
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
liftIO $ exitWith (ExitFailure 2) liftIO $ exitWith (ExitFailure 2)
let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
>>= \Options {..} -> case optCommand of >>= \Options {..} -> case optCommand of

View File

@@ -229,6 +229,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
downloadAll ref dli = do downloadAll ref dli = do
r <- runResourceT r <- runResourceT
. runE @'[DigestError . runE @'[DigestError
, GPGError
, DownloadFailed , DownloadFailed
, UnknownArchive , UnknownArchive
, ArchiveResult , ArchiveResult
@@ -237,7 +238,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
case etool of case etool of
Right (Just GHCup) -> do Right (Just GHCup) -> do
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing pure Nothing
Right _ -> do Right _ -> do
p <- liftE $ downloadCached dli Nothing p <- liftE $ downloadCached dli Nothing
@@ -247,7 +248,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
$ p $ p
Left ShimGen -> do Left ShimGen -> do
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing pure Nothing
case r of case r of
VRight (Just basePath) -> do VRight (Just basePath) -> do

View File

@@ -429,6 +429,7 @@ install' _ (_, ListResult {..}) = do
, BuildFailed , BuildFailed
, TagNotFound , TagNotFound
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, DirNotEmpty , DirNotEmpty
, NoUpdate , NoUpdate
@@ -440,19 +441,19 @@ install' _ (_, ListResult {..}) = do
case lTool of case lTool of
GHC -> do GHC -> do
let vi = getVersionInfo lVer GHC dls let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer Nothing $> vi liftE $ installGHCBin lVer Nothing False $> vi
Cabal -> do Cabal -> do
let vi = getVersionInfo lVer Cabal dls let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer Nothing $> vi liftE $ installCabalBin lVer Nothing False $> vi
GHCup -> do GHCup -> do
let vi = snd <$> getLatest dls GHCup let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> vi liftE $ upgradeGHCup Nothing False $> vi
HLS -> do HLS -> do
let vi = getVersionInfo lVer HLS dls let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer Nothing $> vi liftE $ installHLSBin lVer Nothing False $> vi
Stack -> do Stack -> do
let vi = getVersionInfo lVer Stack dls let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer Nothing $> vi liftE $ installStackBin lVer Nothing False $> vi
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
@@ -547,6 +548,7 @@ settings' = unsafePerformIO $ do
, verbose = False , verbose = False
, urlSource = GHCupURL , urlSource = GHCupURL
, noNetwork = False , noNetwork = False
, gpgSetting = GPGNone
, .. , ..
}) })
dirs dirs
@@ -591,7 +593,7 @@ getGHCupInfo = do
r <- r <-
flip runReaderT settings flip runReaderT settings
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError] . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
$ liftE $ liftE
$ getDownloadsF $ getDownloadsF

View File

@@ -87,21 +87,23 @@ import qualified Text.Megaparsec.Char as MPC
data Options = Options data Options = Options
{ {
-- global options -- global options
optVerbose :: Maybe Bool optVerbose :: Maybe Bool
, optCache :: Maybe Bool , optCache :: Maybe Bool
, optUrlSource :: Maybe URI , optUrlSource :: Maybe URI
, optNoVerify :: Maybe Bool , optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs , optKeepDirs :: Maybe KeepDirs
, optsDownloader :: Maybe Downloader , optsDownloader :: Maybe Downloader
, optNoNetwork :: Maybe Bool , optNoNetwork :: Maybe Bool
, optGpg :: Maybe GPGSetting
-- commands -- commands
, optCommand :: Command , optCommand :: Command
} }
data Command data Command
= Install (Either InstallCommand InstallOptions) = Install (Either InstallCommand InstallOptions)
| InstallCabalLegacy InstallOptions | InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions) | Set (Either SetCommand SetOptions)
| UnSet UnsetCommand
| List ListOptions | List ListOptions
| Rm (Either RmCommand RmOptions) | Rm (Either RmCommand RmOptions)
| DInfo | DInfo
@@ -141,6 +143,7 @@ data InstallOptions = InstallOptions
, instBindist :: Maybe URI , instBindist :: Maybe URI
, instSet :: Bool , instSet :: Bool
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
, forceInstall :: Bool
} }
data SetCommand = SetGHC SetOptions data SetCommand = SetGHC SetOptions
@@ -148,6 +151,11 @@ data SetCommand = SetGHC SetOptions
| SetHLS SetOptions | SetHLS SetOptions
| SetStack SetOptions | SetStack SetOptions
data UnsetCommand = UnsetGHC UnsetOptions
| UnsetCabal UnsetOptions
| UnsetHLS UnsetOptions
| UnsetStack UnsetOptions
-- a superset of ToolVersion -- a superset of ToolVersion
data SetToolVersion = SetToolVersion GHCTargetVersion data SetToolVersion = SetToolVersion GHCTargetVersion
| SetToolTag Tag | SetToolTag Tag
@@ -158,6 +166,10 @@ data SetOptions = SetOptions
{ sToolVer :: SetToolVersion { sToolVer :: SetToolVersion
} }
data UnsetOptions = UnsetOptions
{ sToolVer :: Maybe Text -- target platform triple
}
data ListOptions = ListOptions data ListOptions = ListOptions
{ loTool :: Maybe Tool { loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria , lCriteria :: Maybe ListCriteria
@@ -309,6 +321,13 @@ opts =
<> hidden <> hidden
)) ))
<*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.") <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
<*> optional (option
(eitherReader gpgParser)
( long "gpg"
<> metavar "<strict|lax|none>"
<> help
"GPG verification (default: none)"
))
<*> com <*> com
where where
parseUri s' = parseUri s' =
@@ -348,6 +367,14 @@ com =
<> footerDoc (Just $ text setFooter) <> footerDoc (Just $ text setFooter)
) )
) )
<> command
"unset"
(info
(UnSet <$> unsetParser <**> helper)
( progDesc "Unset currently active GHC/cabal version"
<> footerDoc (Just $ text unsetFooter)
)
)
<> command <> command
"rm" "rm"
(info (info
@@ -461,6 +488,10 @@ com =
is given, sets GHC to 'recommended' version). is given, sets GHC to 'recommended' version).
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|] 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 :: String
rmFooter = [s|Discussion: rmFooter = [s|Discussion:
Remove the given GHC or cabal version. When no command is given, Remove the given GHC or cabal version. When no command is given,
@@ -602,7 +633,7 @@ Examples:
installOpts :: Maybe Tool -> Parser InstallOptions installOpts :: Maybe Tool -> Parser InstallOptions
installOpts tool = installOpts tool =
(\p (u, v) b is -> InstallOptions v p u b is) (\p (u, v) b is f -> InstallOptions v p u b is f)
<$> optional <$> optional
(option (option
(eitherReader platformParser) (eitherReader platformParser)
@@ -640,6 +671,9 @@ installOpts tool =
<> help "install in an isolated dir instead of the default one" <> help "install in an isolated dir instead of the default one"
) )
) )
<*> switch
(short 'f' <> long "force" <> help "Force install")
setParser :: Parser (Either SetCommand SetOptions) setParser :: Parser (Either SetCommand SetOptions)
@@ -703,12 +737,74 @@ setParser =
setHLSFooter = [s|Discussion: setHLSFooter = [s|Discussion:
Sets the the current haskell-language-server version.|] 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 :: Maybe Tool -> Parser SetOptions
setOpts tool = SetOptions <$> setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$> (fromMaybe SetRecommended <$>
optional (setVersionArgument (Just ListInstalled) tool)) optional (setVersionArgument (Just ListInstalled) tool))
unsetOpts :: Parser UnsetOptions
unsetOpts = UnsetOptions . fmap T.pack <$> optional (argument str (metavar "TRIPLE"))
listOpts :: Parser ListOptions listOpts :: Parser ListOptions
listOpts = listOpts =
ListOptions ListOptions
@@ -1141,7 +1237,7 @@ tagCompleter tool add = listIOCompleter $ do
, rawOutter = mempty , rawOutter = mempty
} }
let appState = LeanAppState let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True) (Settings True False Never Curl False GHCupURL True GPGNone)
dirs' dirs'
defaultKeyBindings defaultKeyBindings
loggerConfig loggerConfig
@@ -1166,7 +1262,7 @@ versionCompleter criteria tool = listIOCompleter $ do
, colorOutter = mempty , colorOutter = mempty
, rawOutter = mempty , rawOutter = mempty
} }
let settings = Settings True False Never Curl False GHCupURL True let settings = Settings True False Never Curl False GHCupURL True GPGNone
let leanAppState = LeanAppState let leanAppState = LeanAppState
settings settings
dirs' dirs'
@@ -1253,6 +1349,13 @@ downloaderParser s' | t == T.pack "curl" = Right Curl
| otherwise = Left ("Unknown downloader value: " <> s') | otherwise = Left ("Unknown downloader value: " <> s')
where t = T.toLower (T.pack s') where t = T.toLower (T.pack s')
gpgParser :: String -> Either String GPGSetting
gpgParser s' | t == T.pack "strict" = Right GPGStrict
| t == T.pack "lax" = Right GPGLax
| t == T.pack "none" = Right GPGNone
| otherwise = Left ("Unknown gpg setting value: " <> s')
where t = T.toLower (T.pack s')
platformParser :: String -> Either String PlatformRequest platformParser :: String -> Either String PlatformRequest
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
@@ -1332,6 +1435,7 @@ toSettings options = do
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe GPGNone uGPGSetting) optGpg
in (Settings {..}, keyBindings) in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal defaultDownloader = Internal
@@ -1367,7 +1471,8 @@ updateSettings config settings = do
verbose' = fromMaybe verbose uVerbose verbose' = fromMaybe verbose uVerbose
urlSource' = fromMaybe urlSource uUrlSource urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork noNetwork' = fromMaybe noNetwork uNoNetwork
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' = fromMaybe gpgSetting uGPGSetting
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting'
upgradeOptsP :: Parser UpgradeOpts upgradeOptsP :: Parser UpgradeOpts
upgradeOptsP = upgradeOptsP =
@@ -1392,7 +1497,7 @@ describe_result = $( LitE . StringL <$>
runIO (do runIO (do
CapturedProcess{..} <- do CapturedProcess{..} <- do
dirs <- liftIO getAllDirs dirs <- liftIO getAllDirs
let settings = AppState (Settings True False Never Curl False GHCupURL False) let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone)
dirs dirs
defaultKeyBindings defaultKeyBindings
flip runReaderT settings $ executeOut "git" ["describe"] Nothing flip runReaderT settings $ executeOut "git" ["describe"] Nothing
@@ -1502,7 +1607,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
ghcupInfo <- ghcupInfo <-
( flip runReaderT leanAppstate ( flip runReaderT leanAppstate
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError] . runE @'[DigestError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
$ liftE $ liftE
$ getDownloadsF $ getDownloadsF
) )
@@ -1575,6 +1680,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, BuildFailed , BuildFailed
, TagNotFound , TagNotFound
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, TarDirDoesNotExist , TarDirDoesNotExist
, NextVerNotFound , NextVerNotFound
@@ -1607,6 +1713,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, NoToolVersionSet , NoToolVersionSet
] ]
runUnsetGHC =
runAppState
. runE
@'[ NotInstalled ]
let let
runLeanSetCabal = runLeanSetCabal =
runLeanAppState runLeanAppState
@@ -1665,6 +1776,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
@'[ AlreadyInstalled @'[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, GHCupSetError , GHCupSetError
, NoDownload , NoDownload
@@ -1703,6 +1815,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
. runResourceT . runResourceT
. runE . runE
@'[ DigestError @'[ DigestError
, GPGError
, NoDownload , NoDownload
, NoUpdate , NoUpdate
, FileDoesNotExistError , FileDoesNotExistError
@@ -1719,6 +1832,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, NoToolVersionSet , NoToolVersionSet
, NoDownload , NoDownload
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, JSONError , JSONError
, FileDoesNotExistError , FileDoesNotExistError
@@ -1733,7 +1847,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBin (_tvVersion v) isolateDir liftE $ installGHCBin
(_tvVersion v)
isolateDir
forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi pure vi
Just uri -> do Just uri -> do
@@ -1741,9 +1858,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBindist liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "") (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi pure vi
) )
@@ -1755,8 +1873,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first" "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger $ (logError $ T.pack $ prettyShow err) Never -> runLogger $ (logError $ T.pack $ prettyShow err)
@@ -1775,16 +1897,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal (v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBin (_tvVersion v) isolateDir liftE $ installCabalBin
(_tvVersion v)
isolateDir
forceInstall
pure vi pure vi
Just uri -> do Just uri -> do
s' <- appState s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal (v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBindist liftE $ installCabalBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall
pure vi pure vi
) )
>>= \case >>= \case
@@ -1795,8 +1921,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal " <> prettyVer v <> "' first" "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -1807,16 +1937,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer HLS (v, vi) <- liftE $ fromVersion instVer HLS
liftE $ installHLSBin (_tvVersion v) isolateDir liftE $ installHLSBin
(_tvVersion v)
isolateDir
forceInstall
pure vi pure vi
Just uri -> do Just uri -> do
s' <- appState s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer HLS (v, vi) <- liftE $ fromVersion instVer HLS
liftE $ installHLSBindist liftE $ installHLSBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall
pure vi pure vi
) )
>>= \case >>= \case
@@ -1829,10 +1963,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ logWarn $ runLogger $ logWarn $
"HLS ver " "HLS ver "
<> prettyVer v <> prettyVer v
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls " <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
<> prettyVer v <> prettyVer v
<> "' first" <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -1843,16 +1981,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack (v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBin (_tvVersion v) isolateDir liftE $ installStackBin
(_tvVersion v)
isolateDir
forceInstall
pure vi pure vi
Just uri -> do Just uri -> do
s' <- appState s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack (v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBindist liftE $ installStackBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall
pure vi pure vi
) )
>>= \case >>= \case
@@ -1863,8 +2005,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack " <> prettyVer v <> "' first" "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -2032,6 +2178,27 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Set (Left (SetHLS sopts)) -> setHLS' sopts Set (Left (SetHLS sopts)) -> setHLS' sopts
Set (Left (SetStack sopts)) -> setStack' 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 {..} -> List ListOptions {..} ->
runListGHC (do runListGHC (do
l <- listVersions loTool lCriteria l <- listVersions loTool lCriteria
@@ -2099,8 +2266,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first" "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger $ logError $ T.pack $ prettyShow err Never -> runLogger $ logError $ T.pack $ prettyShow err

View File

@@ -8,6 +8,10 @@ verbose: False
keep-dirs: Errors # Always | Never | Errors keep-dirs: Errors # Always | Never | Errors
# Which downloader to use # Which downloader to use
downloader: Curl # Curl | Wget | Internal downloader: Curl # Curl | Wget | Internal
# whether to run in offline mode
no-network: False
# whether/how to do gpg verification
gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
# TUI key bindings, # TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key # see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key

View File

@@ -72,7 +72,6 @@ toolRequirements:
'( >= 7 && < 8 )': '( >= 7 && < 8 )':
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -83,7 +82,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -96,7 +94,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -111,14 +108,15 @@ toolRequirements:
- binutils-gold - binutils-gold
- curl - curl
- gcc - gcc
- g++
- gmp-dev - gmp-dev
- ncurses-dev - libc-dev
- libffi-dev - libffi-dev
- make - make
- xz - musl-dev
- tar - ncurses-dev
- perl - perl
- tar
- xz
notes: '' notes: ''
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
@@ -1598,6 +1596,11 @@ ghcupDownloads:
dlHash: f10941f16e4fbd98580ab5241b9271bb0851304560c4d5ca127e3b0e20e3076f dlHash: f10941f16e4fbd98580ab5241b9271bb0851304560c4d5ca127e3b0e20e3076f
viPostRemove: *ghc-post-remove viPostRemove: *ghc-post-remove
viPreCompile: *ghc-pre-compile viPreCompile: *ghc-pre-compile
viPostInstall: &ghc-8105-post-install |
GHC 8.10.5 and 8.10.6 have several issues on Darwin, e.g.
https://gitlab.haskell.org/ghc/ghc/-/issues/19950
Consider upgrading to 8.10.7 via
ghcup install ghc --set 8.10.7
viArch: viArch:
A_64: A_64:
Linux_Debian: Linux_Debian:
@@ -1698,6 +1701,7 @@ ghcupDownloads:
dlHash: 43afba72a533408b42c1492bd047b5e37e5f7204e41a5cedd3182cc841610ce9 dlHash: 43afba72a533408b42c1492bd047b5e37e5f7204e41a5cedd3182cc841610ce9
viPostRemove: *ghc-post-remove viPostRemove: *ghc-post-remove
viPreCompile: *ghc-pre-compile viPreCompile: *ghc-pre-compile
viPostInstall: *ghc-8105-post-install
viArch: viArch:
A_64: A_64:
Linux_Debian: Linux_Debian:
@@ -2314,7 +2318,8 @@ ghcupDownloads:
dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57 dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
HLS: HLS:
1.1.0: 1.1.0:
viTags: [] viTags:
- old
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
viPostInstall: &hls-post-install | viPostInstall: &hls-post-install |
This is just the server part of your LSP configuration. Consult the README on how to This is just the server part of your LSP configuration. Consult the README on how to
@@ -2337,7 +2342,8 @@ ghcupDownloads:
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-110-64 unknown_versioning: *hls-110-64
1.2.0: 1.2.0:
viTags: [] viTags:
- old
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
viPostInstall: *hls-post-install viPostInstall: *hls-post-install
viArch: viArch:
@@ -2357,9 +2363,7 @@ ghcupDownloads:
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-120-64 unknown_versioning: *hls-120-64
1.3.0: 1.3.0:
viTags: viTags: []
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
viPostInstall: *hls-post-install viPostInstall: *hls-post-install
viArch: viArch:
@@ -2378,6 +2382,46 @@ ghcupDownloads:
dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-130-64 unknown_versioning: *hls-130-64
1.4.0:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
viPostInstall: *hls-post-install
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &hls-140-64
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Linux-1.4.0.tar.gz
dlHash: f93c114441911ccce55649702adc9553cb4c9f953c37878321d2806a3525fee8
Darwin:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-macOS-1.4.0.tar.gz
dlHash: a7f0ac6be93ffb08cc239e5f5fead99b061061825f99566c1be33ee60cab62a4
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-freebsd-1.4.0.tar.gz
dlHash: 6b2ad2398ed8c3964dea017e3d5e553b54c10ba1373d7653d2edd019854f4da2
Windows:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Windows-1.4.0.tar.gz
dlHash: 0ec77cee750037b7a0ede817b46a913a702821f4098c6a858bcb686cb30f7efd
Linux_Alpine:
unknown_versioning: *hls-140-64
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-aarch64-1.4.0.tar.gz
dlHash: 8ad97e2bf1c538e637edec194e1cd9939019955bb749cb470f34bbe5a067b001
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-macOS-aarch64-1.4.0.tar.gz
dlHash: 70c6fe38e987ba44c1e19173486c01f666ffb30a74cd5a7968296a5aba4c2dd0
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-armv7-1.4.0.tar.gz
dlHash: 4a921fbca06b02f3b1c0930cec5e65e9362b603e7715680ec7b150f18bd703d6
Stack: Stack:
2.5.1: 2.5.1:
viTags: viTags:

View File

@@ -72,7 +72,6 @@ toolRequirements:
'( >= 7 && < 8 )': '( >= 7 && < 8 )':
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -83,7 +82,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -96,7 +94,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -109,7 +106,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- g++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -125,14 +121,15 @@ toolRequirements:
- binutils-gold - binutils-gold
- curl - curl
- gcc - gcc
- g++
- gmp-dev - gmp-dev
- ncurses-dev - libc-dev
- libffi-dev - libffi-dev
- make - make
- xz - musl-dev
- tar - ncurses-dev
- perl - perl
- tar
- xz
notes: '' notes: ''
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
@@ -1652,6 +1649,11 @@ ghcupDownloads:
dlHash: f10941f16e4fbd98580ab5241b9271bb0851304560c4d5ca127e3b0e20e3076f dlHash: f10941f16e4fbd98580ab5241b9271bb0851304560c4d5ca127e3b0e20e3076f
viPostRemove: *ghc-post-remove viPostRemove: *ghc-post-remove
viPreCompile: *ghc-pre-compile viPreCompile: *ghc-pre-compile
viPostInstall: &ghc-8105-post-install |
GHC 8.10.5 and 8.10.6 have several issues on Darwin, e.g.
https://gitlab.haskell.org/ghc/ghc/-/issues/19950
Consider upgrading to 8.10.7 via
ghcup install ghc --set 8.10.7
viArch: viArch:
A_64: A_64:
Linux_Debian: Linux_Debian:
@@ -1754,6 +1756,7 @@ ghcupDownloads:
dlHash: 43afba72a533408b42c1492bd047b5e37e5f7204e41a5cedd3182cc841610ce9 dlHash: 43afba72a533408b42c1492bd047b5e37e5f7204e41a5cedd3182cc841610ce9
viPostRemove: *ghc-post-remove viPostRemove: *ghc-post-remove
viPreCompile: *ghc-pre-compile viPreCompile: *ghc-pre-compile
viPostInstall: *ghc-8105-post-install
viArch: viArch:
A_64: A_64:
Linux_Debian: Linux_Debian:
@@ -2376,7 +2379,8 @@ ghcupDownloads:
dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57 dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
HLS: HLS:
1.1.0: 1.1.0:
viTags: [] viTags:
- old
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
viPostInstall: &hls-post-install | viPostInstall: &hls-post-install |
This is just the server part of your LSP configuration. Consult the README on how to This is just the server part of your LSP configuration. Consult the README on how to
@@ -2399,7 +2403,8 @@ ghcupDownloads:
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-110-64 unknown_versioning: *hls-110-64
1.2.0: 1.2.0:
viTags: [] viTags:
- old
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
viPostInstall: *hls-post-install viPostInstall: *hls-post-install
viArch: viArch:
@@ -2419,9 +2424,7 @@ ghcupDownloads:
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-120-64 unknown_versioning: *hls-120-64
1.3.0: 1.3.0:
viTags: viTags: []
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
viPostInstall: *hls-post-install viPostInstall: *hls-post-install
viArch: viArch:
@@ -2440,6 +2443,46 @@ ghcupDownloads:
dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-130-64 unknown_versioning: *hls-130-64
1.4.0:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
viPostInstall: *hls-post-install
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &hls-140-64
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Linux-1.4.0.tar.gz
dlHash: f93c114441911ccce55649702adc9553cb4c9f953c37878321d2806a3525fee8
Darwin:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-macOS-1.4.0.tar.gz
dlHash: a7f0ac6be93ffb08cc239e5f5fead99b061061825f99566c1be33ee60cab62a4
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-freebsd-1.4.0.tar.gz
dlHash: 6b2ad2398ed8c3964dea017e3d5e553b54c10ba1373d7653d2edd019854f4da2
Windows:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Windows-1.4.0.tar.gz
dlHash: 0ec77cee750037b7a0ede817b46a913a702821f4098c6a858bcb686cb30f7efd
Linux_Alpine:
unknown_versioning: *hls-140-64
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-aarch64-1.4.0.tar.gz
dlHash: 8ad97e2bf1c538e637edec194e1cd9939019955bb749cb470f34bbe5a067b001
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-macOS-aarch64-1.4.0.tar.gz
dlHash: 70c6fe38e987ba44c1e19173486c01f666ffb30a74cd5a7968296a5aba4c2dd0
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-armv7-1.4.0.tar.gz
dlHash: 4a921fbca06b02f3b1c0930cec5e65e9362b603e7715680ec7b150f18bd703d6
Stack: Stack:
2.5.1: 2.5.1:
viTags: viTags:

View File

@@ -121,6 +121,7 @@ fetchToolBindist :: ( MonadFail m
-> Maybe FilePath -> Maybe FilePath
-> Excepts -> Excepts
'[ DigestError '[ DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
] ]
@@ -148,6 +149,7 @@ fetchGHCSrc :: ( MonadFail m
-> Maybe FilePath -> Maybe FilePath
-> Excepts -> Excepts
'[ DigestError '[ DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
] ]
@@ -184,10 +186,12 @@ installGHCBindist :: ( MonadFail m
=> DownloadInfo -- ^ where/how to download => DownloadInfo -- ^ where/how to download
-> Version -- ^ the version to install -> Version -- ^ the version to install
-> Maybe FilePath -- ^ isolated filepath if user passed any -> Maybe FilePath -- ^ isolated filepath if user passed any
-> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -198,15 +202,26 @@ installGHCBindist :: ( MonadFail m
] ]
m m
() ()
installGHCBindist dlinfo ver isoFilepath = do installGHCBindist dlinfo ver isoFilepath forceInstall = do
let tver = mkTVer ver let tver = mkTVer ver
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
case isoFilepath of regularGHCInstalled <- lift $ checkIfToolInstalled GHC ver
-- we only care for already installed errors in regular (non-isolated) installs
Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver) if
_ -> pure () | not forceInstall
, regularGHCInstalled
, Nothing <- isoFilepath -> do
throwE $ AlreadyInstalled GHC ver
| forceInstall
, regularGHCInstalled
, Nothing <- isoFilepath -> do
lift $ logInfo "Removing the currently installed GHC version first!"
liftE $ rmGHCVer tver
| otherwise -> pure ()
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -215,13 +230,13 @@ installGHCBindist dlinfo ver isoFilepath = do
ghcdir <- lift $ ghcupGHCDir tver ghcdir <- lift $ ghcupGHCDir tver
toolchainSanityChecks toolchainSanityChecks
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver forceInstall
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver forceInstall
-- make symlinks & stuff when regular install, -- make symlinks & stuff when regular install,
liftE $ postGHCInstall tver liftE $ postGHCInstall tver
@@ -254,6 +269,7 @@ installPackedGHC :: ( MonadMask m
-> Maybe TarDir -- ^ Subdir of the archive -> Maybe TarDir -- ^ Subdir of the archive
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Version -- ^ The GHC version -> Version -- ^ The GHC version
-> Bool -- ^ Force install
-> Excepts -> Excepts
'[ BuildFailed '[ BuildFailed
, UnknownArchive , UnknownArchive
@@ -261,10 +277,11 @@ installPackedGHC :: ( MonadMask m
, DirNotEmpty , DirNotEmpty
, ArchiveResult , ArchiveResult
] m () ] m ()
installPackedGHC dl msubdir inst ver = do installPackedGHC dl msubdir inst ver forceInstall = do
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
liftE $ installDestSanityCheck inst unless forceInstall
(liftE $ installDestSanityCheck inst)
-- unpack -- unpack
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
@@ -275,7 +292,7 @@ installPackedGHC dl msubdir inst ver = do
workdir <- maybe (pure tmpUnpack) workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack) (liftE . intoSubdir tmpUnpack)
msubdir msubdir
liftE $ runBuildAction tmpUnpack liftE $ runBuildAction tmpUnpack
(Just inst) (Just inst)
(installUnpackedGHC workdir inst ver) (installUnpackedGHC workdir inst ver)
@@ -365,10 +382,12 @@ installGHCBin :: ( MonadFail m
) )
=> Version -- ^ the version to install => Version -- ^ the version to install
-> Maybe FilePath -- ^ isolated install filepath, if user passed any -> Maybe FilePath -- ^ isolated install filepath, if user passed any
-> Bool -- ^ force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -379,9 +398,9 @@ installGHCBin :: ( MonadFail m
] ]
m m
() ()
installGHCBin ver isoFilepath = do installGHCBin ver isoFilepath forceInstall = do
dlinfo <- liftE $ getDownloadInfo GHC ver dlinfo <- liftE $ getDownloadInfo GHC ver
installGHCBindist dlinfo ver isoFilepath installGHCBindist dlinfo ver isoFilepath forceInstall
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as -- | Like 'installCabalBin', except takes the 'DownloadInfo' as
@@ -401,10 +420,12 @@ installCabalBindist :: ( MonadMask m
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolated install filepath, if user provides any. -> Maybe FilePath -- ^ isolated install filepath, if user provides any.
-> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -415,25 +436,30 @@ installCabalBindist :: ( MonadMask m
] ]
m m
() ()
installCabalBindist dlinfo ver isoFilepath = do installCabalBindist dlinfo ver isoFilepath forceInstall = do
lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
case isoFilepath of -- check if we already have a regular cabal already installed
Nothing -> -- for regular install check if any previous versions installed regularCabalInstalled <- lift $ checkIfToolInstalled Cabal ver
whenM
(lift (cabalInstalled ver) >>= \a -> liftIO $
handleIO (\_ -> pure False)
$ fmap (\x -> a && x)
-- ignore when the installation is a legacy cabal (binary, not symlink)
$ pathIsLink (binDir </> "cabal" <> exeExt)
)
(throwE $ AlreadyInstalled Cabal ver)
_ -> pure () -- check isn't required in isolated installs if
| not forceInstall
, regularCabalInstalled
, Nothing <- isoFilepath -> do
throwE $ AlreadyInstalled Cabal ver
| forceInstall
, regularCabalInstalled
, Nothing <- isoFilepath -> do
lift $ logInfo "Removing the currently installed version first!"
liftE $ rmCabalVer ver
| otherwise -> pure ()
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -448,23 +474,24 @@ installCabalBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
liftE $ installCabalUnpacked workdir isoDir Nothing liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installCabalUnpacked workdir binDir (Just ver) liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall
-- create symlink if this is the latest version for regular installs -- create symlink if this is the latest version for regular installs
cVers <- lift $ fmap rights getInstalledCabals cVers <- lift $ fmap rights getInstalledCabals
let lInstCabal = headMay . reverse . sort $ cVers let lInstCabal = headMay . reverse . sort $ cVers
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
-- | Install an unpacked cabal distribution. -- | Install an unpacked cabal distribution.Symbol
installCabalUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Maybe Version -- ^ Nothing for isolated install
-> Bool -- ^ Force Install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked path inst mver' = do installCabalUnpacked path inst mver' forceInstall = do
lift $ logInfo "Installing cabal" lift $ logInfo "Installing cabal"
let cabalFile = "cabal" let cabalFile = "cabal"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
@@ -473,7 +500,8 @@ installCabalUnpacked path inst mver' = do
<> exeExt <> exeExt
let destPath = inst </> destFileName let destPath = inst </> destFileName
liftE $ throwIfFileAlreadyExists destPath unless forceInstall -- Overwrite it when it IS a force install
(liftE $ throwIfFileAlreadyExists destPath)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile <> exeExt) (path </> cabalFile <> exeExt)
@@ -498,10 +526,12 @@ installCabalBin :: ( MonadMask m
) )
=> Version => Version
-> Maybe FilePath -- isolated install Path, if user provided any -> Maybe FilePath -- isolated install Path, if user provided any
-> Bool -- force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -512,9 +542,9 @@ installCabalBin :: ( MonadMask m
] ]
m m
() ()
installCabalBin ver isoFilepath = do installCabalBin ver isoFilepath forceInstall = do
dlinfo <- liftE $ getDownloadInfo Cabal ver dlinfo <- liftE $ getDownloadInfo Cabal ver
installCabalBindist dlinfo ver isoFilepath installCabalBindist dlinfo ver isoFilepath forceInstall
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as -- | Like 'installHLSBin, except takes the 'DownloadInfo' as
@@ -534,10 +564,12 @@ installHLSBindist :: ( MonadMask m
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolated install path, if user passed any -> Maybe FilePath -- ^ isolated install path, if user passed any
-> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -548,20 +580,28 @@ installHLSBindist :: ( MonadMask m
] ]
m m
() ()
installHLSBindist dlinfo ver isoFilepath = do installHLSBindist dlinfo ver isoFilepath forceInstall = do
lift $ logDebug $ "Requested to install hls version " <> prettyVer ver lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
case isoFilepath of regularHLSInstalled <- lift $ checkIfToolInstalled HLS ver
Nothing ->
-- we only check for already installed in regular (non-isolated) installs
whenM (lift (hlsInstalled ver))
(throwE $ AlreadyInstalled HLS ver)
_ -> pure () if
| not forceInstall
, regularHLSInstalled
, Nothing <- isoFilepath -> do -- regular install
throwE $ AlreadyInstalled HLS ver
| forceInstall
, regularHLSInstalled
, Nothing <- isoFilepath -> do -- regular forced install
lift $ logInfo "Removing the currently installed version of HLS before force installing!"
liftE $ rmHLSVer ver
| otherwise -> pure ()
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -576,10 +616,10 @@ installHLSBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do Just isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpacked workdir isoDir Nothing liftE $ installHLSUnpacked workdir isoDir Nothing forceInstall
Nothing -> do Nothing -> do
liftE $ installHLSUnpacked workdir binDir (Just ver) liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
-- create symlink if this is the latest version in a regular install -- create symlink if this is the latest version in a regular install
hlsVers <- lift $ fmap rights getInstalledHLSs hlsVers <- lift $ fmap rights getInstalledHLSs
@@ -592,8 +632,9 @@ installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Maybe Version -- ^ Nothing for isolated install
-> Bool -- ^ is it a force install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpacked path inst mver' = do installHLSUnpacked path inst mver' forceInstall = do
lift $ logInfo "Installing HLS" lift $ logInfo "Installing HLS"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
@@ -612,7 +653,8 @@ installHLSUnpacked path inst mver' = do
let srcPath = path </> f let srcPath = path </> f
let destPath = inst </> toF let destPath = inst </> toF
liftE $ throwIfFileAlreadyExists destPath unless forceInstall -- if it is a force install, overwrite it.
(liftE $ throwIfFileAlreadyExists destPath)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
srcPath srcPath
@@ -627,7 +669,8 @@ installHLSUnpacked path inst mver' = do
srcWrapperPath = path </> wrapper <> exeExt srcWrapperPath = path </> wrapper <> exeExt
destWrapperPath = inst </> toF destWrapperPath = inst </> toF
liftE $ throwIfFileAlreadyExists destWrapperPath unless forceInstall
(liftE $ throwIfFileAlreadyExists destWrapperPath)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
srcWrapperPath srcWrapperPath
@@ -651,11 +694,13 @@ installHLSBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath -> Maybe FilePath -- isolated install Dir (if any)
-> Bool -- force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -666,9 +711,9 @@ installHLSBin :: ( MonadMask m
] ]
m m
() ()
installHLSBin ver isoFilepath = do installHLSBin ver isoFilepath forceInstall = do
dlinfo <- liftE $ getDownloadInfo HLS ver dlinfo <- liftE $ getDownloadInfo HLS ver
installHLSBindist dlinfo ver isoFilepath installHLSBindist dlinfo ver isoFilepath forceInstall
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and -- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
@@ -688,11 +733,13 @@ installStackBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath -> Maybe FilePath -- ^ isolate install Dir (if any)
-> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -703,9 +750,9 @@ installStackBin :: ( MonadMask m
] ]
m m
() ()
installStackBin ver isoFilepath = do installStackBin ver isoFilepath forceInstall = do
dlinfo <- liftE $ getDownloadInfo Stack ver dlinfo <- liftE $ getDownloadInfo Stack ver
installStackBindist dlinfo ver isoFilepath installStackBindist dlinfo ver isoFilepath forceInstall
-- | Like 'installStackBin', except takes the 'DownloadInfo' as -- | Like 'installStackBin', except takes the 'DownloadInfo' as
@@ -724,11 +771,13 @@ installStackBindist :: ( MonadMask m
) )
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -> Maybe FilePath -- ^ isolate install Dir (if any)
-> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@@ -739,18 +788,27 @@ installStackBindist :: ( MonadMask m
] ]
m m
() ()
installStackBindist dlinfo ver isoFilepath = do installStackBindist dlinfo ver isoFilepath forceInstall = do
lift $ logDebug $ "Requested to install stack version " <> prettyVer ver lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
case isoFilepath of regularStackInstalled <- lift $ checkIfToolInstalled Stack ver
Nothing -> -- check previous versions in case of regular installs
whenM (lift (stackInstalled ver))
(throwE $ AlreadyInstalled Stack ver)
_ -> pure () -- don't do shit for isolates if
| not forceInstall
, regularStackInstalled
, Nothing <- isoFilepath -> do
throwE $ AlreadyInstalled Stack ver
| forceInstall
, regularStackInstalled
, Nothing <- isoFilepath -> do
lift $ logInfo "Removing the currently installed version of Stack first!"
liftE $ rmStackVer ver
| otherwise -> pure ()
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -766,9 +824,9 @@ installStackBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
liftE $ installStackUnpacked workdir isoDir Nothing liftE $ installStackUnpacked workdir isoDir Nothing forceInstall
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installStackUnpacked workdir binDir (Just ver) liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall
-- create symlink if this is the latest version and a regular install -- create symlink if this is the latest version and a regular install
sVers <- lift $ fmap rights getInstalledStacks sVers <- lift $ fmap rights getInstalledStacks
@@ -781,8 +839,9 @@ installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated installs -> Maybe Version -- ^ Nothing for isolated installs
-> Bool -- ^ Force install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked path inst mver' = do installStackUnpacked path inst mver' forceInstall = do
lift $ logInfo "Installing stack" lift $ logInfo "Installing stack"
let stackFile = "stack" let stackFile = "stack"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
@@ -791,7 +850,8 @@ installStackUnpacked path inst mver' = do
<> exeExt <> exeExt
destPath = inst </> destFileName destPath = inst </> destFileName
liftE $ throwIfFileAlreadyExists destPath unless forceInstall
(liftE $ throwIfFileAlreadyExists destPath)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> stackFile <> exeExt) (path </> stackFile <> exeExt)
@@ -868,6 +928,8 @@ setGHC ver sghc = do
-- create symlink for share dir -- create symlink for share dir
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
pure ver pure ver
where where
@@ -906,6 +968,17 @@ setGHC ver sghc = do
$ createDirectoryLink targetF fullF $ createDirectoryLink targetF fullF
_ -> pure () _ -> 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. -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
@@ -913,7 +986,6 @@ setCabal :: ( MonadMask m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, HasLog env , HasLog env
, MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
, MonadUnliftIO m) , MonadUnliftIO m)
@@ -937,18 +1009,24 @@ setCabal ver = do
pure () 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. -- | Set the haskell-language-server symlinks.
setHLS :: ( MonadCatch m setHLS :: ( MonadReader env m
, MonadReader env m
, HasDirs env , HasDirs env
, HasLog env , HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m , MonadIO m
, MonadMask m , MonadMask m
, MonadFail m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version => Version
@@ -978,9 +1056,26 @@ setHLS ver = do
lift $ createLink destL wrapper lift $ createLink destL wrapper
lift warnAboutHlsCompatibility
pure () 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. -- | Set the @~\/.ghcup\/bin\/stack@ symlink.
setStack :: ( MonadMask m setStack :: ( MonadMask m
, MonadReader env m , MonadReader env m
@@ -1010,6 +1105,42 @@ setStack ver = do
pure () 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
, HasDirs env
, HasLog env
, MonadThrow m
, MonadCatch m
, MonadIO m
)
=> m ()
warnAboutHlsCompatibility = do
supportedGHC <- hlsGHCVersions
currentGHC <- fmap _tvVersion <$> ghcSet Nothing
currentHLS <- hlsSet
case (currentGHC, currentHLS) of
(Just gv, Just hv) | gv `notElem` supportedGHC -> do
logWarn $
"GHC " <> T.pack (prettyShow gv) <> " is not compatible with " <>
"Haskell Language Server " <> T.pack (prettyShow hv) <> "." <> "\n" <>
"Haskell IDE support may not work until this is fixed." <> "\n" <>
"Install a different HLS version, or install and set one of the following GHCs:" <> "\n" <>
T.pack (prettyShow supportedGHC)
_ -> return ()
------------------ ------------------
--[ List tools ]-- --[ List tools ]--
@@ -1783,6 +1914,7 @@ compileGHC :: ( MonadMask m
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, GPGError
, DownloadFailed , DownloadFailed
, GHCupSetError , GHCupSetError
, NoDownload , NoDownload
@@ -1908,6 +2040,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(Just $ RegexDir "ghc-.*") (Just $ RegexDir "ghc-.*")
ghcdir ghcdir
(tver ^. tvVersion) (tver ^. tvVersion)
False -- not a force install, since we already overwrite when compiling.
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
@@ -2229,6 +2362,8 @@ upgradeGHCup :: ( MonadMask m
-> Excepts -> Excepts
'[ CopyError '[ CopyError
, DigestError , DigestError
, GPGError
, GPGError
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NoUpdate , NoUpdate
@@ -2245,7 +2380,7 @@ upgradeGHCup mtarget force' = do
dli <- liftE $ getDownloadInfo GHCup latestVer dli <- liftE $ getDownloadInfo GHCup latestVer
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
let fn = "ghcup" <> exeExt let fn = "ghcup" <> exeExt
p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False p <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmp (Just fn) False
let destDir = takeDirectory destFile let destDir = takeDirectory destFile
destFile = fromMaybe (binDir </> fn) mtarget destFile = fromMaybe (binDir </> fn) mtarget
lift $ logDebug $ "mkdir -p " <> T.pack destDir lift $ logDebug $ "mkdir -p " <> T.pack destDir
@@ -2354,6 +2489,22 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
currentRunningExecPath <- liftIO getExecutablePath currentRunningExecPath <- liftIO getExecutablePath
liftIO $ canonicalizePath currentRunningExecPath liftIO $ canonicalizePath currentRunningExecPath
-- | Doesn't work for cross GHC.
checkIfToolInstalled :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadCatch m) =>
Tool ->
Version ->
m Bool
checkIfToolInstalled tool ver =
case tool of
Cabal -> cabalInstalled ver
HLS -> hlsInstalled ver
Stack -> stackInstalled ver
GHC -> ghcInstalled $ mkTVer ver
_ -> pure False
throwIfFileAlreadyExists :: ( MonadIO m ) => throwIfFileAlreadyExists :: ( MonadIO m ) =>
FilePath -> FilePath ->

View File

@@ -114,7 +114,7 @@ getDownloadsF :: ( FromJSONKey Tool
, MonadMask m , MonadMask m
) )
=> Excepts => Excepts
'[JSONError , DownloadFailed , FileDoesNotExistError] '[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
m m
GHCupInfo GHCupInfo
getDownloadsF = do getDownloadsF = do
@@ -165,7 +165,7 @@ getBase :: ( MonadReader env m
, MonadMask m , MonadMask m
) )
=> URI => URI
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo -> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
getBase uri = do getBase uri = do
Settings { noNetwork, downloader } <- lift getSettings Settings { noNetwork, downloader } <- lift getSettings
@@ -176,7 +176,6 @@ getBase uri = do
then pure Nothing then pure Nothing
else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing) else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing) . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
. fmap Just . fmap Just
. smartDl . smartDl
$ uri $ uri
@@ -234,6 +233,7 @@ getBase uri = do
-> Excepts -> Excepts
'[ DownloadFailed '[ DownloadFailed
, DigestError , DigestError
, GPGError
] ]
m1 m1
FilePath FilePath
@@ -245,7 +245,7 @@ getBase uri = do
Dirs { cacheDir } <- lift getDirs Dirs { cacheDir } <- lift getDirs
-- for local files, let's short-circuit and ignore access time -- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
| e -> do | e -> do
accessTime <- liftIO $ getAccessTime json_file accessTime <- liftIO $ getAccessTime json_file
@@ -258,7 +258,7 @@ getBase uri = do
where where
dlWithMod modTime json_file = do dlWithMod modTime json_file = do
let (dir, fn) = splitFileName json_file let (dir, fn) = splitFileName json_file
f <- liftE $ download uri' Nothing dir (Just fn) True f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing dir (Just fn) True
liftIO $ setModificationTime f modTime liftIO $ setModificationTime f modTime
liftIO $ setAccessTime f modTime liftIO $ setAccessTime f modTime
pure f pure f
@@ -322,16 +322,17 @@ download :: ( MonadReader env m
, MonadIO m , MonadIO m
) )
=> URI => URI
-> Maybe URI -- ^ URI for gpg sig
-> Maybe T.Text -- ^ expected hash -> Maybe T.Text -- ^ expected hash
-> FilePath -- ^ destination dir (ignored for file:// scheme) -> FilePath -- ^ destination dir (ignored for file:// scheme)
-> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional filename
-> Bool -- ^ whether to read an write etags -> Bool -- ^ whether to read an write etags
-> Excepts '[DigestError , DownloadFailed] m FilePath -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
download uri eDigest dest mfn etags download uri gpgUri eDigest dest mfn etags
| scheme == "https" = dl | scheme == "https" = dl
| scheme == "http" = dl | scheme == "http" = dl
| scheme == "file" = do | scheme == "file" = do
let destFile' = T.unpack . decUTF8Safe $ path let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
lift $ logDebug $ "using local file: " <> T.pack destFile' lift $ logDebug $ "using local file: " <> T.pack destFile'
forM_ eDigest (liftE . flip checkDigest destFile') forM_ eDigest (liftE . flip checkDigest destFile')
pure destFile' pure destFile'
@@ -340,115 +341,179 @@ download uri eDigest dest mfn etags
where where
scheme = view (uriSchemeL' % schemeBSL') uri scheme = view (uriSchemeL' % schemeBSL') uri
dl = do dl = do
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
lift $ logInfo $ "downloading: " <> uri' <> " as file " <> T.pack destFile lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
-- destination dir must exist -- destination dir must exist
liftIO $ createDirRecursive' dest liftIO $ createDirRecursive' dest
-- download -- download
flip onException flip onException
(lift $ hideError doesNotExistErrorType $ recycleFile destFile) (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile))
$ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme] $ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError] @'[DigestError, DownloadFailed, GPGError]
(\e -> (\e' -> do
lift (hideError doesNotExistErrorType $ recycleFile destFile) lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile)
>> (throwE . DownloadFailed $ e) case e' of
V e@GPGError {} -> throwE e
V e@DigestError {} -> throwE e
_ -> throwE (DownloadFailed e')
) $ do ) $ do
Settings{ downloader, noNetwork } <- lift getSettings Settings{ downloader, noNetwork, gpgSetting } <- lift getSettings
when noNetwork $ throwE (DownloadFailed (V NoNetwork :: V '[NoNetwork])) when noNetwork $ throwE (DownloadFailed (V NoNetwork :: V '[NoNetwork]))
case downloader of downloadAction <- case downloader of
Curl -> do Curl -> do
o' <- liftIO getCurlOpts o' <- liftIO getCurlOpts
if etags if etags
then do then pure $ curlEtagsDL o'
dh <- liftIO $ emptySystemTempFile "curl-header" else pure $ curlDL o'
flip finally (try @_ @SomeException $ rmFile dh) $ Wget -> do
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do o' <- liftIO getWgetOpts
metag <- lift $ readETag destFile if etags
liftE $ lEM @_ @'[ProcessError] $ exec "curl" then pure $ wgetEtagsDL o'
(o' ++ (if etags then ["--dump-header", dh] else []) else pure $ wgetDL o'
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
headers <- liftIO $ T.readFile dh
-- this nonsense is necessary, because some older versions of curl would overwrite
-- the destination file when 304 is returned
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
Just (http':sc:_)
| sc == "304"
, T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
| T.pack "HTTP" `T.isPrefixOf` http' -> do
lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
liftIO $ copyFile (destFile <.> "tmp") destFile
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
:: V '[MalformedHeaders]))
lift $ writeEtags destFile (parseEtags headers)
else
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
Wget -> do
destFileTemp <- liftIO $ emptySystemTempFile "wget-tmp"
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
o' <- liftIO getWgetOpts
if etags
then do
metag <- lift $ readETag destFile
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
case _exitCode of
ExitSuccess -> do
liftIO $ copyFile destFileTemp destFile
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
ExitFailure i'
| i' == 8
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
-> do
lift $ logDebug "Not modified, skipping download"
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
| otherwise -> throwE (NonZeroExit i' "wget" opts)
else do
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
liftIO $ copyFile destFileTemp destFile
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
Internal -> do Internal -> do
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri if etags
if etags then pure (\fp -> liftE . internalEtagsDL fp)
then do else pure (\fp -> liftE . internalDL fp)
metag <- lift $ readETag destFile
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
, E.encodeUtf8 etag)]) metag
liftE
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
$ do
r <- downloadToFile https host fullPath port destFile addHeaders
lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
else void $ liftE $ catchE @HTTPNotModified
@'[DownloadFailed]
(\e@(HTTPNotModified _) ->
throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
$ downloadToFile https host fullPath port destFile mempty
#endif #endif
liftE $ downloadAction baseDestFile uri
case (gpgUri, gpgSetting) of
(_, GPGNone) -> pure ()
(Just gpgUri', _) -> do
gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile gpgUri' Nothing
liftE $ flip onException
(lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
$ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
(\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyShow (GPGError e))
) $ do
o' <- liftIO getGpgOpts
lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
liftE $ downloadAction gpgDestFile gpgUri'
lift $ logInfo $ "verifying signature of: " <> T.pack baseDestFile
let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, baseDestFile]
cp <- lift $ executeOut "gpg" args Nothing
case cp of
CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
lift $ logDebug $ decUTF8Safe' _stdErr
throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
_ -> pure ()
forM_ eDigest (liftE . flip checkDigest destFile) forM_ eDigest (liftE . flip checkDigest baseDestFile)
pure destFile pure baseDestFile
curlDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
liftIO $ renameFile destFileTemp destFile
curlEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
=> [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile
dh <- liftIO $ emptySystemTempFile "curl-header"
flip finally (try @_ @SomeException $ rmFile dh) $
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
metag <- lift $ readETag destFile
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ (if etags then ["--dump-header", dh] else [])
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
headers <- liftIO $ T.readFile dh
-- this nonsense is necessary, because some older versions of curl would overwrite
-- the destination file when 304 is returned
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
Just (http':sc:_)
| sc == "304"
, T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
| T.pack "HTTP" `T.isPrefixOf` http' -> do
lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
liftIO $ renameFile destFileTemp destFile
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
:: V '[MalformedHeaders]))
lift $ writeEtags destFile (parseEtags headers)
wgetDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
liftIO $ renameFile destFileTemp destFile
wgetEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
=> [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
metag <- lift $ readETag destFile
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
case _exitCode of
ExitSuccess -> do
liftIO $ renameFile destFileTemp destFile
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
ExitFailure i'
| i' == 8
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
-> do
lift $ logDebug "Not modified, skipping download"
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
| otherwise -> throwE (NonZeroExit i' "wget" opts)
#if defined(INTERNAL_DOWNLOADER)
internalDL :: (MonadCatch m, MonadMask m, MonadIO m)
=> FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
internalDL destFile uri' = do
let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
void $ liftE $ catchE @HTTPNotModified
@'[DownloadFailed]
(\e@(HTTPNotModified _) ->
throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
$ downloadToFile https host fullPath port destFileTemp mempty
liftIO $ renameFile destFileTemp destFile
internalEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
=> FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
internalEtagsDL destFile uri' = do
let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
metag <- lift $ readETag destFile
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
, E.encodeUtf8 etag)]) metag
liftE
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
$ do
r <- downloadToFile https host fullPath port destFileTemp addHeaders
liftIO $ renameFile destFileTemp destFile
lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
#endif
-- Manage to find a file we can write the body into. -- Manage to find a file we can write the body into.
getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
getDestFile = getDestFile uri' mfn' =
case mfn of let path = view pathL' uri'
in case mfn' of
Just fn -> pure (dest </> fn) Just fn -> pure (dest </> fn)
Nothing Nothing
| let urlBase = T.unpack (decUTF8Safe (urlBaseName path)) | let urlBase = T.unpack (decUTF8Safe (urlBaseName path))
, not (null urlBase) -> pure (dest </> urlBase) , not (null urlBase) -> pure (dest </> urlBase)
-- TODO: remove this once we use hpath again -- TODO: remove this once we use hpath again
| otherwise -> throwE $ NoUrlBase uri' | otherwise -> throwE $ NoUrlBase (decUTF8Safe . serializeURIRef' $ uri')
path = view pathL' uri
uri' = decUTF8Safe (serializeURIRef' uri)
parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text) parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
parseEtags stderr = do parseEtags stderr = do
@@ -509,14 +574,14 @@ downloadCached :: ( MonadReader env m
) )
=> DownloadInfo => DownloadInfo
-> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional filename
-> Excepts '[DigestError , DownloadFailed] m FilePath -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached dli mfn = do downloadCached dli mfn = do
Settings{ cache } <- lift getSettings Settings{ cache } <- lift getSettings
case cache of case cache of
True -> downloadCached' dli mfn Nothing True -> downloadCached' dli mfn Nothing
False -> do False -> do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp mfn False liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmp mfn False
downloadCached' :: ( MonadReader env m downloadCached' :: ( MonadReader env m
@@ -531,7 +596,7 @@ downloadCached' :: ( MonadReader env m
=> DownloadInfo => DownloadInfo
-> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional filename
-> Maybe FilePath -- ^ optional destination dir (default: cacheDir) -> Maybe FilePath -- ^ optional destination dir (default: cacheDir)
-> Excepts '[DigestError , DownloadFailed] m FilePath -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached' dli mfn mDestDir = do downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe cacheDir mDestDir let destDir = fromMaybe cacheDir mDestDir
@@ -542,7 +607,7 @@ downloadCached' dli mfn mDestDir = do
| fileExists -> do | fileExists -> do
liftE $ checkDigest (view dlHash dli) cachfile liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile pure cachfile
| otherwise -> liftE $ download (_dlUri dli) (Just (_dlHash dli)) destDir mfn False | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) destDir mfn False
@@ -589,6 +654,12 @@ getWgetOpts =
Just r -> pure $ splitOn " " r Just r -> pure $ splitOn " " r
Nothing -> pure [] Nothing -> pure []
-- | Get additional gpg args from env. This is an undocumented option.
getGpgOpts :: IO [String]
getGpgOpts =
lookupEnv "GHCUP_GPG_OPTS" >>= \case
Just r -> pure $ splitOn " " r
Nothing -> pure []
-- | Get the url base name. -- | Get the url base name.
-- --
@@ -610,3 +681,7 @@ urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
-- "HTTP/1.1 304 Not Modified\n" -- "HTTP/1.1 304 Not Modified\n"
getLastHeader :: T.Text -> T.Text getLastHeader :: T.Text -> T.Text
getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [""] . fmap T.stripEnd . T.lines getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [""] . fmap T.stripEnd . T.lines
tmpFile :: FilePath -> FilePath
tmpFile = (<.> "tmp")

View File

@@ -195,6 +195,14 @@ instance Pretty DigestError where
pPrint (DigestError currentDigest expectedDigest) = pPrint (DigestError currentDigest expectedDigest) =
text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
-- | File digest verification failed.
data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)
deriving instance Show GPGError
instance Pretty GPGError where
pPrint (GPGError reason) = text "GPG verify failed:" <+> pPrint reason
-- | Unexpected HTTP status. -- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString) data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
deriving Show deriving Show

View File

@@ -60,9 +60,10 @@ getCommonRequirements pr tr =
prettyRequirements :: Requirements -> T.Text prettyRequirements :: Requirements -> T.Text
prettyRequirements Requirements {..} = prettyRequirements Requirements {..} =
let d = if not . null $ _distroPKGs let d = if not . null $ _distroPKGs
then then "\n Please ensure the following distro packages "
"\n Please install the following distro packages: " <> "are installed before continuing (you can exit ghcup "
<> T.intercalate " " _distroPKGs <> "and return at any time): "
<> T.intercalate " " _distroPKGs
else "" else ""
n = if not . T.null $ _notes then "\n Note: " <> _notes else "" n = if not . T.null $ _notes then "\n Note: " <> _notes else ""
in "System requirements " <> d <> n in "System requirements " <> d <> n

View File

@@ -303,11 +303,12 @@ data UserSettings = UserSettings
, uKeyBindings :: Maybe UserKeyBindings , uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource , uUrlSource :: Maybe URLSource
, uNoNetwork :: Maybe Bool , uNoNetwork :: Maybe Bool
, uGPGSetting :: Maybe GPGSetting
} }
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing = fromSettings Settings{..} Nothing =
@@ -320,6 +321,7 @@ fromSettings Settings{..} Nothing =
, uNoNetwork = Just noNetwork , uNoNetwork = Just noNetwork
, uKeyBindings = Nothing , uKeyBindings = Nothing
, uUrlSource = Just urlSource , uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
} }
fromSettings Settings{..} (Just KeyBindings{..}) = fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings let ukb = UserKeyBindings
@@ -342,6 +344,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
, uNoNetwork = Just noNetwork , uNoNetwork = Just noNetwork
, uKeyBindings = Just ukb , uKeyBindings = Just ukb
, uUrlSource = Just urlSource , uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
} }
data UserKeyBindings = UserKeyBindings data UserKeyBindings = UserKeyBindings
@@ -415,6 +418,7 @@ data Settings = Settings
, verbose :: Bool , verbose :: Bool
, urlSource :: URLSource , urlSource :: URLSource
, noNetwork :: Bool , noNetwork :: Bool
, gpgSetting :: GPGSetting
} }
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
@@ -448,6 +452,13 @@ data Downloader = Curl
instance NFData Downloader instance NFData Downloader
data GPGSetting = GPGStrict
| GPGLax
| GPGNone
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData GPGSetting
data DebugInfo = DebugInfo data DebugInfo = DebugInfo
{ diBaseDir :: FilePath { diBaseDir :: FilePath
, diBinDir :: FilePath , diBinDir :: FilePath

View File

@@ -54,6 +54,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
instance ToJSON Tag where instance ToJSON Tag where
toJSON Latest = String "Latest" toJSON Latest = String "Latest"

View File

@@ -250,7 +250,6 @@ getInstalledGHCs = do
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@. -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
getInstalledCabals :: ( MonadReader env m getInstalledCabals :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, MonadIO m , MonadIO m
, MonadCatch m , MonadCatch m
) )
@@ -268,7 +267,7 @@ getInstalledCabals = do
-- | Whether the given cabal version is installed. -- | Whether the given cabal version is installed.
cabalInstalled :: (HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
cabalInstalled ver = do cabalInstalled ver = do
vers <- fmap rights getInstalledCabals vers <- fmap rights getInstalledCabals
pure $ elem ver vers pure $ elem ver vers
@@ -475,7 +474,7 @@ hlsGHCVersions = do
. splitOn "~" . splitOn "~"
) )
bins bins
pure . rights . concat . maybeToList $ vers pure . sortBy (flip compare) . rights . concat . maybeToList $ vers
-- | Get all server binaries for an hls version, if any. -- | Get all server binaries for an hls version, if any.
@@ -1032,7 +1031,7 @@ ensureGlobalTools :: ( MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> Excepts '[DigestError , DownloadFailed, NoDownload] m () => Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
ensureGlobalTools = do ensureGlobalTools = do
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
(GHCupInfo _ _ gTools) <- lift getGHCupInfo (GHCupInfo _ _ gTools) <- lift getGHCupInfo
@@ -1044,8 +1043,8 @@ ensureGlobalTools = do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..." lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe")) lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe") lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[DigestError , DownloadFailed] $ dl liftE @'[GPGError, DigestError , DownloadFailed] $ dl
) `catchE` (liftE @'[DigestError , DownloadFailed] dl) ) `catchE` (liftE @'[GPGError, DigestError , DownloadFailed] dl)
pure () pure ()
#else #else
pure () pure ()

View File

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

View File

@@ -100,7 +100,7 @@ eghcup() {
_eghcup() { _eghcup() {
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
args="-s ${BOOTSTRAP_HASKELL_YAML}" args="-s ${BOOTSTRAP_HASKELL_YAML}"
fi fi
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
"${GHCUP_BIN}/ghcup" ${args} "$@" "${GHCUP_BIN}/ghcup" ${args} "$@"
else else
@@ -405,7 +405,7 @@ warn_path() {
echo echo
[ -n "$1" ] && warn "$1" [ -n "$1" ] && warn "$1"
yellow "In order to run ghc and cabal, you need to adjust your PATH variable." yellow "In order to run ghc and cabal, you need to adjust your PATH variable."
yellow "To do so, you may want run 'source $GHCUP_DIR/env' in your current terminal" yellow "To do so, you may want to run 'source $GHCUP_DIR/env' in your current terminal"
yellow "session as well as your shell configuration (e.g. ~/.bashrc)." yellow "session as well as your shell configuration (e.g. ~/.bashrc)."
} }
@@ -677,4 +677,3 @@ _done
) )
# vim: tabstop=4 shiftwidth=4 expandtab # vim: tabstop=4 shiftwidth=4 expandtab