Compare commits

..

17 Commits

Author SHA1 Message Date
Julian Ospald 1793fa43cf
Fix for screen readers 2024-03-23 15:10:55 +08:00
Luis Morillo b375398416 makes ctrl+c the shourtcut to exit menus + fix trailing new line in editor 2024-03-17 09:47:03 +01:00
Luis Morillo 04b29b0b98 fix regression #875 and build system 2024-03-16 16:27:04 +01:00
Luis Morillo 255f7c8eac Remove trailing white space 2024-03-16 16:14:24 +01:00
Luis Morillo 80a6c67cf3 Execute action only if inputs are valid + better UX 2024-03-13 18:14:37 +01:00
Luis Morillo cee4a0d610 untested compile HLS 2024-03-13 18:14:37 +01:00
Luis Morillo 9c4e64baf1 untested compileGHC IOAction 2024-03-13 18:14:37 +01:00
Luis Morillo 0b6e9289fc Visuals for compiling HLS 2024-03-13 18:14:37 +01:00
Luis Morillo cd8d13ff2b Advance Install menu implements functionality. 2024-03-13 18:14:37 +01:00
Luis Morillo 40f94fa016 Better aesth for context menu 2024-03-13 18:14:37 +01:00
Luis Morillo 32c2cd2efa Add visuals for compile Menu 2024-03-13 18:14:37 +01:00
Luis Morillo 7b18cc9081 migrate #987 to new library 2024-03-13 18:14:37 +01:00
Luis Morillo 3f80d41dd7 Add visuals for Advance Install 2024-03-13 18:14:37 +01:00
Luis Morillo 6485e230cd Context Menu visuals 2024-03-13 18:14:37 +01:00
Luis Morillo 3a8c32ae87 Extract common functionality 2024-03-13 18:14:37 +01:00
Luis Morillo 5ebb800646 Create Menu system. Similar to Brick.Forms 2024-03-13 18:14:37 +01:00
Luis Morillo f157cf809e Move tui code into its own library. 2024-03-13 18:14:36 +01:00
59 changed files with 3286 additions and 1946 deletions

View File

@ -1,39 +0,0 @@
name: Test cabal.project files
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
schedule:
- cron: '0 2 * * *'
jobs:
build:
name: Build binary
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [macOS-latest, macOS-11, windows-latest, ubuntu-latest]
ghc: ["8.10.7", "9.0.2", "9.2.8", "9.4.8"]
steps:
- name: Checkout code
uses: actions/checkout@v4
with:
submodules: 'true'
- name: Run build
run: |
env
ghcup --version
ghcup run -i --cabal latest -- cabal update
ghcup run -i --cabal latest --ghc ${GHC_VER} -- cabal build --project-file=cabal.ghc${GHC_VER//./}.project
env:
GHC_VER: ${{ matrix.ghc }}
shell: bash

View File

@ -21,8 +21,8 @@ jobs:
name: Build linux binary
runs-on: [self-hosted, Linux, X64, maerwald]
env:
CABAL_VER: 3.10.3.0
JSON_VERSION: "0.0.8"
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ secrets.S3_HOST }}
@ -31,7 +31,7 @@ jobs:
ARCH: 64
steps:
- name: Checkout code
uses: actions/checkout@v4
uses: actions/checkout@v3
with:
submodules: 'true'
@ -50,7 +50,7 @@ jobs:
- if: always()
name: Upload artifact
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v3
with:
name: artifacts
path: |
@ -61,13 +61,13 @@ jobs:
needs: "build"
runs-on: [self-hosted, Linux, X64]
container:
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:a9297a370025101b479cfd4977f8f910814e03ab
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
options: --user root
env:
CABAL_VER: 3.10.3.0
CABAL_VER: 3.6.2.0
BUILD_CONF_ARGS: "--enable-unregisterised"
HADRIAN_FLAVOUR: ""
JSON_VERSION: "0.0.8"
JSON_VERSION: "0.0.7"
GHC_VER: 8.10.6
GHC_TARGET_VERSION: "8.10.7"
ARCH: 64
@ -77,11 +77,11 @@ jobs:
WRAPPER: "run"
steps:
- name: Checkout code
uses: actions/checkout@v4
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v4
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
@ -89,18 +89,11 @@ jobs:
- name: Run test (64 bit linux)
run: |
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip libstdc++-11-dev
sudo apt-get install -y gcc-arm-linux-gnueabihf g++-arm-linux-gnueabihf
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
sudo apt-get install -y gcc-arm-linux-gnueabihf
sudo dpkg --add-architecture armhf
sudo apt-get update -y
sudo apt-get install -y libncurses-dev:armhf libstdc++-11-dev:armhf
# ld.bfd is broken on armv7: https://sourceware.org/bugzilla/show_bug.cgi?id=16177
update-alternatives --install "/usr/bin/x86_64-linux-gnu-ld" "ld" "/usr/bin/x86_64-linux-gnu-ld.gold" 20
update-alternatives --install "/usr/bin/x86_64-linux-gnu-ld" "ld" "/usr/bin/x86_64-linux-gnu-ld.bfd" 10
update-alternatives --set "ld" "/usr/bin/x86_64-linux-gnu-ld.gold"
update-alternatives --install "/usr/bin/arm-linux-gnueabihf-ld" "ld-arm" "/usr/bin/arm-linux-gnueabihf-ld.gold" 20
update-alternatives --install "/usr/bin/arm-linux-gnueabihf-ld" "ld-arm" "/usr/bin/arm-linux-gnueabihf-ld.bfd" 10
update-alternatives --set "ld-arm" "/usr/bin/arm-linux-gnueabihf-ld.gold"
sudo apt-get install -y libncurses-dev:armhf
sh .github/scripts/cross.sh
test-cross-js:
@ -108,13 +101,13 @@ jobs:
needs: "build"
runs-on: [self-hosted, Linux, X64]
container:
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:a9297a370025101b479cfd4977f8f910814e03ab
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
options: --user root
env:
CABAL_VER: 3.10.3.0
CABAL_VER: 3.6.2.0
BUILD_CONF_ARGS: ""
HADRIAN_FLAVOUR: "default+native_bignum"
JSON_VERSION: "0.0.8"
JSON_VERSION: "0.0.7"
GHC_VER: 9.6.2
GHC_TARGET_VERSION: "9.6.2"
ARCH: 64
@ -124,11 +117,11 @@ jobs:
WRAPPER: "emconfigure"
steps:
- name: Checkout code
uses: actions/checkout@v4
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v4
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out

View File

@ -126,7 +126,6 @@ jobs:
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ env.S3_HOST }}
LD: ld.gold
- if: matrix.ARCH == 'ARM64'
uses: docker://hasufell/arm64v8-debian-haskell:10
@ -398,7 +397,6 @@ jobs:
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: Ubuntu
LD: ld.gold
- if: matrix.ARCH == 'ARM64'
uses: docker://hasufell/arm64v8-debian-haskell:10

View File

@ -1,35 +0,0 @@
name: Test stack.yaml
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
schedule:
- cron: '0 2 * * *'
jobs:
build:
name: Build binary
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [macOS-latest, macOS-11, windows-latest, ubuntu-latest]
steps:
- name: Checkout code
uses: actions/checkout@v4
with:
submodules: 'true'
- name: Run build
run: |
env
ghcup --version
ghcup run -i --stack latest -- stack build
shell: bash

View File

@ -11,7 +11,8 @@
module Main where
#if defined(BRICK)
import BrickMain ( brickMain )
-- import BrickMain ( brickMain )
import GHCup.BrickMain (brickMain)
#endif
import qualified GHCup.GHC as GHC
@ -90,7 +91,6 @@ toSettings options = do
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
defGHCConfOptions = fromMaybe (Types.defGHCConfOptions defaultSettings) uDefGHCConfOptions
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal

View File

@ -1,60 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,60 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,245 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.2.0 || ==3.10.2.1,
any.Cabal-syntax ==3.10.1.0 || ==3.10.2.0,
any.HUnit ==1.6.2.0,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.Win32 ==2.6.2.1 || ==2.13.4.0,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.14.3.0,
any.base-compat ==0.13.1,
any.base-orphans ==0.9.1,
any.base16-bytestring ==1.0.2.0,
any.bifunctors ==5.6.1,
bifunctors +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.8.0 || ==0.8.9.1,
any.binary-instances ==1.0.4,
any.binary-orphans ==1.0.4.1,
any.blaze-builder ==0.4.2.3,
any.brick ==2.1.1,
brick -demos,
any.bytestring ==0.10.12.0 || ==0.11.5.3,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0,
chs-deps -cross,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.5.1,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-array-byte ==0.1.0.1,
any.data-clist ==0.2,
any.data-fix ==0.3.2,
any.deepseq ==1.4.4.0,
any.directory ==1.3.6.0 || ==1.3.8.3,
directory -os-string,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.2.1 || ==1.4.101.0,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1.1,
any.ghc-boot-th ==8.10.7,
any.ghc-prim ==0.6.1,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
any.hspec-discover ==2.10.10,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.indexed-profunctors ==0.1.1.1,
any.indexed-traversable ==0.1.3,
any.indexed-traversable-instances ==0.1.1.2,
any.integer-conversion ==0.1.0.1,
any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.4.2,
libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-clib ==0.2.5,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.1,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.mtl ==2.2.2,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parsec ==3.1.14.0 || ==3.1.17.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.polyparse ==1.13,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.8.0.0,
any.process ==1.6.13.2 || ==1.6.18.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.2,
any.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.regex-posix-clib ==2.7,
any.resourcet ==1.2.6,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.1,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.0.1,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.16.0.0,
any.temporary ==1.3,
any.text ==1.2.4.1 || ==2.0.2,
text -developer -simdutf,
any.text-binary ==0.2.1.1,
any.text-iso8601 ==0.1,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.13,
any.tf-random ==0.5,
any.th-abstraction ==0.6.0.0,
any.th-compat ==0.1.4,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.2,
any.time ==1.9.3 || ==1.11.1.2,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unicode-data ==0.3.1,
unicode-data -ucd2haskell,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-binary-instances ==0.2.5.2,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-windows ==0.2.0.2,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.3.0,
zlib +bundled-c-zlib -non-blocking-ffi -pkg-config
index-state: hackage.haskell.org 2024-03-15T23:51:46Z

View File

@ -1,8 +1,56 @@
if os(mingw32)
import: cabal.ghc8107.Win32.project
import: cabal.ghc8107.Win32.project.freeze
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
import: cabal.ghc8107.Unix.project
import: cabal.ghc8107.Unix.project.freeze
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-8.10.7

View File

@ -77,8 +77,7 @@ constraints: any.Cabal ==3.10.2.1,
any.data-clist ==0.2,
any.data-fix ==0.3.2,
any.deepseq ==1.4.4.0,
any.directory ==1.3.8.3,
directory -os-string,
any.directory ==1.3.8.1,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
@ -86,7 +85,7 @@ constraints: any.Cabal ==3.10.2.1,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.101.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
@ -105,7 +104,7 @@ constraints: any.Cabal ==3.10.2.1,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
@ -127,8 +126,8 @@ constraints: any.Cabal ==3.10.2.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.4.2,
libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode +system-libyaml,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
@ -257,4 +256,4 @@ constraints: any.Cabal ==3.10.2.1,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2024-03-13T09:43:35Z
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

View File

@ -1,60 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,61 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,258 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.2.1,
any.Cabal-syntax ==3.10.2.0,
any.HUnit ==1.6.2.0,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.Win32 ==2.12.0.1 || ==2.13.4.0,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.15.1.0,
any.base-compat ==0.13.1,
any.base-orphans ==0.9.1,
any.base16-bytestring ==1.0.2.0,
any.bifunctors ==5.6.1,
bifunctors +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.9.1,
any.binary-instances ==1.0.4,
any.binary-orphans ==1.0.4.1,
any.bindings-DSL ==1.0.25,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.brick ==2.1.1,
brick -demos,
any.bytestring ==0.11.5.3,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.bzlib-conduit ==0.3.0.3,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-array-byte ==0.1.0.1,
any.data-clist ==0.2,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.2,
any.deepseq ==1.4.5.0,
any.digest ==0.0.2.1,
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
any.directory ==1.3.6.2 || ==1.3.8.3,
directory -os-string,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.2.1 || ==1.4.101.0,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1.1,
any.ghc-bignum ==1.1,
any.ghc-boot-th ==9.0.2,
any.ghc-prim ==0.7.0,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
any.hspec-discover ==2.10.10,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.indexed-profunctors ==0.1.1.1,
any.indexed-traversable ==0.1.3,
any.indexed-traversable-instances ==0.1.1.2,
any.integer-conversion ==0.1.0.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-clib ==0.2.5,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.2,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.monad-control ==1.0.3.1,
any.mono-traversable ==1.0.17.0,
any.mtl ==2.2.2,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parsec ==3.1.17.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.8.0.0,
any.process ==1.6.13.2 || ==1.6.18.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.2,
any.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.regex-posix-clib ==2.7,
any.resourcet ==1.2.6,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.0.0,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.17.0.0,
any.temporary ==1.3,
any.text ==2.0.2,
text -developer -simdutf,
any.text-binary ==0.2.1.1,
any.text-iso8601 ==0.1,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.13,
any.tf-random ==0.5,
any.th-abstraction ==0.6.0.0,
any.th-compat ==0.1.4,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.2,
any.time ==1.9.3 || ==1.11.1.2,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.11.1,
any.unicode-data ==0.3.1,
unicode-data -ucd2haskell,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.1,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-binary-instances ==0.2.5.2,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-windows ==0.2.0.2,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zip ==2.0.0,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.3.0,
zlib +bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-15T23:51:46Z

View File

@ -1,8 +1,56 @@
if os(mingw32)
import: cabal.ghc902.Win32.project
import: cabal.ghc902.Win32.project.freeze
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
import: cabal.ghc902.Unix.project
import: cabal.ghc902.Unix.project.freeze
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-9.0.2

View File

@ -82,8 +82,7 @@ constraints: any.Cabal ==3.10.2.1,
any.deepseq ==1.4.5.0,
any.digest ==0.0.2.1,
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
any.directory ==1.3.8.3,
directory -os-string,
any.directory ==1.3.8.1,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
@ -91,7 +90,7 @@ constraints: any.Cabal ==3.10.2.1,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.101.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
@ -111,7 +110,7 @@ constraints: any.Cabal ==3.10.2.1,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
@ -130,8 +129,8 @@ constraints: any.Cabal ==3.10.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode +system-libyaml,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
@ -270,4 +269,4 @@ constraints: any.Cabal ==3.10.2.1,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-13T09:43:35Z
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

View File

@ -1,60 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,60 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,258 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.2.1,
any.Cabal-syntax ==3.10.2.0,
any.HUnit ==1.6.2.0,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.Win32 ==2.12.0.1 || ==2.13.4.0,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.16.4.0,
any.base-compat ==0.13.1,
any.base-orphans ==0.9.1,
any.base16-bytestring ==1.0.2.0,
any.bifunctors ==5.6.1,
bifunctors +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.9.0,
any.binary-instances ==1.0.4,
any.binary-orphans ==1.0.4.1,
any.bindings-DSL ==1.0.25,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.brick ==2.1.1,
brick -demos,
any.bytestring ==0.11.4.0,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.bzlib-conduit ==0.3.0.3,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.5.1,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-array-byte ==0.1.0.1,
any.data-clist ==0.2,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.2,
any.deepseq ==1.4.6.1,
any.digest ==0.0.2.1,
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
any.directory ==1.3.6.2 || ==1.3.8.3,
directory -os-string,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.2.2 || ==1.4.101.0,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1.1,
any.ghc-bignum ==1.2,
any.ghc-boot-th ==9.2.8,
any.ghc-prim ==0.8.0,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
any.hspec-discover ==2.10.10,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.indexed-profunctors ==0.1.1.1,
any.indexed-traversable ==0.1.3,
any.indexed-traversable-instances ==0.1.1.2,
any.integer-conversion ==0.1.0.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-clib ==0.2.5,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.2,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.monad-control ==1.0.3.1,
any.mono-traversable ==1.0.17.0,
any.mtl ==2.2.2,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parsec ==3.1.17.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.8.0.0,
any.process ==1.6.16.0 || ==1.6.18.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.2,
any.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.regex-posix-clib ==2.7,
any.resourcet ==1.2.6,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.0.2,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.18.0.0,
any.temporary ==1.3,
any.text ==2.0.2,
text -developer -simdutf,
any.text-binary ==0.2.1.1,
any.text-iso8601 ==0.1,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.13,
any.tf-random ==0.5,
any.th-abstraction ==0.6.0.0,
any.th-compat ==0.1.4,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.2,
any.time ==1.11.1.1 || ==1.11.1.2,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.11.1,
any.unicode-data ==0.3.1,
unicode-data -ucd2haskell,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.1,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-binary-instances ==0.2.5.2,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-windows ==0.2.0.2,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zip ==2.0.0,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.3.0,
zlib +bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-15T23:51:46Z

View File

@ -1,8 +1,56 @@
if os(mingw32)
import: cabal.ghc928.Win32.project
import: cabal.ghc928.Win32.project.freeze
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
import: cabal.ghc928.Unix.project
import: cabal.ghc928.Unix.project.freeze
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-9.2.8

View File

@ -82,8 +82,7 @@ constraints: any.Cabal ==3.10.2.1,
any.deepseq ==1.4.6.1,
any.digest ==0.0.2.1,
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
any.directory ==1.3.8.3,
directory -os-string,
any.directory ==1.3.7.1,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
@ -91,7 +90,7 @@ constraints: any.Cabal ==3.10.2.1,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.101.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
@ -111,7 +110,7 @@ constraints: any.Cabal ==3.10.2.1,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
@ -130,8 +129,8 @@ constraints: any.Cabal ==3.10.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode +system-libyaml,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
@ -234,8 +233,7 @@ constraints: any.Cabal ==3.10.2.1,
any.typed-process ==0.2.11.1,
any.unicode-data ==0.3.1,
unicode-data -ucd2haskell,
any.unix ==2.8.5.0,
unix -os-string,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.8,
any.unix-compat ==0.7.1,
unix-compat -old-time,
@ -270,4 +268,4 @@ constraints: any.Cabal ==3.10.2.1,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-13T09:43:35Z
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

View File

@ -1,60 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,61 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@ -1,256 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.2.1,
any.Cabal-syntax ==3.10.2.0,
any.HUnit ==1.6.2.0,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.Win32 ==2.12.0.1 || ==2.13.4.0,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.17.2.1,
any.base-compat ==0.13.1,
any.base-orphans ==0.9.1,
any.base16-bytestring ==1.0.2.0,
any.bifunctors ==5.6.1,
bifunctors +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.9.1,
any.binary-instances ==1.0.4,
any.binary-orphans ==1.0.4.1,
any.bindings-DSL ==1.0.25,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.brick ==2.1.1,
brick -demos,
any.bytestring ==0.11.5.3,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.bzlib-conduit ==0.3.0.3,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.7,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.2,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.2,
any.deepseq ==1.4.8.0,
any.digest ==0.0.2.1,
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
any.directory ==1.3.7.1 || ==1.3.8.3,
directory -os-string,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.5,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.2.2 || ==1.4.101.0,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1.1,
any.ghc-bignum ==1.3,
any.ghc-boot-th ==9.4.8,
any.ghc-prim ==0.9.1,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
any.hspec-discover ==2.10.10,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.indexed-profunctors ==0.1.1.1,
any.indexed-traversable ==0.1.3,
any.indexed-traversable-instances ==0.1.1.2,
any.integer-conversion ==0.1.0.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-clib ==0.2.5,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.2,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.monad-control ==1.0.3.1,
any.mono-traversable ==1.0.17.0,
any.mtl ==2.2.2,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parsec ==3.1.16.1,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.8.0.0,
any.process ==1.6.18.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.2,
any.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.regex-posix-clib ==2.7,
any.resourcet ==1.2.6,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.1.0,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.19.0.0,
any.temporary ==1.3,
any.text ==2.0.2,
any.text-binary ==0.2.1.1,
any.text-iso8601 ==0.1,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.13,
any.tf-random ==0.5,
any.th-abstraction ==0.6.0.0,
any.th-compat ==0.1.4,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.2,
any.time ==1.11.1.2 || ==1.12.2,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.11.1,
any.unicode-data ==0.3.1,
unicode-data -ucd2haskell,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.1,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-binary-instances ==0.2.5.2,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-windows ==0.2.0.2,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zip ==2.0.0,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.3.0,
zlib +bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-15T23:51:46Z

View File

@ -1,8 +1,56 @@
if os(mingw32)
import: cabal.ghc948.Win32.project
import: cabal.ghc948.Win32.project.freeze
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
import: cabal.ghc948.Unix.project
import: cabal.ghc948.Unix.project.freeze
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-9.4.8

View File

@ -81,8 +81,7 @@ constraints: any.Cabal ==3.10.2.1,
any.deepseq ==1.4.8.0,
any.digest ==0.0.2.1,
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
any.directory ==1.3.8.3,
directory -os-string,
any.directory ==1.3.8.1,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
@ -90,7 +89,7 @@ constraints: any.Cabal ==3.10.2.1,
dlist -werror,
any.exceptions ==0.10.5,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.101.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
@ -110,7 +109,7 @@ constraints: any.Cabal ==3.10.2.1,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
@ -129,8 +128,8 @@ constraints: any.Cabal ==3.10.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-streamly ==0.2.2.1,
libyaml-streamly -no-unicode +system-libyaml,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
@ -268,4 +267,4 @@ constraints: any.Cabal ==3.10.2.1,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-13T09:43:35Z
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

View File

@ -11,18 +11,12 @@ else
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
bzlib >= 0.5.2.0
if os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.2.0.2
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3

View File

@ -128,12 +128,3 @@ mirrors:
authority:
host: "mirror.sjtu.edu.cn"
# Arguments to pass to the configure script of the prebuilt bindist.
#
# Do not pass '--prefix' here.
#
# GHCup by default passes '--disable-ld-override', so if you want to enable
# the vanilla way, which aggressively favors 'ld.gold' linker, add the following:
def-ghc-conf-options:
- "--enable-ld-override"

@ -1 +1 @@
Subproject commit c9dae0c58799854823e8c41858ca4cc172ef4c8b
Subproject commit 7e1a50cfff66fdc4039535ea2251fd62a0521579

1
docs/BUGS.md Normal file
View File

@ -0,0 +1 @@
# Known BUGS

39
docs/TODO.md Normal file
View File

@ -0,0 +1,39 @@
# TODOs and Remarks
## Now
* ghcup init?
* merge two download files
* fetch/unpack functionality
* installing multiple versions of the same
* post-install
* proper test suite
* !! update of 0.1.5 must go in ghcup-0.0.1.json !!
* try to run exe before upgrade (backup to ~/.ghcup/bin/ghcup.old)
* stdout flushing?
* resume support (for make-install only)
## Maybe
* version ranges in json
* sign the JSON? (Or check gpg keys?)
* testing (especially distro detection -> unit tests)
## Later
* add support for RC/alpha/HEAD versions
## Cleanups
* avoid alternative for IO
* use plucky or oops instead of Excepts
## Questions
* move out GHCup.Version module, bc it's not library-ish?
* mirror support
* interactive handling when distro doesn't exist and we know the tarball is incompatible?
* ghcup-with wrapper to execute a command with a given ghc in PATH?

View File

@ -40,80 +40,6 @@ All you wanted to know about GHCup.
* [haskell.org](https://www.haskell.org/haskell-org-committee/) via CI and infrastructure
* [Haskell Foundation](https://haskell.foundation/affiliates/) via affiliation
## Project ownership and hierarchy
The project at the time of writing (2024-04-22) follows the model of
[benevolent dictator for life](https://en.wikipedia.org/wiki/Benevolent_dictator_for_life), which is
Julian Ospald at the moment.
Ideally, the ownership should be shared across a core team of collaborators sharing the same vision and
engagement in the future.
I do not believe in people making decisions over projects they are barely involved in. Instead I believe
in listening to end users needs very carefully and making decisions based on that. People who want a direct
influence on the decision process have to both demonstrate they share the vision of GHCup and do the actual
work.
"Work" here doesn't have to be "writing code". There are many ways to be engaged in a project.
### Transition plan in case of maintainer absence
In case the current maintainer of GHCup (Julian Ospald) is unreachable for a prolonged period of time (3 months),
the ownership of this project will be automatically transferred to the following individuals:
- [Moritz Angerman](https://github.com/angerman)
- [Andrew Lelechenko](https://github.com/Bodigrim)
They will be tasked with finding new maintainers in whatever way they see fit (be it appointing themselves or asking HF for help).
The appointed owners may choose to stay owners after the transition period (whether it's in a passive or active capacity) or
fully transfer ownership to someone else or an organization.
The community shall be informed about this process.
If not otherwise specified by the newly appointed owners, the following principles shall apply to the *transition period*:
#### During the transition period
During the transition period, no other individual or organization is allowed to drive changes to
[ghcup-hs](https://github.com/haskell/ghcup-hs) repository, unless they are explicitly allowed to do so by the appointed owners.
The following people (in addition to the owners) shall have full write access to the
[ghcup-metadata](https://github.com/haskell/ghcup-metadata) repository
(all files) for the length of the transition period, unless otherwise specified by the appointed owners:
- [Ben Gamari](https://github.com/bgamari)
- [Hécate Moonlight](https://github.com/Kleidukos)
- [Mike Pilgrem](https://github.com/mpilgrem)
- [Jens Petersen](https://github.com/juhp)
Contributions to the metadata are expected to follow a review process. If that turns out to be impractical due to lack of engagement, a wait
time of 2 days before merging shall be followed anyway, except for the `-vanilla` files, which may be merged at any time.
#### Access
The GHCup website, various scripts and unofficial bindists are hosted on haskell.org infrastructure. Contact the
[Haskell.org committee](https://www.haskell.org/haskell-org-committee/) for access.
The backup owners should already have admin rights on the GHCup repositories, which are hosted on the
[Github haskell namespace](https://github.com/haskell). In case of issues contact one of the
organization admins for access, e.g.:
- [Andrew Lelechenko](https://github.com/orgs/haskell/people/Bodigrim)
- [gbaz](https://github.com/orgs/haskell/people/gbaz)
- [Hécate Moonlight](https://github.com/Kleidukos)
- [davean](https://github.com/orgs/haskell/people/davean)
- [chessai](https://github.com/orgs/haskell/people/chessai)
The owners should already have access to the [hackage package](https://hackage.haskell.org/package/ghcup/maintainers/).
In case of issues contact the [hackage trustees](https://github.com/haskell-infra/hackage-trustees).
#### Private runners
Private runners maintained by Julian Ospald may cease to work. Moritz Angerman will have SSH access to the machines.
However, no one will have access to the Hetzner account and billing information. As such, those runners will simply
have to be replaced.
## How to help
* if you want to contribute code or documentation, check out the [issue tracker](https://github.com/haskell/ghcup-hs/issues) and the [Development guide](./dev.md)
@ -187,7 +113,7 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
### Custom ghc version names
When installing ghc bindists with custom version names as outlined in
[installing custom bindists](guide.md#installing-custom-bindists), then cabal might
[installing custom bindists](#installing-custom-bindists), then cabal might
be unable to find the correct `ghc-pkg` (also see [#73](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/73))
if you use `cabal build --with-compiler=ghc-foo`. Instead, point it to the full path, such as:
`cabal build --with-compiler=$HOME/.ghcup/ghc/<version-name>/bin/ghc` or set that GHC version

View File

@ -146,16 +146,8 @@ a:hover {
color: #996FC2;
}
#toc-collapse a.nav-link {
color: var(--link-pink);
}
#toc-collapse a:hover.nav-link {
color: #996FC2;
}
.col-md-9 img.main-logo {
border: 0px;
border: 0px;
padding: 0px;
margin: 0px;
}

View File

@ -1,27 +1,7 @@
# Development and contribution
# Development
All you wanted to know about GHCup development.
## Building
GHCup supports development via cabal and stack. E.g.:
* build via stack: `stack build`
* build via cabal (with whatever GHC version): `cabal build`
* build via cabal reproducibly with a specific GHC version
- GHC 8.10.7: `cabal build --project-file=cabal.ghc8107.project`
- GHC 9.0.2: `cabal build --project-file=cabal.ghc902.project`
- and so on (check supported versions via `ls cabal.ghc+([0-9]).project`)
* build the release binaries: `cabal build --project-file=cabal.project.release`
## Contribution process and expectations
* discuss your idea first before implementing anything
* GHCup is a dictatorship, so the final decisions are made by the author
* we don't manage contributors... you can work on anything you like
* reviews focus on logic and design, not on style and formatting
* remember that features, decisions and bugs are high impact, since GHCup is used in CIs, github workflows, etc.
## Module graph
[![Module graph](./modules_small.svg){: .center style="width:900px"}](./modules_wide.svg)
@ -81,7 +61,7 @@ Some light suggestions:
3. use `where` a lot, so the main function body reads like prose
4. documentation is part of the code
## Common tasks
## Common Tasks
### Adding a new GHC version

View File

@ -151,7 +151,7 @@ of metadata files to understand their purpose. These can be combined.
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.8.yaml
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
```
@ -180,7 +180,7 @@ url-source:
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 the one-shot CLI option:
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
@ -200,14 +200,14 @@ url-source:
- 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).
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
### 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:
@ -322,24 +322,8 @@ Stack metadata doesn't have a concept of those and we don't try to be smart when
### Windows
#### Using GHCup's MSYS2 installation
Stack usually maintains its own msys2 installation. However, you can instruct it to use GHCup's MSYS2 or any other. E.g. if you
had GHCup install msys2 into `C:\ghcup\msys64\`, then you would add the following config to stack's `config.yaml`
(you can find its location via `stack path --stack-root`):
```yaml
skip-msys: true
extra-lib-dirs:
- C:\ghcup\msys64\mingw64\lib
- C:\ghcup\msys64\mingw64\bin
extra-path:
- C:\ghcup\msys64\mingw64\bin
- C:\ghcup\msys64\usr\bin
- C:\ghcup\msys64\usr\local\bin
extra-include-dirs:
- C:\ghcup\msys64\mingw64\include
```
On windows, you may find the following config options useful too:
`skip-msys`, `extra-path`, `extra-include-dirs`, `extra-lib-dirs`.
Also check out: [https://docs.haskellstack.org/en/stable/yaml_configuration](https://docs.haskellstack.org/en/stable/yaml_configuration)
@ -376,28 +360,6 @@ mirrors:
The configuration depends on the host of the mirror and they have to provide the correct configuration.
## Linkers
The GHC bindist configure script by default doesn't honour the system `ld` that is set, but instead
probes for `ld.lld`, `ld.gold` and only then `ld` in order, see
[find_ld.m4](https://gitlab.haskell.org/ghc/ghc/-/blob/master/m4/find_ld.m4?ref_type=heads).
This is controlled by the configure switch `--enable-ld-override`/`--disable-ld-override`, which is enabled by default in GHC.
GHCup however [has decided](https://github.com/haskell/ghcup-hs/issues/1032) **to disable this switch by default**,
for reasons of stability and simplicity.
That means, when `--disable-ld-override` is passed, the linker is picked simply by:
* checking if `LD` env var is set, then use whatever is specified
* otherwise use `ld` binary in PATH (system/distro default)
You can restore the GHC vanilla default by adding this to your `~/.ghcup/config.yaml`:
```yaml
def-ghc-conf-options:
- "--enable-ld-override"
```
# More on installation
## Customisation of the installation scripts
@ -559,24 +521,19 @@ The next sections explain how to install each cross bindist.
### GHC JS cross bindists (experimental)
You need the required emscripten JS toolchain. GHC JS cross bindists might require you to install a specific
version of emscripten. If that is the case, then ghcup will display the required emscripten version in the
pre install message. You can use the following commands to install the emscripten toolchain on your system,
substituting the required version for the bindist that you want to install.
(Cf. [GHC-MR 10918](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10918))
You need the required emscripten JS toolchain:
```sh
git clone https://github.com/emscripten-core/emsdk.git
cd emsdk
./emsdk install VERSION
./emsdk activate VERSION
./emsdk install latest
./emsdk activate latest
source ./emsdk_env.sh
```
Instructions are also here: [Download and install — Emscripten documentation](https://emscripten.org/docs/getting_started/downloads.html).
Instructions are also here: [Download and install — Emscripten 3.1.43-git (dev) documentation](https://emscripten.org/docs/getting_started/downloads.html).
To install you can either use the tui interface by invoking `emconfigure ghcup tui` or
you can install directly like so:
To install we need to invoke ghcup like so:
```sh
emconfigure ghcup install ghc --set javascript-unknown-ghcjs-9.6.2

View File

@ -1,7 +1,7 @@
# Installation
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](#supported-tools) from scratch.
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./#supported-tools) from scratch.
It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
## How to install
@ -32,7 +32,7 @@ GHCup has two main channels for every tool: **recommended** and **latest**. By d
*latest* follows the latest release of every tool, while *recommended* is at the discretion of the GHCup maintainers and based on community adoption (hackage libraries, tools like HLS, stackage support, etc.) and known bugs.
Also see [tags and shortcuts](guide.md#tags-and-shortcuts) for more information.
Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information.
## System requirements
@ -121,9 +121,9 @@ On Windows, msys2 should already have been set up during the installation, so mo
## Next steps
1. Follow the [First steps guide](steps.md) on how to build a "Hello world" program, use `ghc`, run an interactive REPL and create a Haskell project
1. Follow the [First steps guide](../steps) on how to build a "Hello world" program, use `ghc`, run an interactive REPL and create a Haskell project
2. To understand the difference and overlap of `stack` and `cabal`, read on [here](https://gist.github.com/merijn/8152d561fb8b011f9313c48d876ceb07)
3. To learn Haskell proper check out the links at [How to learn Haskell proper](steps.md#how-to-learn-haskell-proper)
3. To learn Haskell proper check out the links at [How to learn Haskell proper](../steps#how-to-learn-haskell-proper)
4. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
## Uninstallation
@ -382,7 +382,7 @@ All set. You can run `cabal init` now in an empty directory to start a project.
### Void Linux
Since void linux can be installed with glibc and musl, it's hard to support correctly with ghcup.
One way to make ghcup work on **Void Linux musl** is to follow the [Overriding distro detection](guide.md#overriding-distro-detection)
One way to make ghcup work on **Void Linux musl** is to follow the [Overriding distro detection](../guide/#overriding-distro-detection)
section and tell it to consider Alpine bindists only. E.g.:
```sh

View File

@ -13,7 +13,7 @@ installed a Haskell toolchain:
The Glorious Glasgow Haskell Compilation System, version 8.10.7
```
If this fails, consult [the Getting started page](install.md) for information on
If this fails, consult [the Getting started page](../install) for information on
how to install Haskell on your computer.
This guide is partly based on [Gil Mizrahi's blog](https://gilmi.me/blog/post/2021/08/14/hs-core-tools).
@ -44,7 +44,7 @@ follow the [GHC user guide](https://downloads.haskell.org/ghc/latest/docs/html/u
Now we run our program:
```sh
➜ ./hello
➜ ./hello
Hello, Haskell!
```
@ -99,7 +99,7 @@ To enter the environment run the program `ghci`.
```sh
➜ ghci
GHCi, version 9.0.2: https://www.haskell.org/ghc/ :? for help
ghci>
ghci>
```
It provides an interactive prompt where Haskell expressions can be written and
@ -199,7 +199,7 @@ And the modules of the relevant packages will be available for import:
```sh
GHCi, version 9.0.1: https://www.haskell.org/ghc/ :? for help
ghci> import Control.Concurrent.Async
ghci> import Control.Concurrent.Async
ghci> import Say
ghci> concurrently_ (sayString "Hello") (sayString "World")
Hello

View File

@ -322,6 +322,62 @@ library ghcup-optparse
else
build-depends: unix ^>=2.7 || ^>=2.8
library ghcup-tui
import: app-common-depends
exposed-modules:
GHCup.BrickMain
GHCup.Brick.Widgets.Navigation
GHCup.Brick.Widgets.Tutorial
GHCup.Brick.Widgets.KeyInfo
GHCup.Brick.Widgets.SectionList
GHCup.Brick.Widgets.Menu
GHCup.Brick.Widgets.Menus.Context
GHCup.Brick.Widgets.Menus.AdvanceInstall
GHCup.Brick.Widgets.Menus.CompileGHC
GHCup.Brick.Widgets.Menus.CompileHLS
GHCup.Brick.Actions
GHCup.Brick.App
GHCup.Brick.BrickState
GHCup.Brick.Attributes
GHCup.Brick.Common
hs-source-dirs: lib-tui
default-language: Haskell2010
default-extensions:
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
build-depends:
, ghcup
, ghcup-optparse
, optics ^>=0.4
, brick ^>=2.1
, transformers ^>=0.5
, vty ^>=6.0
, optics ^>=0.4
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if flag(tui)
cpp-options: -DBRICK
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
executable ghcup
import: app-common-depends
main-is: Main.hs
@ -345,6 +401,7 @@ executable ghcup
build-depends:
, ghcup
, ghcup-optparse
, ghcup-tui
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER

View File

@ -2,6 +2,10 @@ cradle:
cabal:
- component: "ghcup:lib:ghcup"
path: ./lib
- component: "ghcup:lib:ghcup-optparse"
path: ./lib-opt
- component: "ghcup:lib:ghcup-tui"
path: ./lib-tui
- component: "ghcup:exe:ghcup"
path: ./app/ghcup
- component: "ghcup:lib:ghcup-optparse"

View File

@ -133,8 +133,7 @@ updateSettings usl usr =
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
mirrors' = uMirrors usl <|> uMirrors usr
defGHCconfOptions' = uDefGHCConfOptions usl <|> uDefGHCConfOptions usr
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' defGHCconfOptions'
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

View File

@ -0,0 +1,727 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module GHCup.Brick.Actions where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types.Optics ( getDirs, getPlatformReq )
import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils
import GHCup.OptParse.Common (logGHCPostRm)
import GHCup.Prelude ( decUTF8Safe, runBothE' )
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prompts
import GHCup.Brick.Common (BrickData(..), BrickSettings(..), Name(..), Mode(..))
import qualified GHCup.Brick.Common as Common
import GHCup.Brick.BrickState
import GHCup.Brick.Widgets.SectionList
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
import GHCup.Brick.Widgets.Navigation (BrickInternalState)
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
import qualified Brick
import qualified Brick.Widgets.List as L
import qualified Brick.Focus as F
import Control.Applicative
import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.Trans.Resource
import Data.Bool
import Data.Functor
import Data.Function ( (&), on)
import Data.List
import Data.Maybe
import Data.IORef (IORef, readIORef, newIORef, modifyIORef)
import Data.Versions hiding (Lens')
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile )
import System.Exit
import System.IO.Unsafe
import System.Process ( system )
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy as L
import qualified Graphics.Vty as Vty
import qualified Data.Vector as V
import System.Environment (getExecutablePath)
#if !IS_WINDOWS
import GHCup.Prelude.File
import System.FilePath
import qualified System.Posix.Process as SPP
#endif
import Optics.State (use)
import Optics.State.Operators ( (.=))
import Optics.Operators ((.~),(%~))
import Optics.Getter (view)
import Optics.Optic ((%))
import Optics ((^.), to)
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
import Control.Concurrent (threadDelay)
import qualified GHCup.GHC as GHC
import qualified GHCup.OptParse.Common as OptParse
import qualified GHCup.HLS as HLS
{- Core Logic.
This module defines the IO actions we can execute within the Brick App:
- Install
- Set
- UnInstall
- Launch the Changelog
-}
-- | Update app data and list internal state based on new evidence.
-- This synchronises @BrickInternalState@ with @BrickData@
-- and @BrickSettings@.
updateList :: BrickData -> BrickState -> BrickState
updateList appD bst =
let newInternalState = constructList appD (bst ^. appSettings) (Just (bst ^. appState))
in bst
& appState .~ newInternalState
& appData .~ appD
& mode .~ Navigation
constructList :: BrickData
-> BrickSettings
-> Maybe BrickInternalState
-> BrickInternalState
constructList appD settings =
replaceLR (filterVisible (_showAllVersions settings))
(_lr appD)
-- | Focus on the tool section and the predicate which matches. If no result matches, focus on index 0
selectBy :: Tool -> (ListResult -> Bool) -> BrickInternalState -> BrickInternalState
selectBy tool predicate internal_state =
let new_focus = F.focusSetCurrent (Singular tool) (view sectionListFocusRingL internal_state)
tool_lens = sectionL (Singular tool)
in internal_state
& sectionListFocusRingL .~ new_focus
& tool_lens %~ L.listMoveTo 0 -- We move to 0 first
& tool_lens %~ L.listFindBy predicate -- The lookup by the predicate.
-- | Select the latests GHC tool
selectLatest :: BrickInternalState -> BrickInternalState
selectLatest = selectBy GHC (elem Latest . lTag)
-- | Replace the @appState@ or construct it based on a filter function
-- and a new @[ListResult]@ evidence.
-- When passed an existing @appState@, tries to keep the selected element.
replaceLR :: (ListResult -> Bool)
-> [ListResult]
-> Maybe BrickInternalState
-> BrickInternalState
replaceLR filterF list_result s =
let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e)
newVec = [(Singular $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)]
newSectionList = sectionList AllTools newVec 1
in case oldElem of
Just (_, el) -> selectBy (lTool el) (toolEqual el) newSectionList
Nothing -> selectLatest newSectionList
where
toolEqual e1 e2 =
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
filterVisible :: Bool -> ListResult -> Bool
filterVisible v e | lInstalled e = True
| v
, Nightly `notElem` lTag e = True
| not v
, Old `notElem` lTag e
, Nightly `notElem` lTag e = True
| otherwise = (Old `notElem` lTag e) &&
(Nightly `notElem` lTag e)
-- | Suspend the current UI and run an IO action in terminal. If the
-- IO action returns a Left value, then it's thrown as userError.
withIOAction :: (Ord n, Eq n)
=> ( (Int, ListResult) -> ReaderT AppState IO (Either String a))
-> Brick.EventM n BrickState ()
withIOAction action = do
as <- Brick.get
case sectionListSelectedElement (view appState as) of
Nothing -> pure ()
Just (curr_ix, e) -> do
Brick.suspendAndResume $ do
settings <- readIORef settings'
flip runReaderT settings $ action (curr_ix, e) >>= \case
Left err -> liftIO $ putStrLn ("Error: " <> err)
Right _ -> liftIO $ putStrLn "Success"
getAppData Nothing >>= \case
Right data' -> do
putStrLn "Press enter to continue"
_ <- getLine
pure (updateList data' as)
Left err -> throwIO $ userError err
installWithOptions :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> AdvanceInstall.InstallOptions
-> (Int, ListResult)
-> m (Either String ())
installWithOptions opts (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let
misolated = opts ^. AdvanceInstall.isolateDirL
shouldIsolate = maybe GHCupInternal IsolateDir (opts ^. AdvanceInstall.isolateDirL)
shouldForce = opts ^. AdvanceInstall.forceInstallL
shouldSet = opts ^. AdvanceInstall.instSetL
extraArgs = opts ^. AdvanceInstall.addConfArgsL
v = GHCTargetVersion lCross lVer
let run =
runResourceT
. runE
@'[ AlreadyInstalled
, ArchiveResult
, UnknownArchive
, FileDoesNotExistError
, CopyError
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, DirNotEmpty
, NoUpdate
, TarDirDoesNotExist
, FileAlreadyExistsError
, ProcessError
, ToolShadowed
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
, InstallSetError
]
run (do
ce <- liftIO $ fmap (either (const Nothing) Just) $
try @_ @SomeException $ getExecutablePath >>= canonicalizePath
dirs <- lift getDirs
case lTool of
GHC -> do
let vi = getVersionInfo v GHC dls
case opts ^. AdvanceInstall.instBindistL of
Nothing -> do
liftE $
runBothE'
(installGHCBin v shouldIsolate shouldForce extraArgs)
(when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
pure (vi, dirs, ce)
Just uri -> do
liftE $
runBothE'
(installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
v
shouldIsolate
shouldForce
extraArgs)
(when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
pure (vi, dirs, ce)
Cabal -> do
let vi = getVersionInfo v Cabal dls
case opts ^. AdvanceInstall.instBindistL of
Nothing -> do
liftE $
runBothE'
(installCabalBin lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
pure (vi, dirs, ce)
Just uri -> do
liftE $
runBothE'
(installCabalBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
pure (vi, dirs, ce)
GHCup -> do
let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
HLS -> do
let vi = getVersionInfo v HLS dls
case opts ^. AdvanceInstall.instBindistL of
Nothing -> do
liftE $
runBothE'
(installHLSBin lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing))
pure (vi, dirs, ce)
Just uri -> do
liftE $
runBothE'
(installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
lVer
shouldIsolate
shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing))
pure (vi, dirs, ce)
Stack -> do
let vi = getVersionInfo v Stack dls
case opts ^. AdvanceInstall.instBindistL of
Nothing -> do
liftE $
runBothE'
(installStackBin lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
pure (vi, dirs, ce)
Just uri -> do
liftE $
runBothE'
(installStackBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
pure (vi, dirs, ce)
)
>>= \case
VRight (vi, Dirs{..}, Just ce) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
case lTool of
GHCup -> do
#if !IS_WINDOWS
up <- liftIO $ fmap (either (const Nothing) Just)
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
when ((normalise <$> up) == Just (normalise ce)) $
-- TODO: track cli arguments of previous invocation
liftIO $ SPP.executeFile ce False ["tui"] Nothing
#else
logInfo "Please restart 'ghcup' for the changes to take effect"
#endif
_ -> pure ()
pure $ Right ()
VRight (vi, _, _) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
logInfo "Please restart 'ghcup' for the changes to take effect"
pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V NoUpdate) -> pure $ Right ()
VLeft e -> pure $ Left $ prettyHFError e <> "\n"
<> "Also check the logs in ~/.ghcup/logs"
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> (Int, ListResult) -> m (Either String ())
install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing False [])
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> (Int, ListResult)
-> m (Either String ())
set' input@(_, ListResult {..}) = do
settings <- liftIO $ readIORef settings'
let run =
flip runReaderT settings
. runResourceT
. runE
@'[ AlreadyInstalled
, ArchiveResult
, UnknownArchive
, FileDoesNotExistError
, CopyError
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, DirNotEmpty
, NoUpdate
, TarDirDoesNotExist
, FileAlreadyExistsError
, ProcessError
, ToolShadowed
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]
run (do
case lTool of
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
Cabal -> liftE $ setCabal lVer $> ()
HLS -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
Stack -> liftE $ setStack lVer $> ()
GHCup -> do
promptAnswer <- getUserPromptResponse "Switching GHCup versions is not supported.\nDo you want to install the latest version? [Y/N]: "
case promptAnswer of
PromptYes -> do
void $ liftE $ upgradeGHCup Nothing False False
PromptNo -> pure ()
)
>>= \case
VRight _ -> pure $ Right ()
VLeft e -> case e of
(V (NotInstalled tool _)) -> do
promptAnswer <- getUserPromptResponse userPrompt
case promptAnswer of
PromptYes -> do
res <- install' input
case res of
(Left err) -> pure $ Left err
(Right _) -> do
logInfo "Setting now..."
set' input
PromptNo -> pure $ Left (prettyHFError e)
where
userPrompt = L.toStrict . B.toLazyText . B.fromString $
"This Version of "
<> show tool
<> " you are trying to set is not installed.\n"
<> "Would you like to install it first? [Y/N]: "
_ -> pure $ Left (prettyHFError e)
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> (Int, ListResult)
-> m (Either String ())
del' (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let run = runE @'[NotInstalled, UninstallFailed]
run (do
let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
Cabal -> liftE $ rmCabalVer lVer $> vi
HLS -> liftE $ rmHLSVer lVer $> vi
Stack -> liftE $ rmStackVer lVer $> vi
GHCup -> pure Nothing
)
>>= \case
VRight vi -> do
when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
forM_ (_viPostRemove =<< vi) $ \msg ->
logInfo msg
pure $ Right ()
VLeft e -> pure $ Left (prettyHFError e)
changelog' :: (MonadReader AppState m, MonadIO m)
=> (Int, ListResult)
-> m (Either String ())
changelog' (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (ToolVersion lVer) of
Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do
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 $ Right ()
Left e -> pure $ Left $ prettyHFError e
compileGHC :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> CompileGHC.CompileGHCOptions -> (Int, ListResult) -> m (Either String ())
compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do
appstate <- ask
let run =
runResourceT
. runE @'[ AlreadyInstalled
, BuildFailed
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
, DirNotEmpty
, ArchiveResult
, FileDoesNotExistError
, HadrianNotFound
, InvalidBuildConfig
, ProcessError
, CopyError
, BuildFailed
, UninstallFailed
, MergeFileTreeError
]
compileResult <- run (do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let vi = getVersionInfo (mkTVer lVer) GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
logInfo msg
logInfo
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
targetVer <- liftE $ GHCup.compileGHC
(GHC.SourceDist lVer)
(compopts ^. CompileGHC.crossTarget)
(compopts ^. CompileGHC.overwriteVer)
(compopts ^. CompileGHC.bootstrapGhc)
(compopts ^. CompileGHC.jobs)
(compopts ^. CompileGHC.buildConfig)
(compopts ^. CompileGHC.patches)
(compopts ^. CompileGHC.addConfArgs)
(compopts ^. CompileGHC.buildFlavour)
(compopts ^. CompileGHC.buildSystem)
(maybe GHCupInternal IsolateDir $ compopts ^. CompileGHC.isolateDir)
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask
let vi2 = getVersionInfo targetVer GHC dls2
when
(compopts ^. CompileGHC.setCompile)
(liftE . void $ GHCup.setGHC targetVer SetGHCOnly Nothing)
pure (vi2, targetVer)
)
case compileResult of
VRight (vi, tv) -> do
logInfo "GHC successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
liftIO $ putStr (T.unpack $ tVerToText tv)
pure $ Right ()
VLeft (V (AlreadyInstalled _ v)) -> do
logWarn $
"GHC ver " <> prettyVer v <> " already installed, remove it first to reinstall"
pure $ Right ()
VLeft (V (DirNotEmpty fp)) -> do
logError $
"Install directory " <> T.pack fp <> " is not empty."
pure $ Right ()
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs (appstate & settings) of
Never -> logError $ T.pack $ prettyHFError err
_ -> logError $ T.pack (prettyHFError err) <> "\n"
<> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir)
<> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n"
<> "Make sure to clean up " <> T.pack tmpdir <> " afterwards."
pure $ Right ()
VLeft e -> do
logError $ T.pack $ prettyHFError e
pure $ Right ()
-- This is the case when the tool is not GHC... which should be impossible but,
-- it exhaustes pattern matches
compileGHC _ (_, ListResult{lTool = _}) = pure (Right ())
compileHLS :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> CompileHLS.CompileHLSOptions -> (Int, ListResult) -> m (Either String ())
compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do
appstate <- ask
let run =
runResourceT
. runE @'[ AlreadyInstalled
, BuildFailed
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NotInstalled
, DirNotEmpty
, ArchiveResult
, UninstallFailed
, MergeFileTreeError
]
compileResult <- run (do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let vi = getVersionInfo (mkTVer lVer) GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
logInfo msg
logInfo
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
ghcs <-
liftE $ forM (compopts ^. CompileHLS.targetGHCs)
(\ghc -> fmap (_tvVersion . fst) . OptParse.fromVersion (Just ghc) $ GHC)
targetVer <- liftE $ GHCup.compileHLS
(HLS.SourceDist lVer)
ghcs
(compopts ^. CompileHLS.jobs)
(compopts ^. CompileHLS.overwriteVer)
(maybe GHCupInternal IsolateDir $ compopts ^. CompileHLS.isolateDir)
(compopts ^. CompileHLS.cabalProject)
(compopts ^. CompileHLS.cabalProjectLocal)
(compopts ^. CompileHLS.updateCabal)
(compopts ^. CompileHLS.patches)
(compopts ^. CompileHLS.cabalArgs)
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask
let vi2 = getVersionInfo (mkTVer targetVer) GHC dls2
when
(compopts ^. CompileHLS.setCompile)
(liftE . void $ GHCup.setHLS targetVer SetHLSOnly Nothing)
pure (vi2, targetVer)
)
case compileResult of
VRight (vi, tv) -> do
logInfo "HLS successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
liftIO $ putStr (T.unpack $ prettyVer tv)
pure $ Right ()
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs (appstate & settings) of
Never -> logError $ T.pack $ prettyHFError err
_ -> logError $ T.pack (prettyHFError err) <> "\n"
<> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir)
<> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n"
<> "Make sure to clean up " <> T.pack tmpdir <> " afterwards."
pure $ Right ()
VLeft e -> do
logError $ T.pack $ prettyHFError e
pure $ Right ()
-- This is the case when the tool is not HLS... which should be impossible but,
-- it exhaustes pattern matches
compileHLS _ (_, ListResult{lTool = _}) = pure (Right ())
settings' :: IORef AppState
{-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do
dirs <- getAllDirs
let loggerConfig = LoggerConfig { lcPrintDebug = False
, consoleOutter = \_ -> pure ()
, fileOutter = \_ -> pure ()
, fancyColors = True
}
newIORef $ AppState defaultSettings
dirs
defaultKeyBindings
(GHCupInfo mempty mempty Nothing)
(PlatformRequest A_64 Darwin Nothing)
loggerConfig
getGHCupInfo :: IO (Either String GHCupInfo)
getGHCupInfo = do
settings <- readIORef settings'
r <-
flip runReaderT settings
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
$ do
pfreq <- lift getPlatformReq
liftE $ getDownloadsF pfreq
case r of
VRight a -> pure $ Right a
VLeft e -> pure $ Left (prettyHFError e)
getAppData :: Maybe GHCupInfo
-> IO (Either String BrickData)
getAppData mgi = runExceptT $ do
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
settings <- liftIO $ readIORef settings'
flip runReaderT settings $ do
lV <- listVersions Nothing [] False True (Nothing, Nothing)
pure $ BrickData (reverse lV)
--
keyHandlers :: KeyBindings
-> [ ( KeyCombination
, BrickSettings -> String
, Brick.EventM Name BrickState ()
)
]
keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , Brick.halt)
, (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction set')
, (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAllVersions
, \BrickSettings {..} ->
if _showAllVersions then "Don't show all versions" else "Show all versions"
, hideShowHandler' (not . _showAllVersions)
)
, (bUp, const "Up", Common.zoom appState moveUp)
, (bDown, const "Down", Common.zoom appState moveDown)
, (KeyCombination (Vty.KChar 'h') [], const "help", mode .= KeyInfo)
, (KeyCombination Vty.KEnter [], const "advance options", createMenuforTool )
]
where
createMenuforTool = do
e <- use (appState % to sectionListSelectedElement)
let exitKey = KeyCombination (Vty.KChar 'c') [Vty.MCtrl]
case e of
Nothing -> pure ()
Just (_, r) -> do
-- Create new menus
contextMenu .= ContextMenu.create r exitKey
advanceInstallMenu .= AdvanceInstall.create exitKey
compileGHCMenu .= CompileGHC.create exitKey
compileHLSMenu .= CompileHLS.create exitKey
-- Set mode to context
mode .= ContextPanel
pure ()
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
hideShowHandler' f = do
app_settings <- use appSettings
let
vers = f app_settings
newAppSettings = app_settings & Common.showAllVersions .~ vers
ad <- use appData
current_app_state <- use appState
appSettings .= newAppSettings
appState .= constructList ad newAppSettings (Just current_app_state)

192
lib-tui/GHCup/Brick/App.hs Normal file
View File

@ -0,0 +1,192 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-
This module defines the brick App. The pattern is very simple:
- Pattern match on the Mode
- Dispatch drawing/events to the corresponding widget/s
In general each widget should know how to draw itself and how to handle its own events, so this
module should only contain:
- how to draw non-widget information. For example the footer
- how to change between modes (widgets aren't aware of the whole application state)
-}
module GHCup.Brick.App where
import qualified GHCup.Brick.Actions as Actions
import qualified GHCup.Brick.Attributes as Attributes
import GHCup.Brick.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode, compileGHCMenu, compileHLSMenu)
import GHCup.Brick.Common (Mode (..), Name (..))
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
import qualified GHCup.Brick.Widgets.Navigation as Navigation
import qualified GHCup.Brick.Widgets.Tutorial as Tutorial
import qualified GHCup.Brick.Widgets.Menu as Menu
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import GHCup.Types (AppState (AppState, keyBindings), KeyCombination (KeyCombination))
import qualified Brick.Focus as F
import Brick (
App (..),
AttrMap,
BrickEvent (VtyEvent),
EventM,
Widget (..),
(<=>),
)
import qualified Brick
import Control.Monad.Reader (
MonadIO (liftIO),
void,
)
import Data.IORef (readIORef)
import Data.List (find, intercalate)
import Prelude hiding (appendFile)
import qualified Graphics.Vty as Vty
import qualified Data.Text as T
import Optics.Getter (to)
import Optics.Operators ((^.))
import Optics.Optic ((%))
import Optics.State (use)
import Optics.State.Operators ((.=))
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
import Control.Monad (when)
app :: AttrMap -> AttrMap -> App BrickState () Name
app attrs dimAttrs =
App { appDraw = drawUI dimAttrs
, appHandleEvent = eventHandler
, appStartEvent = return ()
, appAttrMap = const attrs
, appChooseCursor = Brick.showFirstCursor
}
drawUI :: AttrMap -> BrickState -> [Widget Name]
drawUI dimAttrs st =
let
footer = Brick.withAttr Attributes.helpAttr
. Brick.txtWrap
. T.pack
. foldr1 (\x y -> x <> " " <> y)
. fmap (\(KeyCombination key mods, pretty_setting, _)
-> intercalate "+" (Common.showKey key : (Common.showMod <$> mods)) <> ":" <> pretty_setting (st ^. appSettings)
)
$ Actions.keyHandlers (st ^. appKeys)
navg = Navigation.draw dimAttrs (st ^. appState) <=> footer
in case st ^. mode of
Navigation -> [navg]
Tutorial -> [Tutorial.draw, navg]
KeyInfo -> [KeyInfo.draw (st ^. appKeys), navg]
ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg]
AdvanceInstallPanel -> [AdvanceInstall.draw (st ^. advanceInstallMenu), navg]
CompileGHCPanel -> [CompileGHC.draw (st ^. compileGHCMenu), navg]
CompileHLSPanel -> [CompileHLS.draw (st ^. compileHLSMenu), navg]
-- | On q, go back to navigation.
-- On Enter, to go to tutorial
keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState ()
keyInfoHandler ev = case ev of
VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl]) -> mode .= Navigation
VtyEvent (Vty.EvKey Vty.KEnter _ ) -> mode .= Tutorial
_ -> pure ()
-- | On q, go back to navigation. Else, do nothing
tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
tutorialHandler ev =
case ev of
VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl]) -> mode .= Navigation
_ -> pure ()
-- | Tab/Arrows to navigate.
navigationHandler :: BrickEvent Name e -> EventM Name BrickState ()
navigationHandler ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings'
case ev of
inner_event@(VtyEvent (Vty.EvKey key mods)) ->
case find (\(key', _, _) -> key' == KeyCombination key mods) (Actions.keyHandlers kb) of
Just (_, _, handler) -> handler
Nothing -> void $ Common.zoom appState $ Navigation.handler inner_event
inner_event -> Common.zoom appState $ Navigation.handler inner_event
contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState ()
contextMenuHandler ev = do
ctx <- use contextMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= Navigation
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileGHCButton) ) -> mode .= Common.CompileGHCPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileHLSButton) ) -> mode .= Common.CompileHLSPanel
_ -> Common.zoom contextMenu $ ContextMenu.handler ev
--
advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState ()
advanceInstallHandler ev = do
ctx <- use advanceInstallMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL
Actions.withIOAction $ Actions.installWithOptions iopts
_ -> Common.zoom advanceInstallMenu $ AdvanceInstall.handler ev
compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
compileGHCHandler ev = do
ctx <- use compileGHCMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL
when (Menu.isValidMenu ctx)
(Actions.withIOAction $ Actions.compileGHC iopts)
_ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
compileHLSHandler :: BrickEvent Name e -> EventM Name BrickState ()
compileHLSHandler ev = do
ctx <- use compileHLSMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL
when (Menu.isValidMenu ctx)
(Actions.withIOAction $ Actions.compileHLS iopts)
_ -> Common.zoom compileHLSMenu $ CompileHLS.handler ev
eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
eventHandler ev = do
m <- use mode
case m of
KeyInfo -> keyInfoHandler ev
Tutorial -> tutorialHandler ev
Navigation -> navigationHandler ev
ContextPanel -> contextMenuHandler ev
AdvanceInstallPanel -> advanceInstallHandler ev
CompileGHCPanel -> compileGHCHandler ev
CompileHLSPanel -> compileHLSHandler ev

View File

@ -0,0 +1,84 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-
This module defined the attributes. Despite of brick's capability to have a hierarchy of attributes, here
we go for the most-simple-approach: a plain hierarchy
-}
module GHCup.Brick.Attributes where
import Brick ( AttrMap)
import qualified Brick
import qualified Brick.Widgets.List as L
import qualified Graphics.Vty as Vty
defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = Brick.attrMap
Vty.defAttr
[ (L.listSelectedFocusedAttr , Vty.defAttr `withBackColor` Vty.blue)
, (L.listSelectedAttr , Vty.defAttr)
, (notInstalledAttr , Vty.defAttr `withForeColor` Vty.red)
, (setAttr , Vty.defAttr `withForeColor` Vty.green)
, (installedAttr , Vty.defAttr `withForeColor` Vty.green)
, (recommendedAttr , Vty.defAttr `withForeColor` Vty.green)
, (hlsPoweredAttr , Vty.defAttr `withForeColor` Vty.green)
, (latestAttr , Vty.defAttr `withForeColor` Vty.yellow)
, (latestPrereleaseAttr , Vty.defAttr `withForeColor` Vty.red)
, (latestNightlyAttr , Vty.defAttr `withForeColor` Vty.red)
, (prereleaseAttr , Vty.defAttr `withForeColor` Vty.red)
, (nightlyAttr , Vty.defAttr `withForeColor` Vty.red)
, (compiledAttr , Vty.defAttr `withForeColor` Vty.blue)
, (strayAttr , Vty.defAttr `withForeColor` Vty.blue)
, (dayAttr , Vty.defAttr `withForeColor` Vty.blue)
, (helpAttr , Vty.defAttr `withStyle` Vty.italic)
, (hoorayAttr , Vty.defAttr `withForeColor` Vty.brightWhite)
, (helpMsgAttr , Vty.defAttr `withForeColor` Vty.brightBlack)
, (errMsgAttr , Vty.defAttr `withForeColor` Vty.red)
]
where
withForeColor | no_color = const
| otherwise = Vty.withForeColor
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
withStyle = Vty.withStyle
notInstalledAttr, setAttr, installedAttr, recommendedAttr, hlsPoweredAttr :: Brick.AttrName
latestAttr, latestPrereleaseAttr, latestNightlyAttr, prereleaseAttr, nightlyAttr :: Brick.AttrName
compiledAttr, strayAttr, dayAttr, helpAttr, hoorayAttr, helpMsgAttr, errMsgAttr :: Brick.AttrName
notInstalledAttr = Brick.attrName "not-installed"
setAttr = Brick.attrName "set"
installedAttr = Brick.attrName "installed"
recommendedAttr = Brick.attrName "recommended"
hlsPoweredAttr = Brick.attrName "hls-powered"
latestAttr = Brick.attrName "latest"
latestPrereleaseAttr = Brick.attrName "latest-prerelease"
latestNightlyAttr = Brick.attrName "latest-nightly"
prereleaseAttr = Brick.attrName "prerelease"
nightlyAttr = Brick.attrName "nightly"
compiledAttr = Brick.attrName "compiled"
strayAttr = Brick.attrName "stray"
dayAttr = Brick.attrName "day"
helpAttr = Brick.attrName "help"
hoorayAttr = Brick.attrName "hooray"
helpMsgAttr = Brick.attrName "helpMsg"
errMsgAttr = Brick.attrName "errMsg"
dimAttributes :: Bool -> AttrMap
dimAttributes no_color = Brick.attrMap
(Vty.defAttr `Vty.withStyle` Vty.dim)
[ (Brick.attrName "active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
, (Brick.attrName "no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
]
where
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor

View File

@ -0,0 +1,54 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-
This module contains the BrickState. One could be tempted to include this data structure in GHCup.Brick.Common,
but it is better to make a separated module in order to avoid cyclic dependencies.
This happens because the BrickState is sort of a container for all widgets,
but widgets depends on common functionality, hence:
BrickState `depends on` Widgets.XYZ `depends on` Common
The linear relation above breaks if BrickState is defined in Common.
-}
module GHCup.Brick.BrickState where
import GHCup.Types ( KeyBindings )
import GHCup.Brick.Common ( BrickData(..), BrickSettings(..), Mode(..))
import GHCup.Brick.Widgets.Navigation ( BrickInternalState)
import GHCup.Brick.Widgets.Menus.Context (ContextMenu)
import GHCup.Brick.Widgets.Menus.AdvanceInstall (AdvanceInstallMenu)
import GHCup.Brick.Widgets.Menus.CompileGHC (CompileGHCMenu)
import Optics.TH (makeLenses)
import GHCup.Brick.Widgets.Menus.CompileHLS (CompileHLSMenu)
data BrickState = BrickState
{ _appData :: BrickData
, _appSettings :: BrickSettings
, _appState :: BrickInternalState
, _contextMenu :: ContextMenu
, _advanceInstallMenu :: AdvanceInstallMenu
, _compileGHCMenu :: CompileGHCMenu
, _compileHLSMenu :: CompileHLSMenu
, _appKeys :: KeyBindings
, _mode :: Mode
}
--deriving Show
makeLenses ''BrickState

View File

@ -0,0 +1,216 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PatternSynonyms #-}
{-
This module contains common values used across the library. Crucially it contains two important types for the brick app:
- Name: List all resources (widgets) used by the app. see https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#resource-names
- Mode: Use to dispatch events and drawings. see: https://github.com/jtdaugherty/brick/issues/476#issuecomment-1629151920
-}
module GHCup.Brick.Common (
installedSign,
setSign,
notInstalledSign,
showKey,
showMod,
keyToWidget,
separator,
frontwardLayer,
zoom,
defaultAppSettings,
lr,
showAllVersions,
Name(..),
Mode(..),
BrickData(..),
BrickSettings(..),
ResourceId (
UrlEditBox, SetCheckBox, IsolateEditBox, ForceCheckBox, AdditionalEditBox
, TargetGhcEditBox, BootstrapGhcEditBox, JobsEditBox, BuildConfigEditBox
, PatchesEditBox, CrossTargetEditBox, AddConfArgsEditBox, OvewrwiteVerEditBox
, BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
, CompileGHCButton, CompileHLSButton, CabalProjectEditBox
, CabalProjectLocalEditBox, UpdateCabalCheckBox
) ) where
import GHCup.List ( ListResult )
import GHCup.Types ( Tool, KeyCombination (KeyCombination) )
import Data.List (intercalate)
import Prelude hiding ( appendFile )
import qualified Graphics.Vty as Vty
import Optics.TH (makeLenses)
import Optics.Lens (toLensVL)
import qualified Brick
import qualified Brick.Widgets.Border as Border
import Brick ((<+>))
import qualified Data.Text as T
import qualified Brick.Widgets.Center as Brick
import qualified Brick.Widgets.Border.Style as Border
-- We could use regular ADTs but different menus share the same options.
-- example: all of ghcup compile ghc, ghcup compile hls, ghcup install cabal, etc...
-- all have a --set, --force, etc... common arguments. If we went for the ADT we'd end up
-- with SetCompileHLSOption, SetCompileGHCOption, SetInstallCabalOption, etc...
-- which isn't terrible, but verbose enough to reject it.
-- | A newtype for labeling resources in menus. It is bundled along with pattern synonyms
newtype ResourceId = ResourceId Int deriving (Eq, Ord, Show)
pattern OkButton :: ResourceId
pattern OkButton = ResourceId 0
pattern AdvanceInstallButton :: ResourceId
pattern AdvanceInstallButton = ResourceId 100
pattern CompileGHCButton :: ResourceId
pattern CompileGHCButton = ResourceId 101
pattern CompileHLSButton :: ResourceId
pattern CompileHLSButton = ResourceId 102
pattern UrlEditBox :: ResourceId
pattern UrlEditBox = ResourceId 1
pattern SetCheckBox :: ResourceId
pattern SetCheckBox = ResourceId 2
pattern IsolateEditBox :: ResourceId
pattern IsolateEditBox = ResourceId 3
pattern ForceCheckBox :: ResourceId
pattern ForceCheckBox = ResourceId 4
pattern AdditionalEditBox :: ResourceId
pattern AdditionalEditBox = ResourceId 5
pattern TargetGhcEditBox :: ResourceId
pattern TargetGhcEditBox = ResourceId 6
pattern BootstrapGhcEditBox :: ResourceId
pattern BootstrapGhcEditBox = ResourceId 7
pattern JobsEditBox :: ResourceId
pattern JobsEditBox = ResourceId 8
pattern BuildConfigEditBox :: ResourceId
pattern BuildConfigEditBox = ResourceId 9
pattern PatchesEditBox :: ResourceId
pattern PatchesEditBox = ResourceId 10
pattern CrossTargetEditBox :: ResourceId
pattern CrossTargetEditBox = ResourceId 11
pattern AddConfArgsEditBox :: ResourceId
pattern AddConfArgsEditBox = ResourceId 12
pattern OvewrwiteVerEditBox :: ResourceId
pattern OvewrwiteVerEditBox = ResourceId 13
pattern BuildFlavourEditBox :: ResourceId
pattern BuildFlavourEditBox = ResourceId 14
pattern BuildSystemEditBox :: ResourceId
pattern BuildSystemEditBox = ResourceId 15
pattern CabalProjectEditBox :: ResourceId
pattern CabalProjectEditBox = ResourceId 16
pattern CabalProjectLocalEditBox :: ResourceId
pattern CabalProjectLocalEditBox = ResourceId 17
pattern UpdateCabalCheckBox :: ResourceId
pattern UpdateCabalCheckBox = ResourceId 18
-- | Name data type. Uniquely identifies each widget in the TUI.
-- some constructors might end up unused, but still is a good practise
-- to have all of them defined, just in case
data Name = AllTools -- ^ The main list widget
| Singular Tool -- ^ The particular list for each tool
| KeyInfoBox -- ^ The text box widget with action informacion
| TutorialBox -- ^ The tutorial widget
| ContextBox -- ^ The resource for Context Menu
| CompileGHCBox -- ^ The resource for CompileGHC Menu
| AdvanceInstallBox -- ^ The resource for AdvanceInstall Menu
| MenuElement ResourceId -- ^ Each element in a Menu. Resources must not be share for visible
-- Menus, but MenuA and MenuB can share resources if they both are
-- invisible, or just one of them is visible.
deriving (Eq, Ord, Show)
-- | Mode type. It helps to dispatch events to different handlers.
data Mode = Navigation
| KeyInfo
| Tutorial
| ContextPanel
| AdvanceInstallPanel
| CompileGHCPanel
| CompileHLSPanel
deriving (Eq, Show, Ord)
installedSign :: String
#if IS_WINDOWS
installedSign = "I "
#else
installedSign = ""
#endif
setSign :: String
#if IS_WINDOWS
setSign = "IS"
#else
setSign = "✔✔"
#endif
notInstalledSign :: String
#if IS_WINDOWS
notInstalledSign = "X "
#else
notInstalledSign = ""
#endif
showKey :: Vty.Key -> String
showKey (Vty.KChar c) = [c]
showKey Vty.KUp = ""
showKey Vty.KDown = ""
showKey key = tail (show key)
showMod :: Vty.Modifier -> String
showMod = tail . show
-- | Given a KeyComb, produces a string widget with and user friendly text
keyToWidget :: KeyCombination -> Brick.Widget n
keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (showKey key : (showMod <$> mods))
-- | A section separator with max width. Looks like this: -------- o --------
separator :: Brick.Widget n
separator = Border.hBorder <+> Brick.str " o " <+> Border.hBorder
-- | Used to create a layer on top of the main navigation widget (tutorial, info, menus...)
frontwardLayer :: T.Text -> Brick.Widget n -> Brick.Widget n
frontwardLayer layer_name =
Brick.centerLayer
. Brick.hLimitPercent 75
. Brick.vLimitPercent 50
. Brick.withBorderStyle Border.unicode
. Border.borderWithLabel (Brick.txt layer_name)
-- I refuse to give this a type signature.
-- | Given a lens, zoom on it. It is needed because Brick uses microlens but GHCup uses optics.
zoom l = Brick.zoom (toLensVL l)
data BrickData = BrickData
{ _lr :: [ListResult]
}
deriving Show
makeLenses ''BrickData
data BrickSettings = BrickSettings { _showAllVersions :: Bool}
--deriving Show
makeLenses ''BrickSettings
defaultAppSettings :: BrickSettings
defaultAppSettings = BrickSettings False

View File

@ -0,0 +1,72 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-
A very simple information-only widget with no handler.
-}
module GHCup.Brick.Widgets.KeyInfo where
import GHCup.Types ( KeyBindings(..) )
import qualified GHCup.Brick.Common as Common
import Brick
( Padding(Max),
Widget(..),
(<+>),
(<=>))
import qualified Brick
import Brick.Widgets.Center ( center )
import Prelude hiding ( appendFile )
draw :: KeyBindings -> Widget Common.Name
draw KeyBindings {..} =
let
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
in Common.frontwardLayer "Key Actions"
$ Brick.vBox [
center $
mkTextBox [
Brick.hBox [
Brick.txt "Press "
, Common.keyToWidget bUp, Brick.txt " and ", Common.keyToWidget bDown
, Brick.txtWrap " to navigate the list of tools"
]
, Brick.hBox [
Brick.txt "Press "
, Common.keyToWidget bInstall
, Brick.txtWrap " to install the selected tool. Notice, you may need to set it as default afterwards"
]
, Brick.hBox [
Brick.txt "Press "
, Common.keyToWidget bSet
, Brick.txtWrap " to set a tool as the one for use"
]
, Brick.hBox [
Brick.txt "Press "
, Common.keyToWidget bUninstall
, Brick.txtWrap " to uninstall a tool"
]
, Brick.hBox [
Brick.txt "Press "
, Common.keyToWidget bChangelog
, Brick.txtWrap " to open the tool's changelog. It will open a web browser"
]
, Brick.hBox [
Brick.txt "Press "
, Common.keyToWidget bShowAllVersions
, Brick.txtWrap " to show older version of each tool"
]
]
]
<=> Brick.hBox [Brick.txt "Press c+ctrl to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]

View File

@ -0,0 +1,370 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE GADTs #-}
{- **************
A general system inspired by Brick.Form. It uses optics instead of microlenses and it is less generic than
Brick.Form, but generic enough to serve our purpose.
A Menu consists in
a) A state value
b) A list of fields. Each field is capable of modifying a part of the state
c) some metadata
A field (type MenuField) consists in
a) a Lens to a part of the Menu state, so the Menu can call that lens to modify its own state
b) an input widget
An input (type FieldInput) consist in
a) some state
b) a validator function
c) a handler and a renderer
We have to use existential types to achive a composable API since every FieldInput has a different
internal type, and every MenuField has a different Lens. For example:
- The menu state is a record (MyRecord {uri: URI, flag : Bool})
- Then, there are two MenuField:
- One MenuField has (Lens' MyRecord URI) and the other has (Lens' MyRecord Bool)
- The MenuFields has FieldInputs with internal state Text and Bool, respectively
- Obviously, the MenuField has to be polimorphic in the Lens' and in the Input internal state,
But we must hide that polimorphisim (existential), in order to store all MenuField in a List
************** -}
module GHCup.Brick.Widgets.Menu where
import qualified GHCup.Brick.Attributes as Attributes
import qualified GHCup.Brick.Common as Common
import Brick
( BrickEvent(..),
EventM,
Widget(..),
(<+>))
import qualified Brick
import qualified Brick.Widgets.Border as Border
import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.Edit as Edit
import Brick.Focus (FocusRing)
import qualified Brick.Focus as F
import Data.Function ( (&))
import Prelude hiding ( appendFile )
import qualified Data.Text as T
import Optics.TH (makeLensesFor)
import qualified Graphics.Vty as Vty
import Optics.State.Operators ((%=), (.=))
import Optics.Optic ((%))
import Optics.State (use)
import GHCup.Types (KeyCombination)
import Optics (Lens', to, lens)
import Optics.Operators ( (^.), (.~) )
import Data.Foldable (foldl')
-- | Just some type synonym to make things explicit
type Formatter n = Bool -> Widget n -> Widget n
-- | A label
type Label = T.Text
-- | A help message of an entry
type HelpMessage = T.Text
-- | A button name
type ButtonName n = n
idFormatter :: Formatter n
idFormatter = const id
-- | An error message
type ErrorMessage = T.Text
data ErrorStatus = Valid | Invalid ErrorMessage deriving (Eq)
-- | A lens which does nothing. Usefull to defined no-op fields
emptyLens :: Lens' s ()
emptyLens = lens (const ()) (\s _ -> s)
-- | A FieldInput is a pair label-content
-- a - is the type of the field it manipulates
-- b - is its internal state (modified in the gui)
-- n - your application's resource name type
data FieldInput a b n =
FieldInput
{ inputState :: b -- ^ The state of the input field (what's rendered in the screen)
, inputValidator :: b -> Either ErrorMessage a -- ^ A validator function
, inputHelp :: HelpMessage -- ^ The input helpMessage
, inputRender :: Bool
-> ErrorStatus
-> HelpMessage
-> b
-> (Widget n -> Widget n)
-> Widget n -- ^ How to draw the input, with focus a help message and input.
-- A extension function can be applied too
, inputHandler :: BrickEvent n () -> EventM n b () -- ^ The handler
}
makeLensesFor
[ ("inputState", "inputStateL")
, ("inputValidator", "inputValidatorL")
, ("inputName", "inputNameL")
, ("inputHelp", "inputHelpL")
]
''FieldInput
-- | The MenuField is an existential type which stores a Lens' to a part of the Menu state.
-- In also contains a Field input which internal state is hidden
data MenuField s n where
MenuField ::
{ fieldAccesor :: Lens' s a -- ^ A Lens pointing to some part of the state
, fieldInput :: FieldInput a b n -- ^ The input which modifies the state
, fieldLabel :: Label -- ^ The label
, fieldStatus :: ErrorStatus -- ^ Whether the current is valid or not.
, fieldName :: n
} -> MenuField s n
isValidField :: MenuField s n -> Bool
isValidField = (== Valid) . fieldStatus
makeLensesFor
[ ("fieldLabel", "fieldLabelL")
, ("fieldStatus", "fieldStatusL")
]
''MenuField
-- | A fancy lens to the help message
fieldHelpMsgL :: Lens' (MenuField s n) HelpMessage
fieldHelpMsgL = lens g s
where g (MenuField {..})= fieldInput ^. inputHelpL
s (MenuField{..}) msg = MenuField {fieldInput = fieldInput & inputHelpL .~ msg , ..}
-- | How to draw a field given a formater
drawField :: Formatter n -> Bool -> MenuField s n -> Widget n
drawField amp focus (MenuField { fieldInput = FieldInput {..}, ..}) =
let input = inputRender focus fieldStatus inputHelp inputState (amp focus)
in if focus
then Brick.visible input
else input
instance Brick.Named (MenuField s n) n where
getName :: MenuField s n -> n
getName entry = entry & fieldName
{- *****************
CheckBox widget
***************** -}
type CheckBoxField = MenuField
createCheckBoxInput :: FieldInput Bool Bool n
createCheckBoxInput = FieldInput False Right "" checkBoxRender checkBoxHandler
where
border = Border.border . Brick.padRight (Brick.Pad 1) . Brick.padLeft (Brick.Pad 2)
drawBool b =
if b
then border . Brick.withAttr Attributes.installedAttr $ Brick.str Common.installedSign
else border . Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign
checkBoxRender focus _ help check f =
let core = f $ drawBool check
in if focus
then core
else core <+> (Brick.padLeft (Brick.Pad 1) . centerV . renderAsHelpMsg $ help)
checkBoxHandler = \case
VtyEvent (Vty.EvKey Vty.KEnter []) -> Brick.modify not
_ -> pure ()
createCheckBoxField :: n -> Lens' s Bool -> CheckBoxField s n
createCheckBoxField name access = MenuField access createCheckBoxInput "" Valid name
{- *****************
Editable widget
***************** -}
type EditableField = MenuField
createEditableInput :: (Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (Edit.Editor T.Text n) n
createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit Edit.handleEditorEvent
where
drawEdit focus errMsg help edi amp =
let
borderBox = amp . Border.border . Brick.padRight Brick.Max
editorRender = Edit.renderEditor (Brick.txt . T.unlines) focus edi
isEditorEmpty = Edit.getEditContents edi == [mempty]
in case errMsg of
Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help
| otherwise -> borderBox editorRender
Invalid msg
| focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help
| focus -> borderBox editorRender
| otherwise -> borderBox $ renderAsErrMsg msg
validateEditContent = validator . T.init . T.unlines . Edit.getEditContents
initEdit = Edit.editorText name (Just 1) ""
createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n
createEditableField name validator access = MenuField access input "" Valid name
where
input = createEditableInput name validator
{- *****************
Button widget
***************** -}
type Button = MenuField
createButtonInput :: FieldInput () () n
createButtonInput = FieldInput () Right "" drawButton (const $ pure ())
where
drawButton True (Invalid err) _ _ amp = amp . centerV . renderAsErrMsg $ err
drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help
createButtonField :: n -> Button s n
createButtonField = MenuField emptyLens createButtonInput "" Valid
{- *****************
Utilities
***************** -}
-- | highlights a widget (using List.listSelectedFocusedAttr)
highlighted :: Widget n -> Widget n
highlighted = Brick.withAttr L.listSelectedFocusedAttr
-- | Given a text, crates a highlighted label on focus. An amplifier can be passed
renderAslabel :: T.Text -> Bool -> Widget n
renderAslabel t focus =
if focus
then highlighted $ Brick.txt t
else Brick.txt t
-- | Creates a left align column.
-- Example: |- col2 is align dispite the length of col1
-- row1_col1 row1_col2
-- row2_col1_large row2_col2
leftify :: Int -> Brick.Widget n -> Brick.Widget n
leftify i = Brick.hLimit i . Brick.padRight Brick.Max
-- | center a line in three rows.
centerV :: Widget n -> Widget n
centerV = Brick.padTopBottom 1
-- | render some Text using helpMsgAttr
renderAsHelpMsg :: T.Text -> Widget n
renderAsHelpMsg = Brick.withAttr Attributes.helpMsgAttr . Brick.txt
-- | render some Text using errMsgAttr
renderAsErrMsg :: T.Text -> Widget n
renderAsErrMsg = Brick.withAttr Attributes.errMsgAttr . Brick.txt
{- *****************
Menu widget
***************** -}
-- | A menu is a list of Fields and a state. Informally we can think about s in terms of the record type returned by
-- a form.
data Menu s n
= Menu
{ menuFields :: [MenuField s n] -- ^ The datatype representing the list of entries. Precisely, any array-like data type is highly unconvinient.
, menuState :: s
, menuButtons :: [Button s n] -- ^ The buttons. Commonly, the handlers for buttons are defined outside the menu handler.
, menuFocusRing :: FocusRing n -- ^ The focus ring with the resource name for each entry and each button, in the order you want to loop them.
, menuExitKey :: KeyCombination -- ^ The key to exit the Menu
, menuName :: n -- ^ The resource Name.
}
makeLensesFor
[ ("menuFields", "menuFieldsL"), ("menuState", "menuStateL")
, ("menuButtons", "menuButtonsL"), ("menuFocusRing", "menuFocusRingL")
, ("menuExitKey", "menuExitKeyL"), ("menuName", "menuNameL")
]
''Menu
isValidMenu :: Menu s n -> Bool
isValidMenu = all isValidField . menuFields
createMenu :: n -> s -> KeyCombination -> [Button s n] -> [MenuField s n] -> Menu s n
createMenu n initial exitK buttons fields = Menu fields initial buttons ring exitK n
where ring = F.focusRing $ [field & fieldName | field <- fields] ++ [button & fieldName | button <- buttons]
handlerMenu :: forall n e s. Eq n => BrickEvent n e -> EventM n (Menu s n) ()
handlerMenu ev =
case ev of
VtyEvent (Vty.EvKey (Vty.KChar '\t') []) -> menuFocusRingL %= F.focusNext
VtyEvent (Vty.EvKey Vty.KBackTab []) -> menuFocusRingL %= F.focusPrev
VtyEvent (Vty.EvKey Vty.KDown []) -> menuFocusRingL %= F.focusNext
VtyEvent (Vty.EvKey Vty.KUp []) -> menuFocusRingL %= F.focusPrev
VtyEvent e -> do
focused <- use $ menuFocusRingL % to F.focusGetCurrent
fields <- use menuFieldsL
case focused of
Nothing -> pure ()
Just n -> do
updated_fields <- updateFields n (VtyEvent e) fields
if all isValidField updated_fields
then menuButtonsL %= fmap (fieldStatusL .~ Valid)
else menuButtonsL %= fmap (fieldStatusL .~ Invalid "Some fields are invalid")
menuFieldsL .= updated_fields
_ -> pure ()
where
-- runs the Event with the inner handler of MenuField.
updateFields :: n -> BrickEvent n () -> [MenuField s n] -> EventM n (Menu s n) [MenuField s n]
updateFields n e [] = pure []
updateFields n e (x@(MenuField {fieldInput = i@(FieldInput {..}) , ..}):xs) =
if Brick.getName x == n
then do
newb <- Brick.nestEventM' inputState (inputHandler e)
let newField = MenuField {fieldInput = (FieldInput {inputState=newb, ..}) , ..}
case inputValidator newb of
Left errmsg -> pure $ (newField & fieldStatusL .~ Invalid errmsg):xs
Right a -> menuStateL % fieldAccesor .= a >> pure ((newField & fieldStatusL .~ Valid):xs)
else fmap (x:) (updateFields n e xs)
drawMenu :: (Eq n, Ord n, Show n, Brick.Named (MenuField s n) n) => Menu s n -> Widget n
drawMenu menu =
Brick.vBox
[ Brick.vBox buttonWidgets
, Common.separator
, Brick.withVScrollBars Brick.OnRight
$ Brick.viewport (menu ^. menuNameL) Brick.Vertical
$ Brick.vBox fieldWidgets
, Brick.txt " "
, Brick.padRight Brick.Max $
Brick.txt "Press "
<+> Common.keyToWidget (menu ^. menuExitKeyL)
<+> Brick.txt " to go back"
]
where
fieldLabels = [field & fieldLabel | field <- menu ^. menuFieldsL]
buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL]
allLabels = fieldLabels ++ buttonLabels
maxWidth = foldl' max 5 (fmap Brick.textWidth allLabels)
-- A list of functions which draw a highlighted label with right padding at the left of a widget.
amplifiers =
let labelsWidgets = fmap renderAslabel fieldLabels
in fmap (\f b -> ((centerV . leftify (maxWidth + 10) $ f b) <+>) ) labelsWidgets
drawFields = fmap drawField amplifiers
fieldWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawFields (menu ^. menuFieldsL)
buttonAmplifiers =
let buttonAsWidgets = fmap renderAslabel buttonLabels
in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
drawButtons = fmap drawField buttonAmplifiers
buttonWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawButtons (menu ^. menuButtonsL)

View File

@ -0,0 +1,125 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module GHCup.Brick.Widgets.Menus.AdvanceInstall (
InstallOptions (..),
AdvanceInstallMenu,
create,
handler,
draw,
instBindistL,
instSetL,
isolateDirL,
forceInstallL,
addConfArgsL,
) where
import GHCup.Brick.Widgets.Menu (Menu)
import qualified GHCup.Brick.Widgets.Menu as Menu
import GHCup.Brick.Common(Name(..))
import Brick
( BrickEvent(..),
EventM,
Widget(..))
import Prelude hiding ( appendFile )
import Optics.TH (makeLensesFor)
import qualified GHCup.Brick.Common as Common
import GHCup.Types (KeyCombination)
import URI.ByteString (URI)
import qualified Data.Text as T
import qualified Data.ByteString.UTF8 as UTF8
import GHCup.Utils (parseURI)
import Data.Bifunctor (Bifunctor(..))
import Data.Function ((&))
import Optics ((.~))
import Data.Char (isSpace)
import System.FilePath (isValid, isAbsolute, normalise)
import GHCup.Prelude (stripNewlineEnd)
data InstallOptions = InstallOptions
{ instBindist :: Maybe URI
, instSet :: Bool
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
, addConfArgs :: [T.Text]
} deriving (Eq, Show)
makeLensesFor [
("instBindist", "instBindistL")
, ("instSet", "instSetL")
, ("isolateDir", "isolateDirL")
, ("forceInstall", "forceInstallL")
, ("addConfArgs", "addConfArgsL")
]
''InstallOptions
type AdvanceInstallMenu = Menu InstallOptions Name
create :: KeyCombination -> AdvanceInstallMenu
create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields
where
initialState = InstallOptions Nothing False Nothing False []
-- Brick's internal editor representation is [mempty].
emptyEditor i = T.null i || (i == "\n")
uriValidator :: T.Text -> Either Menu.ErrorMessage (Maybe URI)
uriValidator i =
case not $ emptyEditor i of
True -> bimap (T.pack . show) Just . parseURI . UTF8.fromString . T.unpack $ i
False -> Right Nothing
filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
filepathValidator i =
case not $ emptyEditor i of
True -> absolutePathParser (T.unpack i)
False -> Right Nothing
absolutePathParser :: FilePath -> Either Menu.ErrorMessage (Maybe FilePath)
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right . Just . stripNewlineEnd . normalise $ f
False -> Left "Please enter a valid absolute filepath."
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
additionalValidator = Right . T.split isSpace
fields =
[ Menu.createEditableField (Common.MenuElement Common.UrlEditBox) uriValidator instBindistL
& Menu.fieldLabelL .~ "url"
& Menu.fieldHelpMsgL .~ "Install the specified version from this bindist"
, Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) instSetL
& Menu.fieldLabelL .~ "set"
& Menu.fieldHelpMsgL .~ "Set as active version after install"
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathValidator isolateDirL
& Menu.fieldLabelL .~ "isolated"
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
, Menu.createCheckBoxField (Common.MenuElement Common.ForceCheckBox) forceInstallL
& Menu.fieldLabelL .~ "force"
& Menu.fieldHelpMsgL .~ "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)"
, Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgsL
& Menu.fieldLabelL .~ "CONFIGURE_ARGS"
& Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
]
ok = Menu.createButtonField (Common.MenuElement Common.OkButton)
& Menu.fieldLabelL .~ "Advance Install"
& Menu.fieldHelpMsgL .~ "Install with options below"
handler :: BrickEvent Name e -> EventM Name AdvanceInstallMenu ()
handler = Menu.handlerMenu
draw :: AdvanceInstallMenu -> Widget Name
draw = Common.frontwardLayer "Advance Install" . Menu.drawMenu

View File

@ -0,0 +1,207 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module GHCup.Brick.Widgets.Menus.CompileGHC (
CompileGHCOptions,
CompileGHCMenu,
create,
handler,
draw,
bootstrapGhc,
jobs,
buildConfig,
patches,
crossTarget,
addConfArgs,
setCompile,
overwriteVer,
buildFlavour,
buildSystem,
isolateDir,
) where
import GHCup.Brick.Widgets.Menu (Menu)
import qualified GHCup.Brick.Widgets.Menu as Menu
import GHCup.Brick.Common(Name(..))
import Brick
( BrickEvent(..),
EventM,
Widget(..))
import Prelude hiding ( appendFile )
import Optics.TH (makeLenses)
import qualified GHCup.Brick.Common as Common
import GHCup.Types
( KeyCombination, BuildSystem(..), VersionPattern )
import URI.ByteString (URI)
import qualified Data.Text as T
import qualified Data.ByteString.UTF8 as UTF8
import GHCup.Utils (parseURI)
import Data.Bifunctor (Bifunctor(..))
import Data.Function ((&))
import Optics ((.~))
import Data.Char (isSpace)
import Data.Versions (Version, version)
import System.FilePath (isPathSeparator, isValid, isAbsolute, normalise)
import Control.Applicative (Alternative((<|>)))
import Text.Read (readEither)
import GHCup.Prelude (stripNewlineEnd)
import qualified GHCup.OptParse.Common as OptParse
data CompileGHCOptions = CompileGHCOptions
{ _bootstrapGhc :: Either Version FilePath
, _jobs :: Maybe Int
, _buildConfig :: Maybe FilePath
, _patches :: Maybe (Either FilePath [URI])
, _crossTarget :: Maybe T.Text
, _addConfArgs :: [T.Text]
, _setCompile :: Bool
, _overwriteVer :: Maybe [VersionPattern]
, _buildFlavour :: Maybe String
, _buildSystem :: Maybe BuildSystem
, _isolateDir :: Maybe FilePath
} deriving (Eq, Show)
makeLenses ''CompileGHCOptions
type CompileGHCMenu = Menu CompileGHCOptions Name
create :: KeyCombination -> CompileGHCMenu
create k = Menu.createMenu CompileGHCBox initialState k buttons fields
where
initialState =
CompileGHCOptions
(Right "")
Nothing
Nothing
Nothing
Nothing
[]
False
Nothing
Nothing
Nothing
Nothing
-- Brick's internal editor representation is [mempty].
emptyEditor i = T.null i || (i == "\n")
whenEmpty :: a -> (T.Text -> Either Menu.ErrorMessage a) -> T.Text -> Either Menu.ErrorMessage a
whenEmpty emptyval f i = if not (emptyEditor i) then f i else Right emptyval
bootstrapV :: T.Text -> Either Menu.ErrorMessage (Either Version FilePath)
bootstrapV i =
case not $ emptyEditor i of
True ->
let readVersion = bimap (const "Not a valid version") Left (version i)
readPath = do
mfilepath <- filepathV i
case mfilepath of
Nothing -> Left "Invalid Empty value"
Just f -> Right (Right f)
in if T.any isPathSeparator i
then readPath
else readVersion
False -> Left "Invalid Empty value"
versionV :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern])
versionV = whenEmpty Nothing (bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack)
jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
jobsV =
let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack
in whenEmpty Nothing parseInt
patchesV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath [URI]))
patchesV = whenEmpty Nothing readPatches
where
readUri :: T.Text -> Either String URI
readUri = first show . parseURI . UTF8.fromString . T.unpack
readPatches j =
let
x = (bimap T.unpack (fmap Left) $ filepathV j)
y = second (Just . Right) $ traverse readUri (T.split isSpace j)
in first T.pack $ x <|> y
filepathV :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
filepathV i =
case not $ emptyEditor i of
True -> absolutePathParser (T.unpack i)
False -> Right Nothing
absolutePathParser :: FilePath -> Either Menu.ErrorMessage (Maybe FilePath)
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right . Just . stripNewlineEnd . normalise $ f
False -> Left "Please enter a valid absolute filepath."
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
additionalValidator = Right . T.split isSpace
systemV :: T.Text -> Either Menu.ErrorMessage (Maybe BuildSystem)
systemV = whenEmpty Nothing readSys
where
readSys i
| T.toLower i == "hadrian" = Right $ Just Hadrian
| T.toLower i == "make" = Right $ Just Make
| otherwise = Left "Not a valid Build System"
fields =
[ Menu.createEditableField (Common.MenuElement Common.BootstrapGhcEditBox) bootstrapV bootstrapGhc
& Menu.fieldLabelL .~ "bootstrap-ghc"
& Menu.fieldHelpMsgL .~ "The GHC version (or full path) to bootstrap with (must be installed)"
& Menu.fieldStatusL .~ Menu.Invalid "Invalid Empty value"
, Menu.createEditableField (Common.MenuElement Common.JobsEditBox) jobsV jobs
& Menu.fieldLabelL .~ "jobs"
& Menu.fieldHelpMsgL .~ "How many jobs to use for make"
, Menu.createEditableField (Common.MenuElement Common.BuildConfigEditBox) filepathV buildConfig
& Menu.fieldLabelL .~ "build config"
& Menu.fieldHelpMsgL .~ "Absolute path to build config file"
, Menu.createEditableField (Common.MenuElement Common.PatchesEditBox) patchesV patches
& Menu.fieldLabelL .~ "patches"
& Menu.fieldHelpMsgL .~ "Either a URI to a patch (https/http/file) or Absolute path to patch directory"
, Menu.createEditableField (Common.MenuElement Common.CrossTargetEditBox) (Right . Just) crossTarget
& Menu.fieldLabelL .~ "cross target"
& Menu.fieldHelpMsgL .~ "Build cross-compiler for this platform"
, Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgs
& Menu.fieldLabelL .~ "CONFIGURE_ARGS"
& Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
, Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) setCompile
& Menu.fieldLabelL .~ "set"
& Menu.fieldHelpMsgL .~ "Set as active version after install"
, Menu.createEditableField (Common.MenuElement Common.OvewrwiteVerEditBox) versionV overwriteVer
& Menu.fieldLabelL .~ "overwrite-version"
& Menu.fieldHelpMsgL .~ "Allows to overwrite the finally installed VERSION with a different one"
, Menu.createEditableField (Common.MenuElement Common.BuildSystemEditBox) systemV buildSystem
& Menu.fieldLabelL .~ "build system"
& Menu.fieldHelpMsgL .~ "either 'make' or 'hadrian'"
, Menu.createEditableField (Common.MenuElement Common.BuildFlavourEditBox) (Right . Just . T.unpack) buildFlavour
& Menu.fieldLabelL .~ "flavour"
& Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathV isolateDir
& Menu.fieldLabelL .~ "isolated"
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
]
buttons = [
Menu.createButtonField (Common.MenuElement Common.OkButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile GHC from source with options below"
& Menu.fieldStatusL .~ Menu.Invalid "bootstrap GHC is mandatory"
]
handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()
handler = Menu.handlerMenu
draw :: CompileGHCMenu -> Widget Name
draw = Common.frontwardLayer "Compile GHC" . Menu.drawMenu

View File

@ -0,0 +1,191 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module GHCup.Brick.Widgets.Menus.CompileHLS (
CompileHLSOptions,
CompileHLSMenu,
create,
handler,
draw,
jobs,
setCompile,
updateCabal,
overwriteVer,
isolateDir,
cabalProject,
cabalProjectLocal,
patches,
targetGHCs,
cabalArgs,
)
where
import GHCup.Brick.Widgets.Menu (Menu)
import qualified GHCup.Brick.Widgets.Menu as Menu
import GHCup.Brick.Common(Name(..))
import Brick
( BrickEvent(..),
EventM,
Widget(..))
import Prelude hiding ( appendFile )
import Optics.TH (makeLenses)
import qualified GHCup.Brick.Common as Common
import GHCup.Types (KeyCombination, VersionPattern, ToolVersion)
import URI.ByteString (URI)
import qualified Data.Text as T
import qualified Data.ByteString.UTF8 as UTF8
import GHCup.Utils (parseURI)
import Data.Bifunctor (Bifunctor(..))
import Data.Function ((&))
import Optics ((.~))
import Data.Char (isSpace)
import System.FilePath (isValid, isAbsolute, normalise)
import Control.Applicative (Alternative((<|>)))
import Text.Read (readEither)
import GHCup.Prelude (stripNewlineEnd)
import qualified GHCup.OptParse.Common as OptParse
data CompileHLSOptions = CompileHLSOptions
{ _jobs :: Maybe Int
, _setCompile :: Bool
, _updateCabal :: Bool
, _overwriteVer :: Maybe [VersionPattern]
, _isolateDir :: Maybe FilePath
, _cabalProject :: Maybe (Either FilePath URI)
, _cabalProjectLocal :: Maybe URI
, _patches :: Maybe (Either FilePath [URI])
, _targetGHCs :: [ToolVersion]
, _cabalArgs :: [T.Text]
} deriving (Eq, Show)
makeLenses ''CompileHLSOptions
type CompileHLSMenu = Menu CompileHLSOptions Name
create :: KeyCombination -> CompileHLSMenu
create k = Menu.createMenu CompileGHCBox initialState k buttons fields
where
initialState =
CompileHLSOptions
Nothing
False
False
Nothing
Nothing
Nothing
Nothing
Nothing
[]
[]
-- Brick's internal editor representation is [mempty].
emptyEditor i = T.null i || (i == "\n")
whenEmpty :: a -> (T.Text -> Either Menu.ErrorMessage a) -> T.Text -> Either Menu.ErrorMessage a
whenEmpty emptyval f i = if not (emptyEditor i) then f i else Right emptyval
cabalProjectV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath URI))
cabalProjectV i =
case not $ emptyEditor i of
True ->
let readPath = Right . Left . stripNewlineEnd . T.unpack $ i
in bimap T.pack Just $ second Right (readUri i) <|> readPath
False -> Right Nothing
{- There is an unwanted dependency to ghcup-opt... Alternatives are
- copy-paste a bunch of code
- define a new common library
-}
ghcVersionTagEither :: T.Text -> Either Menu.ErrorMessage [ToolVersion]
ghcVersionTagEither = first T.pack . traverse (OptParse.ghcVersionTagEither . T.unpack) . T.split isSpace
overWriteVersionParser :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern])
overWriteVersionParser = bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack
jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
jobsV =
let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack
in whenEmpty Nothing parseInt
readUri :: T.Text -> Either String URI
readUri = first show . parseURI . UTF8.fromString . T.unpack
patchesV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath [URI]))
patchesV = whenEmpty Nothing readPatches
where
readPatches j =
let
x = (bimap T.unpack (fmap Left) $ filepathV j)
y = second (Just . Right) $ traverse readUri (T.split isSpace j)
in first T.pack $ x <|> y
filepathV :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
filepathV i =
case not $ emptyEditor i of
True -> absolutePathParser (T.unpack i)
False -> Right Nothing
absolutePathParser :: FilePath -> Either Menu.ErrorMessage (Maybe FilePath)
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right . Just . stripNewlineEnd . normalise $ f
False -> Left "Please enter a valid absolute filepath."
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
additionalValidator = Right . T.split isSpace
fields =
[ Menu.createEditableField (Common.MenuElement Common.CabalProjectEditBox) cabalProjectV cabalProject
& Menu.fieldLabelL .~ "cabal project"
& Menu.fieldHelpMsgL .~ "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
, Menu.createEditableField (Common.MenuElement Common.CabalProjectLocalEditBox) (bimap T.pack Just . readUri) cabalProjectLocal
& Menu.fieldLabelL .~ "cabal project local"
& Menu.fieldHelpMsgL .~ "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
, Menu.createCheckBoxField (Common.MenuElement Common.UpdateCabalCheckBox) updateCabal
& Menu.fieldLabelL .~ "cabal update"
& Menu.fieldHelpMsgL .~ "Run 'cabal update' before the build"
, Menu.createEditableField (Common.MenuElement Common.JobsEditBox) jobsV jobs
& Menu.fieldLabelL .~ "jobs"
& Menu.fieldHelpMsgL .~ "How many jobs to use for make"
, Menu.createEditableField (Common.MenuElement Common.TargetGhcEditBox) ghcVersionTagEither targetGHCs
& Menu.fieldLabelL .~ "target GHC"
& Menu.fieldHelpMsgL .~ "For which GHC version to compile for (can be specified multiple times)"
, Menu.createEditableField (Common.MenuElement Common.PatchesEditBox) patchesV patches
& Menu.fieldLabelL .~ "patches"
& Menu.fieldHelpMsgL .~ "Either a URI to a patch (https/http/file) or Absolute path to patch directory"
, Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) setCompile
& Menu.fieldLabelL .~ "set"
& Menu.fieldHelpMsgL .~ "Set as active version after install"
, Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator cabalArgs
& Menu.fieldLabelL .~ "CONFIGURE_ARGS"
& Menu.fieldHelpMsgL .~ "Additional arguments to cabal install, prefix with '-- ' (longopts)"
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathV isolateDir
& Menu.fieldLabelL .~ "isolated"
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
, Menu.createEditableField (Common.MenuElement Common.OvewrwiteVerEditBox) overWriteVersionParser overwriteVer
& Menu.fieldLabelL .~ "overwrite version"
& Menu.fieldHelpMsgL .~ "Allows to overwrite the finally installed VERSION with a different one"
]
buttons = [
Menu.createButtonField (Common.MenuElement Common.OkButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile HLS from source with options below"
]
handler :: BrickEvent Name e -> EventM Name CompileHLSMenu ()
handler = Menu.handlerMenu
draw :: CompileHLSMenu -> Widget Name
draw = Common.frontwardLayer "Compile HLS" . Menu.drawMenu

View File

@ -0,0 +1,82 @@
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Brick.Widgets.Menus.Context (ContextMenu, create, draw, handler) where
import Brick (
Widget (..), BrickEvent, EventM,
)
import Data.Function ((&))
import Prelude hiding (appendFile)
import Data.Versions (prettyVer)
import GHCup.List ( ListResult(..) )
import GHCup.Types (KeyCombination, Tool (..))
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Widgets.Menu as Menu
import GHCup.Brick.Common (Name (..))
import GHCup.Brick.Widgets.Menu (Menu)
import qualified Brick.Widgets.Core as Brick
import qualified Brick.Widgets.Border as Border
import qualified Brick.Focus as F
import Brick.Widgets.Core ((<+>))
import Optics (to)
import Optics.Operators ((.~), (^.))
import Optics.Optic ((%))
import Data.Foldable (foldl')
type ContextMenu = Menu ListResult Name
create :: ListResult -> KeyCombination -> ContextMenu
create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
where
advInstallButton =
Menu.createButtonField (MenuElement Common.AdvanceInstallButton)
& Menu.fieldLabelL .~ "Install"
& Menu.fieldHelpMsgL .~ "Advance Installation Settings"
compileGhcButton =
Menu.createButtonField (MenuElement Common.CompileGHCButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile GHC from source"
compileHLSButton =
Menu.createButtonField (MenuElement Common.CompileHLSButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile HLS from source"
buttons =
case lTool lr of
GHC -> [advInstallButton, compileGhcButton]
HLS -> [advInstallButton, compileHLSButton]
_ -> [advInstallButton]
draw :: ContextMenu -> Widget Name
draw menu =
Common.frontwardLayer
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
$ Brick.vBox
[ Brick.vBox buttonWidgets
, Brick.txt " "
, Brick.padRight Brick.Max $
Brick.txt "Press "
<+> Common.keyToWidget (menu ^. Menu.menuExitKeyL)
<+> Brick.txt " to go back"
]
where
buttonLabels = [button & Menu.fieldLabel | button <- menu ^. Menu.menuButtonsL]
maxWidth = foldl' max 5 (fmap Brick.textWidth buttonLabels)
buttonAmplifiers =
let buttonAsWidgets = fmap Menu.renderAslabel buttonLabels
in fmap (\f b -> ((Menu.leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
drawButtons = fmap Menu.drawField buttonAmplifiers
buttonWidgets = zipWith (F.withFocusRing (menu ^. Menu.menuFocusRingL)) drawButtons (menu ^. Menu.menuButtonsL)
tool_str =
case menu ^. Menu.menuStateL % to lTool of
GHC -> "GHC"
GHCup -> "GHCup"
Cabal -> "Cabal"
HLS -> "HLS"
Stack -> "Stack"
handler :: BrickEvent Name e -> EventM Name ContextMenu ()
handler = Menu.handlerMenu

View File

@ -0,0 +1,151 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{- Brick's navigation widget:
It is a FocusRing over many list's. Each list contains the information for each tool. Each list has an internal name (for Brick's runtime)
and a label which we can use in rendering. This data-structure helps to reuse Brick.Widget.List and to navegate easily across
-}
module GHCup.Brick.Widgets.Navigation (BrickInternalState, create, handler, draw) where
import GHCup.List ( ListResult(..) )
import GHCup.Types
( GHCTargetVersion(GHCTargetVersion),
Tool(..),
Tag(..),
tVerToText,
tagToString )
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Attributes as Attributes
import qualified GHCup.Brick.Widgets.SectionList as SectionList
import Brick
( BrickEvent(..),
Padding(Max, Pad),
AttrMap,
EventM,
Widget(..),
(<+>),
(<=>))
import qualified Brick
import Brick.Widgets.Core ( putCursor )
import Brick.Types ( Location(..) )
import Brick.Widgets.Border ( hBorder, borderWithLabel)
import Brick.Widgets.Border.Style ( unicode )
import Brick.Widgets.Center ( center )
import qualified Brick.Widgets.List as L
import Data.List ( intercalate, sort )
import Data.Maybe ( mapMaybe )
import Data.Vector ( Vector)
import Data.Versions ( prettyPVP, prettyVer )
import Prelude hiding ( appendFile )
import qualified Data.Text as T
import qualified Data.Vector as V
type BrickInternalState = SectionList.SectionList Common.Name ListResult
-- | How to create a navigation widget
create :: Common.Name -- The name of the section list
-> [(Common.Name, Vector ListResult)] -- a list of tuples (section name, collection of elements)
-> Int -- The height of each item in a list. Commonly 1
-> BrickInternalState
create = SectionList.sectionList
-- | How the navigation handler handle events
handler :: BrickEvent Common.Name e -> EventM Common.Name BrickInternalState ()
handler = SectionList.handleGenericListEvent
-- | How to draw the navigation widget
draw :: AttrMap -> BrickInternalState -> Widget Common.Name
draw dimAttrs section_list
= Brick.padBottom Max
( Brick.withBorderStyle unicode
$ borderWithLabel (Brick.str "GHCup")
(center (header <=> hBorder <=> renderList' section_list))
)
where
header =
minHSize 2 Brick.emptyWidget
<+> Brick.padLeft (Pad 2) (minHSize 6 $ Brick.str "Tool")
<+> minHSize 15 (Brick.str "Version")
<+> Brick.padLeft (Pad 1) (minHSize 25 $ Brick.str "Tags")
<+> Brick.padLeft (Pad 5) (Brick.str "Notes")
renderList' bis =
let allElements = V.concatMap L.listElements $ SectionList.sectionListElements bis
minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) allElements
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) allElements
in Brick.withDefAttr L.listAttr $ SectionList.renderSectionList (renderItem minTagSize minVerSize) True bis
renderItem minTagSize minVerSize b listResult@ListResult{lTag = lTag', ..} =
let marks = if
| lSet -> (Brick.withAttr Attributes.setAttr $ Brick.str Common.setSign)
| lInstalled -> (Brick.withAttr Attributes.installedAttr $ Brick.str Common.installedSign)
| otherwise -> (Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign)
ver = case lCross of
Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
dim
| lNoBindist && not lInstalled
&& not b -- TODO: overloading dim and active ignores active
-- so we hack around it here
= Brick.updateAttrMap (const dimAttrs) . Brick.withAttr (Brick.attrName "no-bindist")
| otherwise = id
hooray
| elem Latest lTag' && not lInstalled =
Brick.withAttr Attributes.hoorayAttr
| otherwise = id
active = if b then putCursor Common.AllTools (Location (0,0)) else id
in hooray $ active $ dim
( marks
<+> Brick.padLeft (Pad 2)
( minHSize 6
(printTool lTool)
)
<+> minHSize minVerSize (Brick.str ver)
<+> (let l = mapMaybe printTag $ sort lTag'
in Brick.padLeft (Pad 1) $ minHSize minTagSize $ if null l
then Brick.emptyWidget
else foldr1 (\x y -> x <+> Brick.str "," <+> y) l
)
<+> Brick.padLeft (Pad 5)
( let notes = printNotes listResult
in if null notes
then Brick.emptyWidget
else foldr1 (\x y -> x <+> Brick.str "," <+> y) notes
)
<+> Brick.vLimit 1 (Brick.fill ' ')
)
printTag Recommended = Just $ Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
printTag Latest = Just $ Brick.withAttr Attributes.latestAttr $ Brick.str "latest"
printTag Prerelease = Just $ Brick.withAttr Attributes.prereleaseAttr $ Brick.str "prerelease"
printTag Nightly = Just $ Brick.withAttr Attributes.nightlyAttr $ Brick.str "nightly"
printTag (Base pvp'') = Just $ Brick.str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing
printTag LatestPrerelease = Just $ Brick.withAttr Attributes.latestPrereleaseAttr $ Brick.str "latest-prerelease"
printTag LatestNightly = Just $ Brick.withAttr Attributes.latestNightlyAttr $ Brick.str "latest-nightly"
printTag (UnknownTag t) = Just $ Brick.str t
printTool Cabal = Brick.str "cabal"
printTool GHC = Brick.str "GHC"
printTool GHCup = Brick.str "GHCup"
printTool HLS = Brick.str "HLS"
printTool Stack = Brick.str "Stack"
printNotes ListResult {..} =
(if hlsPowered then [Brick.withAttr Attributes.hlsPoweredAttr $ Brick.str "hls-powered"] else mempty
)
++ (if lStray then [Brick.withAttr Attributes.strayAttr $ Brick.str "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [Brick.withAttr Attributes.dayAttr $ Brick.str (show d)])
minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ')

View File

@ -0,0 +1,193 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{- A general system for lists with sections
Consider this code as private. GenericSectionList should not be used directly as the FocusRing should be align with the Vector containing
the elements, otherwise you'd be focusing on a non-existent widget with unknown result (In theory the code is safe unless you have an empty section list).
- To build a SectionList use the safe constructor sectionList
- To access sections use the lens provider sectionL and the name of the section you'd like to access
- You can modify Brick.Widget.List.GenericList within GenericSectionList via sectionL but do not
modify the vector length
-}
module GHCup.Brick.Widgets.SectionList where
import Brick
( BrickEvent(VtyEvent, MouseDown),
EventM,
Size(..),
Widget(..),
ViewportType (Vertical),
(<=>))
import qualified Brick
import Brick.Widgets.Border ( hBorder)
import qualified Brick.Widgets.List as L
import Brick.Focus (FocusRing)
import qualified Brick.Focus as F
import Data.Function ( (&))
import Data.Maybe ( fromMaybe )
import Data.Vector ( Vector )
import qualified GHCup.Brick.Common as Common
import Prelude hiding ( appendFile )
import qualified Graphics.Vty as Vty
import qualified Data.Vector as V
import Optics.TH (makeLensesFor)
import Optics.State (use)
import Optics.State.Operators ( (%=), (<%=))
import Optics.Operators ((.~), (^.))
import Optics.Lens (Lens', lens)
data GenericSectionList n t e
= GenericSectionList
{ sectionListFocusRing :: FocusRing n -- ^ The FocusRing for all sections
, sectionListElements :: !(Vector (L.GenericList n t e)) -- ^ A vector of brick's built-in list
, sectionListName :: n -- ^ The section list name
}
makeLensesFor [("sectionListFocusRing", "sectionListFocusRingL"), ("sectionListElements", "sectionListElementsL"), ("sectionListName", "sectionListNameL")] ''GenericSectionList
type SectionList n e = GenericSectionList n V.Vector e
-- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses.
sectionList :: Foldable t
=> n -- The name of the section list
-> [(n, t e)] -- a list of tuples (section name, collection of elements)
-> Int
-> GenericSectionList n t e
sectionList name elements height
= GenericSectionList
{ sectionListFocusRing = F.focusRing [section_name | (section_name, _) <- elements]
, sectionListElements = V.fromList [L.list section_name els height | (section_name, els) <- elements]
, sectionListName = name
}
-- | This lens constructor, takes a name and looks if a section has such a name.
-- Used to dispatch events to sections. It is a partial function only meant to
-- be used with the FocusRing inside GenericSectionList
sectionL :: Eq n => n -> Lens' (GenericSectionList n t e) (L.GenericList n t e)
sectionL section_name = lens g s
where is_section_name = (== section_name) . L.listName
g section_list =
let elms = section_list ^. sectionListElementsL
zeroth = elms V.! 0 -- TODO: This crashes for empty vectors.
in fromMaybe zeroth (V.find is_section_name elms)
s gl@(GenericSectionList _ elms _) list =
case V.findIndex is_section_name elms of
Nothing -> gl
Just i -> let new_elms = V.update elms (V.fromList [(i, list)])
in gl & sectionListElementsL .~ new_elms
moveDown :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) ()
moveDown = do
ring <- use sectionListFocusRingL
case F.focusGetCurrent ring of
Nothing -> pure ()
Just l -> do -- If it is the last element, move to the first element of the next focus; else, just handle regular list event.
current_list <- use (sectionL l)
let current_idx = L.listSelected current_list
list_length = current_list & length
if current_idx == Just (list_length - 1)
then do
new_focus <- sectionListFocusRingL <%= F.focusNext
case F.focusGetCurrent new_focus of
Nothing -> pure () -- |- Optic.Zoom.zoom doesn't typecheck but Lens.Micro.Mtl.zoom does. It is re-exported by Brick
Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToBeginning)
else Common.zoom (sectionL l) $ Brick.modify L.listMoveDown
moveUp :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) ()
moveUp = do
ring <- use sectionListFocusRingL
case F.focusGetCurrent ring of
Nothing -> pure ()
Just l -> do -- If it is the first element, move to the last element of the prev focus; else, just handle regular list event.
current_list <- use (sectionL l)
let current_idx = L.listSelected current_list
if current_idx == Just 0
then do
new_focus <- sectionListFocusRingL <%= F.focusPrev
case F.focusGetCurrent new_focus of
Nothing -> pure ()
Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToEnd)
else Common.zoom (sectionL l) $ Brick.modify L.listMoveUp
-- | Handle events for list cursor movement. Events handled are:
--
-- * Up (up arrow key). If first element of section, then jump prev section
-- * Down (down arrow key). If last element of section, then jump next section
-- * Page Up (PgUp)
-- * Page Down (PgDown)
-- * Go to next section (Tab)
-- * Go to prev section (BackTab)
handleGenericListEvent :: (Foldable t, L.Splittable t, Ord n)
=> BrickEvent n a
-> EventM n (GenericSectionList n t e) ()
handleGenericListEvent (VtyEvent (Vty.EvResize _ _)) = pure ()
handleGenericListEvent (VtyEvent (Vty.EvKey (Vty.KChar '\t') [])) = sectionListFocusRingL %= F.focusNext
handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KBackTab [])) = sectionListFocusRingL %= F.focusPrev
handleGenericListEvent (MouseDown _ Vty.BScrollDown _ _) = moveDown
handleGenericListEvent (MouseDown _ Vty.BScrollUp _ _) = moveUp
handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KDown [])) = moveDown
handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KUp [])) = moveUp
handleGenericListEvent (VtyEvent ev) = do
ring <- use sectionListFocusRingL
case F.focusGetCurrent ring of
Nothing -> pure ()
Just l -> Common.zoom (sectionL l) $ L.handleListEvent ev
handleGenericListEvent _ = pure ()
-- This re-uses Brick.Widget.List.renderList
renderSectionList :: forall n t e . (Traversable t, Ord n, Show n, Eq n, L.Splittable t, Semigroup (t e))
=> (Bool -> e -> Widget n) -- ^ Rendering function of the list element, True for the selected element
-> Bool -- ^ Whether the section list has focus
-> GenericSectionList n t e -- ^ The section list to render
-> Widget n
renderSectionList renderElem sectionFocus ge@(GenericSectionList focus elms slName) =
Brick.Widget Brick.Greedy Brick.Greedy $ Brick.render $ Brick.viewport slName Brick.Vertical $
V.ifoldl' (\(!accWidget) !i list ->
let hasFocusList = sectionIsFocused list
makeVisible = if hasFocusList then Brick.visibleRegion (Brick.Location (c, r)) (1, 1) else id
appendBorder = if i == 0 then id else (hBorder <=>)
newWidget = appendBorder (makeVisible $ renderInnerList hasFocusList list)
in accWidget <=> newWidget
)
Brick.emptyWidget
elms
where
-- A section is focused if the whole thing is focused, and the inner list has focus
sectionIsFocused :: L.GenericList n t e -> Bool
sectionIsFocused l = sectionFocus && (Just (L.listName l) == F.focusGetCurrent focus)
renderInnerList :: Bool -> L.GenericList n t e -> Widget n
renderInnerList hasFocus l = Brick.vLimit (length l) $ L.renderList (\b -> renderElem (b && hasFocus)) hasFocus l
-- compute the location to focus on within the active section
(c, r) :: (Int, Int) = case sectionListSelectedElement ge of
Nothing -> (0, 0)
Just (selElIx, _) -> (0, selElIx)
-- | Equivalent to listSelectedElement
sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e)
sectionListSelectedElement generic_section_list = do
current_focus <- generic_section_list ^. sectionListFocusRingL & F.focusGetCurrent
let current_section = generic_section_list ^. sectionL current_focus
L.listSelectedElement current_section

View File

@ -0,0 +1,77 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-
A very simple information-only widget with no handler.
-}
module GHCup.Brick.Widgets.Tutorial (draw) where
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Attributes as Attributes
import Brick
( Padding(Max),
Widget(..),
(<=>))
import qualified Brick
import Brick.Widgets.Center ( center )
import Prelude hiding ( appendFile )
draw :: Widget Common.Name
draw =
let
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
in Common.frontwardLayer "Tutorial"
$ Brick.vBox
(fmap center
[ mkTextBox [Brick.txtWrap "GHCup is a distribution channel for Haskell's tools."]
, Common.separator
, mkTextBox [
Brick.hBox [
Brick.txt "This symbol "
, Brick.withAttr Attributes.installedAttr (Brick.str Common.installedSign)
, Brick.txtWrap " means that the tool is installed but not in used"
]
, Brick.hBox [
Brick.txt "This symbol "
, Brick.withAttr Attributes.setAttr (Brick.str Common.setSign)
, Brick.txtWrap " means that the tool is installed and in used"
]
, Brick.hBox [
Brick.txt "This symbol "
, Brick.withAttr Attributes.notInstalledAttr (Brick.str Common.notInstalledSign)
, Brick.txt " means that the tool isn't installed"
]
]
, Common.separator
, mkTextBox [
Brick.hBox [
Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
, Brick.txtWrap " tag is based on community adoption, known bugs, etc... So It makes this version the least experimental"
]
, Brick.hBox [
Brick.withAttr Attributes.latestAttr $ Brick.str "latest"
, Brick.txtWrap " tag is for the latest distributed version of the tool"
]
, Brick.hBox [
Brick.withAttr Attributes.latestAttr $ Brick.str "hls-powered"
, Brick.txt " denotes the compiler version supported by the currently set ("
, Brick.withAttr Attributes.setAttr (Brick.str Common.setSign)
, Brick.txt ") hls"
]
, Brick.txtWrap "base-X.Y.Z.W tag is the minimun version of the base package admited in such ghc version"
]
, Brick.txt " "
])
<=> Brick.padRight Brick.Max (Brick.txt "Press c+ctrl to exit the tutorial")

View File

@ -0,0 +1,79 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-
This module contains the entrypoint for the brick application and nothing else.
-}
module GHCup.BrickMain where
import GHCup.Types
( Settings(noColor),
AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..), KeyCombination (KeyCombination) )
import GHCup.Prelude.Logger ( logError )
import qualified GHCup.Brick.Actions as Actions
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.App as BrickApp
import qualified GHCup.Brick.Attributes as Attributes
import qualified GHCup.Brick.BrickState as AppState
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
import qualified GHCup.Brick.Widgets.SectionList as Navigation
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
import qualified Brick
import qualified Graphics.Vty as Vty
import Control.Monad.Reader ( ReaderT(runReaderT) )
import Data.Functor ( ($>) )
import Data.IORef (writeIORef)
import Prelude hiding ( appendFile )
import System.Exit ( ExitCode(ExitFailure), exitWith )
import qualified Data.Text as T
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
brickMain :: AppState
-> IO ()
brickMain s = do
writeIORef Actions.settings' s
eAppData <- Actions.getAppData (Just $ ghcupInfo s)
case eAppData of
Right ad -> do
let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing
current_element = Navigation.sectionListSelectedElement initial_list
exit_key = KeyCombination (Vty.KChar 'c') [Vty.MCtrl] -- bQuit . keyBindings $ s
case current_element of
Nothing -> do
flip runReaderT s $ logError "Error building app state: empty ResultList"
exitWith $ ExitFailure 2
Just (_, e) ->
let initapp =
BrickApp.app
(Attributes.defaultAttributes $ noColor $ settings s)
(Attributes.dimAttributes $ noColor $ settings s)
initstate =
AppState.BrickState ad
Common.defaultAppSettings
initial_list
(ContextMenu.create e exit_key)
(AdvanceInstall.create exit_key)
(CompileGHC.create exit_key)
(CompileHLS.create exit_key)
(keyBindings s)
Common.Navigation
in Brick.defaultMain initapp initstate
$> ()
Left e -> do
flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
exitWith $ ExitFailure 2

View File

@ -439,22 +439,39 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
liftE $ mergeGHCFileTree path inst tver forceInstall
| otherwise = do
PlatformRequest {..} <- lift getPlatformReq
Settings {..} <- lift getSettings
addConfArgs' <- sanitizefGHCconfOptions (T.unpack <$> addConfArgs)
defGHCConfOptions' <- sanitizefGHCconfOptions defGHCConfOptions
let ldOverride
| _tvVersion tver >= [vver|8.2.2|]
, _rPlatform `elem` [Linux Alpine, Darwin]
= ["--disable-ld-override"]
| otherwise
= []
lift $ logInfo "Installing GHC (this may take a while)"
env <- case _rPlatform of
-- https://github.com/haskell/ghcup-hs/issues/967
Linux Alpine
-- lets not touch LD for cross targets
| Nothing <- _tvTarget tver -> do
cEnv <- liftIO getEnvironment
spaths <- liftIO getSearchPath
has_ld_bfd <- isJust <$> liftIO (searchPath spaths "ld.bfd")
let ldSet = isJust $ lookup "LD" cEnv
-- only set LD if ld.bfd exists in PATH and LD is not set
-- already
if has_ld_bfd && not ldSet
then do
lift $ logInfo "Detected alpine linux... setting LD=ld.bfd"
pure $ Just (("LD", "ld.bfd") : cEnv)
else pure Nothing
_ -> pure Nothing
lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> fromInstallDir inst)
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver)
<> ldOverride (_tvVersion tver)
<> defGHCConfOptions'
<> addConfArgs')
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
)
(Just $ fromGHCupPath path)
"ghc-configure"
Nothing
env
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
@ -462,7 +479,6 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
pure ()
mergeGHCFileTree :: ( MonadReader env m
, HasPlatformReq env
, HasDirs env
@ -1297,8 +1313,6 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
-- https://github.com/haskell/ghcup-hs/issues/1032
++ ldOverride (_tvVersion tver)
++ fmap T.unpack aargs
)
(Just workdir)
@ -1373,16 +1387,3 @@ postGHCInstall ver@GHCTargetVersion {..} = do
forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) _tvTarget)
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY Nothing)
ldOverride :: Version -> [String]
ldOverride ver
| ver >= [vver|8.2.2|]
= ["--disable-ld-override"]
| otherwise
= []
sanitizefGHCconfOptions :: MonadFail m => [String] -> m [String]
sanitizefGHCconfOptions args
| "--prefix" `elem` fmap (takeWhile (/= '=')) args = fail "Don't explicitly set --prefix ...aborting"
| otherwise = pure args

View File

@ -150,7 +150,7 @@ executeOut' :: MonadIO m
-> m CapturedProcess
executeOut' path args chdir env' = do
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir, env = env' })
(exit, out, err) <- liftIO $ withRestorePath (env cp) $ readCreateProcessWithExitCodeBS cp ""
(exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
pure $ CapturedProcess exit out err
@ -166,21 +166,20 @@ execLogged :: ( MonadReader env m
-> FilePath -- ^ log filename (opened in append mode)
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execLogged exe args chdir lfile env' = do
execLogged exe args chdir lfile env = do
Dirs {..} <- getDirs
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
let stdoutLogfile = fromGHCupPath logsDir </> lfile <> ".stdout.log"
stderrLogfile = fromGHCupPath logsDir </> lfile <> ".stderr.log"
cp <- createProcessWithMingwPath ((proc exe args)
{ cwd = chdir
, env = env'
, env = env
, std_in = CreatePipe
, std_out = CreatePipe
, std_err = CreatePipe
})
fmap (toProcessError exe args)
$ liftIO
$ withRestorePath (env cp)
$ withCreateProcess cp
$ \_ mout merr ph ->
case (mout, merr) of
@ -214,9 +213,16 @@ exec :: MonadIO m
-> Maybe FilePath -- ^ optionally chdir into this
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
exec exe args chdir env' = do
cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env' })
exit_code <- liftIO $ withRestorePath (env cp) $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
exec exe args chdir env = do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
forM_ (Map.fromList <$> env) $ \cEnv -> do
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] curPaths
liftIO $ setEnv "PATH" ""
liftIO $ setEnv "Path" newPath
cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
pure $ toProcessError exe args exit_code
-- | Like 'exec', except doesn't add msys2 stuff to PATH.
@ -227,6 +233,13 @@ execNoMinGW :: MonadIO m
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execNoMinGW exe args chdir env = do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
forM_ (Map.fromList <$> env) $ \cEnv -> do
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] curPaths
liftIO $ setEnv "PATH" ""
liftIO $ setEnv "Path" newPath
let cp = (proc exe args) { cwd = chdir, env = env }
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
pure $ toProcessError exe args exit_code
@ -257,27 +270,7 @@ createProcessWithMingwPath cp = do
newPath = intercalate [searchPathSeparator] (mingWPaths ++ curPaths)
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
envWithNewPath = Map.insert "Path" newPath envWithoutPath
liftIO $ setEnv "Path" newPath
pure $ cp { env = Just $ Map.toList envWithNewPath }
withRestorePath :: MonadIO m => Maybe [(String, String)] -- ^ optional env we want to extract 'PATH' from
-> m a -- ^ action to perform
-> m a
withRestorePath env action = do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
oldPATH <- liftIO $ lookupEnv "PATH"
oldPath <- liftIO $ lookupEnv "Path"
forM_ (Map.fromList <$> env) $ \cEnv -> do
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] curPaths
liftIO $ setEnv "PATH" ""
liftIO $ setEnv "Path" newPath
liftIO $ print newPath
r <- action
liftIO $ maybe (unsetEnv "PATH") (setEnv "PATH") oldPATH
liftIO $ maybe (unsetEnv "Path") (setEnv "Path") oldPath
pure r

View File

@ -379,25 +379,24 @@ data MetaMode = Strict
instance NFData MetaMode
data UserSettings = UserSettings
{ uCache :: Maybe Bool
, uMetaCache :: Maybe Integer
, uMetaMode :: Maybe MetaMode
, uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource
, uNoNetwork :: Maybe Bool
, uGPGSetting :: Maybe GPGSetting
, uPlatformOverride :: Maybe PlatformRequest
, uMirrors :: Maybe DownloadMirrors
, uDefGHCConfOptions :: Maybe [String]
{ uCache :: Maybe Bool
, uMetaCache :: Maybe Integer
, uMetaMode :: Maybe MetaMode
, uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource
, uNoNetwork :: Maybe Bool
, uGPGSetting :: Maybe GPGSetting
, uPlatformOverride :: Maybe PlatformRequest
, uMirrors :: Maybe DownloadMirrors
}
deriving (Show, GHC.Generic, Eq)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings 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 =
@ -415,7 +414,6 @@ fromSettings Settings{..} Nothing =
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
, uDefGHCConfOptions = Just defGHCConfOptions
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
@ -442,7 +440,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
, uDefGHCConfOptions = Just defGHCConfOptions
}
data UserKeyBindings = UserKeyBindings
@ -515,20 +512,19 @@ instance NFData LeanAppState
data Settings = Settings
{ cache :: Bool
, metaCache :: Integer
, metaMode :: MetaMode
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
, verbose :: Bool
, urlSource :: URLSource
, noNetwork :: Bool
, gpgSetting :: GPGSetting
, noColor :: Bool -- this also exists in LoggerConfig
, platformOverride :: Maybe PlatformRequest
, mirrors :: DownloadMirrors
, defGHCConfOptions :: [String]
{ cache :: Bool
, metaCache :: Integer
, metaMode :: MetaMode
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
, verbose :: Bool
, urlSource :: URLSource
, noNetwork :: Bool
, gpgSetting :: GPGSetting
, noColor :: Bool -- this also exists in LoggerConfig
, platformOverride :: Maybe PlatformRequest
, mirrors :: DownloadMirrors
}
deriving (Show, GHC.Generic)
@ -536,7 +532,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) []
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
instance NFData Settings

View File

@ -9,33 +9,19 @@ for ghc_ver in "$@" ; do
# shellcheck disable=SC3060
project_file=cabal.ghc${ghc_ver//./}.project
cp cabal.project "${project_file}"
case "$(uname -s)" in
MSYS*|MINGW*)
# shellcheck disable=SC3060
project_file_os=cabal.ghc${ghc_ver//./}.Win32.project
cp cabal.project "${project_file_os}"
cabal freeze --project-file="${project_file_os}" -w "ghc-${ghc_ver}" -ftui
cabal freeze --project-file="${project_file}" -w "ghc-${ghc_ver}"
;;
*)
# shellcheck disable=SC3060
project_file_os=cabal.ghc${ghc_ver//./}.Unix.project
cp cabal.project "${project_file_os}"
cabal freeze --project-file="${project_file_os}" -w "ghc-${ghc_ver}" -ftui -finternal-downloader
cabal freeze --project-file="${project_file}" -w "ghc-${ghc_ver}" -ftui -finternal-downloader
;;
esac
sed -i -e '/ghcup/d' "${project_file_os}".freeze
echo "" >> "${project_file}"
echo "with-compiler: ghc-${ghc_ver}" >> "${project_file}"
cat <<EOF > "${project_file}" || die
if os(mingw32)
import: cabal.ghc${ghc_ver//./}.Win32.project
import: cabal.ghc${ghc_ver//./}.Win32.project.freeze
else
import: cabal.ghc${ghc_ver//./}.Unix.project
import: cabal.ghc${ghc_ver//./}.Unix.project.freeze
with-compiler: ghc-${ghc_ver}
EOF
sed -i -e '/ghcup/d' "${project_file}".freeze
done

View File

@ -8,8 +8,7 @@ extra-deps:
- Cabal-syntax-3.8.1.0
- Win32-2.14.0.0@sha256:e34af84fec733b5c0c8f052ec39499785e719e2fbbe308983adf26c82ea3704d,5942
- brick-2.1.1@sha256:ff36d64f1027eac17a14a83de053067413accb58b79e5002dce2a79cb8a3dcb3,17385
- bzip2-clib-1.0.8@sha256:f595d0b797e3990b336a36986e5537e84105d13f01f4cb8b470ef671f75555ee,1139
- bz2-1.0.1.1@sha256:d21b768c3d41e0cd313beb866dc003a57004ec46b95a6aaf31963603861d1383,3741
- bzlib-0.5.1.0@sha256:197ea0ba028dd1fe274f7601dae58d23607c4760119bf40bc2087720f6734e6c,2288
- cabal-install-parsers-0.6
- cabal-plan-0.7.3.0
- chs-cabal-0.1.1.1@sha256:e8c8c1bf1dbeec64ad86d67ae6dca1c45afd644d20869546dfdcd03910d3848d,1149