Bump version to 0.1.12

These are auto-generated from stack and meant for users.

.gitlab-ci.yml

@@ -60,7 +60,12 @@ variables:
   script:
     - ./.gitlab/script/ghcup_version.sh
   variables:
-    JSON_VERSION: "0.0.2"
+    JSON_VERSION: "0.0.3"
+  artifacts:
+    expire_in: 2 week
+    paths:
+      - golden
+    when: on_failure
 
 .test_ghcup_version:linux:
   extends:
@@ -102,6 +107,29 @@ variables:
   only:
     - tags
 
+######## stack test ########
+
+test:linux:stack:
+  before_script:
+    - ./.gitlab/before_script/linux/install_deps_minimal.sh
+  script:
+    - ./.gitlab/script/ghcup_stack.sh
+  extends:
+    - .debian
+
+######## bootstrap test ########
+
+test:linux:bootstrap_script:
+  before_script:
+    - ./.gitlab/before_script/linux/install_deps_minimal.sh
+  script:
+    - ./.gitlab/script/ghcup_bootstrap.sh
+  variables:
+    GHC_VERSION: "8.8.4"
+    CABAL_VERSION: "3.2.0.0"
+  extends:
+    - .debian
+
 ######## linux test ########
 
 test:linux:recommended:

.gitlab/before_script/linux/install_deps_minimal.sh

@@ -0,0 +1,10 @@
+#!/bin/sh
+
+set -eux
+
+. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
+
+mkdir -p "${TMPDIR}"
+
+sudo apt-get update -y
+sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget

.gitlab/script/ghcup_bootstrap.sh

@@ -0,0 +1,30 @@
+#!/bin/sh
+
+set -eux
+
+. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
+
+mkdir -p "$CI_PROJECT_DIR"/.local/bin
+
+ecabal() {
+	cabal --store-dir="$(pwd)"/.store "$@"
+}
+
+eghcup() {
+	ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
+}
+
+git describe --always
+
+### build
+
+ecabal update
+
+export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
+export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
+export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
+
+./bootstrap-haskell
+
+[ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]
+

.gitlab/script/ghcup_stack.sh

@@ -0,0 +1,21 @@
+#!/bin/sh
+
+set -eux
+
+. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
+
+mkdir -p "$CI_PROJECT_DIR"/.local/bin
+
+git describe --always
+
+### build
+
+curl -L -O https://get.haskellstack.org/stable/linux-x86_64.tar.gz
+tar xf linux-x86_64.tar.gz
+cp stack-*-linux-*/stack "$CI_PROJECT_DIR"/.local/bin/stack
+chmod +x "$CI_PROJECT_DIR"/.local/bin/stack
+
+mkdir -p "$CI_PROJECT_DIR"/.stack_root
+export TAR_OPTIONS=--no-same-owner
+stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root build
+stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root test

CHANGELOG.md

@@ -1,6 +1,14 @@
 # Revision history for ghcup
 
-## 0.1.11 -- ????-??-??
+## 0.1.12 -- ????-??-??
+
+* improve TUI:
+  - separators between tools sections
+  - reverse list order so latest is on top
+  - expand the blues selected bar
+  - show new latest versions in bright white
+
+## 0.1.11 -- 2020-09-23
 
 * Add support for installing haskell-language-server, wrt #65
 * When compiling GHC from source create a bindist first, store that bindist in `~/.ghcup/cache` and install it, wrt #51

README.md

@@ -163,6 +163,17 @@ In addition this script can also install `cabal-install`.
 
 ## Known problems
 
+### Custom ghc version names
+
+When installing ghc bindists with custom version names as outlined in
+[installing custom bindists](#installing-custom-bindists), then cabal might
+be unable to find the correct `ghc-pkg` (also see [#73](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/73))
+if you use `cabal build --with-compiler=ghc-foo`. Instead, point it to the full path, such as:
+`cabal build --with-compiler=$HOME/.ghcup/ghc/<version-name>/bin/ghc` or set that GHC version
+as the current one via: `ghcup set ghc <version-name>`.
+
+This problem doesn't exist for regularly installed GHC versions.
+
 ### Limited distributions supported
 
 Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported.

app/ghcup-gen/Validate.hs

@@ -122,6 +122,7 @@ validate dls = do
    where
     isUniqueTag Latest         = True
     isUniqueTag Recommended    = True
+    isUniqueTag Old            = False
     isUniqueTag Prerelease     = False
     isUniqueTag (Base       _) = False
     isUniqueTag (UnknownTag _) = False

app/ghcup/BrickMain.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 module BrickMain where
 
@@ -19,7 +21,10 @@ import           Brick
 import           Brick.Widgets.Border
 import           Brick.Widgets.Border.Style
 import           Brick.Widgets.Center
-import           Brick.Widgets.List
+import           Brick.Widgets.List             ( listSelectedFocusedAttr
+                                                , listSelectedAttr
+                                                , listAttr
+                                                )
 #if !defined(TAR)
 import           Codec.Archive
 #endif
@@ -34,7 +39,9 @@ import           Data.Maybe
 import           Data.Char
 import           Data.IORef
 import           Data.String.Interpolate
-import           Data.Vector                    ( Vector )
+import           Data.Vector                    ( Vector
+                                                , (!?)
+                                                )
 import           Data.Versions           hiding ( str )
 import           Haskus.Utils.Variant.Excepts
 import           Prelude                 hiding ( appendFile )
@@ -47,31 +54,64 @@ import qualified Graphics.Vty                  as Vty
 import qualified Data.Vector                   as V
 
 
-data AppState = AppState {
-    lr :: LR
-  , dls :: GHCupDownloads
+
+data AppData = AppData
+  { lr    :: [ListResult]
+  , dls   :: GHCupDownloads
   , pfreq :: PlatformRequest
-}
+  }
+  deriving Show
 
-type LR = GenericList String Vector ListResult
+data AppSettings = AppSettings
+  { showAll :: Bool
+  }
+  deriving Show
+
+data AppInternalState = AppInternalState
+  { clr :: Vector ListResult
+  , ix  :: Int
+  }
+  deriving Show
+
+data AppState = AppState
+  { appData     :: AppData
+  , appSettings :: AppSettings
+  , appState    :: AppInternalState
+  }
+  deriving Show
 
 
-keyHandlers :: [(Char, String, AppState -> EventM n (Next AppState))]
+keyHandlers :: [ ( Char
+                 , AppSettings -> String
+                 , AppState -> EventM n (Next AppState)
+                 )
+               ]
 keyHandlers =
-  [ ('q', "Quit"     , halt)
-  , ('i', "Install"  , withIOAction install')
-  , ('u', "Uninstall", withIOAction del')
-  , ('s', "Set"      , withIOAction set')
-  , ('c', "ChangeLog", withIOAction changelog')
+  [ ('q', const "Quit"     , halt)
+  , ('i', const "Install"  , withIOAction install')
+  , ('u', const "Uninstall", withIOAction del')
+  , ('s', const "Set"      , withIOAction set')
+  , ('c', const "ChangeLog", withIOAction changelog')
+  , ( 'a'
+    , (\AppSettings {..} ->
+        if showAll then "Hide old versions" else "Show all versions"
+      )
+    , hideShowHandler
+    )
   ]
+ where
+  hideShowHandler (AppState {..}) =
+    let newAppSettings   = appSettings { showAll = not . showAll $ appSettings }
+        newInternalState = constructList appData newAppSettings (Just appState)
+    in  continue (AppState appData newAppSettings newInternalState)
 
 
 ui :: AppState -> Widget String
-ui AppState {..} =
-  ( padBottom Max
+ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}), ..}
+  = ( padBottom Max
     $ ( withBorderStyle unicode
       $ borderWithLabel (str "GHCup")
-      $ (center $ (header <=> hBorder <=> renderList renderItem True lr))
+      $ (center $ (header <=> hBorder <=> renderList' appState))
       )
     )
     <=> footer
@@ -83,14 +123,15 @@ ui AppState {..} =
       . T.pack
       . foldr1 (\x y -> x <> "  " <> y)
       . (++ ["↑↓:Navigation"])
-      $ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
+      $ (fmap (\(c, s, _) -> (c : ':' : s as)) keyHandlers)
   header =
     (minHSize 2 $ emptyWidget)
       <+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
       <+> (minHSize 15 $ str "Version")
       <+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
       <+> (padLeft (Pad 5) $ str "Notes")
-  renderItem b listResult@(ListResult {..}) =
+  renderList' = withDefAttr listAttr . drawListElements renderItem True
+  renderItem _ b listResult@(ListResult {..}) =
     let marks = if
           | lSet       -> (withAttr "set" $ str "✔✔")
           | lInstalled -> (withAttr "installed" $ str "✓ ")
@@ -101,21 +142,23 @@ ui AppState {..} =
         dim = if lNoBindist
           then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
           else id
-        active = if b then withAttr "active" else id
-    in  dim
+        hooray
+          | elem Latest lTag && not lInstalled =
+              withAttr "hooray"
+          | otherwise = id
+        active = if b then forceAttr "active" else id
+    in  hooray $ active $ dim
           (   marks
           <+> (( padLeft (Pad 2)
-               $ active
                $ minHSize 6
-               $ (str (fmap toLower . show $ lTool))
+               $ (printTool lTool)
                )
               )
-          <+> (minHSize 15 $ active $ (str ver))
-          <+> (padLeft (Pad 1) $ minHSize 25 $ if null lTag
-                then emptyWidget
-                else
-                  foldr1 (\x y -> x <+> str "," <+> y)
-                    $ (fmap printTag $ sort lTag)
+          <+> (minHSize 15 $ (str ver))
+          <+> (let l = catMaybes . fmap printTag $ sort lTag
+               in  padLeft (Pad 1) $ minHSize 25 $ if null l
+                     then emptyWidget
+                     else foldr1 (\x y -> x <+> str "," <+> y) l
               )
           <+> ( padLeft (Pad 5)
               $ let notes = printNotes listResult
@@ -123,13 +166,20 @@ ui AppState {..} =
                       then emptyWidget
                       else foldr1 (\x y -> x <+> str "," <+> y) $ notes
               )
+          <+> (vLimit 1 $ fill ' ')
           )
 
-  printTag Recommended        = withAttr "recommended" $ str "recommended"
-  printTag Latest             = withAttr "latest" $ str "latest"
-  printTag Prerelease         = withAttr "prerelease" $ str "prerelease"
-  printTag (Base       pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp''))
-  printTag (UnknownTag t    ) = str t
+  printTag Recommended    = Just $ withAttr "recommended" $ str "recommended"
+  printTag Latest         = Just $ withAttr "latest" $ str "latest"
+  printTag Prerelease     = Just $ withAttr "prerelease" $ str "prerelease"
+  printTag (Base pvp'')   = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
+  printTag Old            = Nothing
+  printTag (UnknownTag t) = Just $ str t
+
+  printTool Cabal = str "cabal"
+  printTool GHC = str "GHC"
+  printTool GHCup = str "GHCup"
+  printTool HLS = str "HLS"
 
   printNotes ListResult {..} =
     (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
@@ -137,6 +187,41 @@ ui AppState {..} =
       ++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
       ++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
 
+  -- | Draws the list elements.
+  --
+  -- Evaluates the underlying container up to, and a bit beyond, the
+  -- selected element. The exact amount depends on available height
+  -- for drawing and 'listItemHeight'. At most, it will evaluate up to
+  -- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
+  -- available height.
+  drawListElements :: (Int -> Bool -> ListResult -> Widget String)
+                   -> Bool
+                   -> AppInternalState
+                   -> Widget String
+  drawListElements drawElem foc is@(AppInternalState clr _) =
+    Widget Greedy Greedy $
+      let
+        es = clr
+        listSelected        = fmap fst $ listSelectedElement' is
+
+        drawnElements = flip V.imap es $ \i' e ->
+          let addSeparator w = case es !? (i' - 1) of
+                Just e' | lTool e' /= lTool e ->
+                  hBorder <=> w
+                _                             -> w
+
+              isSelected  = Just i' == listSelected
+              elemWidget  = drawElem i' isSelected e
+              selItemAttr = if foc
+                then withDefAttr listSelectedFocusedAttr
+                else withDefAttr listSelectedAttr
+              makeVisible = if isSelected then visible . selItemAttr else id
+          in  addSeparator $ makeVisible elemWidget
+
+      in render
+        $ viewport "GHCup" Vertical
+        $ vBox
+        $ V.toList drawnElements
 
 
 minHSize :: Int -> Widget n -> Widget n
@@ -165,6 +250,7 @@ defaultAttributes = attrMap
   , ("compiled"     , Vty.defAttr `Vty.withForeColor` Vty.blue)
   , ("stray"        , Vty.defAttr `Vty.withForeColor` Vty.blue)
   , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
+  , ("hooray"       , Vty.defAttr `Vty.withForeColor` Vty.brightWhite)
   ]
 
 
@@ -175,16 +261,14 @@ dimAttributes = attrMap
   , ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
   ]
 
-
-
 eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState)
 eventHandler st (VtyEvent (Vty.EvResize _               _)) = continue st
 eventHandler st (VtyEvent (Vty.EvKey    (Vty.KChar 'q') _)) = halt st
 eventHandler st (VtyEvent (Vty.EvKey    Vty.KEsc        _)) = halt st
 eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
-  continue (AppState (listMoveUp lr) dls pfreq)
+  continue (AppState { appState = (moveCursor appState Up), .. })
 eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
-  continue (AppState (listMoveDown lr) dls pfreq)
+  continue (AppState { appState = (moveCursor appState Down), .. })
 eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
   case find (\(c', _, _) -> c' == c) keyHandlers of
     Nothing              -> continue as
@@ -192,56 +276,116 @@ eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
 eventHandler st _ = continue st
 
 
+moveCursor :: AppInternalState -> Direction -> AppInternalState
+moveCursor ais@(AppInternalState {..}) direction =
+  let newIx = if direction == Down then ix + 1 else ix - 1
+  in  case clr !? newIx of
+        Just _  -> AppInternalState { ix = newIx, .. }
+        Nothing -> ais
+
+
 -- | 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 :: (AppState -> (Int, ListResult) -> IO (Either String a))
              -> AppState
              -> EventM n (Next AppState)
-withIOAction action as = case listSelectedElement (lr as) of
+withIOAction action as = case listSelectedElement' (appState as) of
   Nothing      -> continue as
   Just (ix, e) -> suspendAndResume $ do
     action as (ix, e) >>= \case
       Left  err -> putStrLn $ ("Error: " <> err)
       Right _   -> putStrLn "Success"
-    apps <- (fmap . fmap)
-      (\AppState {..} -> AppState { lr = listMoveTo ix lr, .. })
-      $ getAppState Nothing (pfreq as)
-    case apps of
-      Right nas -> do
+    getAppData Nothing (pfreq . appData $ as) >>= \case
+      Right data' -> do
         putStrLn "Press enter to continue"
         _ <- getLine
-        pure nas
+        pure (updateList data' as)
       Left err -> throwIO $ userError err
 
 
+-- | Update app data and list internal state based on new evidence.
+-- This synchronises @AppInternalState@ with @AppData@
+-- and @AppSettings@.
+updateList :: AppData -> AppState -> AppState
+updateList appD (AppState {..}) =
+  let newInternalState = constructList appD appSettings (Just appState)
+  in  AppState { appState    = newInternalState
+               , appData     = appD
+               , appSettings = appSettings
+               }
+
+
+constructList :: AppData
+              -> AppSettings
+              -> Maybe AppInternalState
+              -> AppInternalState
+constructList appD appSettings mapp =
+  replaceLR (filterVisible (showAll appSettings)) (lr appD) mapp
+
+listSelectedElement' :: AppInternalState -> Maybe (Int, ListResult)
+listSelectedElement' (AppInternalState {..}) = fmap (ix, ) $ clr !? ix
+
+
+selectLatest :: Vector ListResult -> Int
+selectLatest v =
+  case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
+    Just ix -> ix
+    Nothing -> 0
+
+
+-- | 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 AppInternalState
+          -> AppInternalState
+replaceLR filterF lr s =
+  let oldElem = s >>= listSelectedElement'
+      newVec  = V.fromList . filter filterF $ lr
+      newSelected =
+        case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
+          Just ix -> ix
+          Nothing -> selectLatest newVec
+  in  AppInternalState newVec newSelected
+ where
+  toolEqual e1 e2 =
+    lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
+
+
+filterVisible :: Bool -> ListResult -> Bool
+filterVisible showAll e | lInstalled e = True
+                        | showAll      = True
+                        | otherwise    = not (elem Old (lTag e))
+
+
 install' :: AppState -> (Int, ListResult) -> IO (Either String ())
-install' AppState {..} (_, ListResult {..}) = do
+install' AppState { appData = AppData {..} } (_, ListResult {..}) = do
   settings <- readIORef settings'
   l        <- readIORef logger'
   let runLogger = myLoggerT l
 
-  let
-    run =
-      runLogger
-        . flip runReaderT settings
-        . runResourceT
-        . runE
-          @'[AlreadyInstalled
-            , UnknownArchive
+  let run =
+        runLogger
+          . flip runReaderT settings
+          . runResourceT
+          . runE
+            @'[ AlreadyInstalled
 #if !defined(TAR)
-            , ArchiveResult
+              , ArchiveResult
 #endif
-            , FileDoesNotExistError
-            , CopyError
-            , NoDownload
-            , NotInstalled
-            , BuildFailed
-            , TagNotFound
-            , DigestError
-            , DownloadFailed
-            , NoUpdate
-            , TarDirDoesNotExist
-            ]
+              , UnknownArchive
+              , FileDoesNotExistError
+              , CopyError
+              , NoDownload
+              , NotInstalled
+              , BuildFailed
+              , TagNotFound
+              , DigestError
+              , DownloadFailed
+              , NoUpdate
+              , TarDirDoesNotExist
+              ]
 
   (run $ do
       case lTool of
@@ -271,7 +415,7 @@ set' _ (_, ListResult {..}) = do
   let run =
         runLogger
           . flip runReaderT settings
-          . runE @'[FileDoesNotExistError, NotInstalled, TagNotFound]
+          . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
 
   (run $ do
       case lTool of
@@ -306,15 +450,15 @@ del' _ (_, ListResult {..}) = do
 
 
 changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
-changelog' AppState {..} (_, ListResult {..}) = do
+changelog' AppState { appData = AppData {..} } (_, ListResult {..}) = do
   case getChangeLog dls lTool (Left lVer) of
     Nothing -> pure $ Left
       [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
     Just uri -> do
       let cmd = case _rPlatform pfreq of
-                  Darwin  -> "open"
-                  Linux _ -> "xdg-open"
-                  FreeBSD -> "xdg-open"
+            Darwin  -> "open"
+            Linux _ -> "xdg-open"
+            FreeBSD -> "xdg-open"
       exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
         Right _ -> pure $ Right ()
         Left  e -> pure $ Left [i|#{e}|]
@@ -330,12 +474,12 @@ settings' :: IORef Settings
 settings' = unsafePerformIO $ do
   dirs <- getDirs
   newIORef Settings { cache      = True
-                     , noVerify   = False
-                     , keepDirs   = Never
-                     , downloader = Curl
-                     , verbose    = False
-                     , ..
-                     }
+                    , noVerify   = False
+                    , keepDirs   = Never
+                    , downloader = Curl
+                    , verbose    = False
+                    , ..
+                    }
 
 
 logger' :: IORef LoggerConfig
@@ -348,7 +492,12 @@ logger' = unsafePerformIO
   )
 
 
-brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO ()
+brickMain :: Settings
+          -> Maybe URI
+          -> LoggerConfig
+          -> GHCupDownloads
+          -> PlatformRequest
+          -> IO ()
 brickMain s muri l av pfreq' = do
   writeIORef uri'      muri
   writeIORef settings' s
@@ -356,23 +505,27 @@ brickMain s muri l av pfreq' = do
   writeIORef logger'   l
   let runLogger = myLoggerT l
 
-  eApps <- getAppState (Just av) pfreq'
-  case eApps of
-    Right as -> defaultMain app (selectLatest as) $> ()
-    Left  e  -> do
+  eAppData <- getAppData (Just av) pfreq'
+  case eAppData of
+    Right ad ->
+      defaultMain
+          app
+          (AppState ad
+                    defaultAppSettings
+                    (constructList ad defaultAppSettings Nothing)
+          )
+        $> ()
+    Left e -> do
       runLogger ($(logError) [i|Error building app state: #{show e}|])
       exitWith $ ExitFailure 2
- where
-  selectLatest :: AppState -> AppState
-  selectLatest AppState {..} =
-    (\ix -> AppState { lr = listMoveTo ix lr, .. })
-      . fromJust
-      . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
-      $ (listElements lr)
 
 
-getAppState :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppState)
-getAppState mg pfreq' = do
+defaultAppSettings :: AppSettings
+defaultAppSettings = AppSettings { showAll = False }
+
+
+getDownloads' :: IO (Either String GHCupDownloads)
+getDownloads' = do
   muri     <- readIORef uri'
   settings <- readIORef settings'
   l        <- readIORef logger'
@@ -381,14 +534,30 @@ getAppState mg pfreq' = do
   r <-
     runLogger
     . flip runReaderT settings
-    . runE
-      @'[JSONError, DownloadFailed, FileDoesNotExistError]
-    $ do
-        dls <- maybe (fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)) pure mg
-
-        lV <- lift $ listVersions dls Nothing Nothing pfreq'
-        pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls pfreq')
+    . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
+    $ fmap _ghcupDownloads
+    $ liftE
+    $ getDownloadsF (maybe GHCupURL OwnSource muri)
 
   case r of
     VRight a -> pure $ Right a
     VLeft  e -> pure $ Left [i|#{e}|]
+
+
+getAppData :: Maybe GHCupDownloads
+           -> PlatformRequest
+           -> IO (Either String AppData)
+getAppData mg pfreq' = do
+  settings <- readIORef settings'
+  l        <- readIORef logger'
+  let runLogger = myLoggerT l
+
+  r <- maybe getDownloads' (pure . Right) mg
+
+  runLogger . flip runReaderT settings $ do
+    case r of
+      Right dls -> do
+        lV <- listVersions dls Nothing Nothing pfreq'
+        pure $ Right $ (AppData (reverse lV) dls pfreq')
+      Left e -> pure $ Left [i|#{e}|]
+

app/ghcup/Main.hs

@@ -1480,7 +1480,7 @@ printListResult raw lr = do
                      , case lCross of
                        Nothing -> T.unpack . prettyVer $ lVer
                        Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
-                     , intercalate "," $ (fmap printTag $ sort lTag)
+                     , intercalate "," $ (filter (/= "") . fmap printTag $ sort lTag)
                      , intercalate ","
                      $  (if hlsPowered
                           then [color' Green "hls-powered"]
@@ -1507,6 +1507,7 @@ printListResult raw lr = do
   printTag Prerelease         = color' Red "prerelease"
   printTag (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
   printTag (UnknownTag t    ) = t
+  printTag Old                = ""
 
   color' = case raw of
     True  -> flip const

bootstrap-haskell

@@ -59,7 +59,7 @@ _done() {
 download_ghcup() {
 	_plat="$(uname -s)"
 	_arch=$(uname -m)
-	_ghver="0.1.10"
+	_ghver="0.1.11"
 	_base_url="https://downloads.haskell.org/~ghcup"
 
     case "${_plat}" in
@@ -188,7 +188,30 @@ printf "\\033[0;35m%s\\033[0m\\n" ""
 printf "\\033[0;35m%s\\033[0m\\n" "Installation done!"
 printf "\\033[0;35m%s\\033[0m\\n" ""
 
+
 if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
+	printf "\\033[0;35m%s\\033[0m\\n" "Do you want to install haskell-language-server (HLS) now?"
+	printf "\\033[0;35m%s\\033[0m\\n" "HLS is a language-server that provides IDE-like functionality"
+	printf "\\033[0;35m%s\\033[0m\\n" "and can integrate with different editors, such as Vim, Emacs, VS Code, Atom, ..."
+	printf "\\033[0;35m%s\\033[0m\\n" "Also see https://github.com/haskell/haskell-language-server/blob/master/README.md"
+	printf "\\033[0;35m%s\\033[0m\\n" ""
+	printf "\\033[0;35m%s\\033[0m\\n" "Answer with YES or NO and press ENTER."
+	printf "\\033[0;35m%s\\033[0m\\n" ""
+
+	while true; do
+		read -r hls_answer </dev/tty
+
+		case $hls_answer in
+			[Yy]*)
+				eghcup --cache install hls
+				break ;;
+			[Nn]*)
+				break ;;
+			*)
+				echo "Please type YES or NO and press enter.";;
+		esac
+	done
+
     echo "In order to run ghc and cabal, you need to adjust your PATH variable."
     echo "You may want to source '$GHCUP_DIR/env' in your shell"
     echo "configuration to do so (e.g. ~/.bashrc)."
@@ -238,7 +261,20 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
 							echo "test -f $GHCUP_DIR/env ; and set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH" >> "${GHCUP_PROFILE_FILE}"
 						fi
 						break ;;
-					*)
+					bash)
+						if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
+							echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+						fi
+						case "$(uname -s)" in
+							"Darwin"|"darwin")
+								if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
+									echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
+								fi
+								;;
+						esac
+						break ;;
+
+					zsh)
 						if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
 							echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 						fi

cabal.ghc884.project

@@ -0,0 +1,52 @@
+-- Generated by stackage-to-hackage
+
+index-state: 2020-10-05T20:10:01Z
+
+with-compiler: ghc-8.8.4
+
+packages:
+    ./
+  , 3rdparty/lzma/
+  , 3rdparty/lzma-clib/
+  , 3rdparty/zlib/
+
+source-repository-package
+    type: git
+    location: https://github.com/haskus/packages.git
+    tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
+    subdir: haskus-utils-types
+
+source-repository-package
+    type: git
+    location: https://github.com/hasufell/hpath.git
+    tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
+    subdir: hpath-io
+
+source-repository-package
+    type: git
+    location: https://github.com/hasufell/hpath.git
+    tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
+    subdir: hpath-directory
+
+source-repository-package
+    type: git
+    location: https://github.com/hasufell/text-conversions.git
+    tag: 9abf0e5e5664a3178367597c32db19880477a53c
+
+allow-older: *
+allow-newer: *
+
+package lzma
+    ghc-options: -O2
+
+package lzma-clib
+    ghc-options: -O2
+
+package zlib
+    ghc-options: -O2
+
+package ghcup
+    ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
+
+package streamly
+    ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

cabal.project

@@ -20,12 +20,6 @@ source-repository-package
     tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
     subdir: hpath-directory
 
--- https://github.com/cjdev/text-conversions/pull/10
-source-repository-package
-    type: git
-    location: https://github.com/hasufell/text-conversions.git
-    tag: 9abf0e5e5664a3178367597c32db19880477a53c
-
 optimization: 2
 
 package streamly

ghcup-0.0.2.yaml

@@ -1312,7 +1312,7 @@ ghcupDownloads:
               dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
               dlHash: 44e25e0b0d15361acb369f4bf2206a39d2432a08fb922cc40a9b8a045d0a3a6f
   GHCup:
-    0.1.10:
+    0.1.11:
       viTags:
       - Recommended
       - Latest
@@ -1322,39 +1322,22 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-linux-ghcup-0.1.10
-              dlHash: 87661bd127f857b990174ac8d96ad4bd629865306b2058c8cc64d3b36ed317c9
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-linux-ghcup-0.1.11
+              dlHash: 99d97c9a1dce76892001e5cffd50cc23bf804f2282998c546d1b965aa2179699
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-apple-darwin-ghcup-0.1.10
-              dlHash: e71666fde6a7700f307e1a55720859d3a042fe27c68ff32f3d1181f4436b7391
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-apple-darwin-ghcup-0.1.11
+              dlHash: 4b91dcd9bfdc40534156b8fadea3f317b3c44af1255169895f4911a221f819c6
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-portbld-freebsd-ghcup-0.1.10
-              dlHash: b5ef1b0454f1a9c5a62b378c1e9c48c2b794d64a22086adf482b064dfb34e68d
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-portbld-freebsd-ghcup-0.1.11
+              dlHash: 6f04ce98d3f3eb9299ce74f8264aa956f0dc38a64a3bd12ee048b7f146e9e1b4
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.10/i386-linux-ghcup-0.1.10
-              dlHash: 50ac43199b64bc0724400b0a3db674bef3ec53cf6d41acc04a2c4ca8557e534f
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.11/i386-linux-ghcup-0.1.11
+              dlHash: ec339e4c2b8b4d502f66a03c0d3f112cb68cd922dd3c4a6f66323628cf6a76c2
           Linux_Alpine:
             unknown_versioning: *ghcup-32
-
-  HLS:
-    0.4.0:
-      viTags:
-        - Recommended
-        - Latest
-      viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#040
-      viArch:
-        A_64:
-          Linux_UnknownLinux:
-            unknown_versioning:
-              dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.4.0/haskell-language-server-Linux-0.4.0.tar.gz
-              dlHash: 325b21b38a5e570f00b983885e8ec1eadcb5504a29b28ea4cbe1b85b32058f6d
-          Darwin:
-            unknown_versioning:
-              dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.4.0/haskell-language-server-macOS-0.4.0.tar.gz
-              dlHash: 06a23f1495086438e9676213f7aeddbbc382014ad8016ed7c8ad241a2a15fcfe

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               ghcup
-version:            0.1.11
+version:            0.1.12
 synopsis:           ghc toolchain installer as an exe/library
 description:
   A rewrite of the shell script ghcup, for providing

hie.yaml

@@ -1,6 +1,19 @@
 cradle:
   cabal:
-    - path: "."
-      component: "ghcup:lib:ghcup"
-    - path: "."
+    - path: "./lib"
+      component: "lib:ghcup"
+
+    - path: "./app/ghcup/Main.hs"
       component: "ghcup:exe:ghcup"
+
+    - path: "./app/ghcup/BrickMain.hs"
+      component: "ghcup:exe:ghcup"
+
+    - path: "./app/ghcup-gen/Main.hs"
+      component: "ghcup:exe:ghcup-gen"
+
+    - path: "./app/ghcup-gen/Validate.hs"
+      component: "ghcup:exe:ghcup-gen"
+
+    - path: "./test"
+      component: "ghcup:test:ghcup-test"

lib/GHCup/Types.hs

@@ -96,6 +96,7 @@ data Tag = Latest
          | Recommended
          | Prerelease
          | Base PVP
+         | Old                -- ^ old version are hidden by default in TUI
          | UnknownTag String  -- ^ used for upwardscompat
          deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
 

lib/GHCup/Types/JSON.hs

@@ -55,6 +55,7 @@ instance ToJSON Tag where
   toJSON Latest             = String "Latest"
   toJSON Recommended        = String "Recommended"
   toJSON Prerelease         = String "Prerelease"
+  toJSON Old                = String "old"
   toJSON (Base       pvp'') = String ("base-" <> prettyPVP pvp'')
   toJSON (UnknownTag x    ) = String (T.pack x)
 
@@ -63,6 +64,7 @@ instance FromJSON Tag where
     "Latest"                             -> pure Latest
     "Recommended"                        -> pure Recommended
     "Prerelease"                         -> pure Prerelease
+    "old"                                -> pure Old
     ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
       Right x -> pure $ Base x
       Left  e -> fail . show $ e

lib/GHCup/Version.hs

@@ -26,7 +26,7 @@ ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.3.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: PVP
-ghcUpVer = [pver|0.1.11|]
+ghcUpVer = [pver|0.1.12|]
 
 -- | ghcup version as numeric string.
 numericVer :: String

stack.yaml

@@ -0,0 +1,70 @@
+resolver: lts-16.17
+
+packages:
+  - .
+
+extra-deps:
+  - 3rdparty/lzma
+  - 3rdparty/lzma-clib
+  - 3rdparty/zlib
+
+  - git: https://github.com/haskus/packages.git
+    commit: 80a1c5fc07f7226c424250ec17f674cd4d618f42
+    subdirs:
+      - haskus-utils-types
+
+  - git: https://github.com/hasufell/hpath.git
+    commit: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
+    subdirs:
+      - hpath-io
+      - hpath-directory
+
+  - git: https://github.com/hasufell/text-conversions.git
+    commit: 9abf0e5e5664a3178367597c32db19880477a53c
+
+  - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
+  - QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
+  - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
+  - base64-bytestring-1.1.0.0@sha256:190264fef9e65d9085f00ccda419137096d1dc94777c58272bc96821dc7f37c3,2334
+  - brick-0.55@sha256:f98736eca0cd694837062e06da4655eed969d53b789dfd919716e9b6f5b4c5ce,15858
+  - brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
+  - brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
+  - chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153
+  - chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
+  - composition-prelude-3.0.0.0@sha256:7407835ce8c1e0e2fd6febd25391b12989b216773e685e3cf95bd89072af0ecc,1149
+  - haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466
+  - haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159
+  - hpath-0.11.0@sha256:12b8405bee13d0007d644a888ef8407069ce7bbbd76970f8746b801447124ade,1440
+  - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
+  - hpath-posix-0.13.2@sha256:eec4ff2b00dc86be847aca0f409fc8f6212ffd2170ec36a17dc9a52b46562392,1615
+  - http-io-streams-0.1.4.0@sha256:9a74a059daeddf7a41d361919190b9f4d4292f05e0e4bdf156e2098a116a8145,3582
+  - libarchive-3.0.0.0@sha256:e4157b307acf16cca0ec3d398ac5093cc06f092b33a9743be559ef0f6c6ae52f,11204
+  - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
+  - primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
+  - primitive-unlifted-0.1.3.0@sha256:a98f827740f5dcf097d885b3a47c32f4462204449620abc9d51b8c4f8619f9e6,1427
+  - random-1.2.0@sha256:4321209c8faedc034810ea8ed0dbc4a36f1a1df97b75af024219f2f533da57de,6094
+  - splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
+  - streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
+  - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
+  - tar-bytestring-0.6.3.2@sha256:88f29bed56b688c543a4cb3986402d64b360f76b3fd9b88ac618b8344f8da712,5715
+  - vty-5.30@sha256:4af3938d7b9e6096e222bf52d0ea5d39873bc6fe19febd34106906306af13730,20857
+  - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
+
+flags:
+  http-io-streams:
+    brotli: false
+
+  libarchive:
+    system-libarchive: false
+
+  ghcup:
+    tui: true
+
+system-ghc: true
+compiler: ghc-8.8.4
+compiler-check: match-exact
+
+ghc-options:
+  "$locals": -O2
+  streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
+  ghcup: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16