Avance Install Functionality. Bug

.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,22 +1,16 @@
 # Revision history for ghcup
 
-## 0.1.22.0 -- 2024-03-13
+## 0.1.22.0 -- ????-??-??
 
 ### 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)

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

@@ -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
@@ -334,7 +335,6 @@ library ghcup-tui
     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

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

@@ -75,11 +75,6 @@ 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
 
 
 
@@ -461,175 +456,6 @@ changelog' (_, ListResult {..}) = do
         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' #-}
@@ -702,15 +528,13 @@ keyHandlers KeyBindings {..} =
  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
+        contextMenu .= ContextMenu.create r bQuit
-        advanceInstallMenu .= AdvanceInstall.create exitKey
+        advanceInstallMenu .= AdvanceInstall.create bQuit
-        compileGHCMenu .= CompileGHC.create exitKey
+        compileGHCMenu .= CompileGHC.create bQuit
-        compileHLSMenu .= CompileHLS.create exitKey
         -- Set mode to context
         mode           .= ContextPanel
     pure ()

lib-tui/GHCup/Brick/App.hs

@@ -25,7 +25,7 @@ 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.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode, compileGHCMenu)
 import GHCup.Brick.Common (Mode (..), Name (..))
 import qualified GHCup.Brick.Common as Common
 import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo
@@ -65,8 +65,6 @@ 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 =
@@ -96,13 +94,13 @@ drawUI dimAttrs st =
        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.KChar 'q') _ ) -> mode .= Navigation
   VtyEvent (Vty.EvKey Vty.KEnter _ )   -> mode .= Tutorial
   _ -> pure ()
 
@@ -110,7 +108,7 @@ keyInfoHandler ev = case ev of
 tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
 tutorialHandler ev =
   case ev of
-    VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl]) -> mode .= Navigation
+    VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
     _ -> pure ()
 
 -- | Tab/Arrows to navigate. 
@@ -118,8 +116,8 @@ 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)) ->
+    inner_event@(VtyEvent (Vty.EvKey key _)) ->
-      case find (\(key', _, _) -> key' == KeyCombination key mods) (Actions.keyHandlers kb) of
+      case find (\(key', _, _) -> key' == KeyCombination key []) (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
@@ -128,23 +126,32 @@ contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState ()
 contextMenuHandler ev = do
   ctx <- use contextMenu 
   let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
+      buttons = ctx ^. Menu.menuButtonsL
       (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 k m), Just n) 
+      |  k == exitKey 
+          && m == mods 
+          && n `elem` [Menu.fieldName button | button <- buttons]
+      -> 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.CompilieButton) ) -> 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
+      buttons = ctx ^. Menu.menuButtonsL
       (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 k m), Just n)
+        | k == exitKey
+            && m == mods
+            && n `elem` [Menu.fieldName button | button <- buttons]
+        -> mode .= ContextPanel
     (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
         let iopts = ctx ^. Menu.menuStateL
         Actions.withIOAction $ Actions.installWithOptions iopts
@@ -154,31 +161,17 @@ compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
 compileGHCHandler ev = do
   ctx <- use compileGHCMenu 
   let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
+      buttons = ctx ^. Menu.menuButtonsL
       (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 k m), Just n)
-    (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
+      | k == exitKey
-        let iopts = ctx ^. Menu.menuStateL
+          && m == mods
-        when (Menu.isValidMenu ctx)
+          && n `elem` [Menu.fieldName button | button <- buttons]
-          (Actions.withIOAction $ Actions.compileGHC iopts)
+      -> mode .= ContextPanel
     _ -> 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
@@ -189,4 +182,3 @@ eventHandler ev = do
     ContextPanel -> contextMenuHandler ev
     AdvanceInstallPanel -> advanceInstallHandler ev
     CompileGHCPanel     -> compileGHCHandler ev
-    CompileHLSPanel     -> compileHLSHandler ev

lib-tui/GHCup/Brick/Attributes.hs

@@ -46,8 +46,10 @@ defaultAttributes no_color = Brick.attrMap
   where
     withForeColor | no_color  = const
                   | otherwise = Vty.withForeColor
+
     withBackColor | no_color  = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
                   | otherwise = Vty.withBackColor
+
     withStyle                 = Vty.withStyle
 
 

lib-tui/GHCup/Brick/BrickState.hs

@@ -35,7 +35,6 @@ 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
@@ -45,7 +44,6 @@ data BrickState = BrickState
   , _contextMenu        :: ContextMenu
   , _advanceInstallMenu :: AdvanceInstallMenu
   , _compileGHCMenu     :: CompileGHCMenu
-  , _compileHLSMenu     :: CompileHLSMenu
   , _appKeys            :: KeyBindings
   , _mode               :: Mode
   }

lib-tui/GHCup/Brick/Common.hs

@@ -45,8 +45,7 @@ module GHCup.Brick.Common  (
     , TargetGhcEditBox, BootstrapGhcEditBox, JobsEditBox, BuildConfigEditBox
     , PatchesEditBox, CrossTargetEditBox, AddConfArgsEditBox, OvewrwiteVerEditBox
     , BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
-    , CompileGHCButton, CompileHLSButton, CabalProjectEditBox
+    , CompilieButton
-    , CabalProjectLocalEditBox, UpdateCabalCheckBox
   ) ) where
 
 import           GHCup.List ( ListResult )
@@ -76,10 +75,8 @@ pattern OkButton :: ResourceId
 pattern OkButton = ResourceId 0
 pattern AdvanceInstallButton :: ResourceId
 pattern AdvanceInstallButton = ResourceId 100
-pattern CompileGHCButton :: ResourceId
+pattern CompilieButton :: ResourceId
-pattern CompileGHCButton = ResourceId 101
+pattern CompilieButton = ResourceId 101
-pattern CompileHLSButton :: ResourceId
-pattern CompileHLSButton = ResourceId 102
 
 pattern UrlEditBox :: ResourceId
 pattern UrlEditBox = ResourceId 1
@@ -113,14 +110,6 @@ 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
@@ -144,7 +133,6 @@ data Mode = Navigation
           | ContextPanel
           | AdvanceInstallPanel 
           | CompileGHCPanel
-          | CompileHLSPanel
           deriving (Eq, Show, Ord)
 
 installedSign :: String

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

@@ -69,4 +69,4 @@ draw KeyBindings {..} =
             ]
           ]
         ]
-      <=> 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"]
+      <=> Brick.hBox [Brick.txt "Press q 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

@@ -93,7 +93,7 @@ idFormatter = const id
 
 -- | An error message
 type ErrorMessage = T.Text
-data ErrorStatus = Valid | Invalid ErrorMessage deriving (Eq)
+data ErrorStatus = Valid | Invalid ErrorMessage
 
 -- | A lens which does nothing. Usefull to defined no-op fields
 emptyLens :: Lens' s ()
@@ -137,8 +137,6 @@ data MenuField s n where
       , fieldName      :: n
       } -> MenuField s n
 
-isValidField :: MenuField s n -> Bool
-isValidField = (== Valid) . fieldStatus
 
 makeLensesFor
   [ ("fieldLabel", "fieldLabelL")
@@ -212,7 +210,7 @@ createEditableInput name validator = FieldInput initEdit validateEditContent ""
              | focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help
              | focus     -> borderBox editorRender
              | otherwise -> borderBox $ renderAsErrMsg msg
-    validateEditContent = validator . T.init . T.unlines . Edit.getEditContents
+    validateEditContent = validator . 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
@@ -228,9 +226,7 @@ type Button = MenuField
 
 createButtonInput :: FieldInput () () n
 createButtonInput = FieldInput () Right "" drawButton (const $ pure ())
-  where
+  where drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help
-    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
@@ -285,6 +281,7 @@ data Menu s n
     , menuName      :: n                 -- ^ The resource Name.
     }
 
+
 makeLensesFor
   [ ("menuFields", "menuFieldsL"), ("menuState", "menuStateL")
   , ("menuButtons", "menuButtonsL"), ("menuFocusRing", "menuFocusRingL")
@@ -292,9 +289,6 @@ makeLensesFor
   ]
   ''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]
@@ -313,13 +307,9 @@ handlerMenu ev =
         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) =

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

@@ -46,8 +46,6 @@ 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
@@ -84,14 +82,9 @@ create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields
     filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
     filepathValidator i = 
       case not $ emptyEditor i of
-        True  -> absolutePathParser (T.unpack i)
+        True  -> Right . Just . 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
 

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

@@ -14,24 +14,7 @@
 {-# LANGUAGE InstanceSigs #-}
 {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 
-module GHCup.Brick.Widgets.Menus.CompileGHC (
+module GHCup.Brick.Widgets.Menus.CompileGHC (CompileGHCOptions, CompileGHCMenu, create, handler, draw) where
-  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
@@ -43,8 +26,7 @@ import Brick
 import           Prelude                 hiding ( appendFile )
 import           Optics.TH (makeLenses)
 import qualified GHCup.Brick.Common as Common
-import GHCup.Types
+import GHCup.Types (KeyCombination, BuildSystem (Hadrian))
-    ( KeyCombination, BuildSystem(..), VersionPattern )
 import URI.ByteString (URI)
 import qualified Data.Text as T
 import qualified Data.ByteString.UTF8 as UTF8
@@ -54,11 +36,9 @@ import Data.Function ((&))
 import Optics ((.~))
 import Data.Char (isSpace)
 import Data.Versions (Version, version)
-import System.FilePath (isPathSeparator, isValid, isAbsolute, normalise)
+import System.FilePath (isPathSeparator)
 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
@@ -68,7 +48,7 @@ data CompileGHCOptions = CompileGHCOptions
   , _crossTarget  :: Maybe T.Text
   , _addConfArgs  :: [T.Text]
   , _setCompile   :: Bool
-  , _overwriteVer :: Maybe [VersionPattern]
+  , _ovewrwiteVer :: Maybe Version
   , _buildFlavour :: Maybe String
   , _buildSystem  :: Maybe BuildSystem
   , _isolateDir   :: Maybe FilePath
@@ -103,19 +83,18 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
     bootstrapV i =
       case not $ emptyEditor i of
         True  -> 
-          let readVersion = bimap (const "Not a valid version") Left (version i)
+          let readVersion = bimap (const "Not a valid version") Left (version (T.init i)) -- Brick adds \n at the end, hence T.init
-              readPath = do
+              readPath
-                mfilepath <- filepathV i
+                 = if isPathSeparator (T.head i) 
-                case mfilepath of
+                    then pure $ Right (T.unpack i)
-                  Nothing -> Left "Invalid Empty value"
+                    else Left "Not an absolute Path"
-                  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 :: T.Text -> Either Menu.ErrorMessage (Maybe Version)
-    versionV = whenEmpty Nothing (bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack)
+    versionV = bimap (const "Not a valid version") Just . version . T.init  -- Brick adds \n at the end, hence T.init
 
     jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
     jobsV = 
@@ -134,15 +113,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
           in first T.pack $ x <|> y
 
     filepathV :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
-    filepathV i =
+    filepathV = whenEmpty Nothing (Right . Just . T.unpack)
-      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
@@ -152,7 +123,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
       where 
         readSys i
           | T.toLower i == "hadrian" = Right $ Just Hadrian
-          | T.toLower i == "make"    = Right $ Just Make
+          | T.toLower i == "make"    = Right $ Just Hadrian
           | otherwise = Left "Not a valid Build System"
 
     fields = 
@@ -178,15 +149,15 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
       , 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.createEditableField (Common.MenuElement Common.OvewrwiteVerEditBox) versionV ovewrwiteVer
           & 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.BuildSystemEditBox) systemV buildSystem
+          & Menu.fieldLabelL .~ "build system"
+          & 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"
@@ -196,7 +167,6 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
        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 ()

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

@@ -35,18 +35,14 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
     Menu.createButtonField (MenuElement Common.AdvanceInstallButton)
       & Menu.fieldLabelL .~ "Install"
       & Menu.fieldHelpMsgL .~ "Advance Installation Settings"
-  compileGhcButton =
+  compileButton =
-    Menu.createButtonField (MenuElement Common.CompileGHCButton)
+    Menu.createButtonField (MenuElement Common.CompilieButton)
       & Menu.fieldLabelL .~ "Compile"
-      & Menu.fieldHelpMsgL .~ "Compile GHC from source"
+      & Menu.fieldHelpMsgL .~ "Compile tool 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]
+      GHC -> [advInstallButton, compileButton]
-      HLS -> [advInstallButton, compileHLSButton]
+      HLS -> [advInstallButton, compileButton]
       _ -> [advInstallButton]
 
 draw :: ContextMenu -> Widget Name

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

@@ -36,8 +36,6 @@ import Brick
       (<+>),
       (<=>))
 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 )
@@ -102,8 +100,7 @@ draw dimAttrs section_list
           | 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 $ dim
-    in  hooray $ active $ dim
           (   marks
           <+> Brick.padLeft (Pad 2)
                ( minHSize 6

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

@@ -74,4 +74,4 @@ draw =
               ]
             , Brick.txt " "
             ])
-        <=> Brick.padRight Brick.Max (Brick.txt "Press c+ctrl to exit the tutorial")
+        <=> Brick.padRight Brick.Max (Brick.txt "Press q to exit the tutorial")

lib-tui/GHCup/BrickMain.hs

@@ -17,7 +17,7 @@ module GHCup.BrickMain where
 
 import GHCup.Types
     ( Settings(noColor),
-      AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..), KeyCombination (KeyCombination) )
+      AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..) )
 import GHCup.Prelude.Logger ( logError )
 import qualified GHCup.Brick.Actions as Actions
 import qualified GHCup.Brick.Common as Common
@@ -29,7 +29,6 @@ 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 ( ($>) )
@@ -38,7 +37,6 @@ 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
 
 
 
@@ -52,7 +50,7 @@ brickMain s = do
     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
+          exit_key = bQuit . keyBindings $ s 
       case current_element of
         Nothing -> do
           flip runReaderT s $ logError "Error building app state: empty ResultList" 
@@ -67,9 +65,8 @@ brickMain s = do
                       Common.defaultAppSettings
                       initial_list
                       (ContextMenu.create e exit_key)
-                      (AdvanceInstall.create exit_key)
+                      (AdvanceInstall.create (bQuit . keyBindings $ s ))
                       (CompileGHC.create exit_key)
-                      (CompileHLS.create exit_key)
                       (keyBindings s)
                       Common.Navigation
           in Brick.defaultMain initapp initstate 

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