Clean up on error, fixes #1004

.github/workflows/release.yaml

@@ -40,7 +40,7 @@ jobs:
             ARCH: 64
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -94,11 +94,11 @@ jobs:
       fail-fast: true
       matrix:
         include:
-          - os: [self-hosted, Linux, ARM64, maerwald]
+          - os: [self-hosted, Linux, ARM64]
             ARTIFACT: "armv7-linux-ghcup"
             GHC_VER: 9.2.8
             ARCH: ARM
-          - os: [self-hosted, Linux, ARM64, maerwald]
+          - os: [self-hosted, Linux, ARM64]
             ARTIFACT: "aarch64-linux-ghcup"
             GHC_VER: 9.4.8
             ARCH: ARM64
@@ -109,7 +109,7 @@ jobs:
         shell: bash
 
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -177,7 +177,7 @@ jobs:
             ARCH: 64
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -258,7 +258,7 @@ jobs:
       RUNNER_OS: FreeBSD
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -305,7 +305,7 @@ jobs:
 
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -365,12 +365,12 @@ jobs:
     strategy:
       matrix:
         include:
-          - os: [self-hosted, Linux, ARM64, maerwald]
+          - os: [self-hosted, Linux, ARM64]
             ARTIFACT: "armv7-linux-ghcup"
             GHC_VER: 9.2.8
             ARCH: ARM
             DISTRO: Ubuntu
-          - os: [self-hosted, Linux, ARM64, maerwald]
+          - os: [self-hosted, Linux, ARM64]
             ARTIFACT: "aarch64-linux-ghcup"
             GHC_VER: 9.4.8
             ARCH: ARM64
@@ -378,7 +378,7 @@ jobs:
 
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -446,7 +446,7 @@ jobs:
 
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -508,7 +508,7 @@ jobs:
       RUNNER_OS: FreeBSD
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 
@@ -545,7 +545,7 @@ jobs:
       S3_HOST: ${{ secrets.S3_HOST }}
     steps:
       - name: Checkout code
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           submodules: 'true'
 

CHANGELOG.md

@@ -1,43 +1,5 @@
 # Revision history for ghcup
 
-## 0.1.22.0 -- 2024-03-13
-
-### New features
-
-* A help screen/tutorial in the TUI by @lsmor (Luis Morillo)
-* Beef up `--overwrite-version`, fixes [#998](https://github.com/haskell/ghcup-hs/issues/998)
-  * e.g. `ghcup compile hls -g master --overwrite-version='%v-%h' --ghc 9.4.8` will produce a binary called `haskell-language-server-wrapper-<version-from-cabal-file>-<short-git-commit-hash>`... refer to `ghcup compile hls --help` for more information
-* Allow to set ghcup msys2 environment wrt [#982](https://github.com/haskell/ghcup-hs/issues/982)
-* Add mechanism to warn on new metadata versions, fixes [#860](https://github.com/haskell/ghcup-hs/issues/860)
-* Add pre-install message support via ghcup metadata, wrt [#1016](https://github.com/haskell/ghcup-hs/issues/1016)
-* Allow to remove all unset versions, fixes [#1019](https://github.com/haskell/ghcup-hs/issues/1019)
-  * e.g.: `ghcup gc --unset`
-
-### Improvements and bug fixes
-
-* Fix potential [HSEC-2024-0002](https://haskell.github.io/security-advisories/advisory/HSEC-2024-0002.html)
-* Fix TUI crash in windows terminal 1.19 [#1013](https://github.com/haskell/ghcup-hs/issues/1013)
-* Clean up on git clone errors, fixes [#1004](https://github.com/haskell/ghcup-hs/issues/1004)
-* Error out on empty UserSettings wrt [#922](https://github.com/haskell/ghcup-hs/issues/922)
-* Fix failure mode when metadata is garbage, fixes [#921](https://github.com/haskell/ghcup-hs/issues/921)
-* Be less confusing when user tries to 'set' ghcup in TUI, fixes [#923](https://github.com/haskell/ghcup-hs/issues/923)
-* Fix prefetch for cross bindists
-* Fix misinterpretation of '+' in URI paths, fixes [#408](https://github.com/haskell/ghcup-hs/issues/408)
-* Stricter (and better) file uri handling
-* Set LD=ld.bfd on Alpine linux during bindist configure
-* Add rocky/void detection
-* Logging improvements
-* Remove the "show all tool" config in the TUI
-* Fix opening changelog on windows
-* Don't remove share dir link prematurely
-* Require user to explicitly choose subcommand for 'ghcup config'
-* Don't download twice when trying stack decoding
-
-### Refactoring and maintenance
-
-* Large TUI code cleanup by @lsmor (Luis Morillo)... more coming up soon
-* Allow building with `tar` instead of `libarchive` (mainly to make contributions easier)
-
 ## 0.1.20.0 -- 2023-11-10
 
 ### New features

app/ghcup/Main.hs

@@ -11,8 +11,7 @@
 module Main where
 
 #if defined(BRICK)
--- import           BrickMain                    ( brickMain )
+import           BrickMain                    ( brickMain )
-import           GHCup.BrickMain (brickMain)
 #endif
 
 import qualified GHCup.GHC as GHC

cabal.ghc8107.project

@@ -10,18 +10,12 @@ else
         flags: +tui +tar
 
 constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0,
+             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

cabal.ghc8107.project.freeze

@@ -14,7 +14,7 @@ constraints: any.Cabal ==3.10.2.1,
              aeson +ordered-keymap,
              any.aeson-pretty ==0.8.10,
              aeson-pretty +lib-only,
-             any.alex ==3.5.1.0,
+             any.alex ==3.5.0.0,
              any.ansi-terminal ==1.0.2,
              ansi-terminal -example,
              any.ansi-terminal-types ==0.11.5,
@@ -44,9 +44,8 @@ constraints: any.Cabal ==3.10.2.1,
              any.brick ==2.1.1,
              brick -demos,
              any.bytestring ==0.11.5.3,
-             any.bz2 ==1.0.1.1,
+             any.bz2 ==1.0.1.0,
              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,
@@ -242,7 +241,7 @@ constraints: any.Cabal ==3.10.2.1,
              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.versions ==6.0.5,
              any.vty ==6.2,
              any.vty-crossplatform ==0.4.0.0,
              vty-crossplatform -demos,
@@ -256,4 +255,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-10T10:13:56Z
+index-state: hackage.haskell.org 2024-02-18T14:07:35Z

cabal.ghc902.project

@@ -10,18 +10,12 @@ else
         flags: +tui +tar
 
 constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0,
+             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

cabal.ghc902.project.freeze

@@ -14,7 +14,7 @@ constraints: any.Cabal ==3.10.2.1,
              aeson +ordered-keymap,
              any.aeson-pretty ==0.8.10,
              aeson-pretty +lib-only,
-             any.alex ==3.5.1.0,
+             any.alex ==3.5.0.0,
              any.ansi-terminal ==1.0.2,
              ansi-terminal -example,
              any.ansi-terminal-types ==0.11.5,
@@ -47,10 +47,9 @@ constraints: any.Cabal ==3.10.2.1,
              any.brick ==2.1.1,
              brick -demos,
              any.bytestring ==0.11.5.3,
-             any.bz2 ==1.0.1.1,
+             any.bz2 ==1.0.1.0,
              bz2 -cross +with-bzlib,
-             any.bzip2-clib ==1.0.8,
+             any.bzlib-conduit ==0.3.0.2,
-             any.bzlib-conduit ==0.3.0.3,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
              any.cabal-install-parsers ==0.6.1.1,
@@ -141,7 +140,7 @@ constraints: any.Cabal ==3.10.2.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.mono-traversable ==1.0.15.3,
              any.mtl ==2.2.2,
              any.mtl-compat ==0.2.2,
              mtl-compat -two-point-one -two-point-two,
@@ -251,7 +250,7 @@ constraints: any.Cabal ==3.10.2.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.versions ==6.0.5,
              any.vty ==6.2,
              any.vty-crossplatform ==0.4.0.0,
              vty-crossplatform -demos,
@@ -269,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-10T10:13:56Z
+index-state: hackage.haskell.org 2024-02-18T14:07:35Z

cabal.ghc928.project

@@ -10,18 +10,12 @@ else
         flags: +tui +tar
 
 constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0,
+             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

cabal.ghc928.project.freeze

@@ -14,7 +14,7 @@ constraints: any.Cabal ==3.10.2.1,
              aeson +ordered-keymap,
              any.aeson-pretty ==0.8.10,
              aeson-pretty +lib-only,
-             any.alex ==3.5.1.0,
+             any.alex ==3.5.0.0,
              any.ansi-terminal ==1.0.2,
              ansi-terminal -example,
              any.ansi-terminal-types ==0.11.5,
@@ -47,10 +47,9 @@ constraints: any.Cabal ==3.10.2.1,
              any.brick ==2.1.1,
              brick -demos,
              any.bytestring ==0.11.4.0,
-             any.bz2 ==1.0.1.1,
+             any.bz2 ==1.0.1.0,
              bz2 -cross +with-bzlib,
-             any.bzip2-clib ==1.0.8,
+             any.bzlib-conduit ==0.3.0.2,
-             any.bzlib-conduit ==0.3.0.3,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
              any.cabal-install-parsers ==0.6.1.1,
@@ -141,7 +140,7 @@ constraints: any.Cabal ==3.10.2.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.mono-traversable ==1.0.15.3,
              any.mtl ==2.2.2,
              any.mtl-compat ==0.2.2,
              mtl-compat -two-point-one -two-point-two,
@@ -250,7 +249,7 @@ constraints: any.Cabal ==3.10.2.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.versions ==6.0.5,
              any.vty ==6.2,
              any.vty-crossplatform ==0.4.0.0,
              vty-crossplatform -demos,
@@ -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-10T10:13:56Z
+index-state: hackage.haskell.org 2024-02-18T14:07:35Z

cabal.ghc948.project

@@ -10,18 +10,12 @@ else
         flags: +tui +tar
 
 constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0,
+             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

cabal.ghc948.project.freeze

@@ -14,7 +14,7 @@ constraints: any.Cabal ==3.10.2.1,
              aeson +ordered-keymap,
              any.aeson-pretty ==0.8.10,
              aeson-pretty +lib-only,
-             any.alex ==3.5.1.0,
+             any.alex ==3.5.0.0,
              any.ansi-terminal ==1.0.2,
              ansi-terminal -example,
              any.ansi-terminal-types ==0.11.5,
@@ -47,10 +47,9 @@ constraints: any.Cabal ==3.10.2.1,
              any.brick ==2.1.1,
              brick -demos,
              any.bytestring ==0.11.5.3,
-             any.bz2 ==1.0.1.1,
+             any.bz2 ==1.0.1.0,
              bz2 -cross +with-bzlib,
-             any.bzip2-clib ==1.0.8,
+             any.bzlib-conduit ==0.3.0.2,
-             any.bzlib-conduit ==0.3.0.3,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
              any.cabal-install-parsers ==0.6.1.1,
@@ -140,7 +139,7 @@ constraints: any.Cabal ==3.10.2.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.mono-traversable ==1.0.15.3,
              any.mtl ==2.2.2,
              any.mtl-compat ==0.2.2,
              mtl-compat -two-point-one -two-point-two,
@@ -249,7 +248,7 @@ constraints: any.Cabal ==3.10.2.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.versions ==6.0.5,
              any.vty ==6.2,
              any.vty-crossplatform ==0.4.0.0,
              vty-crossplatform -demos,
@@ -267,4 +266,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-10T10:13:56Z
+index-state: hackage.haskell.org 2024-02-18T14:07:35Z

cabal.project

@@ -10,18 +10,12 @@ else
         flags: +tui +tar
 
 constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0,
+             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

cabal.project.release

@@ -18,7 +18,7 @@ elif os(mingw32)
   constraints: zlib +bundled-c-zlib,
                lzma +static,
                text -simdutf,
-               vty-windows >=0.2.0.2
+               vty-windows >=0.1.0.3
   if impl(ghc >= 9.4)
     constraints: language-c >= 0.9.3
 elif os(freebsd)
@@ -30,18 +30,12 @@ elif os(freebsd)
 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
 
 package libarchive
   flags: -system-libarchive
 
-package libyaml-streamly
-  flags: -system-libyaml
-
 package aeson-pretty
   flags: +lib-only
 

docs/guide.md

@@ -561,8 +561,6 @@ export SKIP_GHC=yes
 source ~/.ghc-wasm/env
 ```
 
-**Note that some wasm bindists don't work with the master branch of ghc-wasm-meta. GHCup will warn you about such cases prior to installation and point you to the right commit.**
-
 To install, we need to invoke ghcup like so also passing the `--host=<host>` flag (adjust as needed):
 
 ```sh

ghcup.cabal

@@ -1,9 +1,9 @@
 cabal-version:      2.4
 name:               ghcup
-version:            0.1.22.0
+version:            0.1.20.0
 license:            LGPL-3.0-only
 license-file:       LICENSE
-copyright:          Julian Ospald 2024
+copyright:          Julian Ospald 2020
 maintainer:         hasufell@posteo.de
 author:             Julian Ospald
 homepage:           https://github.com/haskell/ghcup-hs
@@ -175,7 +175,6 @@ library
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            >=0.10       && <0.12
-    , bz2                   ^>=1.0.1.1
     , Cabal                 ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
@@ -245,6 +244,7 @@ library
     -- GHCup.OptParse.Run uses this
     exposed-modules: GHCup.Prelude.Process.Windows
     build-depends:
+      , bzlib
       , process  ^>=1.6.11.0
       , Win32    >=2.10
 
@@ -261,6 +261,7 @@ library
     install-includes: dirutils.h
     c-sources:        cbits/dirutils.c
     build-depends:
+      , bz2              >=0.5.0.5 && <1.1
       , terminal-size    ^>=0.3.3
       , unix             ^>=2.7 || ^>=2.8
       , unix-bytestring  ^>=0.3.7.3
@@ -322,62 +323,6 @@ 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
@@ -401,7 +346,6 @@ executable ghcup
   build-depends:
     , ghcup
     , ghcup-optparse
-    , ghcup-tui
 
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER

hie.yaml

@@ -2,10 +2,6 @@ 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"

lib-opt/GHCup/OptParse/Compile.hs

@@ -529,14 +529,9 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
           HLS.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo (mkTVer targetVer) HLS dls
-            forM_ (_viPreInstall =<< vi) $ \msg -> do
-              lift $ logWarn msg
-              lift $ logWarn
-                "...waiting for 5 seconds, you can still abort..."
-              liftIO $ threadDelay 5000000 -- give the user a sec to intervene
             forM_ (_viPreCompile =<< vi) $ \msg -> do
-              lift $ logWarn msg
+              lift $ logInfo msg
-              lift $ logWarn
+              lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
           _ -> pure ()
@@ -583,14 +578,9 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
           GHC.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo (mkTVer targetVer) GHC dls
-            forM_ (_viPreInstall =<< vi) $ \msg -> do
-              lift $ logWarn msg
-              lift $ logWarn
-                "...waiting for 5 seconds, you can still abort..."
-              liftIO $ threadDelay 5000000 -- give the user a sec to intervene
             forM_ (_viPreCompile =<< vi) $ \msg -> do
-              lift $ logWarn msg
+              lift $ logInfo msg
-              lift $ logWarn
+              lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
           _ -> pure ()

lib-opt/GHCup/OptParse/GC.hs

@@ -47,7 +47,6 @@ data GCOptions = GCOptions
   , gcHLSNoGHC :: Bool
   , gcCache :: Bool
   , gcTmp :: Bool
-  , gcUnset :: Bool
   } deriving (Eq, Show)
 
 
@@ -78,9 +77,6 @@ gcP =
   <*>
     switch
       (short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
-  <*>
-    switch
-      (short 'u' <> long "unset" <> help "Remove all tool versions that are not 'set'")
 
 
 
@@ -138,7 +134,6 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
   liftE $ when gcHLSNoGHC rmHLSNoGHC
   lift $ when gcCache rmCache
   lift $ when gcTmp rmTmp
-  liftE $ when gcUnset rmUnsetTools
    ) >>= \case
             VRight _ -> do
                   pure ExitSuccess

lib-opt/GHCup/OptParse/Install.hs

@@ -24,7 +24,6 @@ import           GHCup.Prelude
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
 
-import           Control.Concurrent (threadDelay)
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
@@ -328,11 +327,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
     (case instBindist of
        Nothing -> runInstGHC s' $ do
          (v, vi) <- liftE $ fromVersion instVer GHC
-         forM_ (_viPreInstall =<< vi) $ \msg -> do
-           lift $ logWarn msg
-           lift $ logWarn
-             "...waiting for 5 seconds, you can still abort..."
-           liftIO $ threadDelay 5000000 -- give the user a sec to intervene
          liftE $ runBothE' (installGHCBin
                      v
                      (maybe GHCupInternal IsolateDir isolateDir)
@@ -344,11 +338,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
        Just uri -> do
          runInstGHC s'{ settings = settings {noVerify = True}} $ do
            (v, vi) <- liftE $ fromVersion instVer GHC
-           forM_ (_viPreInstall =<< vi) $ \msg -> do
-             lift $ logWarn msg
-             lift $ logWarn
-               "...waiting for 5 seconds, you can still abort..."
-             liftIO $ threadDelay 5000000 -- give the user a sec to intervene
            liftE $ runBothE' (installGHCBindist
                        (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
                        v
@@ -410,11 +399,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
     (case instBindist of
        Nothing -> runInstTool s' $ do
          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-         forM_ (_viPreInstall =<< vi) $ \msg -> do
-           lift $ logWarn msg
-           lift $ logWarn
-             "...waiting for 5 seconds, you can still abort..."
-           liftIO $ threadDelay 5000000 -- give the user a sec to intervene
          liftE $ runBothE' (installCabalBin
                                     v
                                     (maybe GHCupInternal IsolateDir isolateDir)
@@ -424,11 +408,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} $ do
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-           forM_ (_viPreInstall =<< vi) $ \msg -> do
-             lift $ logWarn msg
-             lift $ logWarn
-               "...waiting for 5 seconds, you can still abort..."
-             liftIO $ threadDelay 5000000 -- give the user a sec to intervene
            liftE $ runBothE' (installCabalBindist
                                       (DownloadInfo uri Nothing "" Nothing Nothing)
                                       v
@@ -469,11 +448,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
      (case instBindist of
        Nothing -> runInstTool s' $ do
          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-         forM_ (_viPreInstall =<< vi) $ \msg -> do
-           lift $ logWarn msg
-           lift $ logWarn
-             "...waiting for 5 seconds, you can still abort..."
-           liftIO $ threadDelay 5000000 -- give the user a sec to intervene
          liftE $ runBothE' (installHLSBin
                                     v
                                     (maybe GHCupInternal IsolateDir isolateDir)
@@ -483,11 +457,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} $ do
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-           forM_ (_viPreInstall =<< vi) $ \msg -> do
-             lift $ logWarn msg
-             lift $ logWarn
-               "...waiting for 5 seconds, you can still abort..."
-             liftIO $ threadDelay 5000000 -- give the user a sec to intervene
            -- TODO: support legacy
            liftE $ runBothE' (installHLSBindist
                                       (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
@@ -529,11 +498,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
      (case instBindist of
         Nothing -> runInstTool s' $ do
           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-          forM_ (_viPreInstall =<< vi) $ \msg -> do
-            lift $ logWarn msg
-            lift $ logWarn
-              "...waiting for 5 seconds, you can still abort..."
-            liftIO $ threadDelay 5000000 -- give the user a sec to intervene
           liftE $ runBothE' (installStackBin
                                      v
                                      (maybe GHCupInternal IsolateDir isolateDir)
@@ -543,11 +507,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
         Just uri -> do
           runInstTool s'{ settings = settings { noVerify = True}} $ do
             (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-            forM_ (_viPreInstall =<< vi) $ \msg -> do
-              lift $ logWarn msg
-              lift $ logWarn
-                "...waiting for 5 seconds, you can still abort..."
-              liftIO $ threadDelay 5000000 -- give the user a sec to intervene
             liftE $ runBothE' (installStackBindist
                                        (DownloadInfo uri Nothing "" Nothing Nothing)
                                        v

lib-opt/GHCup/OptParse/Upgrade.hs

@@ -17,7 +17,6 @@ import           GHCup.Types
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
 
-import           Control.Concurrent (threadDelay)
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
@@ -136,15 +135,8 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
     UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
 
   runUpgrade runAppState (do
+    v' <- liftE $ upgradeGHCup target force' fatal
     GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-    Just (tver, vi) <- pure $ getLatest dls GHCup
-    let latestVer = _tvVersion tver
-    forM_ (_viPreInstall vi) $ \msg -> do
-      lift $ logWarn msg
-      lift $ logWarn
-        "...waiting for 5 seconds, you can still abort..."
-      liftIO $ threadDelay 5000000 -- give the user a sec to intervene
-    v' <- liftE $ upgradeGHCup' target force' fatal latestVer
     pure (v', dls)
     ) >>= \case
       VRight (v', dls) -> do

lib-tui/GHCup/Brick/Actions.hs

@@ -1,727 +0,0 @@
-{-# 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)

lib-tui/GHCup/Brick/App.hs

@@ -1,192 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Attributes.hs

@@ -1,84 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/BrickState.hs

@@ -1,54 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Common.hs

@@ -1,216 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Widgets/KeyInfo.hs

@@ -1,72 +0,0 @@
-{-# 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"]

lib-tui/GHCup/Brick/Widgets/Menu.hs

@@ -1,370 +0,0 @@
-{-# 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)
-
-

lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs

@@ -1,125 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs

@@ -1,207 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Widgets/Menus/CompileHLS.hs

@@ -1,191 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Widgets/Menus/Context.hs

@@ -1,82 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Widgets/Navigation.hs

@@ -1,151 +0,0 @@
-{-# 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 ' ')

lib-tui/GHCup/Brick/Widgets/SectionList.hs

@@ -1,193 +0,0 @@
-{-# 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

lib-tui/GHCup/Brick/Widgets/Tutorial.hs

@@ -1,77 +0,0 @@
-{-# 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")

lib-tui/GHCup/BrickMain.hs

@@ -1,79 +0,0 @@
-{-# 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

lib/GHCup.hs

@@ -273,6 +273,7 @@ getDebugInfo = do
     --[ GHCup upgrade etc ]--
     -------------------------
 
+
 -- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
 -- if no path is provided.
 upgradeGHCup :: ( MonadMask m
@@ -307,48 +308,11 @@ upgradeGHCup :: ( MonadMask m
                   m
                   Version
 upgradeGHCup mtarget force' fatal = do
-  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-  let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
-  upgradeGHCup' mtarget force' fatal latestVer
-
-
--- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
--- if no path is provided.
-upgradeGHCup' :: ( MonadMask m
-                 , MonadReader env m
-                 , HasDirs env
-                 , HasPlatformReq env
-                 , HasGHCupInfo env
-                 , HasSettings env
-                 , MonadCatch m
-                 , HasLog env
-                 , MonadThrow m
-                 , MonadFail m
-                 , MonadResource m
-                 , MonadIO m
-                 , MonadUnliftIO m
-                 )
-              => Maybe FilePath    -- ^ full file destination to write ghcup into
-              -> Bool              -- ^ whether to force update regardless
-                                   --   of currently installed version
-              -> Bool              -- ^ whether to throw an error if ghcup is shadowed
-              -> Version
-              -> Excepts
-                   '[ CopyError
-                    , DigestError
-                    , ContentLengthError
-                    , GPGError
-                    , GPGError
-                    , DownloadFailed
-                    , NoDownload
-                    , NoUpdate
-                    , ToolShadowed
-                    ]
-                   m
-                   Version
-upgradeGHCup' mtarget force' fatal latestVer = do
   Dirs {..} <- lift getDirs
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+
   lift $ logInfo "Upgrading GHCup..."
+  let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
   (Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
   when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
   dli   <- liftE $ getDownloadInfo GHCup latestVer
@@ -542,26 +506,6 @@ rmOldGHC = do
   forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
 
 
-rmUnsetTools :: ( MonadReader env m
-                , HasGHCupInfo env
-                , HasPlatformReq env
-                , HasDirs env
-                , HasLog env
-                , MonadIO m
-                , MonadFail m
-                , MonadMask m
-                , MonadUnliftIO m
-                )
-             => Excepts '[NotInstalled, UninstallFailed] m ()
-rmUnsetTools = do
-  vers <- lift $ listVersions Nothing [ListInstalled True, ListSet False] False True (Nothing, Nothing)
-  forM_ vers $ \ListResult{..} -> case lTool of
-    GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer)
-    HLS   -> liftE $ rmHLSVer lVer
-    Cabal -> liftE $ rmCabalVer lVer
-    Stack -> liftE $ rmStackVer lVer
-    GHCup -> pure ()
-
 
 rmProfilingLibs :: ( MonadReader env m
                    , HasDirs env

lib/GHCup/Download.hs

@@ -177,7 +177,7 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
    where
     fromDownloadInfo :: DownloadInfo -> VersionInfo
     fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
-                           in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing Nothing
+                           in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing
 
     fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
     fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do

lib/GHCup/Types.hs

@@ -149,7 +149,6 @@ data VersionInfo = VersionInfo
   , _viTestDL      :: Maybe DownloadInfo -- ^ test tarball
   , _viArch        :: ArchitectureSpec   -- ^ descend for binary downloads per arch
   -- informative messages
-  , _viPreInstall  :: Maybe Text
   , _viPostInstall :: Maybe Text
   , _viPostRemove  :: Maybe Text
   , _viPreCompile  :: Maybe Text

scripts/bootstrap/bootstrap-haskell

@@ -39,7 +39,7 @@ die() {
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.22.0"
+ghver="0.1.20.0"
 : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes

stack.yaml

@@ -37,7 +37,7 @@ extra-deps:
   - vty-6.2@sha256:3536dc83a3fee17d9a114baf58fe47b6f080c24987266f0cd0b7b4b1fcd9cf19,3520
   - vty-crossplatform-0.4.0.0@sha256:50593f91ad16777d921138475a8d2784d538fd206addd30664c620278d6c8544,3172
   - vty-unix-0.2.0.0@sha256:2af3d0bdae3c4b7b7e567ee374efe32c7439fabdf9096465ce011a6c6736e9ae,2932
-  - vty-windows-0.2.0.2
+  - vty-windows-0.2.0.1@sha256:6c75230057a708168dbc420975572511ad3ec09956bf73c3b6f4be03324e8b13,2815
   - yaml-streamly-0.12.4@sha256:b5250c5dc71d668c43c42ed6f86f956d69125136ea960858527a4b2ff712d3d1,5165
   - github: hasufell/uri-bytestring
     commit: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001

test/optparse-test/GCTest.hs

@@ -17,7 +17,6 @@ defaultOptions =
     False
     False
     False
-    False
 
 gcCheckList :: [(String, GCOptions)]
 gcCheckList =
@@ -34,9 +33,7 @@ gcCheckList =
   , ("gc --cache", defaultOptions{gcCache = True})
   , ("gc -t", defaultOptions{gcTmp = True})
   , ("gc --tmpdirs", defaultOptions{gcTmp = True})
-  , ("gc -u", defaultOptions{gcUnset = True})
+  , ("gc -o -p -s -h -c -t", GCOptions True True True True True True)
-  , ("gc --unset", defaultOptions{gcUnset = True})
-  , ("gc -o -p -s -h -c -t -u", GCOptions True True True True True True True)
   ]
 
 gcParseWith :: [String] -> IO GCOptions