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
@@ -9,7 +17,7 @@
   - `ghcup install ghc -u <url> <version>`
 * fix bug when cabal isn't marked executable in bindist
 * fix bug when `~/.ghcup` is a valid symlink wrt #49
-* Add JSON roundtrip tests
+* Drop support for compiling cabal from source (the old bootstrap script is discontinued)
 
 ## 0.1.10 -- 2020-08-14
 

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

@@ -64,7 +64,6 @@ import           System.Environment
 import           System.Exit
 import           System.IO               hiding ( appendFile )
 import           Text.Read               hiding ( lift )
-import           Text.Layout.Table
 import           URI.ByteString
 
 import qualified Data.ByteString               as B
@@ -73,6 +72,7 @@ import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
+import qualified Text.Megaparsec.Char          as MPC
 
 
 
@@ -148,7 +148,6 @@ data RmOptions = RmOptions
 
 
 data CompileCommand = CompileGHC GHCCompileOptions
-                    | CompileCabal CabalCompileOptions
 
 
 data GHCCompileOptions = GHCCompileOptions
@@ -612,16 +611,6 @@ compileP = subparser
             )
           )
       )
-  <> command
-       "cabal"
-       (   CompileCabal
-       <$> (info
-             (cabalCompileOpts <**> helper)
-             (  progDesc "Compile Cabal from source"
-             <> footerDoc (Just $ text compileCabalFooter)
-             )
-           )
-       )
   )
  where
   compileFooter = [s|Discussion:
@@ -642,13 +631,6 @@ Examples:
   ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2
   # build cross compiler
   ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
-  compileCabalFooter = [i|Discussion:
-  Compiles and installs the specified Cabal version
-  into "~/.ghcup/bin".
-
-Examples:
-  ghcup compile cabal -j 4 -v 3.2.0.0 -b 8.6.5
-  ghcup compile cabal -j 4 -v 3.2.0.0 -b /usr/bin/ghc-8.6.5|]
 
 
 ghcCompileOpts :: Parser GHCCompileOptions
@@ -1060,26 +1042,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 #endif
                       ]
 
-          let runCompileCabal =
-                runLogger
-                  . flip runReaderT settings
-                  . runResourceT
-                  . runE
-                    @'[ AlreadyInstalled
-                      , BuildFailed
-                      , CopyError
-                      , DigestError
-                      , DownloadFailed
-                      , NoDownload
-                      , NotInstalled
-                      , PatchFailed
-                      , UnknownArchive
-                      , TarDirDoesNotExist
-#if !defined(TAR)
-                      , ArchiveResult
-#endif
-                      ]
-
           let runUpgrade =
                 runLogger
                   . flip runReaderT settings
@@ -1385,28 +1347,6 @@ Make sure to clean up #{tmpdir} afterwards.|])
                         runLogger ($(logError) [i|#{e}|])
                         pure $ ExitFailure 9
 
-            Compile (CompileCabal CabalCompileOptions {..}) ->
-              (runCompileCabal $ do
-                  liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir pfreq
-                )
-                >>= \case
-                      VRight _ -> do
-                        runLogger
-                          ($(logInfo)
-                            "Cabal successfully compiled and installed"
-                          )
-                        pure ExitSuccess
-                      VLeft (V (BuildFailed tmpdir e)) -> do
-                        case keepDirs of
-                          Never -> runLogger ($(logError) [i|Build failed with #{e}|])
-                          _ -> runLogger ($(logError) [i|Build failed with #{e}
-Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
-Make sure to clean up #{tmpdir} afterwards.|])
-                        pure $ ExitFailure 10
-                      VLeft e -> do
-                        runLogger ($(logError) [i|#{e}|])
-                        pure $ ExitFailure 10
-
             Upgrade (uOpts) force -> do
               target <- case uOpts of
                 UpgradeInplace -> do
@@ -1523,50 +1463,145 @@ printListResult raw lr = do
   setLocaleEncoding utf8
 
   let
-    formatted =
-      gridString
-          (  (if raw then [] else [column expand left def def])
-          ++ [ column expand left def def
-             , column expand left def def
-             , column expand left def def
-             , column expand left def def
-             ]
-          )
-        . (\x -> if raw
-            then x
-            else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
-          )
-        $ fmap
+    rows =
+      (\x -> if raw
+          then x
+          else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
+        )
+        . fmap
             (\ListResult {..} ->
               let marks = if
                     | lSet       -> (color Green "✔✔")
-                    | lInstalled -> (color Green "✓")
-                    | otherwise  -> (color Red "✗")
-              in  (if raw then [] else [marks])
-                    ++ [ fmap toLower . show $ lTool
-                       , case lCross of
-                           Nothing -> T.unpack . prettyVer $ lVer
-                           Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
-                       , intercalate "," $ (fmap printTag $ sort lTag)
-                       , intercalate ","
-                       $  (if hlsPowered then [color' Green "hls-powered"] else mempty)
-                       ++ (if fromSrc then [color' Blue "compiled"] else mempty)
-                       ++ (if lStray then [color' Yellow "stray"] else mempty)
-                       ++ (if lNoBindist then [color' Red "no-bindist"] else mempty)
-                       ]
+                    | lInstalled -> (color Green "✓ ")
+                    | otherwise  -> (color Red "✗ ")
+              in
+                (if raw then [] else [marks])
+                  ++ [ fmap toLower . show $ lTool
+                     , case lCross of
+                       Nothing -> T.unpack . prettyVer $ lVer
+                       Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
+                     , intercalate "," $ (filter (/= "") . fmap printTag $ sort lTag)
+                     , intercalate ","
+                     $  (if hlsPowered
+                          then [color' Green "hls-powered"]
+                          else mempty
+                        )
+                     ++ (if fromSrc then [color' Blue "compiled"] else mempty)
+                     ++ (if lStray then [color' Yellow "stray"] else mempty)
+                     ++ (if lNoBindist
+                          then [color' Red "no-bindist"]
+                          else mempty
+                        )
+                     ]
             )
-            lr
-  putStrLn $ formatted
+        $ lr
+  let cols =
+        foldr (\xs ys -> zipWith (:) xs ys) (replicate (length rows) []) rows
+      lengths = fmap maximum . (fmap . fmap) strWidth $ cols
+      padded  = fmap (\xs -> zipWith padTo xs lengths) rows
+
+  forM_ padded $ \row -> putStrLn $ intercalate " " row
  where
   printTag Recommended        = color' Green "recommended"
   printTag Latest             = color' Yellow "latest"
   printTag Prerelease         = color' Red "prerelease"
-  printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
+  printTag (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
   printTag (UnknownTag t    ) = t
+  printTag Old                = ""
+
   color' = case raw of
     True  -> flip const
     False -> color
 
+  padTo str' x =
+    let lstr = strWidth str'
+        add' = x - lstr
+    in  if add' < 0 then str' else str' ++ replicate add' ' '
+
+  -- | Calculate the render width of a string, considering
+  -- wide characters (counted as double width), ANSI escape codes
+  -- (not counted), and line breaks (in a multi-line string, the longest
+  -- line determines the width).
+  strWidth :: String -> Int
+  strWidth =
+    maximum
+      . (0 :)
+      . map (foldr (\a b -> charWidth a + b) 0)
+      . lines
+      . stripAnsi
+
+  -- | Strip ANSI escape sequences from a string.
+  --
+  -- >>> stripAnsi "\ESC[31m-1\ESC[m"
+  -- "-1"
+  stripAnsi :: String -> String
+  stripAnsi s' =
+    case
+        MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
+      of
+        Nothing -> error "Bad ansi escape"  -- PARTIAL: should not happen
+        Just xs -> concat xs
+   where
+      -- This parses lots of invalid ANSI escape codes, but that should be fine
+    ansi =
+      MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
+          Void
+          String
+          Char
+    digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
+    suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
+
+  -- | Get the designated render width of a character: 0 for a combining
+  -- character, 1 for a regular character, 2 for a wide character.
+  -- (Wide characters are rendered as exactly double width in apps and
+  -- fonts that support it.) (From Pandoc.)
+  charWidth :: Char -> Int
+  charWidth c = case c of
+    _ | c < '\x0300'                     -> 1
+      | c >= '\x0300' && c <= '\x036F'   -> 0
+      |  -- combining
+        c >= '\x0370' && c <= '\x10FC'   -> 1
+      | c >= '\x1100' && c <= '\x115F'   -> 2
+      | c >= '\x1160' && c <= '\x11A2'   -> 1
+      | c >= '\x11A3' && c <= '\x11A7'   -> 2
+      | c >= '\x11A8' && c <= '\x11F9'   -> 1
+      | c >= '\x11FA' && c <= '\x11FF'   -> 2
+      | c >= '\x1200' && c <= '\x2328'   -> 1
+      | c >= '\x2329' && c <= '\x232A'   -> 2
+      | c >= '\x232B' && c <= '\x2E31'   -> 1
+      | c >= '\x2E80' && c <= '\x303E'   -> 2
+      | c == '\x303F'                    -> 1
+      | c >= '\x3041' && c <= '\x3247'   -> 2
+      | c >= '\x3248' && c <= '\x324F'   -> 1
+      | -- ambiguous
+        c >= '\x3250' && c <= '\x4DBF'   -> 2
+      | c >= '\x4DC0' && c <= '\x4DFF'   -> 1
+      | c >= '\x4E00' && c <= '\xA4C6'   -> 2
+      | c >= '\xA4D0' && c <= '\xA95F'   -> 1
+      | c >= '\xA960' && c <= '\xA97C'   -> 2
+      | c >= '\xA980' && c <= '\xABF9'   -> 1
+      | c >= '\xAC00' && c <= '\xD7FB'   -> 2
+      | c >= '\xD800' && c <= '\xDFFF'   -> 1
+      | c >= '\xE000' && c <= '\xF8FF'   -> 1
+      | -- ambiguous
+        c >= '\xF900' && c <= '\xFAFF'   -> 2
+      | c >= '\xFB00' && c <= '\xFDFD'   -> 1
+      | c >= '\xFE00' && c <= '\xFE0F'   -> 1
+      | -- ambiguous
+        c >= '\xFE10' && c <= '\xFE19'   -> 2
+      | c >= '\xFE20' && c <= '\xFE26'   -> 1
+      | c >= '\xFE30' && c <= '\xFE6B'   -> 2
+      | c >= '\xFE70' && c <= '\xFEFF'   -> 1
+      | c >= '\xFF01' && c <= '\xFF60'   -> 2
+      | c >= '\xFF61' && c <= '\x16A38'  -> 1
+      | c >= '\x1B000' && c <= '\x1B001' -> 2
+      | c >= '\x1D000' && c <= '\x1F1FF' -> 1
+      | c >= '\x1F200' && c <= '\x1F251' -> 2
+      | c >= '\x1F300' && c <= '\x1F773' -> 1
+      | c >= '\x20000' && c <= '\x3FFFD' -> 2
+      | otherwise                        -> 1
+
+
 checkForUpdates :: (MonadReader Settings m, MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
                 => GHCupDownloads
                 -> PlatformRequest

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

@@ -1193,86 +1193,10 @@ ghcupDownloads:
               dlUri: https://files.hasufell.de/ghc/ghc-8.10.2-i386-alpine-linux.tar.xz
               dlSubdir: ghc-8.10.2
               dlHash: 9ee1cf1e85e9536088b3c9e80e975074e525ea378cd4eb156071bbc4b7b38327
-    9.0.1-alpha1:
-      viTags:
-      - Prerelease
-      - base-4.15.0.0
-      viSourceDL:
-        dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-src.tar.xz
-        dlSubdir: ghc-9.0.0.20200821
-        dlHash: 8a3a36a0d770dbe678dbc084c3cc9a426749ac9d695f34fa30dc4da1564be6cb
-      viArch:
-        A_64:
-          Linux_Debian:
-            '9': &ghc-901a1-64-deb9
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-deb9-linux.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: a58b508e5d9f85a5831c7e451766105c4b2188987b3110ac62c8182e3e6ed0f6
-            '10': &ghc-901a1-64-deb10
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-deb10-linux-dwarf.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: 963d4cef71780f24d23cd947d33f61e9ee338f85e2aed06ec588fdb8be339a04
-            unknown_versioning: *ghc-901a1-64-deb9
-          Linux_Ubuntu:
-            unknown_versioning: &ghc-901a1-64-fedora
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-fedora27-linux.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: e6c241d7945fe84e03501c8a9b947a5f50ad489cdf2b6e286d5de76046a8a6f3
-            '16.04': *ghc-901a1-64-deb9
-            '18.04': *ghc-901a1-64-deb9
-          Linux_Mint:
-            unknown_versioning: *ghc-901a1-64-deb10
-          Linux_Fedora:
-            '27': *ghc-901a1-64-fedora
-            unknown_versioning: *ghc-901a1-64-fedora
-          Linux_CentOS:
-            '7': &ghc-901a1-64-centos
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-centos7-linux.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: e9be471727d6753514667781335018be0fed91483bf80da3f24d21c2e49086e9
-            unknown_versioning: *ghc-901a1-64-centos
-          Linux_RedHat:
-            unknown_versioning: *ghc-901a1-64-centos
-          Linux_Alpine:
-            unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-alpine3.10-linux-integer-simple.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: 8a73cbcebe8aac004dda4411873b6cd57169af9af74cbeb636d695852da1f10c
-          Linux_AmazonLinux:
-            unknown_versioning: *ghc-901a1-64-centos
-          Linux_UnknownLinux:
-            unknown_versioning: *ghc-901a1-64-fedora
-          Darwin:
-            unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-apple-darwin.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: 5bb43fe34997222ae092f3c255d0545dd8ff17409d00f56a356aece9042ace2a
-          FreeBSD:
-            unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-unknown-freebsd.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: 2cb2763fa59bff4c045b7012170132a7a49f09e4f0f894c5367f990b60c38830
-        A_32:
-          Linux_Debian:
-            '9': &ghc-901a1-32-deb9
-              dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-i386-deb9-linux.tar.xz
-              dlSubdir: ghc-9.0.0
-              dlHash: 8b025e0c66bb4e21c050755d4c77b7cea66d0269f00f5206c3cef51861aa360f
-            unknown_versioning: *ghc-901a1-32-deb9
-          Linux_Ubuntu:
-            unknown_versioning: *ghc-901a1-32-deb9
-          Linux_Mint:
-            unknown_versioning: *ghc-901a1-32-deb9
-          Linux_UnknownLinux:
-            unknown_versioning: *ghc-901a1-32-deb9
   Cabal:
     2.4.1.0:
       viTags: []
       viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog
-      viSourceDL:
-        dlUri: https://github.com/haskell/cabal/archive/cabal-install-v2.4.1.0.tar.gz
-        dlSubdir: cabal-cabal-install-v2.4.1.0/cabal-install
-        dlHash: 61eb64a5addafca026aff9277291f4643fe07e83886f76d059d42c734fed829c
       viArch:
         A_64:
           Linux_Alpine:
@@ -1304,10 +1228,6 @@ ghcupDownloads:
     3.0.0.0:
       viTags: []
       viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog
-      viSourceDL:
-        dlUri: https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz
-        dlSubdir: cabal-cabal-install-v3.0.0.0/cabal-install
-        dlHash: c0b26817a7b7c2907e45cb38235ce1157e732211880f62e92eaff4066202e674
       viArch:
         A_64:
           Linux_Alpine:
@@ -1340,10 +1260,6 @@ ghcupDownloads:
       - Recommended
       - Latest
       viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/changelog
-      viSourceDL:
-        dlUri: https://github.com/haskell/cabal/archive/cabal-install-v3.2.0.0.tar.gz
-        dlSubdir: cabal-cabal-install-v3.2.0.0/cabal-install
-        dlHash: 77202358bdf0b481c09326268ce18880df14194c5aaa840f99510bdd1a124b75
       viArch:
         A_64:
           Linux_Alpine:
@@ -1396,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
@@ -1406,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://files.hasufell.de/hls/haskell-language-server-Linux-0.4.0.tar.gz
-              dlHash: a132365554a1bfcbdfef7403366854f09e6f05376c6aec6562500f09e32af9ed
-          Darwin:
-            unknown_versioning:
-              dlUri: https://files.hasufell.de/hls/haskell-language-server-macOS-0.4.0.tar.gz
-              dlHash: 8f7ceaf1150774029d45420895546b50fd70605c0ef0b055344a3600e54721ce

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
@@ -180,9 +180,6 @@ common strict-base
 common string-interpolate
   build-depends: string-interpolate >=0.2.0.0
 
-common table-layout
-  build-depends: table-layout >=0.8
-
 common template-haskell
   build-depends: template-haskell >=2.7
 
@@ -378,7 +375,6 @@ executable ghcup
     , safe
     , safe-exceptions
     , string-interpolate
-    , table-layout
     , template-haskell
     , text
     , uri-bytestring
@@ -433,7 +429,6 @@ executable ghcup-gen
     , resourcet
     , safe-exceptions
     , string-interpolate
-    , table-layout
     , text
     , transformers
     , uri-bytestring

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.hs

@@ -1261,122 +1261,6 @@ Stage1Only = YES|]
 
 
 
--- | Compile a cabal from source. This behaves wrt symlinks and installation
--- the same as 'installCabalBin'.
-compileCabal :: ( MonadReader Settings m
-                , MonadResource m
-                , MonadMask m
-                , MonadLogger m
-                , MonadIO m
-                , MonadFail m
-                )
-             => GHCupDownloads
-             -> Version                    -- ^ version to install
-             -> Either Version (Path Abs)  -- ^ version to bootstrap with
-             -> Maybe Int
-             -> Maybe (Path Abs)
-             -> PlatformRequest
-             -> Excepts
-                  '[ AlreadyInstalled
-                   , BuildFailed
-                   , CopyError
-                   , DigestError
-                   , DownloadFailed
-                   , NoDownload
-                   , NotInstalled
-                   , PatchFailed
-                   , UnknownArchive
-                   , TarDirDoesNotExist
-#if !defined(TAR)
-                   , ArchiveResult
-#endif
-                   ]
-                  m
-                  ()
-compileCabal dls tver bghc jobs patchdir PlatformRequest{..} = do
-  lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|]
-
-  Settings {dirs = Dirs {..}} <- lift ask
-
-  whenM
-      (lift (cabalInstalled tver) >>= \a -> liftIO $
-        handleIO (\_ -> pure False)
-          $ fmap (\x -> a && isSymbolicLink x)
-          -- ignore when the installation is a legacy cabal (binary, not symlink)
-          $ getSymbolicLinkStatus (toFilePath (binDir </> [rel|cabal|]))
-      )
-    $ (throwE $ AlreadyInstalled Cabal tver)
-
-  -- download source tarball
-  dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload
-  dl <- liftE $ downloadCached dlInfo Nothing
-
-  -- unpack
-  tmpUnpack <- lift mkGhcupTmpDir
-  liftE $ unpackToDir tmpUnpack dl
-  void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-
-  workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlInfo)
-
-  cbin         <- liftE $ runBuildAction tmpUnpack Nothing (compile workdir)
-
-  destFileName <- lift $ parseRel ("cabal-" <> verToBS tver)
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile
-    cbin
-    (binDir </> destFileName)
-    Overwrite
-
-  -- create symlink if this is the latest version
-  cVers <- lift $ fmap rights $ getInstalledCabals
-  let lInstCabal = headMay . reverse . sort $ cVers
-  when (maybe True (tver >=) lInstCabal) $ liftE $ setCabal tver
-
-  pure ()
-
- where
-  compile :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m, MonadResource m)
-          => Path Abs
-          -> Excepts '[ProcessError , PatchFailed] m (Path Abs)
-  compile workdir = do
-    lift $ $(logInfo) [i|Building (this may take a while)...|]
-
-    forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
-
-    ghcEnv <- case bghc of
-      Right path -> do
-        -- recover the version from /foo/ghc-6.5.4
-        bn <- basename path
-        let dn  = toFilePath $ dirname path
-        let ver = snd . B.break (== _hyphen) . toFilePath $ bn
-
-        pure
-          [ ("GHC"    , toFilePath path)
-          , ("GHC_PKG", dn <> "/" <> "ghc-pkg" <> ver)
-          , ("HADDOCK", dn <> "/" <> "haddock" <> ver)
-          ]
-      Left bver -> do
-        let v' = verToBS bver
-        pure
-          [ ("GHC"    , "ghc-" <> v')
-          , ("GHC_PKG", "ghc-pkg-" <> v')
-          , ("HADDOCK", "haddock-" <> v')
-          ]
-
-    tmp <- lift withGHCupTmpDir
-    liftIO $ createDirRecursive' (tmp </> [rel|bin|])
-    newEnv <- lift $ addToCurrentEnv (("PREFIX", toFilePath tmp) : ghcEnv)
-    lift $ $(logDebug) [i|Environment: #{newEnv}|]
-
-    lEM $ execLogged "./bootstrap.sh"
-                              False
-                              (maybe [] (\j -> ["-j", fS (show j)]) jobs)
-                              [rel|cabal-bootstrap|]
-                              (Just workdir)
-                              (Just newEnv)
-    pure $ (tmp </> [rel|bin/cabal|])
-
-
-
 
     ---------------------
     --[ Upgrade GHCup ]--

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

@@ -22,11 +22,11 @@ import qualified Data.Text                     as T
 
 -- | This reflects the API version of the YAML.
 ghcupURL :: URI
-ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.yaml|]
+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