Compare commits
42 Commits
opencollec
...
unset
| Author | SHA1 | Date | |
|---|---|---|---|
|
4767f3db5b
|
|||
|
709658462c
|
|||
|
c431c0ae00
|
|||
|
6f61b5dbef
|
|||
|
c42c4b64f9
|
|||
|
d3a36c2c9a
|
|||
|
6799e9616e
|
|||
|
|
e8d962ac44 | ||
|
ac1e145028
|
|||
|
2fdf121167
|
|||
|
dcca8b0bf2
|
|||
|
b1f891b005
|
|||
|
648dcc7287
|
|||
|
2175f7dd3d
|
|||
|
aff90a52f1
|
|||
|
0f14dee72a
|
|||
|
ae2031174e
|
|||
|
c163278c64
|
|||
|
d10133f06f
|
|||
|
4377fc663e
|
|||
|
|
8fc128e89b | ||
|
|
737f72f90f | ||
|
|
c3aab65521 | ||
|
|
972474f79a | ||
| bc64d2ade0 | |||
|
|
eddda55fe6 | ||
|
|
13aca91231 | ||
|
|
6011242eae | ||
|
|
cadb5086e1 | ||
|
|
10a30bbf38 | ||
|
|
6ac7a75bab | ||
|
|
d60f58cf43 | ||
|
|
7a6a119829 | ||
|
|
f0fb019c70 | ||
|
|
0f98ec6b78 | ||
|
|
107fed6e60 | ||
|
|
59a9a770a5 | ||
|
|
20bcb26e3d | ||
|
|
be82565775 | ||
|
|
f8d0243146 | ||
|
|
d7f82d643c | ||
|
|
15560a06b1 |
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
86
README.md
86
README.md
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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:
|
||||||
|
|||||||
@@ -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:
|
||||||
|
|||||||
291
lib/GHCup.hs
291
lib/GHCup.hs
@@ -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 ->
|
||||||
|
|||||||
@@ -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")
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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"
|
||||||
|
|||||||
@@ -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 ()
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user