Compare commits

..

76 Commits

Author SHA1 Message Date
d46bdbf959 Fix misinterpretation of '+' in URI paths, fixes #408 2024-01-03 00:42:01 +08:00
55030d83da Merge branch 'issue-958' 2024-01-01 21:40:36 +08:00
c680a9f33b Support cygwin in bootstrap-haskell too
Fixes #958
2023-12-29 19:56:38 +08:00
df192ee18e Merge remote-tracking branch 'origin/pr/956' 2023-12-26 21:41:40 +08:00
Rune K. Svendsen
008def2ff4 Add comment about why we ignore this error 2023-12-20 10:26:42 +01:00
Rune K. Svendsen
3976daddb7 bootstrap-haskell.ps1: don't exit if tmp file removal fails 2023-12-20 10:21:22 +01:00
524cdbbeb1 Merge remote-tracking branch 'origin/pr/953' 2023-12-15 23:53:59 +08:00
a01c5acfe2 Update submodules 2023-12-15 23:53:41 +08:00
Rune K. Svendsen
6689312ac5 docs: remove "TUI not supported on Windows"
TUI works on Windows since v0.1.20.0 (cf. https://github.com/haskell/ghcup-hs/pull/912)
2023-12-15 16:49:55 +01:00
e214695a3e Merge remote-tracking branch 'origin/pr/850' 2023-12-02 18:42:22 +08:00
3cea6ef97c Merge remote-tracking branch 'origin/pr/937' 2023-11-28 21:25:12 +08:00
3b0f131a65 Merge remote-tracking branch 'origin/pr/940' 2023-11-28 21:08:49 +08:00
konsumlamm
e0a3020e34 Update WASM install instructions 2023-11-28 13:55:52 +01:00
Luis Morillo
0e46b9509a complete tutorial. remove show all tools from widgets. resolve some conflicts. 2023-11-23 16:05:12 +01:00
Luis Morillo
d3474d0cd9 add KeyInfo handler and widget. Improve tutorial 2023-11-23 15:32:23 +01:00
Luis Morillo
5c3dad1bb9 reorganize code by sections 2023-11-23 15:31:33 +01:00
Luis Morillo
987cdaf313 factor out attr names. Add windows symbols to tutotial widget. Improve tutorial aesthetics and text 2023-11-23 15:28:21 +01:00
Luis Morillo
835352428a simplify rendering for better ux 2023-11-23 15:28:19 +01:00
Luis Morillo
8f4246e716 Use proper Name type and Modal type. Create tutorial Widget 2023-11-23 15:27:33 +01:00
Luis Morillo
1353a2fd20 use map-like data structure 2023-11-23 15:26:49 +01:00
Luis Morillo
aa9fbdbfc2 Use MonadState Instance to simplify install', del', set' and changelog'. Lensify the app 2023-11-23 15:24:24 +01:00
3a8cdf9967 Fix opening changelog on windows 2023-11-20 22:36:17 +08:00
2caf491e9d Remove the "show all tool" config
We show all tools at the moment anyway.
2023-11-18 18:55:06 +08:00
d277e56121 Improve logging by dropping trailing newline 2023-11-18 13:09:19 +08:00
335099ad19 Add rocky/void detection 2023-11-17 17:03:10 +08:00
b1106985ec Merge branch 'monday-improvements' 2023-11-14 23:16:42 +08:00
cd8ce9aaa9 Update test artifact upload 2023-11-14 22:11:28 +08:00
18f0cb086b Fix tests 2023-11-14 09:37:07 +08:00
dee54445bf Merge remote-tracking branch 'origin/pr/928' 2023-11-13 17:50:37 +08:00
Bryan Richter
2df59fd1b3 Emphasize experimental nature of wasm and js 2023-11-13 11:28:14 +02:00
2e5dee8e1a Add mechanism to warn on new metadata versions, fixes #860 2023-11-13 16:53:24 +08:00
c6aa5c3ed7 Don't remove share dir link prematurely 2023-11-13 16:00:48 +08:00
47ef380ebd Add update-shell-completions.sh 2023-11-13 16:00:31 +08:00
d6601b0353 Remove globalTools from metadata 2023-11-13 15:39:58 +08:00
0eba225723 Update modgraph 2023-11-13 15:21:54 +08:00
e7d91d138b Improve metadata documentation 2023-11-13 15:19:58 +08:00
0103e2771e Merge branch 'sunday-improvements' 2023-11-12 22:50:09 +08:00
b6246734e4 Givee cross bindists it's own doc section 2023-11-12 18:47:54 +08:00
6146c3494f Improve documentation for cross bindists 2023-11-12 18:39:06 +08:00
e5a7a2da70 Fix prefetch for cross bindists 2023-11-12 18:21:49 +08:00
6047614a16 Be less confusing when user tries to 'set' ghcup in TUI
Fixes #923
2023-11-12 17:36:00 +08:00
6a86e9e77e Fix failure mode when metadata is garbage, fixes #921 2023-11-12 17:11:33 +08:00
4132447e04 Require user to explicitly choose subcommand for 'ghcup config'
This should further reduce confusion wrt #922
2023-11-12 16:49:39 +08:00
9d223730de Error out on empty UserSettings wrt #922 2023-11-12 16:49:06 +08:00
ad9199568b Don't download twice when trying stack decoding 2023-11-12 16:24:39 +08:00
0d91c2ac14 Make install error more visible 2023-11-12 15:59:15 +08:00
8644ca41e1 Merge remote-tracking branch 'origin/pr/924' 2023-11-12 12:19:56 +08:00
Cheng Shao
6051c0cfbc Bump minimum windows version to 8.1 2023-11-11 06:18:13 +01:00
67d977ce39 Update metadata submodule 2023-11-10 21:42:31 +08:00
8b6b3d2fbe Update bootstrap script ghver 2023-11-10 21:41:19 +08:00
a5d228ba89 Bump to 0.1.20.0 2023-11-10 19:53:04 +08:00
a7be1e7068 Merge branch 'brick-windows' 2023-11-10 19:32:20 +08:00
30a10d871a Update bootstrap script 2023-11-09 23:42:31 +08:00
90b0281c1c Merge remote-tracking branch 'origin/pr/918' 2023-11-09 23:30:05 +08:00
Tom Smeding
bba92baeb1 Fix typo in ToolShadowed error for stack 2023-11-09 13:41:21 +01:00
e06a1c03d4 Merge remote-tracking branch 'origin/pr/911' 2023-11-09 18:00:06 +08:00
0171f2e870 Merge branch 'issue-914' 2023-11-09 17:53:42 +08:00
da078c7362 Use prompt for desktop shortcuts, fixes #914 2023-11-09 17:24:41 +08:00
94b4b7c455 Merge branch 'issue-913' 2023-11-06 22:12:46 +08:00
6aa486594a Redo ghc-install.sh, fixes #913 2023-11-06 18:23:02 +08:00
2c3148abcc Update supported tools table, fixes #915 2023-11-06 18:20:36 +08:00
dde32fa72e Ensure patched version of vty-windows is used 2023-11-06 17:35:20 +08:00
675ab17fff Improve signs on windows (no unicode) 2023-11-05 22:29:55 +08:00
9fcacbd96b Fix CPP defines for windows+brick 2023-11-05 22:22:53 +08:00
ba4c6e5b99 Relax vector upper bound 2023-11-05 17:33:54 +08:00
f2b139b58b Drop temp source-repository stanza for 'versions' 2023-11-05 17:32:25 +08:00
a44bf5884d Enable tui for windows in release builds 2023-11-05 17:32:25 +08:00
64c1d63d33 Allow tui flag for windows as well 2023-11-05 17:32:25 +08:00
0300d8f2cc Bump for brick windows 2023-11-05 17:20:29 +08:00
citrusmunch
bb395b652d Fix typo in guide.md
xdg section is below (not above)
2023-11-01 12:04:43 -04:00
59bfdd9a30 Stack docs improvement 2023-10-25 15:01:18 +08:00
d85accb08e Merge branch 'improve-stack-setup-use' 2023-10-25 15:01:04 +08:00
c7439d3c89 Improve stack metadata support wrt #892 2023-10-25 14:00:01 +08:00
38cd5ad8ed Merge branch 'improved-key-brick' 2023-10-24 15:00:31 +08:00
5fd0fa8d8e Merge branch 'issue-892' 2023-10-24 15:00:10 +08:00
452ca8cca2 Improve key handling in TUI, fixes #875 2023-10-23 22:47:17 +08:00
43 changed files with 17616 additions and 16537 deletions

View File

@@ -322,7 +322,7 @@ jobs:
with:
name: testfiles
path: |
./test/golden/unix/GHCupInfo*json
./test/ghcup-test/golden/unix/GHCupInfo*json
test-arm:
name: Test ARM
@@ -389,7 +389,7 @@ jobs:
with:
name: testfiles
path: |
./test/golden/unix/GHCupInfo*json
./test/ghcup-test/golden/unix/GHCupInfo*json
test-macwin:
name: Test Mac/Win
@@ -458,7 +458,7 @@ jobs:
with:
name: testfiles
path: |
./test/golden/windows/GHCupInfo*json
./test/ghcup-test/golden/windows/GHCupInfo*json
- if: failure() && runner.os != 'Windows'
name: Upload artifact
@@ -466,7 +466,7 @@ jobs:
with:
name: testfiles
path: |
./test/golden/unix/GHCupInfo*json
./test/ghcup-test/golden/unix/GHCupInfo*json
hls:
name: hls
needs: build-linux

View File

@@ -1,8 +1,20 @@
# Revision history for ghcup
## 0.1.19.5 -- ????-?-??
## 0.1.20.0 -- 2023-11-10
* support JS cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838)
### New features
* support TUI on windows thanks to the work from vty and brick maintainers (Chris Hackett, Timofey Zakrevskiy, Jonathan Daugherty, ...), wrt [#912](https://github.com/haskell/ghcup-hs/pull/912)
* support JS and wasm cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838), thanks to Sylvain Henry and IOG
* Support stacks installation strategy and metadata wrt [#892](https://github.com/haskell/ghcup-hs/issues/892)
- you can now enable stacks installation method via `ghcup config set url-source '["GHCupURL", "StackSetupURL"]'`... for more information, check the [documentation](https://www.haskell.org/ghcup/guide/#using-stacks-setup-info-metadata-to-install-ghc)
### Improvements and bug fixes
* fix segfault in TUI when hitting enter early wrt [#887](https://github.com/haskell/ghcup-hs/issues/887)
* Improve key handling in TUI, fixes [#875](https://github.com/haskell/ghcup-hs/issues/875)
* add explicit support for Void Linux and Rocky Linux (this requires a metadata version bump to `ghcup-0.0.8.yaml`)
* optparse cli interface now has a test suite thanks to Lei Zhu, wrt [#862](https://github.com/haskell/ghcup-hs/pull/862)
## 0.1.19.4 -- 2023-7-02

File diff suppressed because it is too large Load Diff

View File

@@ -42,7 +42,6 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Versions
import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH
@@ -85,13 +84,11 @@ toSettings options = do
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
urlSource = fromMaybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) optUrlSource
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
stackSetupSource = fromMaybe (Types.stackSetupSource defaultSettings) uStackSetupSource
stackSetup = fromMaybe (Types.stackSetup defaultSettings) uStackSetup
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal
@@ -110,7 +107,6 @@ toSettings options = do
, bSet = fromMaybe bSet kSet
, bChangelog = fromMaybe bChangelog kChangelog
, bShowAllVersions = fromMaybe bShowAllVersions kShowAll
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
}
@@ -213,10 +209,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
exitWith (ExitFailure 2)
ghcupInfo <-
( flip runReaderT leanAppstate
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
$ liftE getDownloadsF
)
( flip runReaderT leanAppstate . runE @'[ContentLengthError, DigestError, DistroNotFound, DownloadFailed, FileDoesNotExistError, GPGError, JSONError, NoCompatibleArch, NoCompatiblePlatform, NoDownload, GHCup.Errors.ParseError, ProcessError, UnsupportedSetupCombo, StackPlatformDetectError] $ do
liftE $ getDownloadsF pfreq
)
>>= \case
VRight r -> pure r
VLeft e -> do
@@ -265,7 +260,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
Just _ -> pure ()
-- TODO: always run for windows
siletRunLogger (flip runReaderT s' $ runE ensureGlobalTools) >>= \case
siletRunLogger (flip runReaderT s' $ runE ensureShimGen) >>= \case
VRight _ -> pure ()
VLeft e -> do
runLogger
@@ -341,8 +336,8 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
, NextVerNotFound
, NoToolVersionSet
] m Bool
alreadyInstalling (Install (Right InstallGHCOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallGHCOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
@@ -380,3 +375,4 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool
pure (v == ver)

View File

@@ -13,6 +13,11 @@ source-repository-package
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive

View File

@@ -4,35 +4,26 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
package ghcup
flags: +tui
if os(linux)
package ghcup
flags: +tui
if arch(x86_64) || arch(i386)
package *
ghc-options: -split-sections -optl-static
elif os(darwin)
constraints: zlib +bundled-c-zlib,
lzma +static
package ghcup
flags: +tui
elif os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf
package ghcup
flags: -tui
text -simdutf,
vty-windows >=0.1.0.3
elif os(freebsd)
constraints: zlib +bundled-c-zlib,
zip +disable-zstd
package *
ghc-options: -split-sections -pgmc clang++14
package ghcup
flags: +tui
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,

View File

@@ -16,6 +16,11 @@ gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
# TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
# for possible values.
# It's also possible to define key+modifier, e.g.:
# quit:
# Key:
# KChar: c
# Mods: [MCtrl]
key-bindings:
up:
KUp: []
@@ -46,53 +51,45 @@ meta-cache: 300 # in seconds
# 2. Strict: fail hard
meta-mode: Lax # Strict | Lax
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code.
# Where to get GHC/cabal/hls download info/versions from. This is a list that performs
# union over tool versions, preferring the later entries.
url-source:
## Use the internal download uri, this is the default
GHCupURL: []
- GHCupURL
## Example 1: Read download info from this location instead
## Accepts file/http/https scheme
## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
## which case they are merged right-biased (overwriting duplicate versions).
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
## Prefer stack supplied metadata (will still use GHCup metadata for versions not existing in stack metadata)
# - StackSetupURL
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
# AddSource:
# Left:
# globalTools: {}
# toolRequirements: {}
# ghcupDownloads:
# GHC:
# 9.10.2:
# viTags: []
# viArch:
# A_64:
# Linux_UnknownLinux:
# unknown_versioning:
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
# dlSubdir: ghc-7.10.3
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
## Add pre-release channel
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
## Add nightly channel
# - https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
## Add cross compiler channel
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
## versions).
# AddSource:
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
# For stack's setup-info, this works similar, e.g.:
# stack-setup-source:
# AddSource:
# - Left:
# ghc:
# linux64-tinfo6:
# 9.4.7:
# url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
# content-length: 179117892
# sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
## Use dwarf bindist for 9.4.7 for ghcup metadata
# - ghcup-info:
# ghcupDownloads:
# GHC:
# 9.4.7:
# viTags: []
# viArch:
# A_64:
# Linux_UnknownLinux:
# unknown_versioning:
# dlUri: https://downloads.haskell.org/ghc/9.4.7/ghc-9.4.7-x86_64-deb10-linux-dwarf.tar.xz
# dlSubdir:
# RegexDir: "ghc-.*"
# dlHash: b261b3438ba455e3cf757f9c8dc3a06fdc061ea8ec287a65b7809e25fe18bad4
## for stack metadata and the linux64-tinfo6 bindists, use static alpine for 9.8.1
# - setup-info:
# ghc:
# linux64-tinfo6:
# 9.8.1:
# url: "https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-alpine3_12-linux-static.tar.xz"
# content-length: 229037440
# sha256: b48f3d3a508d0c140d1c801e04afc65e80c0d25e7e939a8a41edb387b26b81b3
# This is a way to override platform detection, e.g. when you're running
# a Ubuntu derivate based on 18.04, you could do:

View File

@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
## Basic usage
For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
For the simple, interactive, text-based user interface (TUI), run:
```sh
ghcup tui
@@ -67,8 +67,7 @@ and make sure your bashrc sources the startup script
`ghcup` is very portable. There are a few exceptions though:
1. `ghcup tui` is only available on non-windows platforms
2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
1. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
# Configuration
@@ -95,7 +94,7 @@ platform-override:
This is the complete list of env variables that change GHCup behavior:
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) below
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
@@ -142,50 +141,29 @@ If you experience problems, consider clearing the cache via `ghcup gc --cache`.
## Metadata
The metadata are the files that describe tool versions, where to download them etc. and
can be viewed here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata)
Metadata files are also called release or distribution channels. They describe tool versions, where to download them etc. and
can be viewed here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata).
### Mirrors
See the [description](https://github.com/haskell/ghcup-metadata#metadata-variants-distribution-channels)
of metadata files to understand their purpose. These can be combined.
GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
To use a mirror, set the following option in `~/.ghcup/config.yaml`:
```yml
url-source:
# Accepts file/http/https scheme
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
```
See [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
for more options.
Alternatively you can do it via a cli switch:
```sh
ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
```
#### Known mirrors
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
### (Pre-)Release channels
A release channel is basically just a metadata file location. You can add additional release
channels that complement the default one, such as the **prerelease channel** like so:
For example, if you want access to both prerelease and cross bindists, you'd do:
```sh
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
```
This will result in `~/.ghcup/config.yaml` to contain this record:
This results in the following configuration in `~/.ghcup/config.yaml`:
```yml
```yaml
url-source:
AddSource:
- Right: https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
# the base url that contains all the release bindists
- GHCupURL
# prereleases
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml
# cross bindists
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
```
You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
@@ -195,18 +173,68 @@ To remove the channel, delete the entire `url-source` section or set it back to
```yml
url-source:
GHCupURL: []
- GHCupURL
```
If you want to combine your release channel with a mirror, you'd do it like so:
Also see [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
for more options.
You can also use an alternative metadata via one-shot cli option:
```sh
ghcup --url-source=https://some-url/ghcup-0.0.8.yaml tui
```
One main caveat of using URLs is that you might need to check whether there are new versions
of the file (e.g. `ghcup-0.0.7.yaml` vs `ghcup-0.0.8.yaml`). Although old metadata files
are supported for some time, they are not so indefinitely.
### Mirrors
Metadata files can also be used to operate 3rd party mirrors, in which case you want to use
a URL instead of the `GHCupURL` alias. E.g. in `~/.ghcup/config.yaml`, you'd do:
```yml
url-source:
OwnSource:
# base metadata
- "https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml"
# prerelease channel
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
- https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml
```
Note that later versions of GHCup allow more sophisticated mirror support, see [here](./#mirrors-proper).
#### Known mirrors
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
### Git based metadata config
If you don't like the way ghcup updates its metadata with caching and fetching via curl, you can also do as follows:
Clone the metadata git repo:
```sh
mkdir -p /home/user/git/
cd /home/user/git/
git clone -b master https://github.com/haskell/ghcup-metadata.git
```
Then tell ghcup to use file locations in `~/.ghcup/config.yaml`, e.g.:
```yaml
url-source:
- file:///home/user/git/ghcup-metadata/ghcup-0.0.8.yaml
- file:///home/user/git/ghcup-metadata/ghcup-cross-0.0.8.yaml
- file:///home/user/git/ghcup-metadata/ghcup-prereleases-0.0.8.yaml
```
Now, if you invoke `ghcup tui`, it will open instantly without any download, since it just
reads the metadata from local disk.
You'll have to update the metadata manually though, like so:
```sh
cd /home/user/git/
git pull --ff-only origin master
```
## Stack integration
@@ -249,24 +277,32 @@ stack config set system-ghc true --global
### Using stack's setup-info metadata to install GHC
You can now use stack's [setup-info metadata](https://github.com/commercialhaskell/stackage-content/blob/master/stack/stack-setup-2.yaml)
to install GHC. For that, you can invoke ghcup like so:
to install GHC. For that, you can invoke ghcup like so as a shorthand:
```sh
ghcup install ghc --stack-setup 9.4.7
# ghcup will only see GHC now
ghcup -s StackSetupURL install ghc 9.4.7
# this combines both ghcup and stack metadata
ghcup -s '["GHCupURL", "StackSetupURL"]' install ghc 9.4.7
```
To make this permanent, you can add the following to you `~/.ghcup/config.yaml`:
To make this permanent and combine it with the GHCup metadata, you can add the following to your `~/.ghcup/config.yaml`:
```yaml
stack-setup: true
url-source:
- GHCupURL
# stack versions take precedence
# you'll still have access to GHCup provided versions and tools in case they don't exist in stack metadata
- StackSetupURL
```
You can customize or add sections to the setup-info similar to how the [stack documentation](https://docs.haskellstack.org/en/stable/yaml_configuration/#setup-info) explains it. E.g. to change the 9.4.7 bindist, you might do:
```yaml
stack-setup-source:
AddSource:
- Left:
url-source:
- GHCupURL
- StackSetupURL
- setup-info:
ghc:
linux64-tinfo6:
9.4.7:
@@ -275,9 +311,14 @@ stack-setup-source:
sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
```
#### Caveats
The main caveat with using this method is that there's no guarantee that GHCup will pick a compatible HLS bindist
when you try to install HLS.
Another potential usability issue is that the `latest` and `recommended` shorthands won't work anymore, since
Stack metadata doesn't have a concept of those and we don't try to be smart when combining the metadatas.
### Windows
On windows, you may find the following config options useful too:
@@ -285,6 +326,39 @@ On windows, you may find the following config options useful too:
Also check out: [https://docs.haskellstack.org/en/stable/yaml_configuration](https://docs.haskellstack.org/en/stable/yaml_configuration)
## Mirrors (proper)
Mirrors are now supported via configuration, instead of specifying alternative metadata files.
As an example, this would be a complete mirror configuration in `~/.ghcup/config.yaml`:
```yaml
mirrors:
# yaml download location, would result in:
# https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.8.yaml
# -> https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml
"raw.githubusercontent.com":
authority:
host: "mirror.sjtu.edu.cn"
pathPrefix: "ghcup/yaml"
# for stack and some older HLS versions, would result in e.g.
# https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
# -> https://mirror.sjtu.edu.cn/ghcup/github/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
"github.com":
authority:
host: "mirror.sjtu.edu.cn"
pathPrefix: "ghcup/github"
# for all haskell.org hosted bindists, would result in e.g.
# https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
# -> https://mirror.sjtu.edu.cn/ghcup/haskell-downloads/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
"downloads.haskell.org":
authority:
host: "mirror.sjtu.edu.cn"
pathPrefix: "downloads.haskell.org"
```
The configuration depends on the host of the mirror and they have to provide the correct configuration.
# More on installation
## Customisation of the installation scripts
@@ -421,9 +495,9 @@ ghcup compile hls --git-ref master --git-describe-version --ghc 8.10.7 --ghc 9.2
This however will create a new HLS version in ghcup, e.g. `1.7.0.0-105-gdc682ba1`, for both 8.10.7 and 9.2.4. If you want to switch back to the official bindists, run `ghcup set hls 1.7.0.0`.
### Cross support
## Cross support
ghcup can compile and install a cross GHC for any target. However, this
ghcup can compile a cross GHC for any target. However, this
requires that the build host has a complete cross toolchain and various
libraries installed for the target platform.
@@ -432,6 +506,76 @@ For distributions with non-standard locations of cross toolchain and
libraries, this may need some tweaking of `build.mk` or configure args.
See `ghcup compile ghc --help` for further information.
Since ghcup version 0.1.20.0, we provide cross bindists for GHC JS and WASM. These can be installed conveniently.
However, these are intended as a developer preview only. By using these GHC variants, you are implicitly signing up to participate in GHC development!
If you run into bugs or missing behavior, join the dev chat at https://matrix.to/#/#GHC:matrix.org.
First, add the cross release channel:
```sh
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-cross-0.0.8.yaml
```
The next sections explain how to install each cross bindist.
### GHC JS cross bindists (experimental)
You need the required emscripten JS toolchain:
```sh
git clone https://github.com/emscripten-core/emsdk.git
cd emsdk
./emsdk install latest
./emsdk activate latest
source ./emsdk_env.sh
```
Instructions are also here: [Download and install — Emscripten 3.1.43-git (dev) documentation](https://emscripten.org/docs/getting_started/downloads.html).
To install we need to invoke ghcup like so:
```sh
emconfigure ghcup install ghc --set javascript-unknown-ghcjs-9.6.2
```
You'll now have the compiler `javascript-unknown-ghcjs-ghc`. To build a hello world, do e.g.:
```sh
echo 'main = putStrLn "hello world"' > hello.hs
javascript-unknown-ghcjs-ghc -fforce-recomp hello.hs
./hello
```
You can follow the instructions [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/javascript-backend/building#compiling-hello-world).
### GHC WASM cross bindists (experimental)
You need the required wasm toolchain:
```sh
git clone https://gitlab.haskell.org/ghc/ghc-wasm-meta.git
cd ghc-wasm-meta/
export SKIP_GHC=yes
./setup.sh
source ~/.ghc-wasm/env
```
To install, we need to invoke ghcup like so also passing the `--host=<host>` flag (adjust as needed):
```sh
ghcup install ghc --set wasm32-wasi-9.6.3.20230927 -- --host=x86_64-linux --with-intree-gmp --with-system-libffi
```
Also check the documentation here: [Glasgow Haskell Compiler / ghc-wasm-meta](https://gitlab.haskell.org/ghc/ghc-wasm-meta).
You'll now have the compiler `wasm32-wasi-ghc`. To build a hello world, do e.g.:
```sh
echo 'main = putStrLn "hello world"' > hello.hs
wasm32-wasi-ghc hello.hs -o hello.wasm
wasmtime ./hello.wasm
```
## Isolated installs
**Before using isolated installs, make sure to have at least GHCup version 0.1.17.8!**

View File

@@ -140,16 +140,18 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>9.6.2</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
<tr><td>9.8.1</td><td><span style="color:blue">latest</span>, base-4.19.0.0</td></tr>
<tr><td>9.6.3</td><td>base-4.18.1.0</td></tr>
<tr><td>9.6.2</td><td>base-4.18.0.0</td></tr>
<tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
<tr><td>9.4.7</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.7</td><td><span style="color:green">recommended</span>, base-4.17.2.0</td></tr>
<tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
<tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
<tr><td>9.2.8</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
<tr><td>9.2.8</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
@@ -190,7 +192,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>3.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.10.2.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.10.1.0</td><td></td></tr>
<tr><td>3.8.1.0</td><td></td></tr>
<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>3.6.0.0</td><td></td></tr>
@@ -234,8 +237,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.11.1</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>2.9.3</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>2.13.1</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>2.11.1</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>2.9.3</td><td></td></tr>
<tr><td>2.9.1</td><td></td></tr>
<tr><td>2.7.5</td><td></td></tr>
<tr><td>2.7.3</td><td></td></tr>
@@ -251,7 +255,7 @@ This list may not be exhaustive and specifies support for bindists only.
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
| Windows 7 | amd64 | | ✅ | ✅ | ✅ | ✅ |
| Windows 8.1 | amd64 | | ✅ | ✅ | ✅ | ✅ |
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
@@ -267,12 +271,11 @@ This list may not be exhaustive and specifies support for bindists only.
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
### Windows 7
### Windows <8.1
May or may not work, several issues:
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
No longer supported for recent GHCs, according to manual testing of GHC 9.8.1 on Windows 7.
According to [msys2 documentation](https://www.msys2.org/docs/windows_support), the minimum Windows
version is now 8.1.
### WSL1

File diff suppressed because it is too large Load Diff

Before

Width:  |  Height:  |  Size: 40 KiB

After

Width:  |  Height:  |  Size: 27 KiB

File diff suppressed because it is too large Load Diff

Before

Width:  |  Height:  |  Size: 40 KiB

After

Width:  |  Height:  |  Size: 28 KiB

View File

@@ -1,6 +1,6 @@
cabal-version: 2.4
name: ghcup
version: 0.1.19.5
version: 0.1.20.0
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
@@ -36,7 +36,7 @@ source-repository head
flag tui
description:
Build the brick powered tui (ghcup tui). This is disabled on windows.
Build the brick powered tui (ghcup tui).
default: False
manual: True
@@ -86,7 +86,7 @@ common app-common-depends
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, vector >=0.12 && <0.14
, versions >=6.0.3 && <6.1
, yaml-streamly ^>=0.12.0
@@ -190,7 +190,7 @@ library
, unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2
, vector ^>=0.12
, vector >=0.12 && <0.14
, versions >=6.0.3 && <6.1
, word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0
@@ -236,9 +236,9 @@ library
, unix ^>=2.7
, unix-bytestring ^>=0.3.7.3
if (flag(tui) && !os(windows))
if flag(tui)
cpp-options: -DBRICK
build-depends: vty ^>=5.39
build-depends: vty ^>=6.0
library ghcup-optparse
import: app-common-depends
@@ -284,7 +284,7 @@ library ghcup-optparse
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows))
if flag(tui)
cpp-options: -DBRICK
if os(windows)
@@ -320,14 +320,15 @@ executable ghcup
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows))
if flag(tui)
cpp-options: -DBRICK
other-modules: BrickMain
build-depends:
, brick ^>=1.5
, brick ^>=2.1
, transformers ^>=0.5
, vty ^>=6.0
, unix ^>=2.7
, vty ^>=5.39
, optics ^>=0.4
if os(windows)
cpp-options: -DIS_WINDOWS

View File

@@ -57,16 +57,13 @@ import GHCup.Types
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Data.Bifunctor
import Data.Either
import Data.Functor
import Data.Maybe
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8
data Options = Options
@@ -77,18 +74,19 @@ data Options = Options
, optMetaCache :: Maybe Integer
, optMetaMode :: Maybe MetaMode
, optPlatform :: Maybe PlatformRequest
, optUrlSource :: Maybe URI
, optUrlSource :: Maybe URLSource
, optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs
, optsDownloader :: Maybe Downloader
, optNoNetwork :: Maybe Bool
, optGpg :: Maybe GPGSetting
, optStackSetup :: Maybe Bool
-- commands
, optCommand :: Command
}
data Command
= Install (Either InstallCommand InstallGHCOptions)
= Install (Either InstallCommand InstallOptions)
| Test TestCommand
| InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions)
@@ -134,13 +132,13 @@ opts =
)
<*> optional
(option
(eitherReader parseUri)
(eitherReader parseUrlSource)
( short 's'
<> long "url-source"
<> metavar "URL"
<> help "Alternative ghcup download info url"
<> metavar "URL_SOURCE"
<> help "Alternative ghcup download info"
<> internal
<> completer fileUri
<> completer urlSourceCompleter
)
)
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
@@ -178,10 +176,9 @@ opts =
"GPG verification (default: none)"
<> completer (listCompleter ["strict", "lax", "none"])
))
<*> invertableSwitch "stack-setup" (Just 's') False (help "Use stack's setup info for discovering and installing GHC versions")
<*> com
where
parseUri s' =
first show $ parseURI strictURIParserOptions (UTF8.fromString s')
com :: Parser Command

View File

@@ -29,6 +29,7 @@ import Data.Maybe
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import System.Process ( system )
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
@@ -128,21 +129,22 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
Just uri -> do
pfreq <- runAppState getPlatformReq
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
if clOpen
then do
runAppState $
exec cmd
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
Nothing
Nothing
case _rPlatform pfreq of
Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Windows -> do
let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
c <- liftIO $ system $ args
case c of
(ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
ExitSuccess -> pure $ Right ()
>>= \case
Right _ -> pure ExitSuccess
Left e -> logError (T.pack $ prettyHFError e)
>> pure (ExitFailure 13)
else liftIO $ putStrLn uri' >> pure ExitSuccess

View File

@@ -64,6 +64,8 @@ import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Text.Lazy.Encoding as LE
import qualified Data.Text.Lazy as LT
import qualified Text.Megaparsec as MP
import qualified System.FilePath.Posix as FP
import GHCup.Version
@@ -322,6 +324,15 @@ toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
gitFileUri :: [String] -> Completer
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
urlSourceCompleter :: Completer
urlSourceCompleter = mkCompleter $ urlSourceCompleter' []
urlSourceCompleter' :: [String] -> String -> IO [String]
urlSourceCompleter' add str' = do
let static = ["GHCupURL", "StackSetupURL"]
file <- fileUri' add str'
pure $ static ++ file
fileUri :: Completer
fileUri = mkCompleter $ fileUri' []
@@ -450,13 +461,15 @@ tagCompleter tool add = listIOCompleter $ do
defaultKeyBindings
loggerConfig
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
case mGhcUpInfo of
VRight ghcupInfo -> do
let allTags = filter (/= Old)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
mpFreq <- flip runReaderT appState . runE $ platformRequest
forFold mpFreq $ \pfreq -> do
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF pfreq
case mGhcUpInfo of
VRight ghcupInfo -> do
let allTags = filter (/= Old)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
@@ -477,8 +490,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
defaultKeyBindings
loggerConfig
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
forFold mpFreq $ \pfreq -> do
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF pfreq
forFold mGhcUpInfo $ \ghcupInfo -> do
let appState = AppState
settings
@@ -817,3 +830,15 @@ logGHCPostRm ghcVer = do
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
parseUrlSource :: String -> Either String URLSource
parseUrlSource "GHCupURL" = pure GHCupURL
parseUrlSource "StackSetupURL" = pure StackSetupURL
parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
parseNewUrlSource :: String -> Either String NewURLSource
parseNewUrlSource "GHCupURL" = pure NewGHCupURL
parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')

View File

@@ -32,7 +32,6 @@ import Options.Applicative hiding ( style, ParseError )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T
import qualified Data.ByteString.UTF8 as UTF8
@@ -51,7 +50,7 @@ data ConfigCommand
= ShowConfig
| SetConfig String (Maybe String)
| InitConfig
| AddReleaseChannel Bool URI
| AddReleaseChannel Bool NewURLSource
deriving (Eq, Show)
@@ -68,15 +67,14 @@ configP = subparser
<> command "show" showP
<> command "add-release-channel" addP
)
<|> argsP -- add show for a single option
<|> pure ShowConfig
where
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
addP = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
(progDesc "Add a release channel from a URI")
addP = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader parseNewUrlSource) (metavar "URL_SOURCE" <> completer urlSourceCompleter))
(progDesc "Add a release channel, e.g. from a URI")
@@ -135,9 +133,7 @@ updateSettings usl usr =
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
mirrors' = uMirrors usl <|> uMirrors usr
stackSetupSource' = uStackSetupSource usl <|> uStackSetupSource usr
stackSetup' = uStackSetup usl <|> uStackSetup usr
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' stackSetupSource' stackSetup'
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
where
updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
updateKeyBindings Nothing Nothing = Nothing
@@ -153,7 +149,6 @@ updateSettings usl usr =
, kSet = kSet kbl <|> kSet kbr
, kChangelog = kChangelog kbl <|> kChangelog kbr
, kShowAll = kShowAll kbl <|> kShowAll kbr
, kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
}
@@ -196,10 +191,14 @@ config configCommand settings userConf keybindings runLogger = case configComman
throwE $ ParseError "Empty values are not allowed"
Nothing -> do
usersettings <- decodeSettings k
when (usersettings == defaultUserSettings)
$ throwE $ ParseError ("Failed to parse setting (maybe typo?): " <> k)
lift $ doConfig usersettings
pure ()
Just v -> do
usersettings <- decodeSettings (k <> ": " <> v <> "\n")
when (usersettings == defaultUserSettings)
$ throwE $ ParseError ("Failed to parse key '" <> k <> "' with value '" <> v <> "' as user setting. Maybe typo?")
lift $ doConfig usersettings
pure ()
case r of
@@ -207,29 +206,19 @@ config configCommand settings userConf keybindings runLogger = case configComman
VLeft (V (JSONDecodeError e)) -> do
runLogger $ logError $ "Error decoding config: " <> T.pack e
pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65
VLeft e -> do
runLogger (logError $ T.pack $ prettyHFError e)
pure $ ExitFailure 65
AddReleaseChannel force uri -> do
AddReleaseChannel force new -> do
r <- runE @'[DuplicateReleaseChannel] $ do
case urlSource settings of
AddSource xs -> do
case checkDuplicate xs (Right uri) of
Duplicate
| not force -> throwE (DuplicateReleaseChannel uri)
DuplicateLast -> pure ()
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (appendUnique xs (Right uri)) })
GHCupURL -> do
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
pure ()
OwnSource xs -> do
case checkDuplicate xs (Right uri) of
Duplicate
| not force -> throwE (DuplicateReleaseChannel uri)
DuplicateLast -> pure ()
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (appendUnique xs (Right uri)) })
OwnSpec spec -> do
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource [Left spec, Right uri] })
pure ()
let oldSources = fromURLSource (urlSource settings)
let merged = oldSources ++ [new]
case checkDuplicate oldSources new of
Duplicate
| not force -> throwE (DuplicateReleaseChannel new)
DuplicateLast -> pure ()
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ SimpleList merged })
case r of
VRight _ -> do
pure ExitSuccess
@@ -244,15 +233,6 @@ config configCommand settings userConf keybindings runLogger = case configComman
| a `elem` xs = Duplicate
| otherwise = NoDuplicate
-- appends the element to the end of the list, but also removes it from the existing list
appendUnique :: Eq a => [a] -> a -> [a]
appendUnique xs' e = go xs'
where
go [] = [e]
go (x:xs)
| x == e = go xs -- skip
| otherwise = x : go xs
doConfig :: MonadIO m => UserSettings -> m ()
doConfig usersettings = do
let settings' = updateSettings usersettings userConf

View File

@@ -50,7 +50,7 @@ import qualified Data.Text as T
----------------
data InstallCommand = InstallGHC InstallGHCOptions
data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
| InstallStack InstallOptions
@@ -63,16 +63,6 @@ data InstallCommand = InstallGHC InstallGHCOptions
--[ Options ]--
---------------
data InstallGHCOptions = InstallGHCOptions
{ instVer :: Maybe ToolVersion
, instBindist :: Maybe URI
, instSet :: Bool
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
, addConfArgs :: [T.Text]
, useStackSetup :: Maybe Bool
} deriving (Eq, Show)
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
, instBindist :: Maybe URI
@@ -102,14 +92,14 @@ installCabalFooter = [s|Discussion:
--[ Parsers ]--
---------------
installParser :: Parser (Either InstallCommand InstallGHCOptions)
installParser :: Parser (Either InstallCommand InstallOptions)
installParser =
(Left <$> subparser
( command
"ghc"
( InstallGHC
<$> info
(installGHCOpts <**> helper)
(installOpts (Just GHC) <**> helper)
( progDesc "Install GHC"
<> footerDoc (Just $ text installGHCFooter)
)
@@ -143,7 +133,7 @@ installParser =
)
)
)
<|> (Right <$> installGHCOpts)
<|> (Right <$> installOpts (Just GHC))
where
installHLSFooter :: String
installHLSFooter = [s|Discussion:
@@ -219,12 +209,6 @@ installOpts tool =
Just GHC -> False
Just _ -> True
installGHCOpts :: Parser InstallGHCOptions
installGHCOpts =
(\InstallOptions{..} b -> let useStackSetup = b in InstallGHCOptions{..})
<$> installOpts (Just GHC)
<*> invertableSwitch "stack-setup" (Just 's') False (help "Set as active version after install")
@@ -328,7 +312,7 @@ runInstGHC appstate' =
-------------------
install :: Either InstallCommand InstallGHCOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install installCommand settings getAppState' runLogger = case installCommand of
(Right iGHCopts) -> do
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
@@ -338,11 +322,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(Left (InstallHLS iopts)) -> installHLS iopts
(Left (InstallStack iopts)) -> installStack iopts
where
installGHC :: InstallGHCOptions -> IO ExitCode
installGHC InstallGHCOptions{..} = do
installGHC :: InstallOptions -> IO ExitCode
installGHC InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
Nothing -> runInstGHC s'{ settings = maybe settings (\b -> settings {stackSetup = b}) useStackSetup } $ do
Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin
v

View File

@@ -14,6 +14,7 @@ module GHCup.OptParse.Prefetch where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
@@ -157,7 +158,9 @@ type PrefetchEffects = '[ TagNotFound
, GPGError
, DownloadFailed
, JSONError
, FileDoesNotExistError ]
, FileDoesNotExistError
, StackPlatformDetectError
]
runPrefetch :: MonadUnliftIO m
@@ -196,21 +199,22 @@ prefetch prefetchCommand runAppState runLogger =
(v, _) <- liftE $ fromVersion mt GHC
if pfGHCSrc
then liftE $ fetchGHCSrc v pfCacheDir
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
else liftE $ fetchToolBindist v GHC pfCacheDir
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt Cabal
liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
liftE $ fetchToolBindist v Cabal pfCacheDir
PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt HLS
liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
liftE $ fetchToolBindist v HLS pfCacheDir
PrefetchStack PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt Stack
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
liftE $ fetchToolBindist v Stack pfCacheDir
PrefetchMetadata -> do
_ <- liftE getDownloadsF
pfreq <- lift getPlatformReq
_ <- liftE $ getDownloadsF pfreq
pure ""
) >>= \case
VRight _ -> do

View File

@@ -100,7 +100,7 @@ fetchToolBindist :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> Version
=> GHCTargetVersion
-> Tool
-> Maybe FilePath
-> Excepts
@@ -113,7 +113,7 @@ fetchToolBindist :: ( MonadFail m
m
FilePath
fetchToolBindist v t mfp = do
dlinfo <- liftE $ getDownloadInfo t v
dlinfo <- liftE $ getDownloadInfo' t v
liftE $ downloadCached' dlinfo Nothing mfp

View File

@@ -31,10 +31,10 @@ import GHCup.Download.Utils
import GHCup.Errors
import GHCup.Types
import qualified GHCup.Types.Stack as Stack
import GHCup.Types.Stack (downloadInfoUrl, downloadInfoSha256)
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Platform
import GHCup.Prelude
import GHCup.Prelude.File
import GHCup.Prelude.Logger.Internal
@@ -56,6 +56,7 @@ import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( mk )
#endif
import Data.Maybe
import Data.Either
import Data.List
import Data.Time.Clock
import Data.Time.Clock.POSIX
@@ -113,33 +114,84 @@ getDownloadsF :: ( FromJSONKey Tool
, MonadFail m
, MonadMask m
)
=> Excepts
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
=> PlatformRequest
-> Excepts
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
m
GHCupInfo
getDownloadsF = do
getDownloadsF pfreq@(PlatformRequest arch plat _) = do
Settings { urlSource } <- lift getSettings
case urlSource of
GHCupURL -> liftE $ getBase ghcupURL
(OwnSource exts) -> do
ext <- liftE $ mapM (either pure getBase) exts
mergeGhcupInfo ext
(OwnSpec av) -> pure av
(AddSource exts) -> do
base <- liftE $ getBase ghcupURL
ext <- liftE $ mapM (either pure getBase) exts
mergeGhcupInfo (base:ext)
let newUrlSources = fromURLSource urlSource
infos <- liftE $ mapM dl' newUrlSources
keys <- if any isRight infos
then liftE . reThrowAll @_ @_ @'[StackPlatformDetectError] StackPlatformDetectError $ getStackPlatformKey pfreq
else pure []
ghcupInfos <- fmap catMaybes $ forM infos $ \case
Left gi -> pure (Just gi)
Right si -> pure $ fromStackSetupInfo si keys
mergeGhcupInfo ghcupInfos
where
dl' :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
, MonadReader env m
, HasSettings env
, HasDirs env
, MonadIO m
, MonadCatch m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> NewURLSource
-> Excepts
'[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
m (Either GHCupInfo Stack.SetupInfo)
dl' NewGHCupURL = fmap Left $ liftE (getBase ghcupURL) >>= liftE . decodeMetadata @GHCupInfo
dl' NewStackSetupURL = fmap Right $ liftE (getBase stackSetupURL) >>= liftE . decodeMetadata @Stack.SetupInfo
dl' (NewGHCupInfo gi) = pure (Left gi)
dl' (NewSetupInfo si) = pure (Right si)
dl' (NewURI uri) = do
base <- liftE $ getBase uri
catchE @JSONError (\(JSONDecodeError _) -> do
logDebug $ "Couldn't decode " <> T.pack base <> " as GHCupInfo, trying as SetupInfo: "
Right <$> decodeMetadata @Stack.SetupInfo base)
$ fmap Left (decodeMetadata @GHCupInfo base >>= \gI -> warnOnMetadataUpdate uri gI >> pure gI)
fromStackSetupInfo :: MonadThrow m
=> Stack.SetupInfo
-> [String]
-> m GHCupInfo
fromStackSetupInfo (Stack.siGHCs -> ghcDli) keys = do
let ghcVersionsPerKey = (`M.lookup` ghcDli) <$> (T.pack <$> keys)
ghcVersions = fromMaybe mempty . listToMaybe . catMaybes $ ghcVersionsPerKey
(ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
M.mapKeys mkTVer <$> M.traverseMaybeWithKey (\_ a -> pure $ fromStackDownloadInfo a) ghcVersions
let ghcupDownloads' = M.singleton GHC (M.map fromDownloadInfo ghcupInfo')
pure (GHCupInfo mempty ghcupDownloads' Nothing)
where
fromDownloadInfo :: DownloadInfo -> VersionInfo
fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing
fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
mergeGhcupInfo :: MonadFail m
=> [GHCupInfo]
-> m GHCupInfo
mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
mergeGhcupInfo xs@(GHCupInfo{}: _) =
let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs)
newGlobalTools = M.unionsWith (\_ a2 -> a2 ) (_globalTools <$> xs)
newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
in pure $ GHCupInfo newToolReqs newDownloads Nothing
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
@@ -152,7 +204,7 @@ etagsFile :: FilePath -> FilePath
etagsFile = (<.> "etags")
getBase :: ( MonadReader env m
getBase :: forall m env . ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadFail m
@@ -160,10 +212,9 @@ getBase :: ( MonadReader env m
, MonadCatch m
, HasLog env
, MonadMask m
, FromJSON j
)
=> URI
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m j
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError] m FilePath
getBase uri = do
Settings { noNetwork, downloader, metaMode } <- lift getSettings
@@ -183,25 +234,8 @@ getBase uri = do
$ uri
-- if we didn't get a filepath from the download, use the cached yaml
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
liftE
. onE_ (onError actualYaml)
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
. liftIO
. Y.decodeFileEither
$ actualYaml
maybe (lift $ yamlFromCache uri) pure mYaml
where
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- may re-download and succeed.
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError fp = do
let efp = etagsFile fp
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
(hideError doesNotExistErrorType $ rmFile efp)
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
warnCache s downloader' = do
let tryDownloder = case downloader' of
@@ -273,6 +307,69 @@ getBase uri = do
pure f
warnOnMetadataUpdate ::
( MonadReader env m
, MonadIO m
, HasLog env
, HasDirs env
)
=> URI
-> GHCupInfo
-> m ()
warnOnMetadataUpdate uri (GHCupInfo { _metadataUpdate = Just newUri })
| scheme' uri == "file"
, urlBase' uri /= urlBase' newUri = do
confFile <- getConfigFilePath'
logWarn $ "New metadata version detected"
<> "\n old URI: " <> (decUTF8Safe . serializeURIRef') uri
<> "\n new URI: " <> (decUTF8Safe . serializeURIRef') newUri
<> "\nYou might need to update your " <> T.pack confFile
| scheme' uri /= "file"
, uri /= newUri = do
confFile <- getConfigFilePath'
logWarn $ "New metadata version detected"
<> "\n old URI: " <> (decUTF8Safe . serializeURIRef') uri
<> "\n new URI: " <> (decUTF8Safe . serializeURIRef') newUri
<> "\nYou might need to update your " <> T.pack confFile
where
scheme' = view (uriSchemeL' % schemeBSL')
urlBase' = T.unpack . decUTF8Safe . urlBaseName . view pathL'
warnOnMetadataUpdate _ _ = pure ()
decodeMetadata :: forall j m env .
( MonadReader env m
, HasDirs env
, HasSettings env
, MonadFail m
, MonadIO m
, MonadCatch m
, HasLog env
, MonadMask m
, FromJSON j
)
=> FilePath
-> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata actualYaml = do
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
liftE
. onE_ (onError actualYaml)
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
. liftIO
. Y.decodeFileEither
$ actualYaml
where
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- may re-download and succeed.
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError fp = do
let efp = etagsFile fp
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
(hideError doesNotExistErrorType $ rmFile efp)
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
getDownloadInfo :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
@@ -327,106 +424,6 @@ getDownloadInfo' t v = do
_ -> with_distro <|> without_distro_ver <|> without_distro
)
getStackDownloadInfo :: ( MonadReader env m
, HasDirs env
, HasGHCupInfo env
, HasLog env
, HasPlatformReq env
, HasSettings env
, MonadCatch m
, MonadFail m
, MonadIO m
, MonadMask m
, MonadThrow m
)
=> StackSetupURLSource
-> [String]
-> Tool
-> GHCTargetVersion
-- ^ tool version
-> Excepts
'[NoDownload, DownloadFailed]
m
DownloadInfo
getStackDownloadInfo stackSetupSource keys@(_:_) GHC tv@(GHCTargetVersion Nothing v) =
case stackSetupSource of
StackSetupURL -> do
(dli :: Stack.SetupInfo) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getBase stackSetupURL
sDli <- liftE $ stackDownloadInfo dli
lift $ fromStackDownloadInfo sDli
(SOwnSource exts) -> do
(dlis :: [Stack.SetupInfo]) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ mapM (either pure getBase) exts
dli <- lift $ mergeSetupInfo dlis
sDli <- liftE $ stackDownloadInfo dli
lift $ fromStackDownloadInfo sDli
(SOwnSpec si) -> do
sDli <- liftE $ stackDownloadInfo si
lift $ fromStackDownloadInfo sDli
(SAddSource exts) -> do
base :: Stack.SetupInfo <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getBase stackSetupURL
(dlis :: [Stack.SetupInfo]) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ mapM (either pure getBase) exts
dli <- lift $ mergeSetupInfo (base:dlis)
sDli <- liftE $ stackDownloadInfo dli
lift $ fromStackDownloadInfo sDli
where
stackDownloadInfo :: MonadIO m => Stack.SetupInfo -> Excepts '[NoDownload] m Stack.DownloadInfo
stackDownloadInfo dli@Stack.SetupInfo{} = do
let siGHCs = Stack.siGHCs dli
ghcVersionsPerKey = (`M.lookup` siGHCs) <$> (T.pack <$> keys)
ghcVersions <- (listToMaybe . catMaybes $ ghcVersionsPerKey) ?? NoDownload tv GHC Nothing
(Stack.gdiDownloadInfo <$> M.lookup v ghcVersions) ?? NoDownload tv GHC Nothing
mergeSetupInfo :: MonadFail m
=> [Stack.SetupInfo]
-> m Stack.SetupInfo
mergeSetupInfo [] = fail "mergeSetupInfo: internal error: need at least one SetupInfo"
mergeSetupInfo xs@(Stack.SetupInfo{}: _) =
let newSevenzExe = Stack.siSevenzExe $ last xs
newSevenzDll = Stack.siSevenzDll $ last xs
newMsys2 = M.unionsWith (\_ a2 -> a2 ) (Stack.siMsys2 <$> xs)
newGHCs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (Stack.siGHCs <$> xs)
newStack = M.unionsWith (M.unionWith (\_ b2 -> b2)) (Stack.siStack <$> xs)
in pure $ Stack.SetupInfo newSevenzExe newSevenzDll newMsys2 newGHCs newStack
fromStackDownloadInfo :: MonadThrow m => Stack.DownloadInfo -> m DownloadInfo
fromStackDownloadInfo Stack.DownloadInfo{..} = do
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
getStackDownloadInfo _ _ t v = throwE $ NoDownload v t Nothing
{--
data SetupInfo = SetupInfo
{ siSevenzExe :: Maybe DownloadInfo
, siSevenzDll :: Maybe DownloadInfo
, siMsys2 :: Map Text VersionedDownloadInfo
, siGHCs :: Map Text (Map Version GHCDownloadInfo)
, siStack :: Map Text (Map Version DownloadInfo)
data VersionedDownloadInfo = VersionedDownloadInfo
{ vdiVersion :: Version
, vdiDownloadInfo :: DownloadInfo
}
}
data DownloadInfo = DownloadInfo
{ downloadInfoUrl :: Text
-- ^ URL or absolute file path
, downloadInfoContentLength :: Maybe Int
, downloadInfoSha1 :: Maybe ByteString
, downloadInfoSha256 :: Maybe ByteString
}
data GHCDownloadInfo = GHCDownloadInfo
{ gdiConfigureOpts :: [Text]
, gdiConfigureEnv :: Map Text Text
, gdiDownloadInfo :: DownloadInfo
}
--}
-- | Tries to download from the given http or https url
@@ -858,7 +855,7 @@ getGpgOpts =
-- "baz"
urlBaseName :: ByteString -- ^ the url path (without scheme and host)
-> ByteString
urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
urlBaseName = snd . B.breakEnd (== _slash)
-- | Curl saves all intermediate connect headers as well, not just the last one, so we make an effort to take the

View File

@@ -209,7 +209,6 @@ instance HFErrorProject NoCompatiblePlatform where
-- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
| NoDownload' GlobalTool
deriving Show
instance Pretty NoDownload where
@@ -227,7 +226,6 @@ instance Pretty NoDownload where
<> T.unpack (prettyVer vv)
<> "'"
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
instance HFErrorProject NoDownload where
eBase _ = 10
@@ -676,18 +674,18 @@ instance HFErrorProject ContentLengthError where
eBase _ = 340
eDesc _ = "File content length verification failed"
data DuplicateReleaseChannel = DuplicateReleaseChannel URI
data DuplicateReleaseChannel = DuplicateReleaseChannel NewURLSource
deriving Show
instance HFErrorProject DuplicateReleaseChannel where
eBase _ = 350
eDesc _ = "Duplicate release channel detected when adding URI.\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
eDesc _ = "Duplicate release channel detected when adding new source.\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
instance Pretty DuplicateReleaseChannel where
pPrint (DuplicateReleaseChannel uri) =
pPrint (DuplicateReleaseChannel source) =
text $ "Duplicate release channel detected when adding: \n "
<> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
<> "\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
<> show source
<> "\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
data UnsupportedSetupCombo = UnsupportedSetupCombo Architecture Platform
deriving Show
@@ -724,7 +722,7 @@ data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorPr
instance Pretty InstallSetError where
pPrint (InstallSetError reason1 reason2) =
text "Both installation and setting the tool failed. Install error was:"
text "Both installation and setting the tool failed.\nInstall error was:"
<+> pPrint reason1
<+> text "\nSet error was:"
<+> pPrint reason2
@@ -787,6 +785,22 @@ instance HFErrorProject GHCupSetError where
eNum (GHCupSetError xs) = 9000 + eNum xs
eDesc _ = "Setting the current version failed."
-- | Executing stacks platform detection failed.
data StackPlatformDetectError = forall es . (ToVariantMaybe StackPlatformDetectError es, PopVariant StackPlatformDetectError es, Show (V es), Pretty (V es), HFErrorProject (V es)) => StackPlatformDetectError (V es)
instance Pretty StackPlatformDetectError where
pPrint (StackPlatformDetectError reason) =
case reason of
VMaybe (_ :: StackPlatformDetectError) -> pPrint reason
_ -> text "Running stack platform detection logic failed:" <+> pPrint reason
deriving instance Show StackPlatformDetectError
instance HFErrorProject StackPlatformDetectError where
eBase _ = 6000
eNum (StackPlatformDetectError xs) = 6000 + eNum xs
eDesc _ = "Running stack platform detection logic failed."
---------------------------------------------
--[ True Exceptions (e.g. for MonadThrow) ]--

View File

@@ -26,7 +26,6 @@ import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Platform
import GHCup.Prelude
import GHCup.Prelude.File
import GHCup.Prelude.Logger
@@ -547,14 +546,7 @@ installGHCBin :: ( MonadFail m
m
()
installGHCBin tver installDir forceInstall addConfArgs = do
Settings{ stackSetupSource, stackSetup } <- lift getSettings
dlinfo <- if stackSetup
then do
lift $ logInfo "Using stack's setup-info to install GHC"
pfreq <- lift getPlatformReq
keys <- liftE $ getStackPlatformKey pfreq
liftE $ getStackDownloadInfo stackSetupSource keys GHC tver
else liftE $ getDownloadInfo' GHC tver
dlinfo <- liftE $ getDownloadInfo' GHC tver
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
@@ -771,7 +763,8 @@ rmGHCVer ver = do
Dirs {..} <- lift getDirs
lift $ hideError doesNotExistErrorType $ rmDirectoryLink (fromGHCupPath baseDir </> "share")
when isSetGHC $ do
lift $ hideError doesNotExistErrorType $ rmDirectoryLink (fromGHCupPath baseDir </> "share")

View File

@@ -23,7 +23,7 @@ import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils
import GHCup.Utils.Dirs
import GHCup.Prelude
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
@@ -152,6 +152,9 @@ getLinuxDistro = do
| hasWord name ["exherbo"] -> Exherbo
| hasWord name ["gentoo"] -> Gentoo
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
| hasWord name ["rocky", "Rocky Linux"] -> Rocky
-- https://github.com/void-linux/void-packages/blob/master/srcpkgs/base-files/files/os-release
| hasWord name ["void", "Void Linux"] -> Void
| otherwise -> UnknownLinux
pure (distro, parsedVer)
where
@@ -348,7 +351,7 @@ getStackOSKey PlatformRequest { .. } =
(A_ARM64, FreeBSD) -> pure "freebsd-aarch64"
(arch', os') -> throwE $ UnsupportedSetupCombo arch' os'
getStackPlatformKey :: (MonadReader env m, Alternative m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
getStackPlatformKey :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> PlatformRequest
-> Excepts '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound, ProcessError] m [String]
getStackPlatformKey pfreq@PlatformRequest{..} = do

View File

@@ -43,6 +43,10 @@ import Control.Monad.Reader
import Haskus.Utils.Variant.Excepts
import Text.PrettyPrint.HughesPJClass ( Pretty )
import qualified Data.Text as T
import System.Environment (getEnvironment)
import qualified Data.Map.Strict as Map
import System.FilePath
import Data.List (intercalate)
@@ -88,3 +92,25 @@ throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excep
{-# INLINABLE throwSomeE #-}
throwSomeE = Excepts . pure . VLeft . liftVariant
#endif
addToPath :: [FilePath]
-> Bool -- ^ if False will prepend
-> IO [(String, String)]
addToPath paths append = do
cEnv <- getEnvironment
return $ addToPath' cEnv paths append
addToPath' :: [(String, String)]
-> [FilePath]
-> Bool -- ^ if False will prepend
-> [(String, String)]
addToPath' cEnv' newPaths append =
let cEnv = Map.fromList cEnv'
paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
{- HLINT ignore "Redundant bracket" -}
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ newPaths) else (newPaths ++ curPaths))
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
pathVar = if isWindows then "Path" else "PATH"
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
in envWithNewPath

View File

@@ -387,7 +387,7 @@ rmLink fp
--
-- This overwrites previously existing files.
--
-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
-- On windows, this requires that 'ensureShimGen' was run beforehand.
createLink :: ( MonadMask m
, MonadThrow m
, HasLog env

View File

@@ -80,7 +80,7 @@ logInternal logLevel msg = do
Info -> style' "[ Info ]"
Warn -> style' "[ Warn ]"
Error -> style' "[ Error ]"
let strs = T.split (== '\n') msg
let strs = T.split (== '\n') . T.dropWhileEnd (`elem` ("\n\r" :: String)) $ msg
let out = case strs of
[] -> T.empty
(x:xs) ->

View File

@@ -234,7 +234,7 @@ setStack ver = do
liftIO (isShadowed stackbin) >>= \case
Nothing -> pure ()
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Stack pa stackbin ver)
pure ()

View File

@@ -22,6 +22,7 @@ module GHCup.Types
( module GHCup.Types
#if defined(BRICK)
, Key(..)
, Modifier(..)
#endif
)
where
@@ -40,7 +41,7 @@ import Optics ( makeLenses )
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
import URI.ByteString
#if defined(BRICK)
import Graphics.Vty ( Key(..) )
import Graphics.Vty ( Key(..), Modifier(..) )
#endif
import qualified Data.ByteString.Lazy as BL
@@ -55,8 +56,14 @@ data Key = KEsc | KChar Char | KBS | KEnter
| KFun Int | KBackTab | KPrtScr | KPause | KIns
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
deriving (Eq,Show,Read,Ord,GHC.Generic)
data Modifier = MShift | MCtrl | MMeta | MAlt
deriving (Eq,Show,Read,Ord,GHC.Generic)
#endif
data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
deriving (Eq,Show,Read,Ord,GHC.Generic)
--------------------
@@ -67,7 +74,7 @@ data Key = KEsc | KChar Char | KBS | KEnter
data GHCupInfo = GHCupInfo
{ _toolRequirements :: ToolRequirements
, _ghcupDownloads :: GHCupDownloads
, _globalTools :: Map GlobalTool DownloadInfo
, _metadataUpdate :: Maybe URI
}
deriving (Show, GHC.Generic, Eq)
@@ -129,14 +136,6 @@ instance Pretty Tool where
instance NFData Tool
data GlobalTool = ShimGen
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
instance NFData GlobalTool
instance Pretty GlobalTool where
pPrint ShimGen = text "shimgen"
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
@@ -194,7 +193,7 @@ instance Pretty Tag where
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
pPrint (UnknownTag t ) = text t
pPrint LatestPrerelease = text "latest-prerelease"
pPrint LatestNightly = text "latest-prerelease"
pPrint LatestNightly = text "latest-prerelease"
pPrint Old = mempty
data Architecture = A_64
@@ -335,18 +334,35 @@ instance Pretty TarDir where
-- | Where to fetch GHCupDownloads from.
data URLSource = GHCupURL
| OwnSource [Either GHCupInfo URI] -- ^ complete source list
| OwnSpec GHCupInfo
| AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
deriving (GHC.Generic, Show)
| StackSetupURL
| OwnSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ complete source list
| OwnSpec (Either GHCupInfo SetupInfo)
| AddSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ merge with GHCupURL
| SimpleList [NewURLSource]
deriving (Eq, GHC.Generic, Show)
data StackSetupURLSource = StackSetupURL
| SOwnSource [Either SetupInfo URI] -- ^ complete source list
| SOwnSpec SetupInfo
| SAddSource [Either SetupInfo URI] -- ^ merge with GHCupURL
deriving (Show, Eq, GHC.Generic)
data NewURLSource = NewGHCupURL
| NewStackSetupURL
| NewGHCupInfo GHCupInfo
| NewSetupInfo SetupInfo
| NewURI URI
deriving (Eq, GHC.Generic, Show)
instance NFData StackSetupURLSource
instance NFData NewURLSource
fromURLSource :: URLSource -> [NewURLSource]
fromURLSource GHCupURL = [NewGHCupURL]
fromURLSource StackSetupURL = [NewStackSetupURL]
fromURLSource (OwnSource arr) = convert' <$> arr
fromURLSource (AddSource arr) = NewGHCupURL:(convert' <$> arr)
fromURLSource (SimpleList arr) = arr
fromURLSource (OwnSpec (Left gi)) = [NewGHCupInfo gi]
fromURLSource (OwnSpec (Right si)) = [NewSetupInfo si]
convert' :: Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
convert' (Left (Left gi)) = NewGHCupInfo gi
convert' (Left (Right si)) = NewSetupInfo si
convert' (Right uri) = NewURI uri
instance NFData URLSource
instance NFData (URIRef Absolute) where
@@ -373,13 +389,11 @@ data UserSettings = UserSettings
, uGPGSetting :: Maybe GPGSetting
, uPlatformOverride :: Maybe PlatformRequest
, uMirrors :: Maybe DownloadMirrors
, uStackSetupSource :: Maybe StackSetupURLSource
, uStackSetup :: Maybe Bool
}
deriving (Show, GHC.Generic)
deriving (Show, GHC.Generic, Eq)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
@@ -397,8 +411,6 @@ fromSettings Settings{..} Nothing =
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
, uStackSetupSource = Just stackSetupSource
, uStackSetup = Just stackSetup
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
@@ -410,7 +422,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
, kSet = Just bSet
, kChangelog = Just bChangelog
, kShowAll = Just bShowAllVersions
, kShowAllTools = Just bShowAllTools
}
in UserSettings {
uCache = Just cache
@@ -426,52 +437,51 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
, uStackSetupSource = Just stackSetupSource
, uStackSetup = Just stackSetup
}
data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Key
, kDown :: Maybe Key
, kQuit :: Maybe Key
, kInstall :: Maybe Key
, kUninstall :: Maybe Key
, kSet :: Maybe Key
, kChangelog :: Maybe Key
, kShowAll :: Maybe Key
, kShowAllTools :: Maybe Key
{ kUp :: Maybe KeyCombination
, kDown :: Maybe KeyCombination
, kQuit :: Maybe KeyCombination
, kInstall :: Maybe KeyCombination
, kUninstall :: Maybe KeyCombination
, kSet :: Maybe KeyCombination
, kChangelog :: Maybe KeyCombination
, kShowAll :: Maybe KeyCombination
}
deriving (Show, GHC.Generic)
deriving (Show, GHC.Generic, Eq)
data KeyBindings = KeyBindings
{ bUp :: Key
, bDown :: Key
, bQuit :: Key
, bInstall :: Key
, bUninstall :: Key
, bSet :: Key
, bChangelog :: Key
, bShowAllVersions :: Key
, bShowAllTools :: Key
{ bUp :: KeyCombination
, bDown :: KeyCombination
, bQuit :: KeyCombination
, bInstall :: KeyCombination
, bUninstall :: KeyCombination
, bSet :: KeyCombination
, bChangelog :: KeyCombination
, bShowAllVersions :: KeyCombination
}
deriving (Show, GHC.Generic)
instance NFData KeyBindings
#if defined(IS_WINDOWS) || !defined(BRICK)
#if !defined(BRICK)
instance NFData Key
instance NFData Modifier
#endif
instance NFData KeyCombination
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
{ bUp = KUp
, bDown = KDown
, bQuit = KChar 'q'
, bInstall = KChar 'i'
, bUninstall = KChar 'u'
, bSet = KChar 's'
, bChangelog = KChar 'c'
, bShowAllVersions = KChar 'a'
, bShowAllTools = KChar 't'
{ bUp = KeyCombination { key = KUp , mods = [] }
, bDown = KeyCombination { key = KDown , mods = [] }
, bQuit = KeyCombination { key = KChar 'q', mods = [] }
, bInstall = KeyCombination { key = KChar 'i', mods = [] }
, bUninstall = KeyCombination { key = KChar 'u', mods = [] }
, bSet = KeyCombination { key = KChar 's', mods = [] }
, bChangelog = KeyCombination { key = KChar 'c', mods = [] }
, bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
}
data AppState = AppState
@@ -512,8 +522,6 @@ data Settings = Settings
, noColor :: Bool -- this also exists in LoggerConfig
, platformOverride :: Maybe PlatformRequest
, mirrors :: DownloadMirrors
, stackSetupSource :: StackSetupURLSource
, stackSetup :: Bool
}
deriving (Show, GHC.Generic)
@@ -521,7 +529,7 @@ defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty) StackSetupURL False
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
instance NFData Settings

View File

@@ -22,6 +22,7 @@ Portability : portable
module GHCup.Types.JSON where
import GHCup.Types
import GHCup.Types.Stack (SetupInfo)
import GHCup.Types.JSON.Utils
import GHCup.Types.JSON.Versions ()
import GHCup.Prelude.MegaParsec
@@ -32,7 +33,9 @@ import Data.Aeson.TH
import Data.Aeson.Types hiding (Key)
import Data.ByteString ( ByteString )
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Maybe
import Data.Text.Encoding as E
import Data.Foldable
import Data.Versions
import Data.Void
import URI.ByteString
@@ -56,7 +59,6 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
@@ -155,12 +157,6 @@ instance ToJSONKey Tool where
instance FromJSONKey Tool where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey GlobalTool where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
instance FromJSONKey GlobalTool where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSON TarDir where
toJSON (RealDir p) = toJSON p
toJSON (RegexDir r) = object ["RegexDir" .= r]
@@ -278,34 +274,64 @@ instance FromJSONKey (Maybe VersionRange) where
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, constructorTagModifier = \str' -> if str' == "StackSetupURL" then str' else maybe str' T.unpack . T.stripPrefix (T.pack "S") . T.pack $ str' } ''StackSetupURLSource
instance FromJSON GHCupInfo where
parseJSON = withObject "GHCupInfo" $ \o -> do
toolRequirements' <- o .:? "toolRequirements"
metadataUpdate <- o .:? "metadataUpdate"
ghcupDownloads' <- o .: "ghcupDownloads"
pure (GHCupInfo (fromMaybe mempty toolRequirements') ghcupDownloads' metadataUpdate)
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
instance ToJSON NewURLSource where
toJSON NewGHCupURL = String "GHCupURL"
toJSON NewStackSetupURL = String "StackSetupURL"
toJSON (NewGHCupInfo gi) = object [ "ghcup-info" .= gi ]
toJSON (NewSetupInfo si) = object [ "setup-info" .= si ]
toJSON (NewURI uri) = toJSON uri
instance ToJSON URLSource where
toJSON = toJSON . fromURLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Modifier
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
instance FromJSON URLSource where
parseJSON v =
parseGHCupURL v
<|> parseStackURL v
<|> parseOwnSourceLegacy v
<|> parseOwnSourceNew1 v
<|> parseOwnSourceNew2 v
<|> parseOwnSpec v
<|> legacyParseAddSource v
<|> newParseAddSource v
-- new since Stack SetupInfo
<|> parseOwnSpecNew v
<|> parseOwnSourceNew3 v
<|> newParseAddSource2 v
-- more lenient versions
<|> parseOwnSpecLenient v
<|> parseOwnSourceLenient v
<|> parseAddSourceLenient v
-- simplified list
<|> parseNewUrlSource v
<|> parseNewUrlSource' v
where
convert'' :: Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
convert'' (Left gi) = Left (Left gi)
convert'' (Right uri) = Right uri
parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
r :: URI <- o .: "OwnSource"
pure (OwnSource [Right r])
@@ -314,18 +340,100 @@ instance FromJSON URLSource where
pure (OwnSource (fmap Right r))
parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
r :: [Either GHCupInfo URI] <- o .: "OwnSource"
pure (OwnSource r)
pure (OwnSource (convert'' <$> r))
parseOwnSpec = withObject "URLSource" $ \o -> do
r :: GHCupInfo <- o .: "OwnSpec"
pure (OwnSpec r)
pure (OwnSpec $ Left r)
parseGHCupURL = withObject "URLSource" $ \o -> do
_ :: [Value] <- o .: "GHCupURL"
pure GHCupURL
parseStackURL = withObject "URLSource" $ \o -> do
_ :: [Value] <- o .: "StackSetupURL"
pure StackSetupURL
legacyParseAddSource = withObject "URLSource" $ \o -> do
r :: Either GHCupInfo URI <- o .: "AddSource"
pure (AddSource [r])
pure (AddSource [convert'' r])
newParseAddSource = withObject "URLSource" $ \o -> do
r :: [Either GHCupInfo URI] <- o .: "AddSource"
pure (AddSource (convert'' <$> r))
-- new since Stack SetupInfo
parseOwnSpecNew = withObject "URLSource" $ \o -> do
r :: Either GHCupInfo SetupInfo <- o .: "OwnSpec"
pure (OwnSpec r)
parseOwnSourceNew3 = withObject "URLSource" $ \o -> do
r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "OwnSource"
pure (OwnSource r)
newParseAddSource2 = withObject "URLSource" $ \o -> do
r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "AddSource"
pure (AddSource r)
-- more lenient versions
parseOwnSpecLenient = withObject "URLSource" $ \o -> do
spec :: Object <- o .: "OwnSpec"
OwnSpec <$> lenientInfoParser spec
parseOwnSourceLenient = withObject "URLSource" $ \o -> do
mown :: Array <- o .: "OwnSource"
OwnSource . toList <$> mapM lenientInfoUriParser mown
parseAddSourceLenient = withObject "URLSource" $ \o -> do
madd :: Array <- o .: "AddSource"
AddSource . toList <$> mapM lenientInfoUriParser madd
-- simplified
parseNewUrlSource = withArray "URLSource" $ \a -> do
SimpleList . toList <$> mapM parseJSON a
parseNewUrlSource' v' = SimpleList .(:[]) <$> parseJSON v'
lenientInfoUriParser :: Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
lenientInfoUriParser (Object o) = Left <$> lenientInfoParser o
lenientInfoUriParser v@(String _) = Right <$> parseJSON v
lenientInfoUriParser _ = fail "Unexpected json in lenientInfoUriParser"
lenientInfoParser :: Object -> Parser (Either GHCupInfo SetupInfo)
lenientInfoParser o = do
setup_info :: Maybe Object <- o .:? "setup-info"
case setup_info of
Nothing -> do
r <- parseJSON (Object o)
pure $ Left r
Just setup_info' -> do
r <- parseJSON (Object setup_info')
pure $ Right r
instance FromJSON NewURLSource where
parseJSON v = uri v <|> url v <|> gi v <|> si v
where
uri = withText "NewURLSource" $ \t -> NewURI <$> parseJSON (String t)
url = withText "NewURLSource" $ \t -> case T.unpack t of
"GHCupURL" -> pure NewGHCupURL
"StackSetupURL" -> pure NewStackSetupURL
t' -> fail $ "Unexpected text value in NewURLSource: " <> t'
gi = withObject "NewURLSource" $ \o -> do
ginfo :: GHCupInfo <- o .: "ghcup-info"
pure $ NewGHCupInfo ginfo
si = withObject "NewURLSource" $ \o -> do
sinfo :: SetupInfo <- o .: "setup-info"
pure $ NewSetupInfo sinfo
instance FromJSON KeyCombination where
parseJSON v = proper v <|> simple v
where
simple = withObject "KeyCombination" $ \o -> do
k <- parseJSON (Object o)
pure (KeyCombination k [])
proper = withObject "KeyCombination" $ \o -> do
k <- o .: "Key"
m <- o .: "Mods"
pure $ KeyCombination k m
instance ToJSON KeyCombination where
toJSON (KeyCombination k m) = object ["Key" .= k, "Mods" .= m]
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings

View File

@@ -50,7 +50,7 @@ instance FromJSON SetupInfo where
siSevenzExe <- o .:? "sevenzexe-info"
siSevenzDll <- o .:? "sevenzdll-info"
siMsys2 <- o .:? "msys2" .!= mempty
siGHCs <- o .:? "ghc" .!= mempty
siGHCs <- o .: "ghc"
siStack <- o .:? "stack" .!= mempty
pure SetupInfo {..}

View File

@@ -89,9 +89,9 @@ import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
import qualified Data.List.NonEmpty as NE
import qualified Streamly.Prelude as S
import Control.DeepSeq (force)
import GHC.IO (evaluate)
import System.Environment (getEnvironment)
import Data.Time (Day(..), diffDays, addDays)
@@ -1199,24 +1199,22 @@ getVersionInfo v' tool =
)
ensureGlobalTools :: ( MonadMask m
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasGHCupInfo env
, MonadUnliftIO m
, MonadFail m
)
=> Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
ensureGlobalTools
ensureShimGen :: ( MonadMask m
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasGHCupInfo env
, MonadUnliftIO m
, MonadFail m
)
=> Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
ensureShimGen
| isWindows = do
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
let shimDownload = DownloadInfo shimGenURL Nothing shimGenSHA Nothing Nothing
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\DigestError{} -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
@@ -1320,29 +1318,6 @@ warnAboutHlsCompatibility = do
addToPath :: [FilePath]
-> Bool -- ^ if False will prepend
-> IO [(String, String)]
addToPath paths append = do
cEnv <- getEnvironment
return $ addToPath' cEnv paths append
addToPath' :: [(String, String)]
-> [FilePath]
-> Bool -- ^ if False will prepend
-> [(String, String)]
addToPath' cEnv' newPaths append =
let cEnv = Map.fromList cEnv'
paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
{- HLINT ignore "Redundant bracket" -}
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ newPaths) else (newPaths ++ curPaths))
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
pathVar = if isWindows then "Path" else "PATH"
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
in envWithNewPath
-----------
--[ Git ]--
-----------

View File

@@ -29,6 +29,7 @@ module GHCup.Utils.Dirs
, relativeSymlink
, withGHCupTmpDir
, getConfigFilePath
, getConfigFilePath'
, useXDG
, cleanupTrash
@@ -360,6 +361,12 @@ getConfigFilePath = do
confDir <- liftIO ghcupConfigDir
pure $ fromGHCupPath confDir </> "config.yaml"
getConfigFilePath' :: (MonadReader env m, HasDirs env) => m FilePath
getConfigFilePath' = do
Dirs {..} <- getDirs
pure $ fromGHCupPath confDir </> "config.yaml"
ghcupConfigFile :: (MonadIO m)
=> Excepts '[JSONError] m UserSettings
ghcupConfigFile = do

View File

@@ -39,6 +39,12 @@ ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/
stackSetupURL :: URI
stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]
shimGenURL :: URI
shimGenURL = [uri|https://downloads.haskell.org/~ghcup/shimgen/shim-2.exe|]
shimGenSHA :: T.Text
shimGenSHA = T.pack "7c55e201f71860c5babea886007c8fa44b861abf50d1c07e5677eb0bda387a70"
-- | The current ghcup version.
ghcUpVer :: V.PVP
ghcUpVer = V.PVP . NE.fromList . fmap fromIntegral $ versionBranch version

View File

@@ -28,14 +28,14 @@
plat="$(uname -s)"
arch=$(uname -m)
ghver="0.1.19.4"
ghver="0.1.20.0"
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
export GHCUP_SKIP_UPDATE_CHECK=yes
: "${BOOTSTRAP_HASKELL_DOWNLOADER:=curl}"
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
: "${GHCUP_INSTALL_BASE_PREFIX:=/c}"
GHCUP_DIR=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup")
GHCUP_BIN=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup/bin")
@@ -72,7 +72,7 @@ warn() {
printf "%s\\n" "$1"
else
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
# shellcheck disable=SC3037
echo -e "\\033[0;35m$1\\033[0m"
;;
@@ -88,7 +88,7 @@ yellow() {
printf "%s\\n" "$1"
else
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
# shellcheck disable=SC3037
echo -e "\\033[0;33m$1\\033[0m"
;;
@@ -104,7 +104,7 @@ green() {
printf "%s\\n" "$1"
else
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
# shellcheck disable=SC3037
echo -e "\\033[0;32m$1\\033[0m"
;;
@@ -160,7 +160,7 @@ _done() {
echo
echo "==============================================================================="
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
green
green "All done!"
green
@@ -172,9 +172,8 @@ _done() {
green "Start a new haskell project in the current directory via:"
green " cabal init --interactive"
green
green "Install other GHC versions and tools via:"
green " ghcup list"
green " ghcup install <tool> <version>"
green "To install other GHC versions and tools, run:"
green " ghcup tui"
green
green "To install system libraries and update msys2/mingw64,"
green "open the \"Mingw haskell shell\""
@@ -314,7 +313,7 @@ download_ghcup() {
;;
esac
;;
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
case "${arch}" in
x86_64|amd64)
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-mingw64-ghcup-${ghver}.exe
@@ -327,7 +326,7 @@ download_ghcup() {
;;
esac
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
"curl")
# shellcheck disable=SC2086
@@ -546,7 +545,7 @@ adjust_bashrc() {
printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
fi
;;
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
if [ ! -e "${HOME}/.bash_profile" ] ; then
echo '# generated by ghcup' > "${HOME}/.bash_profile"
echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
@@ -596,7 +595,7 @@ adjust_cabal_config() {
ask_cabal_config_init() {
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
if [ -n "${BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG}" ] ; then
return 1
fi
@@ -637,7 +636,7 @@ ask_cabal_config_init() {
do_cabal_config_init() {
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
case $1 in
1)
adjust_cabal_config
@@ -757,7 +756,7 @@ if [ -z "${GHCUP_USE_XDG_DIRS}" ] ; then
echo "ghcup installs only into the following directory,"
echo "which can be removed anytime:"
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
echo " $(cygpath -w "$GHCUP_DIR")"
;;
*)
@@ -824,7 +823,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
edo cabal update --ignore-project
else # don't install ghc and cabal
case "${plat}" in
MSYS*|MINGW*)
MSYS*|MINGW*|CYGWIN*)
# need to bootstrap cabal to initialize config on windows
# we'll remove it afterwards
tmp_dir="$(mktemp -d)"

View File

@@ -11,7 +11,7 @@
* cabal - The Cabal build tool for managing Haskell software"
* stack - (optional) A cross-platform program for developing Haskell projects"
* hls - (optional) A language server for developers to integrate with their editor/IDE"
By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
#>
param (
@@ -42,7 +42,9 @@ param (
# The Msys2 version to download (e.g. 20221216)
[string]$Msys2Version,
# The Msys2 sha256sum hash
[string]$Msys2Hash
[string]$Msys2Hash,
# Whether to disable creation of several desktop shortcuts
[switch]$DontWriteDesktopShortcuts
)
$DefaultMsys2Version = "20221216"
@@ -139,7 +141,7 @@ filter Get-FileSize {
function Get-FileWCSynchronous{
param(
[Parameter(Mandatory=$true)]
[string]$url,
[string]$url,
[string]$destinationFolder="$env:USERPROFILE\Downloads",
[switch]$includeStats
)
@@ -229,7 +231,7 @@ if ($GhcupBasePrefixEnv) {
Print-Msg -color Green -msg ("Picked {0} as default Install prefix!" -f $defaultGhcupBasePrefix)
} else {
Print-Msg -color Red -msg "Couldn't find a writable partition with at least 5GB free disk space!"
Exit 1
Exit 1
}
}
@@ -274,7 +276,7 @@ Press enter to accept the default [{0}]:
if (!($GhcupBasePrefix.EndsWith('\'))) {
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
}
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
if (!($GhcupBasePrefix)) {
Print-Msg -color Red -msg "No directory specified!"
@@ -350,7 +352,7 @@ if ($CabalDir) {
$CabDirEnv = $CabalDir
if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!"
Exit 1
Exit 1
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
Exit 1
@@ -365,7 +367,7 @@ if ($CabalDir) {
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!"
Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
} else {
@@ -410,6 +412,26 @@ if (!($InstallStack)) {
}
}
if ($Interactive) {
$DesktopDecision = $Host.UI.PromptForChoice('Create Desktop shortcuts'
, 'Do you want to create convenience desktop shortcuts (e.g. for uninstallation and msys2 shell)?'
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Yes'
'&No'
'&Abort'), 0)
if ($DesktopDecision -eq 0) {
$InstallDesktopShortcuts = $true
} elseif ($DesktopDecision -eq 2) {
Exit 0
}
} else {
if ($Minimal) {
$InstallDesktopShortcuts = $false
} elseif ($DontWriteDesktopShortcuts) {
$InstallDesktopShortcuts = $false
} else {
$InstallDesktopShortcuts = $true
}
}
# mingw foo
Print-Msg -msg 'First checking for Msys2...'
@@ -454,7 +476,9 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Print-Msg -msg 'Extracting Msys2 archive...'
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
Remove-Item -Path "$archivePath"
# We ignore errors because we don't want the installation script to fail just because a temporary file can't be removed.
# Relevant issue: https://github.com/haskell/ghcup-hs/issues/952
Remove-Item -Path "$archivePath" -ErrorAction Continue
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
Exec "$Bash" '-lc' 'exit'
@@ -485,12 +509,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
$MsysDirPrompt = Read-Host
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
} else {
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
$MsysDir = Read-Host
}
$MsysDir = $MsysDir.TrimEnd().TrimStart()
if (!($MsysDir)) {
Print-Msg -color Red -msg "No directory specified!"
Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
Print-Msg -color Red -msg ('MSys2 installation at ''{0}'' could not be found!' -f $MsysDir)
} elseif (!(Split-Path -IsAbsolute -Path "$MsysDir")) {
@@ -510,8 +534,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Start-Sleep -s 5
}
Print-Msg -msg 'Creating shortcuts...'
$uninstallShortCut = @'
if ($InstallDesktopShortcuts) {
Print-Msg -msg 'Creating shortcuts...'
$uninstallShortCut = @'
$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
@@ -573,12 +600,13 @@ if ($Host.Name -eq "ConsoleHost")
}
'@
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
$DesktopDir = [Environment]::GetFolderPath("Desktop")
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
$DesktopDir = [Environment]::GetFolderPath("Desktop")
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
}
Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'

View File

@@ -0,0 +1,8 @@
#!/bin/sh
set -xue
cabal --verbose=0 run ghcup:exe:ghcup -- --bash-completion-script ghcup > scripts/shell-completions/bash
cabal --verbose=0 run ghcup:exe:ghcup -- --zsh-completion-script ghcup > scripts/shell-completions/zsh
cabal --verbose=0 run ghcup:exe:ghcup -- --fish-completion-script ghcup > scripts/shell-completions/fish

View File

@@ -9,8 +9,8 @@ set -eu
case $HOOK_GHC_TYPE in
bindist)
ghcdir=$(ghcup whereis --directory ghc "$HOOK_GHC_VERSION" || ghcup run --ghc "$HOOK_GHC_VERSION" --install) || exit 3
printf "%s/ghc" "${ghcdir}"
ghc_path=$(ghcup whereis ghc "$HOOK_GHC_VERSION" || { ghcup install ghc "$HOOK_GHC_VERSION" >/dev/null && ghcup whereis ghc "$HOOK_GHC_VERSION" ; }) || { >&2 echo "Installing $HOOK_GHC_VERSION via ghcup failed" exit 3 ;}
printf "%s" "${ghc_path}"
;;
git)
# TODO: should be somewhat possible

View File

@@ -175,10 +175,6 @@ instance Arbitrary Tool where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary GlobalTool where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary GHCupInfo where
arbitrary = genericArbitrary
shrink = genericShrink

File diff suppressed because it is too large Load Diff

View File

@@ -4116,17 +4116,7 @@
}
}
},
"globalTools": {
"ShimGen": {
"dlCSize": -1,
"dlHash": "xrocmtsmjzgmemxrenf",
"dlOutput": null,
"dlSubdir": {
"RegexDir": "\u0013tt\u0013m-"
},
"dlUri": "https:wjmqkzflmlzetqdcxed"
}
},
"metadataUpdate": "https:ixnnceymgu",
"toolRequirements": {
"GHCup": {
"3.8.8": {
@@ -9309,17 +9299,7 @@
}
}
},
"globalTools": {
"ShimGen": {
"dlCSize": -18,
"dlHash": "wbpx",
"dlOutput": null,
"dlSubdir": {
"RegexDir": "[u3"
},
"dlUri": "https:"
}
},
"metadataUpdate": "https:cxnnfovqllcccybmllaikuvluhp",
"toolRequirements": {
"HLS": {
"2.6.9": {
@@ -11308,15 +11288,7 @@
}
}
},
"globalTools": {
"ShimGen": {
"dlCSize": null,
"dlHash": "yfwka",
"dlOutput": "c5q",
"dlSubdir": "􊆁M󿅃/|",
"dlUri": "https:yolsdtmmo"
}
},
"metadataUpdate": "http:fbptvnonarkxeszcsn",
"toolRequirements": {
"Cabal": {
"7.7.4": {
@@ -13648,15 +13620,7 @@
"GHCup": {},
"Stack": {}
},
"globalTools": {
"ShimGen": {
"dlCSize": null,
"dlHash": "hoegok",
"dlOutput": null,
"dlSubdir": "􁃽\u0005]?9\u0001Q:𭲎8ᙣ𑐛'oD\u001a󱧼(𛆎􃥧\u0004\\𢨓[\u001e",
"dlUri": "https:nimu"
}
},
"metadataUpdate": null,
"toolRequirements": {
"Cabal": {
"3.5.4": {
@@ -18153,17 +18117,7 @@
}
}
},
"globalTools": {
"ShimGen": {
"dlCSize": null,
"dlHash": "mpljxguikoebuynzv",
"dlOutput": "Q􆹿@i\"%\u0014gb0/PPYE\u001f\u0014KC`-wL",
"dlSubdir": {
"RegexDir": ".`_\u0005󹦸&󲥠\u0014^1Fml\u001e􄋔>o􅟘G"
},
"dlUri": "http:tmcnu"
}
},
"metadataUpdate": "http:ntkddscbgdrjmwymnvpqpmgr",
"toolRequirements": {
"GHC": {
"6.3.1": {
@@ -19958,4 +19912,4 @@
}
],
"seed": 89490121
}
}

View File

@@ -5,6 +5,7 @@ module ConfigTest where
import Test.Tasty
import Test.Tasty.HUnit
import GHCup.OptParse
import GHCup.Types (NewURLSource(..))
import Utils
import Control.Monad.IO.Class
import URI.ByteString.QQ
@@ -23,7 +24,13 @@ checkList =
, ("config init", InitConfig)
, ("config show", ShowConfig)
, ("config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
, AddReleaseChannel False [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|]
, AddReleaseChannel False (NewURI [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|])
)
, ("config add-release-channel GHCupURL"
, AddReleaseChannel False NewGHCupURL
)
, ("config add-release-channel StackSetupURL"
, AddReleaseChannel False NewStackSetupURL
)
, ("config set cache true", SetConfig "cache" (Just "true"))
]

View File

@@ -2,9 +2,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module InstallTest where
@@ -16,8 +13,6 @@ import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHCup.OptParse.Install as Install
import URI.ByteString.QQ
import URI.ByteString
import Data.Text (Text)
-- Some interests:
-- install ghc *won't* select `set as activate version` as default
@@ -31,52 +26,37 @@ installTests = testGroup "install"
(buildTestTree installParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", installGhcCheckList)
, ("cabal", (fmap . fmap . fmap) toGHCOptions installCabalCheckList)
, ("hls", (fmap . fmap . fmap) toGHCOptions installHlsCheckList)
, ("stack", (fmap . fmap . fmap) toGHCOptions installStackCheckList)
, ("cabal", installCabalCheckList)
, ("hls", installHlsCheckList)
, ("stack", installStackCheckList)
]
toGHCOptions :: InstallOptions -> InstallGHCOptions
toGHCOptions InstallOptions{..}
= InstallGHCOptions instVer
instBindist
instSet
isolateDir
forceInstall
addConfArgs
Nothing
defaultOptions :: InstallOptions
defaultOptions = InstallOptions Nothing Nothing False Nothing False []
defaultGHCOptions :: InstallGHCOptions
defaultGHCOptions = InstallGHCOptions Nothing Nothing False Nothing False [] Nothing
-- | Don't set as active version
mkInstallOptions :: ToolVersion -> InstallGHCOptions
mkInstallOptions ver = InstallGHCOptions (Just ver) Nothing False Nothing False [] Nothing
mkInstallOptions :: ToolVersion -> InstallOptions
mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False []
-- | Set as active version
mkInstallOptions' :: ToolVersion -> InstallOptions
mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False []
oldStyleCheckList :: [(String, Either InstallCommand InstallGHCOptions)]
oldStyleCheckList :: [(String, Either InstallCommand InstallOptions)]
oldStyleCheckList =
("install", Right defaultGHCOptions)
: ("install --set", Right (defaultGHCOptions{instSet = True} :: InstallGHCOptions))
: ("install --force", Right (defaultGHCOptions{forceInstall = True} :: InstallGHCOptions))
("install", Right defaultOptions)
: ("install --set", Right defaultOptions{instSet = True})
: ("install --force", Right defaultOptions{forceInstall = True})
#ifdef IS_WINDOWS
: ("install -i C:\\\\", Right (defaultGHCOptions{Install.isolateDir = Just "C:\\\\"} :: InstallGHCOptions))
: ("install -i C:\\\\", Right defaultOptions{Install.isolateDir = Just "C:\\\\"})
#else
: ("install -i /", Right (defaultGHCOptions{Install.isolateDir = Just "/"} :: InstallGHCOptions))
: ("install -i /", Right defaultOptions{Install.isolateDir = Just "/"})
#endif
: ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
, Right (defaultGHCOptions
, Right defaultOptions
{ instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|]
, instVer = Just $ GHCVersion $ GHCTargetVersion Nothing $(versionQ "head")
} :: InstallGHCOptions)
}
)
: mapSecond
(Right . mkInstallOptions)
@@ -128,9 +108,9 @@ oldStyleCheckList =
)
]
installGhcCheckList :: [(String, Either InstallCommand InstallGHCOptions)]
installGhcCheckList :: [(String, Either InstallCommand InstallOptions)]
installGhcCheckList =
("install ghc", Left $ InstallGHC defaultGHCOptions)
("install ghc", Left $ InstallGHC defaultOptions)
: mapSecond (Left . InstallGHC . mkInstallOptions)
[ ("install ghc 9.2", GHCVersion
$ GHCTargetVersion
@@ -171,7 +151,7 @@ installGhcCheckList =
installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
installCabalCheckList =
("install cabal", Left $ InstallCabal (defaultOptions{instSet = True} :: InstallOptions))
("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
: mapSecond (Left . InstallCabal . mkInstallOptions')
[ ("install cabal 3.10", ToolVersion $(versionQ "3.10"))
, ("install cabal next", ToolVersion $(versionQ "next"))
@@ -217,7 +197,7 @@ installStackCheckList =
, ("install stack stack-2.9", ToolVersion $(versionQ "stack-2.9"))
]
installParseWith :: [String] -> IO (Either InstallCommand InstallGHCOptions)
installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)
installParseWith args = do
Install a <- parseWith args
pure a