Fix

This should only be necessary in edge cases.

.gitlab/script/ghcup_release.sh

@@ -17,6 +17,7 @@ ecabal update
 
 if [ "${OS}" = "LINUX" ] ; then
 	if [ "${BIT}" = "32" ] ; then
+		rm -r 3rdparty/libarchive
 		ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static'
 	else
 		ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui

3rdparty/libarchive/c/autoconf-linux/config.h

@@ -606,7 +606,7 @@
 /* #undef HAVE_LCHFLAGS */
 
 /* Define to 1 if you have the `lchmod' function. */
-/* #undef HAVE_LCHMOD 1 */
+#define HAVE_LCHMOD 1
 
 /* Define to 1 if you have the `lchown' function. */
 #define HAVE_LCHOWN 1
@@ -1028,10 +1028,10 @@
 /* #undef HAVE_STRUCT_STAT_ST_UMTIME */
 
 /* Define to 1 if `tm_gmtoff' is a member of `struct tm'. */
-/* #undef HAVE_STRUCT_TM_TM_GMTOFF 1 */
+#define HAVE_STRUCT_TM_TM_GMTOFF 1
 
 /* Define to 1 if `__tm_gmtoff' is a member of `struct tm'. */
-/* #undef HAVE_STRUCT_TM___TM_GMTOFF 1 */
+#define HAVE_STRUCT_TM___TM_GMTOFF 1
 
 /* Define to 1 if the system has the type `struct vfsconf'. */
 /* #undef HAVE_STRUCT_VFSCONF */

app/ghcup/BrickMain.hs

@@ -27,7 +27,6 @@ import           Control.Monad.Trans.Resource
 import           Data.Bool
 import           Data.Functor
 import           Data.List
-import           Data.Maybe
 import           Data.Char
 import           Data.IORef
 import           Data.String.Interpolate
@@ -52,16 +51,6 @@ data AppState = AppState {
 type LR = GenericList String Vector ListResult
 
 
-keyHandlers :: [(Char, 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')
-  ]
-
-
 ui :: AppState -> Widget String
 ui AppState {..} =
   ( padBottom Max
@@ -70,13 +59,15 @@ ui AppState {..} =
       $ (center $ renderList renderItem True lr)
       )
     )
-    <=> ( withAttr "help"
+    <=> foldr1
-        . txtWrap
+          (\x y -> x <+> str "  " <+> y)
-        . T.pack
+          [ (str "q:Quit")
-        . foldr1 (\x y -> x <> "  " <> y)
+          , (str "i:Install")
-        . (++ ["↑↓:Navigation"])
+          , (str "s:Set")
-        $ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
+          , (str "u:Uninstall")
-        )
+          , (str "c:ChangeLog")
+          , (str "↑↓:Navigation")
+          ]
 
  where
   renderItem b ListResult {..} =
@@ -92,11 +83,11 @@ ui AppState {..} =
             $ minHSize 20
             $ (withAttr
                 (bool "inactive" "active" b)
-                (str $ (fmap toLower . show $ lTool) <> " " <> ver)
+                (str (fmap toLower . show $ lTool) <+> str " " <+> str ver)
               )
             )
         <+> (padLeft (Pad 1) $ if null lTag
-              then emptyWidget
+              then str ""
               else
                 foldr1 (\x y -> x <+> str "," <+> y)
                   $ (fmap printTag $ sort lTag)
@@ -110,7 +101,7 @@ ui AppState {..} =
 
 
 minHSize :: Int -> Widget n -> Widget n
-minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
+minHSize s' = hLimit s' . vLimit 1 . (<+> str (replicate s' ' '))
 
 
 app :: App AppState e String
@@ -129,7 +120,6 @@ app = App { appDraw         = \st -> [ui st]
     , ("installed"    , fg Vty.green)
     , ("recommended"  , fg Vty.green)
     , ("latest"       , fg Vty.yellow)
-    , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
     ]
 
 
@@ -141,22 +131,16 @@ eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
   continue (AppState (listMoveUp lr) dls)
 eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
   continue (AppState (listMoveDown lr) dls)
-eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
+eventHandler AppState { dls = dls', lr = lr' } (VtyEvent (Vty.EvKey (Vty.KChar c) _))
-  case find (\(c', _, _) -> c' == c) keyHandlers of
+  | (Just (ix, e)) <- listSelectedElement lr'
-    Nothing              -> continue as
+  , c `elem` ['i', 's', 'u', 'c']
-    Just (_, _, handler) -> handler as
+  = suspendAndResume $ do
-eventHandler st _ = continue st
+    r <- case c of
-
+      'i' -> install' e dls'
-
+      's' -> set' e
--- | Suspend the current UI and run an IO action in terminal. If the
+      'u' -> del' e
--- IO action returns a Left value, then it's thrown as userError.
+      'c' -> changelog' e dls'
-withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a))
+      _   -> error ""
-             -> AppState
-             -> EventM n (Next AppState)
-withIOAction action as = case listSelectedElement (lr as) of
-  Nothing      -> continue as
-  Just (ix, e) -> suspendAndResume $ do
-    r <- action as (ix, e)
     case r of
       Left  err -> throwIO $ userError err
       Right _   -> do
@@ -164,17 +148,17 @@ withIOAction action as = case listSelectedElement (lr as) of
           (\AppState {..} -> AppState { lr = listMoveTo ix lr, .. })
           getAppState
         case apps of
-          Right nas -> do
+          Right as  -> do
             putStrLn "Press enter to continue"
             _ <- getLine
-            pure nas
+            pure as
-          Left err -> throwIO $ userError err
+          Left  err -> throwIO $ userError err
+eventHandler st _ = continue st
 
 
-install' :: AppState -> (Int, ListResult) -> IO (Either String ())
+install' :: ListResult -> GHCupDownloads -> IO (Either String ())
-install' AppState {..} (_, ListResult {..}) = do
+install' ListResult {..} dls = do
-  settings <- readIORef settings'
+  l <- readIORef logger'
-  l        <- readIORef logger'
   let runLogger = myLoggerT l
 
   let
@@ -203,10 +187,9 @@ install' AppState {..} (_, ListResult {..}) = do
 Also check the logs in ~/.ghcup/logs|]
 
 
-set' :: AppState -> (Int, ListResult) -> IO (Either String ())
+set' :: ListResult -> IO (Either String ())
-set' _ (_, ListResult {..}) = do
+set' ListResult {..} = do
-  settings <- readIORef settings'
+  l <- readIORef logger'
-  l        <- readIORef logger'
   let runLogger = myLoggerT l
 
   let run =
@@ -225,10 +208,9 @@ set' _ (_, ListResult {..}) = do
           VLeft  e -> pure $ Left [i|#{e}|]
 
 
-del' :: AppState -> (Int, ListResult) -> IO (Either String ())
+del' :: ListResult -> IO (Either String ())
-del' _ (_, ListResult {..}) = do
+del' ListResult {..} = do
-  settings <- readIORef settings'
+  l <- readIORef logger'
-  l        <- readIORef logger'
   let runLogger = myLoggerT l
 
   let run = runLogger . flip runReaderT settings . runE @'[NotInstalled]
@@ -244,8 +226,8 @@ del' _ (_, ListResult {..}) = do
           VLeft  e -> pure $ Left [i|#{e}|]
 
 
-changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
+changelog' :: ListResult -> GHCupDownloads -> IO (Either String ())
-changelog' AppState {..} (_, ListResult {..}) = do
+changelog' ListResult {..} dls = do
   case getChangeLog dls lTool (Left lVer) of
     Nothing -> pure $ Left
       [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
@@ -255,15 +237,12 @@ changelog' AppState {..} (_, ListResult {..}) = do
         Left  e -> pure $ Left [i|#{e}|]
 
 
-settings' :: IORef Settings
+settings :: Settings
-{-# NOINLINE settings' #-}
+settings = Settings { cache      = True
-settings' = unsafePerformIO
+                    , noVerify   = False
-  (newIORef Settings { cache      = True
+                    , keepDirs   = Never
-                     , noVerify   = False
+                    , downloader = Curl
-                     , keepDirs   = Never
+                    }
-                     , downloader = Curl
-                     }
-  )
 
 
 logger' :: IORef LoggerConfig
@@ -276,32 +255,23 @@ logger' = unsafePerformIO
   )
 
 
-brickMain :: Settings -> LoggerConfig -> IO ()
+brickMain :: LoggerConfig -> IO ()
-brickMain s l = do
+brickMain l = do
-  writeIORef settings' s
   -- logger interpreter
-  writeIORef logger'   l
+  writeIORef logger' l
   let runLogger = myLoggerT l
 
   eApps <- getAppState
   case eApps of
-    Right as -> defaultMain app (selectLatest as) $> ()
+    Right as -> defaultMain app as $> ()
-    Left  e  -> do
+    Left  _  -> do
-      runLogger ($(logError) [i|Error building app state: #{show e}|])
+      runLogger ($(logError) [i|Error building app state|])
       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 :: IO (Either String AppState)
 getAppState = do
-  settings <- readIORef settings'
+  l <- readIORef logger'
-  l        <- readIORef logger'
   let runLogger = myLoggerT l
 
   r <-
@@ -312,9 +282,10 @@ getAppState = do
     $ do
         (GHCupInfo _ dls) <- liftE $ getDownloadsF GHCupURL
 
-        lV                <- liftE $ listVersions dls Nothing Nothing
+        lV                 <- liftE $ listVersions dls Nothing Nothing
         pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls)
 
   case r of
     VRight a -> pure $ Right a
     VLeft  e -> pure $ Left [i|#{e}|]
+

app/ghcup/Main.hs

@@ -1150,7 +1150,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           res <- case optCommand of
 #if defined(BRICK)
-            Interactive -> liftIO $ brickMain settings loggerConfig >> pure ExitSuccess
+            Interactive -> liftIO $ brickMain loggerConfig >> pure ExitSuccess
 #endif
             Install (Right iopts) -> do
               runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])

ghcup.cabal

@@ -22,7 +22,7 @@ source-repository head
   location: https://gitlab.haskell.org/haskell/ghcup-hs.git
 
 flag tui
-  description: Build the brick powered tui (ghcup tui)
+  description: Build the brick powered tui (ghcup \-\-interactive)
   default:     False
   manual:      True
 

lib/GHCup.hs

@@ -928,6 +928,7 @@ upgradeGHCup dls mtarget force = do
           `unionFileModes` groupExecuteMode
           `unionFileModes` otherExecuteMode
   binDir <- liftIO $ ghcupBinDir
+  liftIO $ createDirIfMissing newDirPerms binDir
   let fullDest = fromMaybe (binDir </> fn) mtarget
   liftIO $ hideError NoSuchThing $ deleteFile fullDest
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile p