Grey out versions without bindists in tui

app/ghcup/BrickMain.hs

@@ -87,21 +87,24 @@ ui AppState {..} =
         ver = case lCross of
           Nothing -> T.unpack . prettyVer $ lVer
           Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
-    in  (   marks
+        dim = if lNoBindist
-        <+> ( padLeft (Pad 2)
+          then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
-            $ minHSize 20
+          else id
-            $ (withAttr
+    in  dim
-                (bool "inactive" "active" b)
+          (   marks
-                (str $ (fmap toLower . show $ lTool) <> " " <> ver)
+          <+> ( padLeft (Pad 2)
+              $ minHSize 20
+              $ ((if b then withAttr "active" else id)
+                  (str $ (fmap toLower . show $ lTool) <> " " <> ver)
+                )
               )
-            )
+          <+> (padLeft (Pad 1) $ if null lTag
-        <+> (padLeft (Pad 1) $ if null lTag
+                then emptyWidget
-              then emptyWidget
+                else
-              else
+                  foldr1 (\x y -> x <+> str "," <+> y)
-                foldr1 (\x y -> x <+> str "," <+> y)
+                    $ (fmap printTag $ sort lTag)
-                  $ (fmap printTag $ sort lTag)
+              )
-            )
+          )
-        )
 
   printTag Recommended        = withAttr "recommended" $ str "recommended"
   printTag Latest             = withAttr "latest" $ str "latest"
@@ -117,20 +120,30 @@ app :: App AppState e String
 app = App { appDraw         = \st -> [ui st]
           , appHandleEvent  = eventHandler
           , appStartEvent   = return
-          , appAttrMap      = const theMap
+          , appAttrMap      = const defaultAttributes
           , appChooseCursor = neverShowCursor
           }
- where
+
-  theMap = attrMap
+defaultAttributes :: AttrMap
-    Vty.defAttr
+defaultAttributes = attrMap
-    [ ("active"       , bg Vty.blue)
+  Vty.defAttr
-    , ("not-installed", fg Vty.red)
+  [ ("active"       , Vty.defAttr `Vty.withBackColor` Vty.blue)
-    , ("set"          , fg Vty.green)
+  , ("not-installed", Vty.defAttr `Vty.withForeColor` Vty.red)
-    , ("installed"    , fg Vty.green)
+  , ("set"          , Vty.defAttr `Vty.withForeColor` Vty.green)
-    , ("recommended"  , fg Vty.green)
+  , ("installed"    , Vty.defAttr `Vty.withForeColor` Vty.green)
-    , ("latest"       , fg Vty.yellow)
+  , ("recommended"  , Vty.defAttr `Vty.withForeColor` Vty.green)
-    , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
+  , ("latest"       , Vty.defAttr `Vty.withForeColor` Vty.yellow)
-    ]
+  , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
+  ]
+
+
+dimAttributes :: AttrMap
+dimAttributes = attrMap
+  (Vty.defAttr `Vty.withStyle` Vty.dim)
+  [ ("active"    , Vty.defAttr `Vty.withBackColor` Vty.blue)
+  , ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
+  ]
+
 
 
 eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState)
@@ -255,6 +268,11 @@ changelog' AppState {..} (_, ListResult {..}) = do
         Left  e -> pure $ Left [i|#{e}|]
 
 
+uri' :: IORef (Maybe URI)
+{-# NOINLINE uri' #-}
+uri' = unsafePerformIO (newIORef Nothing)
+
+
 settings' :: IORef Settings
 {-# NOINLINE settings' #-}
 settings' = unsafePerformIO
@@ -276,8 +294,9 @@ logger' = unsafePerformIO
   )
 
 
-brickMain :: Settings -> LoggerConfig -> IO ()
+brickMain :: Settings -> Maybe URI -> LoggerConfig -> IO ()
-brickMain s l = do
+brickMain s muri l = do
+  writeIORef uri'      muri
   writeIORef settings' s
   -- logger interpreter
   writeIORef logger'   l
@@ -300,6 +319,7 @@ brickMain s l = do
 
 getAppState :: IO (Either String AppState)
 getAppState = do
+  muri     <- readIORef uri'
   settings <- readIORef settings'
   l        <- readIORef logger'
   let runLogger = myLoggerT l
@@ -310,9 +330,10 @@ getAppState = do
     . runE
       @'[JSONError, DownloadFailed, FileDoesNotExistError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     $ do
-        (GHCupInfo _ dls) <- liftE $ getDownloadsF GHCupURL
+        (GHCupInfo _ dls) <- liftE
+          $ getDownloadsF (maybe GHCupURL OwnSource muri)
 
-        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

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 settings optUrlSource 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.|])