Move tui code into its own library.

app/ghcup/Main.hs

@@ -11,7 +11,8 @@
 module Main where
 
 #if defined(BRICK)
-import           BrickMain                    ( brickMain )
+-- import           BrickMain                    ( brickMain )
+import           GHCup.BrickMain (brickMain)
 #endif
 
 import qualified GHCup.GHC as GHC

ghcup.cabal

@@ -323,6 +323,57 @@ library ghcup-optparse
   else
     build-depends:  unix ^>=2.7 || ^>=2.8
 
+library ghcup-tui
+  import:             app-common-depends
+  exposed-modules:
+    GHCup.BrickMain
+    GHCup.Brick.Widgets.Navigation
+    GHCup.Brick.Widgets.Tutorial
+    GHCup.Brick.Widgets.KeyInfo
+    GHCup.Brick.Widgets.SectionList
+    GHCup.Brick.Actions
+    GHCup.Brick.App
+    GHCup.Brick.BrickState
+    GHCup.Brick.Attributes
+    GHCup.Brick.Common
+
+  hs-source-dirs:     lib-tui
+  default-language:   Haskell2010
+  default-extensions:
+    LambdaCase
+    MultiWayIf
+    NamedFieldPuns
+    PackageImports
+    RecordWildCards
+    ScopedTypeVariables
+    StrictData
+    TupleSections
+
+  ghc-options:
+    -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
+    -fwarn-incomplete-record-updates
+
+  build-depends:  
+    , ghcup
+    , ghcup-optparse
+    , optics        ^>=0.4
+    , brick         ^>=2.1
+    , transformers  ^>=0.5
+    , vty           ^>=6.0
+    , optics        ^>=0.4
+
+  if flag(internal-downloader)
+    cpp-options: -DINTERNAL_DOWNLOADER
+
+  if flag(tui)
+    cpp-options:   -DBRICK
+
+  if os(windows)
+    cpp-options: -DIS_WINDOWS
+
+  else
+    build-depends: unix ^>=2.7
+
 executable ghcup
   import:             app-common-depends
   main-is:            Main.hs
@@ -346,6 +397,7 @@ executable ghcup
   build-depends:
     , ghcup
     , ghcup-optparse
+    , ghcup-tui
 
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER

hie.yaml

@@ -2,6 +2,10 @@ cradle:
   cabal:
   - component: "ghcup:lib:ghcup"
     path: ./lib
+  - component: "ghcup:lib:ghcup-optparse"
+    path: ./lib-opt
+  - component: "ghcup:lib:ghcup-tui"
+    path: ./lib-tui
   - component: "ghcup:exe:ghcup"
     path: ./app/ghcup
   - component: "ghcup:lib:ghcup-optparse"

lib-tui/GHCup/Brick/Actions.hs

@@ -0,0 +1,462 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module GHCup.Brick.Actions where
+
+import           GHCup
+import           GHCup.Download
+import           GHCup.Errors
+import           GHCup.Types.Optics ( getDirs, getPlatformReq )
+import           GHCup.Types         hiding ( LeanAppState(..) )
+import           GHCup.Utils
+import           GHCup.OptParse.Common (logGHCPostRm)
+import           GHCup.Prelude ( decUTF8Safe )
+import           GHCup.Prelude.Logger
+import           GHCup.Prelude.Process
+import           GHCup.Prompts
+import           GHCup.Brick.Common (BrickData(..), BrickSettings(..), Name(..), Mode(..))
+import qualified GHCup.Brick.Common as Common
+import           GHCup.Brick.BrickState
+import           GHCup.Brick.Widgets.SectionList
+import           GHCup.Brick.Widgets.Navigation (BrickInternalState)
+
+import qualified Brick
+import qualified Brick.Widgets.List as L
+import qualified Brick.Focus as F
+import           Codec.Archive
+import           Control.Applicative
+import           Control.Exception.Safe
+#if !MIN_VERSION_base(4,13,0)
+import           Control.Monad.Fail             ( MonadFail )
+#endif
+import           Control.Monad.Reader
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Resource
+import           Data.Bool
+import           Data.Functor
+import           Data.Function ( (&), on)
+import           Data.List
+import           Data.Maybe
+import           Data.IORef (IORef, readIORef, newIORef, modifyIORef)
+import           Data.Versions hiding (Lens')
+import           Haskus.Utils.Variant.Excepts
+import           Prelude                 hiding ( appendFile )
+import           System.Exit
+import           System.IO.Unsafe
+import           System.Process                 ( system )
+import           Text.PrettyPrint.HughesPJClass ( prettyShow )
+import           URI.ByteString
+
+import qualified Data.Text                     as T
+import qualified Data.Text.Lazy.Builder        as B
+import qualified Data.Text.Lazy                as L
+import qualified Graphics.Vty                  as Vty
+import qualified Data.Vector                   as V
+import System.Environment (getExecutablePath)
+#if !IS_WINDOWS
+import           GHCup.Prelude.File
+import           System.FilePath
+import qualified System.Posix.Process          as SPP
+#endif
+
+import           Optics.State (use)
+import           Optics.State.Operators ( (.=))
+import           Optics.Operators ((.~),(%~))
+import           Optics.Getter (view)
+
+
+{- Core Logic. 
+
+This module defines the IO actions we can execute within the Brick App:
+ - Install
+ - Set
+ - UnInstall
+ - Launch the Changelog
+
+-}
+
+-- | Update app data and list internal state based on new evidence.
+-- This synchronises @BrickInternalState@ with @BrickData@
+-- and @BrickSettings@.
+updateList :: BrickData -> BrickState -> BrickState
+updateList appD BrickState{..} =
+  let newInternalState = constructList appD _appSettings (Just _appState)
+  in  BrickState { _appState    = newInternalState
+                 , _appData     = appD
+                 , _appSettings = _appSettings
+                 , _appKeys     = _appKeys
+                 , _mode        = Navigation
+                 }
+
+constructList :: BrickData
+              -> BrickSettings
+              -> Maybe BrickInternalState
+              -> BrickInternalState
+constructList appD settings =
+  replaceLR (filterVisible (_showAllVersions settings))
+            (_lr appD)
+
+-- | Focus on the tool section and the predicate which matches. If no result matches, focus on index 0
+selectBy :: Tool -> (ListResult -> Bool) -> BrickInternalState -> BrickInternalState
+selectBy tool predicate internal_state =
+  let new_focus = F.focusSetCurrent (Singular tool) (view sectionListFocusRingL internal_state)
+      tool_lens = sectionL (Singular tool) 
+   in internal_state
+        & sectionListFocusRingL .~ new_focus
+        & tool_lens %~ L.listMoveTo 0            -- We move to 0 first
+        & tool_lens %~ L.listFindBy predicate    -- The lookup by the predicate.
+
+-- | Select the latests GHC tool
+selectLatest :: BrickInternalState -> BrickInternalState
+selectLatest = selectBy GHC (elem Latest . lTag)
+
+
+-- | 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 BrickInternalState
+          -> BrickInternalState
+replaceLR filterF list_result s =
+  let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e)
+      newVec  =  [(Singular $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)]
+      newSectionList = sectionList AllTools newVec 1
+  in case oldElem of
+      Just (_, el) -> selectBy (lTool el) (toolEqual el) newSectionList
+      Nothing -> selectLatest newSectionList
+ where
+  toolEqual e1 e2 =
+    lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
+
+
+filterVisible :: Bool -> ListResult -> Bool
+filterVisible v e | lInstalled e = True
+                  | v
+                  , Nightly `notElem` lTag e = True
+                  | not v
+                  , Old `notElem` lTag e
+                  , Nightly `notElem` lTag e = True
+                  | otherwise = (Old `notElem` lTag e)       &&
+                                  (Nightly `notElem` lTag e)
+
+-- | 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 :: (Ord n, Eq n)
+             => ( (Int, ListResult) -> ReaderT AppState IO (Either String a))
+             -> Brick.EventM n BrickState ()
+withIOAction action = do
+  as <- Brick.get
+  case sectionListSelectedElement (view appState as) of
+    Nothing      -> pure ()
+    Just (curr_ix, e) -> do
+      Brick.suspendAndResume $ do
+        settings <- readIORef settings'
+        flip runReaderT settings $ action (curr_ix, e) >>= \case
+          Left  err -> liftIO $ putStrLn ("Error: " <> err)
+          Right _   -> liftIO $ putStrLn "Success"
+        getAppData Nothing >>= \case
+          Right data' -> do
+            putStrLn "Press enter to continue"
+            _ <- getLine
+            pure (updateList data' as)
+          Left err -> throwIO $ userError err
+
+install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
+         => (Int, ListResult)
+         -> m (Either String ())
+install' (_, ListResult {..}) = do
+  AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+
+  let run =
+        runResourceT
+          . runE
+            @'[ AlreadyInstalled
+              , ArchiveResult
+              , UnknownArchive
+              , FileDoesNotExistError
+              , CopyError
+              , NoDownload
+              , NotInstalled
+              , BuildFailed
+              , TagNotFound
+              , DigestError
+              , ContentLengthError
+              , GPGError
+              , DownloadFailed
+              , DirNotEmpty
+              , NoUpdate
+              , TarDirDoesNotExist
+              , FileAlreadyExistsError
+              , ProcessError
+              , ToolShadowed
+              , UninstallFailed
+              , MergeFileTreeError
+              , NoCompatiblePlatform
+              , GHCup.Errors.ParseError
+              , UnsupportedSetupCombo
+              , DistroNotFound
+              , NoCompatibleArch
+              ]
+
+  run (do
+      ce <- liftIO $ fmap (either (const Nothing) Just) $
+        try @_ @SomeException $ getExecutablePath >>= canonicalizePath
+      dirs <- lift getDirs
+      case lTool of
+        GHC   -> do
+          let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls
+          liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce)
+        Cabal -> do
+          let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls
+          liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
+        GHCup -> do
+          let vi = snd <$> getLatest dls GHCup
+          liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
+        HLS   -> do
+          let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls
+          liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
+        Stack -> do
+          let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls
+          liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
+    )
+    >>= \case
+          VRight (vi, Dirs{..}, Just ce) -> do
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
+            case lTool of
+              GHCup -> do
+#if !IS_WINDOWS
+                up <- liftIO $ fmap (either (const Nothing) Just)
+                  $ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
+                when ((normalise <$> up) == Just (normalise ce)) $
+                  -- TODO: track cli arguments of previous invocation
+                  liftIO $ SPP.executeFile ce False ["tui"] Nothing
+#else
+                logInfo "Please restart 'ghcup' for the changes to take effect"
+#endif
+              _ -> pure ()
+            pure $ Right ()
+          VRight (vi, _, _) -> do
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
+            logInfo "Please restart 'ghcup' for the changes to take effect"
+            pure $ Right ()
+          VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
+          VLeft (V NoUpdate) -> pure $ Right ()
+          VLeft e -> pure $ Left $ prettyHFError e <> "\n"
+            <> "Also check the logs in ~/.ghcup/logs"
+
+
+set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
+     => (Int, ListResult)
+     -> m (Either String ())
+set' input@(_, ListResult {..}) = do
+  settings <- liftIO $ readIORef settings'
+
+  let run =
+        flip runReaderT settings
+          . runResourceT
+          . runE
+            @'[ AlreadyInstalled
+              , ArchiveResult
+              , UnknownArchive
+              , FileDoesNotExistError
+              , CopyError
+              , NoDownload
+              , NotInstalled
+              , BuildFailed
+              , TagNotFound
+              , DigestError
+              , ContentLengthError
+              , GPGError
+              , DownloadFailed
+              , DirNotEmpty
+              , NoUpdate
+              , TarDirDoesNotExist
+              , FileAlreadyExistsError
+              , ProcessError
+              , ToolShadowed
+              , UninstallFailed
+              , MergeFileTreeError
+              , NoCompatiblePlatform
+              , GHCup.Errors.ParseError
+              , UnsupportedSetupCombo
+              , DistroNotFound
+              , NoCompatibleArch
+              ]
+
+  run (do
+      case lTool of
+        GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
+        Cabal -> liftE $ setCabal lVer $> ()
+        HLS   -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
+        Stack -> liftE $ setStack lVer $> ()
+        GHCup -> do
+          promptAnswer <- getUserPromptResponse "Switching GHCup versions is not supported.\nDo you want to install the latest version? [Y/N]: "
+          case promptAnswer of
+                PromptYes -> do
+                  void $ liftE $ upgradeGHCup Nothing False False
+                PromptNo -> pure ()
+    )
+    >>= \case
+          VRight _ -> pure $ Right ()
+          VLeft  e -> case e of
+            (V (NotInstalled tool _)) -> do
+              promptAnswer <- getUserPromptResponse userPrompt
+              case promptAnswer of
+                PromptYes -> do
+                  res <- install' input
+                  case res of
+                    (Left err) -> pure $ Left err
+                    (Right _) -> do
+                      logInfo "Setting now..."
+                      set' input
+
+                PromptNo -> pure $ Left (prettyHFError e)
+              where
+                userPrompt = L.toStrict . B.toLazyText . B.fromString $
+                  "This Version of "
+                  <> show tool
+                  <> " you are trying to set is not installed.\n"
+                  <> "Would you like to install it first? [Y/N]: "
+
+            _ -> pure $ Left (prettyHFError e)
+
+
+
+del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
+     => (Int, ListResult)
+     -> m (Either String ())
+del' (_, ListResult {..}) = do
+  AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+
+  let run = runE @'[NotInstalled, UninstallFailed]
+
+  run (do
+      let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
+      case lTool of
+        GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
+        Cabal -> liftE $ rmCabalVer lVer $> vi
+        HLS   -> liftE $ rmHLSVer lVer $> vi
+        Stack -> liftE $ rmStackVer lVer $> vi
+        GHCup -> pure Nothing
+    )
+    >>= \case
+          VRight vi -> do
+            when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
+            forM_ (_viPostRemove =<< vi) $ \msg ->
+              logInfo msg
+            pure $ Right ()
+          VLeft  e -> pure $ Left (prettyHFError e)
+
+
+changelog' :: (MonadReader AppState m, MonadIO m)
+           => (Int, ListResult)
+           -> m (Either String ())
+changelog' (_, ListResult {..}) = do
+  AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+  case getChangeLog dls lTool (ToolVersion lVer) of
+    Nothing -> pure $ Left $
+      "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
+    Just uri -> do
+      case _rPlatform pfreq of
+            Darwin  -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
+            Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
+            FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
+            Windows -> do
+              let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
+              c <- liftIO $ system $ args
+              case c of
+                 (ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
+                 ExitSuccess -> pure $ Right ()
+
+       >>= \case
+        Right _ -> pure $ Right ()
+        Left  e -> pure $ Left $ prettyHFError e
+
+
+settings' :: IORef AppState
+{-# NOINLINE settings' #-}
+settings' = unsafePerformIO $ do
+  dirs <- getAllDirs
+  let loggerConfig = LoggerConfig { lcPrintDebug  = False
+                                  , consoleOutter = \_ -> pure ()
+                                  , fileOutter    = \_ -> pure ()
+                                  , fancyColors   = True
+                                  }
+  newIORef $ AppState defaultSettings
+                      dirs
+                      defaultKeyBindings
+                      (GHCupInfo mempty mempty Nothing)
+                      (PlatformRequest A_64 Darwin Nothing)
+                      loggerConfig
+
+
+getGHCupInfo :: IO (Either String GHCupInfo)
+getGHCupInfo = do
+  settings <- readIORef settings'
+
+  r <-
+    flip runReaderT settings
+    . runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
+    $ do
+      pfreq <- lift getPlatformReq
+      liftE $ getDownloadsF pfreq
+
+  case r of
+    VRight a -> pure $ Right a
+    VLeft  e -> pure $ Left (prettyHFError e)
+
+
+getAppData :: Maybe GHCupInfo
+           -> IO (Either String BrickData)
+getAppData mgi = runExceptT $ do
+  r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
+  liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
+  settings <- liftIO $ readIORef settings'
+
+  flip runReaderT settings $ do
+    lV <- listVersions Nothing [] False True (Nothing, Nothing)
+    pure $ BrickData (reverse lV)
+
+-- 
+
+keyHandlers :: KeyBindings
+            -> [ ( KeyCombination
+                 , BrickSettings -> String
+                 , Brick.EventM Name BrickState ()
+                 )
+               ]
+keyHandlers KeyBindings {..} =
+  [ (bQuit, const "Quit"     , Brick.halt)
+  , (bInstall, const "Install"  , withIOAction install')
+  , (bUninstall, const "Uninstall", withIOAction del')
+  , (bSet, const "Set"      , withIOAction set')
+  , (bChangelog, const "ChangeLog", withIOAction changelog')
+  , ( bShowAllVersions
+    , \BrickSettings {..} ->
+       if _showAllVersions then "Don't show all versions" else "Show all versions"
+    , hideShowHandler' (not . _showAllVersions)
+    )
+  , (bUp, const "Up", Common.zoom appState moveUp)
+  , (bDown, const "Down", Common.zoom appState moveDown)
+  , (KeyCombination (Vty.KChar 'h') [], const "help", mode .= KeyInfo)
+  ]
+ where
+  --hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
+  hideShowHandler' f = do 
+    app_settings <- use appSettings
+    let 
+      vers = f app_settings
+      newAppSettings = app_settings & Common.showAllVersions .~ vers
+    ad <- use appData
+    current_app_state <- use appState
+    appSettings .= newAppSettings
+    appState    .= constructList ad newAppSettings (Just current_app_state)

lib-tui/GHCup/Brick/App.hs

@@ -0,0 +1,118 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-
+This module defines the brick App. The pattern is very simple:
+
+- Pattern match on the Mode
+- Dispatch drawing/events to the corresponding widget/s
+
+In general each widget should know how to draw itself and how to handle its own events, so this
+module should only contain:
+
+- how to draw non-widget information. For example the footer
+- how to change between modes (widgets aren't aware of the whole application state)
+
+-}
+
+module GHCup.Brick.App where
+
+import           GHCup.Types ( AppState(AppState, keyBindings), KeyCombination(KeyCombination) )
+import           GHCup.Brick.Common ( Name(..), Mode(..))
+import qualified GHCup.Brick.Common as Common
+import           GHCup.Brick.BrickState (BrickState(..), appState, mode, appKeys, appSettings)
+import qualified GHCup.Brick.Attributes as Attributes
+import qualified GHCup.Brick.Widgets.Navigation as Navigation
+import qualified GHCup.Brick.Widgets.Tutorial as Tutorial
+import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo
+import qualified GHCup.Brick.Actions as Actions
+
+import Brick
+    ( BrickEvent(VtyEvent),
+      App(..),
+      AttrMap,
+      EventM,
+      Widget(..),
+      (<=>))
+import qualified Brick
+import Control.Monad.Reader
+    ( void, MonadIO(liftIO) )
+import Data.List ( find, intercalate)
+import           Data.IORef (readIORef)
+import           Prelude                 hiding ( appendFile )
+
+import qualified Graphics.Vty                  as Vty
+
+import           Optics.State (use)
+import           Optics.State.Operators ( (.=))
+import           Optics.Operators ((^.))
+import qualified Data.Text as T
+
+app :: AttrMap -> AttrMap -> App BrickState () Name
+app attrs dimAttrs =
+  App { appDraw         = drawUI dimAttrs
+      , appHandleEvent  = eventHandler
+      , appStartEvent   = return ()
+      , appAttrMap      = const attrs
+      , appChooseCursor = Brick.showFirstCursor
+      }
+
+drawUI :: AttrMap -> BrickState -> [Widget Name]
+drawUI dimAttrs st =
+  let 
+    footer = Brick.withAttr Attributes.helpAttr
+      . Brick.txtWrap
+      . T.pack
+      . foldr1 (\x y -> x <> "  " <> y)
+      . fmap (\(KeyCombination key mods, pretty_setting, _) 
+                  -> intercalate "+" (Common.showKey key : (Common.showMod <$> mods)) <> ":" <> pretty_setting (st ^. appSettings)
+             )
+      $ Actions.keyHandlers (st ^. appKeys)
+    navg = Navigation.draw dimAttrs (st ^. appState) <=> footer
+  in case st ^. mode of
+       Navigation   -> [navg]
+       Tutorial     -> [Tutorial.draw, navg]
+       KeyInfo      -> [KeyInfo.draw (st ^. appKeys), navg]
+--       InstallPopUp -> [drawCompilePopUp (st ^. popUp),  navg]
+
+-- | On q, go back to navigation. 
+--   On Enter, to go to tutorial
+keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState ()
+keyInfoHandler ev = case ev of
+  VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
+  VtyEvent (Vty.EvKey Vty.KEnter _ )   -> mode .= Tutorial
+  _ -> pure ()
+
+-- | On q, go back to navigation. Else, do nothing
+tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
+tutorialHandler ev =
+  case ev of
+    VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
+    _ -> pure ()
+
+-- | Tab/Arrows to navigate. 
+navigationHandler :: BrickEvent Name e -> EventM Name BrickState ()
+navigationHandler ev = do
+  AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings'
+  case ev of
+    inner_event@(VtyEvent (Vty.EvKey key _)) ->
+      case find (\(key', _, _) -> key' == KeyCombination key []) (Actions.keyHandlers kb) of
+        Just (_, _, handler) -> handler
+        Nothing -> void $ Common.zoom appState $ Navigation.handler inner_event
+    inner_event -> Common.zoom appState $ Navigation.handler inner_event
+
+
+eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
+eventHandler ev = do
+  m <- use mode
+  case m of
+    KeyInfo      -> keyInfoHandler ev
+    Tutorial     -> tutorialHandler ev
+    Navigation   -> navigationHandler ev
+--    InstallPopUp -> compilePopUpHandler ev

lib-tui/GHCup/Brick/Attributes.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-
+This module defined the attributes. Despite of brick's capability to have a hierarchy of attributes, here
+we go for the most-simple-approach: a plain hierarchy
+-}
+
+module GHCup.Brick.Attributes where
+
+import           Brick    ( AttrMap)
+import qualified Brick
+import qualified Brick.Widgets.List as L
+import qualified Graphics.Vty                  as Vty
+
+defaultAttributes :: Bool -> AttrMap
+defaultAttributes no_color = Brick.attrMap
+  Vty.defAttr
+  [ (L.listSelectedFocusedAttr , Vty.defAttr `withBackColor` Vty.blue)
+  , (L.listSelectedAttr        , Vty.defAttr)
+  , (notInstalledAttr          , Vty.defAttr `withForeColor` Vty.red)
+  , (setAttr                   , Vty.defAttr `withForeColor` Vty.green)
+  , (installedAttr             , Vty.defAttr `withForeColor` Vty.green)
+  , (recommendedAttr           , Vty.defAttr `withForeColor` Vty.green)
+  , (hlsPoweredAttr            , Vty.defAttr `withForeColor` Vty.green)
+  , (latestAttr                , Vty.defAttr `withForeColor` Vty.yellow)
+  , (latestPrereleaseAttr      , Vty.defAttr `withForeColor` Vty.red)
+  , (latestNightlyAttr         , Vty.defAttr `withForeColor` Vty.red)
+  , (prereleaseAttr            , Vty.defAttr `withForeColor` Vty.red)
+  , (nightlyAttr               , Vty.defAttr `withForeColor` Vty.red)
+  , (compiledAttr              , Vty.defAttr `withForeColor` Vty.blue)
+  , (strayAttr                 , Vty.defAttr `withForeColor` Vty.blue)
+  , (dayAttr                   , Vty.defAttr `withForeColor` Vty.blue)
+  , (helpAttr                  , Vty.defAttr `withStyle`     Vty.italic)
+  , (hoorayAttr                , Vty.defAttr `withForeColor` Vty.brightWhite)
+  ]
+  where
+    withForeColor | no_color  = const
+                  | otherwise = Vty.withForeColor
+
+    withBackColor | no_color  = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
+                  | otherwise = Vty.withBackColor
+
+    withStyle                 = Vty.withStyle
+
+
+notInstalledAttr, setAttr, installedAttr, recommendedAttr, hlsPoweredAttr:: Brick.AttrName
+latestAttr, latestPrereleaseAttr, latestNightlyAttr, prereleaseAttr, nightlyAttr:: Brick.AttrName
+compiledAttr, strayAttr, dayAttr, helpAttr, hoorayAttr:: Brick.AttrName
+
+notInstalledAttr = Brick.attrName "not-installed"
+setAttr = Brick.attrName "set"
+installedAttr = Brick.attrName "installed"
+recommendedAttr = Brick.attrName "recommended"
+hlsPoweredAttr = Brick.attrName "hls-powered"
+latestAttr = Brick.attrName "latest"
+latestPrereleaseAttr = Brick.attrName "latest-prerelease"
+latestNightlyAttr = Brick.attrName "latest-nightly"
+prereleaseAttr = Brick.attrName "prerelease"
+nightlyAttr = Brick.attrName "nightly"
+compiledAttr = Brick.attrName "compiled"
+strayAttr = Brick.attrName "stray"
+dayAttr = Brick.attrName "day"
+helpAttr = Brick.attrName "help"
+hoorayAttr = Brick.attrName "hooray"
+
+dimAttributes :: Bool -> AttrMap
+dimAttributes no_color = Brick.attrMap
+  (Vty.defAttr `Vty.withStyle` Vty.dim)
+  [ (Brick.attrName "active"    , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
+  , (Brick.attrName "no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
+  ]
+  where
+    withBackColor | no_color  = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
+                  | otherwise = Vty.withBackColor

lib-tui/GHCup/Brick/BrickState.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE ViewPatterns      #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE InstanceSigs #-}
+
+{-
+This module contains the BrickState. One could be tempted to include this data structure in GHCup.Brick.Common, 
+but it is better to make a separated module in order to avoid cyclic dependencies.
+
+This happens because the BrickState is sort of a container for all widgets, 
+but widgets depends on common functionality, hence:
+
+             BrickState `depends on` Widgets.XYZ `depends on` Common 
+
+The linear relation above breaks if BrickState is defined in Common. 
+
+-}
+
+module GHCup.Brick.BrickState where
+
+import           GHCup.Types                    ( KeyBindings )
+import           GHCup.Brick.Common             ( BrickData(..), BrickSettings(..), Mode(..))
+import           GHCup.Brick.Widgets.Navigation ( BrickInternalState)
+import           Optics.TH                      (makeLenses)
+
+
+data BrickState = BrickState
+  { _appData     :: BrickData
+  , _appSettings :: BrickSettings
+  , _appState    :: BrickInternalState
+  , _appKeys     :: KeyBindings
+  , _mode        :: Mode
+  }
+  --deriving Show
+
+makeLenses ''BrickState

lib-tui/GHCup/Brick/Common.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE ViewPatterns      #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE InstanceSigs #-}
+
+{-
+This module contains common values used across the library. Crucially it contains two important types for the brick app:
+
+- Name: List all resources (widgets) used by the app. see https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#resource-names
+- Mode: Use to dispatch events and drawings. see: https://github.com/jtdaugherty/brick/issues/476#issuecomment-1629151920
+
+-}
+
+module GHCup.Brick.Common where
+
+import           GHCup.List ( ListResult )
+import           GHCup.Types ( Tool )
+import           Prelude                 hiding ( appendFile )
+import qualified Graphics.Vty                  as Vty
+import           Optics.TH (makeLenses)
+import           Optics.Lens (toLensVL)
+import qualified Brick
+
+-- | Some verbosity. A FocusRing (to loop through advance options), needs an set of resource names to be able to 
+-- dtermine focus. See https://hackage.haskell.org/package/brick-2.1.1/docs/Brick-Focus.html#t:FocusRing
+{- data PopUpResources 
+    = UrlEditBox
+    | SetCheckBox
+    | IsolateEditBox
+    | ForceCheckBox
+    | AdditionalEditBox
+    | RegularInstallButton
+    | AdvanceInstallButton
+    | CancellInstallButton
+    deriving (Eq, Ord, Show)
+-}
+
+-- | Name data type. Uniquely identifies each widget in the TUI. 
+-- some constructors might end up unused, but still is a good practise
+-- to have all of them defined, just in case
+data Name = AllTools        -- ^ The main list widget
+          | Singular Tool   -- ^ The particular list for each tool
+          | KeyInfoBox      -- ^ The text box widget with action informacion
+          | TutorialBox     -- ^ The tutorial widget
+--           | PopUpBox        -- ^ The whole popUp widget
+--           | PopUpElement PopUpResources -- ^ each element in the popUp
+          deriving (Eq, Ord, Show)
+
+-- | Mode type. It helps to dispatch events to different handlers.
+data Mode = Navigation | KeyInfo | Tutorial deriving (Eq, Show, Ord)
+
+installedSign :: String
+#if IS_WINDOWS
+installedSign = "I "
+#else
+installedSign = "✓ "
+#endif
+
+setSign :: String
+#if IS_WINDOWS
+setSign = "IS"
+#else
+setSign = "✔✔"
+#endif
+
+notInstalledSign :: String
+#if IS_WINDOWS
+notInstalledSign = "X "
+#else
+notInstalledSign = "✗ "
+#endif
+
+showKey :: Vty.Key -> String
+showKey (Vty.KChar c) = [c]
+showKey Vty.KUp = "↑"
+showKey Vty.KDown = "↓"
+showKey key = tail (show key)
+
+showMod :: Vty.Modifier -> String
+showMod = tail . show
+
+
+-- I refuse to give this a type signature. 
+
+-- | Given a lens, zoom on it. It is needed because Brick uses microlens but GHCup uses optics.
+zoom l = Brick.zoom (toLensVL l)
+
+data BrickData = BrickData
+  { _lr    :: [ListResult]
+  }
+  deriving Show
+
+makeLenses ''BrickData
+
+data BrickSettings = BrickSettings { _showAllVersions :: Bool}
+  --deriving Show
+
+makeLenses ''BrickSettings
+
+defaultAppSettings :: BrickSettings
+defaultAppSettings = BrickSettings { _showAllVersions = False}

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

@@ -0,0 +1,80 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-
+A very simple information-only widget with no handler. 
+-}
+
+module GHCup.Brick.Widgets.KeyInfo where
+
+import           GHCup.Types ( KeyBindings(..), KeyCombination(KeyCombination) )
+import qualified GHCup.Brick.Common as Common
+
+
+import Brick
+    ( Padding(Max),
+      Widget(..), 
+      (<+>),
+      (<=>))
+import qualified Brick
+import           Brick.Widgets.Border ( borderWithLabel)
+import           Brick.Widgets.Border.Style ( unicode )
+import           Brick.Widgets.Center ( center, centerLayer )
+import           Data.List ( intercalate )
+import           Prelude                 hiding ( appendFile )
+
+
+
+draw :: KeyBindings -> Widget Common.Name
+draw KeyBindings {..} =
+  let
+    mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
+    keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (Common.showKey key : (Common.showMod <$> mods))
+  in centerLayer
+      $ Brick.hLimitPercent 75
+      $ Brick.vLimitPercent 50
+      $ Brick.withBorderStyle unicode
+      $ borderWithLabel (Brick.txt "Key Actions")
+      $ Brick.vBox [
+        center $
+         mkTextBox [
+            Brick.hBox [
+              Brick.txt "Press "
+            , keyToWidget bUp, Brick.txt " and ", keyToWidget bDown
+            , Brick.txtWrap " to navigate the list of tools"
+            ]
+          , Brick.hBox [
+              Brick.txt "Press "
+            , keyToWidget bInstall
+            , Brick.txtWrap " to install the selected tool. Notice, you may need to set it as default afterwards"
+            ]
+          , Brick.hBox [
+              Brick.txt "Press "
+            , keyToWidget bSet
+            , Brick.txtWrap " to set a tool as the one for use"
+            ]
+          , Brick.hBox [
+              Brick.txt "Press "
+            , keyToWidget bUninstall
+            , Brick.txtWrap " to uninstall a tool"
+            ]
+          , Brick.hBox [
+              Brick.txt "Press "
+            , keyToWidget bChangelog
+            , Brick.txtWrap " to open the tool's changelog. It will open a web browser"
+            ]
+          , Brick.hBox [
+              Brick.txt "Press "
+            , keyToWidget bShowAllVersions
+            , Brick.txtWrap " to show older version of each tool"
+            ]
+          ]
+        ]
+      <=> Brick.hBox [Brick.txt "Press q to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]

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

@@ -0,0 +1,148 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{- Brick's navigation widget:
+It is a FocusRing over many list's. Each list contains the information for each tool. Each list has an internal name (for Brick's runtime)
+and a label which we can use in rendering. This data-structure helps to reuse Brick.Widget.List and to navegate easily across
+
+-}
+
+
+module GHCup.Brick.Widgets.Navigation (BrickInternalState, create, handler, draw) where
+
+import GHCup.List ( ListResult(..) )
+import GHCup.Types
+    ( GHCTargetVersion(GHCTargetVersion),
+      Tool(..),
+      Tag(..),
+      tVerToText,
+      tagToString )
+import qualified GHCup.Brick.Common as Common
+import qualified GHCup.Brick.Attributes as Attributes
+import qualified GHCup.Brick.Widgets.SectionList as SectionList
+import Brick
+    ( BrickEvent(..),
+      Padding(Max, Pad),
+      AttrMap,
+      EventM,
+      Widget(..),
+      (<+>),
+      (<=>))
+import qualified Brick
+import           Brick.Widgets.Border ( hBorder, borderWithLabel)
+import           Brick.Widgets.Border.Style ( unicode )
+import           Brick.Widgets.Center ( center )
+import qualified Brick.Widgets.List as L
+import           Data.List ( intercalate, sort )
+import           Data.Maybe ( mapMaybe )
+import           Data.Vector ( Vector)
+import           Data.Versions ( prettyPVP, prettyVer )
+import           Prelude                 hiding ( appendFile )
+import qualified Data.Text                     as T
+import qualified Data.Vector                   as V
+
+
+type BrickInternalState = SectionList.SectionList Common.Name ListResult
+
+-- | How to create a navigation widget
+create :: Common.Name                         -- The name of the section list
+       -> [(Common.Name, Vector ListResult)]  -- a list of tuples (section name, collection of elements)
+       -> Int                                 -- The height of each item in a list. Commonly 1 
+       -> BrickInternalState
+create = SectionList.sectionList
+
+-- | How the navigation handler handle events
+handler :: BrickEvent Common.Name e -> EventM Common.Name BrickInternalState ()
+handler = SectionList.handleGenericListEvent
+
+-- | How to draw the navigation widget
+draw :: AttrMap -> BrickInternalState -> Widget Common.Name
+draw dimAttrs section_list
+  = Brick.padBottom Max
+      ( Brick.withBorderStyle unicode
+        $ borderWithLabel (Brick.str "GHCup")
+          (center (header <=> hBorder <=> renderList' section_list))
+      )
+ where
+  header =
+    minHSize 2 Brick.emptyWidget
+      <+> Brick.padLeft (Pad 2) (minHSize 6 $ Brick.str "Tool")
+      <+> minHSize 15 (Brick.str "Version")
+      <+> Brick.padLeft (Pad 1) (minHSize 25 $ Brick.str "Tags")
+      <+> Brick.padLeft (Pad 5) (Brick.str "Notes")
+  renderList' bis =
+    let allElements = V.concatMap L.listElements $ SectionList.sectionListElements bis
+        minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) allElements
+        minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) allElements
+    in Brick.withDefAttr L.listAttr $ SectionList.renderSectionList (renderItem minTagSize minVerSize) True bis
+  renderItem minTagSize minVerSize b listResult@ListResult{lTag = lTag', ..} =
+    let marks = if
+          | lSet       -> (Brick.withAttr Attributes.setAttr $ Brick.str Common.setSign)
+          | lInstalled -> (Brick.withAttr Attributes.installedAttr $ Brick.str Common.installedSign)
+          | otherwise  -> (Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign)
+        ver = case lCross of
+          Nothing -> T.unpack . prettyVer $ lVer
+          Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
+        dim
+          | lNoBindist && not lInstalled
+            && not b -- TODO: overloading dim and active ignores active
+                       --       so we hack around it here
+          = Brick.updateAttrMap (const dimAttrs) . Brick.withAttr (Brick.attrName "no-bindist")
+          | otherwise  = id
+        hooray
+          | elem Latest lTag' && not lInstalled =
+              Brick.withAttr Attributes.hoorayAttr
+          | otherwise = id
+    in  hooray $ dim
+          (   marks
+          <+> Brick.padLeft (Pad 2)
+               ( minHSize 6
+                 (printTool lTool)
+               )
+          <+> minHSize minVerSize (Brick.str ver)
+          <+> (let l = mapMaybe printTag $ sort lTag'
+               in  Brick.padLeft (Pad 1) $ minHSize minTagSize $ if null l
+                     then Brick.emptyWidget
+                     else foldr1 (\x y -> x <+> Brick.str "," <+> y) l
+              )
+          <+> Brick.padLeft (Pad 5)
+              ( let notes = printNotes listResult
+                in  if null notes
+                      then Brick.emptyWidget
+                      else foldr1 (\x y -> x <+> Brick.str "," <+> y) notes
+              )
+          <+> Brick.vLimit 1 (Brick.fill ' ')
+          )
+
+  printTag Recommended    = Just $ Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
+  printTag Latest         = Just $ Brick.withAttr Attributes.latestAttr $ Brick.str "latest"
+  printTag Prerelease     = Just $ Brick.withAttr Attributes.prereleaseAttr $ Brick.str "prerelease"
+  printTag Nightly        = Just $ Brick.withAttr Attributes.nightlyAttr $ Brick.str "nightly"
+  printTag (Base pvp'')   = Just $ Brick.str ("base-" ++ T.unpack (prettyPVP pvp''))
+  printTag Old            = Nothing
+  printTag LatestPrerelease = Just $ Brick.withAttr Attributes.latestPrereleaseAttr $ Brick.str "latest-prerelease"
+  printTag LatestNightly    = Just $ Brick.withAttr Attributes.latestNightlyAttr $ Brick.str "latest-nightly"
+  printTag (UnknownTag t) = Just $ Brick.str t
+
+  printTool Cabal = Brick.str "cabal"
+  printTool GHC = Brick.str "GHC"
+  printTool GHCup = Brick.str "GHCup"
+  printTool HLS = Brick.str "HLS"
+  printTool Stack = Brick.str "Stack"
+
+  printNotes ListResult {..} =
+    (if hlsPowered then [Brick.withAttr Attributes.hlsPoweredAttr $ Brick.str "hls-powered"] else mempty
+      )
+      ++ (if lStray then [Brick.withAttr Attributes.strayAttr $ Brick.str "stray"] else mempty)
+      ++ (case lReleaseDay of
+            Nothing -> mempty
+            Just d  -> [Brick.withAttr Attributes.dayAttr $ Brick.str (show d)])
+
+  minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ')

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

@@ -0,0 +1,192 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE ViewPatterns      #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE InstanceSigs #-}
+
+{- A general system for lists with sections
+
+Consider this code as private. GenericSectionList should not be used directly as the FocusRing should be align with the Vector containing 
+the elements, otherwise you'd be focusing on a non-existent widget with unknown result (In theory the code is safe unless you have an empty section list). 
+
+- To build a SectionList use the safe constructor sectionList
+- To access sections use the lens provider sectionL and the name of the section you'd like to access
+- You can modify Brick.Widget.List.GenericList within GenericSectionList via sectionL but do not
+  modify the vector length
+
+-}
+
+
+module GHCup.Brick.Widgets.SectionList where
+
+
+import Brick
+    ( BrickEvent(VtyEvent, MouseDown),
+      EventM,
+      Size(..),
+      Widget(..), 
+      ViewportType (Vertical),
+      (<=>))
+import qualified Brick
+import           Brick.Widgets.Border ( hBorder)
+import qualified Brick.Widgets.List as L
+import           Brick.Focus (FocusRing)
+import qualified Brick.Focus as F
+import           Data.Function ( (&))
+import Data.Maybe ( fromMaybe )
+import           Data.Vector ( Vector )
+import qualified GHCup.Brick.Common as Common
+import           Prelude                 hiding ( appendFile )
+
+import qualified Graphics.Vty                  as Vty
+import qualified Data.Vector                   as V
+
+import           Optics.TH (makeLensesFor)
+import           Optics.State (use)
+import           Optics.State.Operators ( (%=), (<%=))
+import           Optics.Operators ((.~), (^.))
+import           Optics.Lens (Lens', lens)
+
+data GenericSectionList n t e
+    = GenericSectionList
+    { sectionListFocusRing :: FocusRing n                   -- ^ The FocusRing for all sections
+    , sectionListElements :: !(Vector (L.GenericList n t e)) -- ^ A vector of brick's built-in list
+    , sectionListName :: n                                   -- ^ The section list name
+    }
+
+makeLensesFor [("sectionListFocusRing", "sectionListFocusRingL"), ("sectionListElements", "sectionListElementsL"), ("sectionListName", "sectionListNameL")] ''GenericSectionList
+
+type SectionList n e = GenericSectionList n V.Vector e
+
+
+-- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses. 
+sectionList :: Foldable t 
+            => n                     -- The name of the section list
+            -> [(n, t e)]            -- a list of tuples (section name, collection of elements)
+            -> Int
+            -> GenericSectionList n t e
+sectionList name elements height
+  = GenericSectionList
+  { sectionListFocusRing = F.focusRing [section_name | (section_name, _) <- elements]
+  , sectionListElements  = V.fromList [L.list section_name els height | (section_name, els) <- elements]
+  , sectionListName = name
+  }
+-- | This lens constructor, takes a name and looks if a section has such a name.
+--   Used to dispatch events to sections. It is a partial function only meant to 
+--   be used with the FocusRing inside GenericSectionList
+sectionL :: Eq n => n -> Lens' (GenericSectionList n t e) (L.GenericList n t e)
+sectionL section_name = lens g s
+    where is_section_name = (== section_name) . L.listName
+          g section_list =
+            let elms   = section_list ^. sectionListElementsL
+                zeroth = elms V.! 0 -- TODO: This crashes for empty vectors. 
+            in fromMaybe zeroth (V.find is_section_name elms)
+          s gl@(GenericSectionList _ elms _) list =
+            case V.findIndex is_section_name elms of
+                 Nothing -> gl
+                 Just i  -> let new_elms = V.update elms (V.fromList [(i, list)])
+                             in gl & sectionListElementsL .~ new_elms
+
+moveDown :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) ()
+moveDown = do 
+    ring <- use sectionListFocusRingL
+    case F.focusGetCurrent ring of 
+        Nothing -> pure ()
+        Just l  -> do      -- If it is the last element, move to the first element of the next focus; else, just handle regular list event.
+            current_list <- use (sectionL l)
+            let current_idx = L.listSelected current_list
+                list_length = current_list & length
+            if current_idx == Just (list_length - 1)
+                then do 
+                    new_focus <- sectionListFocusRingL <%= F.focusNext
+                    case F.focusGetCurrent new_focus of
+                        Nothing -> pure () -- |- Optic.Zoom.zoom doesn't typecheck but Lens.Micro.Mtl.zoom does. It is re-exported by Brick
+                        Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToBeginning)
+                else Common.zoom  (sectionL l) $ Brick.modify L.listMoveDown
+
+moveUp :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) ()
+moveUp = do
+    ring <- use sectionListFocusRingL
+    case F.focusGetCurrent ring of
+        Nothing -> pure ()
+        Just l  -> do  -- If it is the first element, move to the last element of the prev focus; else, just handle regular list event.
+            current_list <- use (sectionL l)
+            let current_idx = L.listSelected current_list
+            if current_idx == Just 0
+                then do 
+                    new_focus <- sectionListFocusRingL <%= F.focusPrev
+                    case F.focusGetCurrent new_focus of
+                        Nothing -> pure ()  
+                        Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToEnd)
+                else Common.zoom (sectionL l) $ Brick.modify L.listMoveUp
+
+-- | Handle events for list cursor movement.  Events handled are:
+--
+-- * Up (up arrow key). If first element of section, then jump prev section
+-- * Down (down arrow key). If last element of section, then jump next section
+-- * Page Up (PgUp)
+-- * Page Down (PgDown)
+-- * Go to next section (Tab)
+-- * Go to prev section (BackTab)
+handleGenericListEvent :: (Foldable t, L.Splittable t, Ord n)
+                       => BrickEvent n a
+                       -> EventM n (GenericSectionList n t e) ()
+handleGenericListEvent (VtyEvent (Vty.EvResize _ _))              = pure ()
+handleGenericListEvent (VtyEvent (Vty.EvKey (Vty.KChar '\t') [])) = sectionListFocusRingL %= F.focusNext
+handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KBackTab []))     = sectionListFocusRingL %= F.focusPrev
+handleGenericListEvent (MouseDown _ Vty.BScrollDown _ _)          = moveDown
+handleGenericListEvent (MouseDown _ Vty.BScrollUp _ _)            = moveUp
+handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KDown []))        = moveDown
+handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KUp []))          = moveUp
+handleGenericListEvent (VtyEvent ev) = do
+    ring <- use sectionListFocusRingL
+    case F.focusGetCurrent ring of
+        Nothing -> pure ()
+        Just l  -> Common.zoom (sectionL l) $ L.handleListEvent ev
+handleGenericListEvent _ = pure ()
+
+-- This re-uses Brick.Widget.List.renderList
+renderSectionList :: (Traversable t, Ord n, Show n, Eq n, L.Splittable t)
+                  => (Bool -> e -> Widget n)             -- ^ Rendering function of the list element, True for the selected element
+                  -> Bool                                -- ^ Whether the section list has focus
+                  -> GenericSectionList n t e            -- ^ The section list to render
+                  -> Widget n
+renderSectionList render_elem section_focus (GenericSectionList focus elms sl_name) =
+    Brick.Widget Brick.Greedy Brick.Greedy $ do
+        c <- Brick.getContext
+        let -- A section is focused if the whole thing is focused, and the inner list has focus
+            section_is_focused l = section_focus && (Just (L.listName l) == F.focusGetCurrent focus)
+            -- We need to limit the widget size when the length of the list is higher than the size of the terminal
+            limit = min (Brick.windowHeight c) (Brick.availHeight c)
+            s_idx = fromMaybe 0 $ V.findIndex section_is_focused elms
+            render_inner_list has_focus l = Brick.vLimit (length l) $ L.renderList (\b -> render_elem (b && has_focus)) has_focus l
+            (widget, off) = 
+                V.ifoldl' (\wacc i list ->
+                                let has_focus_list = section_is_focused list
+                                    (!acc_widget, !acc_off) = wacc
+                                    new_widget = if i == 0 then render_inner_list has_focus_list list else hBorder <=> render_inner_list has_focus_list list
+                                    new_off 
+                                        | i < s_idx  = 1 + L.listItemHeight list * length list 
+                                        | i == s_idx = 1 + L.listItemHeight list * fromMaybe 0 (L.listSelected list)
+                                        | otherwise  = 0
+                                in  (acc_widget <=> new_widget, acc_off + new_off)
+                                )
+                (Brick.emptyWidget, 0)
+                elms
+        Brick.render $  Brick.viewport sl_name Brick.Vertical $ Brick.translateBy (Brick.Location (0, min 0 (limit-off))) widget
+
+-- | Equivalent to listSelectedElement
+sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e)
+sectionListSelectedElement generic_section_list = do
+  current_focus <- generic_section_list ^. sectionListFocusRingL & F.focusGetCurrent 
+  let current_section = generic_section_list ^. sectionL current_focus
+  L.listSelectedElement current_section 

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

@@ -0,0 +1,84 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-
+A very simple information-only widget with no handler. 
+-}
+
+module GHCup.Brick.Widgets.Tutorial (draw) where
+
+import qualified GHCup.Brick.Common as Common
+import qualified GHCup.Brick.Attributes as Attributes
+
+import Brick
+    ( Padding(Max),
+      Widget(..),
+      (<+>),
+      (<=>))
+import qualified Brick
+import           Brick.Widgets.Border ( hBorder, borderWithLabel)
+import           Brick.Widgets.Border.Style ( unicode )
+import           Brick.Widgets.Center ( center, centerLayer )
+import           Prelude                 hiding ( appendFile )
+
+
+
+draw :: Widget Common.Name
+draw =
+  let
+    mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
+    txt_separator = hBorder <+> Brick.str " o " <+> hBorder
+  in centerLayer
+      $ Brick.hLimitPercent 75
+      $ Brick.vLimitPercent 50
+      $ Brick.withBorderStyle unicode
+      $ borderWithLabel (Brick.txt "Tutorial")
+      $ Brick.vBox
+          (fmap center
+            [ mkTextBox [Brick.txtWrap "GHCup is a distribution channel for Haskell's tools."]
+            , txt_separator
+            , mkTextBox [
+                Brick.hBox [
+                  Brick.txt "This symbol "
+                , Brick.withAttr Attributes.installedAttr (Brick.str Common.installedSign)
+                , Brick.txtWrap " means that the tool is installed but not in used"
+                ]
+              , Brick.hBox [
+                  Brick.txt "This symbol "
+                , Brick.withAttr Attributes.setAttr (Brick.str Common.setSign)
+                , Brick.txtWrap " means that the tool is installed and in used"
+                ]
+              , Brick.hBox [
+                  Brick.txt "This symbol "
+                , Brick.withAttr Attributes.notInstalledAttr (Brick.str Common.notInstalledSign)
+                , Brick.txt " means that the tool isn't installed"
+                ]
+              ]
+            , txt_separator
+            , mkTextBox [
+                Brick.hBox [
+                  Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
+                , Brick.txtWrap " tag is based on community adoption, known bugs, etc... So It makes this version the least experimental"
+                ]
+              , Brick.hBox [
+                  Brick.withAttr Attributes.latestAttr $ Brick.str "latest"
+                , Brick.txtWrap " tag is for the latest distributed version of the tool"
+                ]
+              , Brick.hBox [
+                  Brick.withAttr Attributes.latestAttr $ Brick.str "hls-powered"
+                , Brick.txt " denotes the compiler version supported by the currently set ("
+                , Brick.withAttr Attributes.setAttr (Brick.str Common.setSign)
+                , Brick.txt ") hls"
+                ]
+              , Brick.txtWrap "base-X.Y.Z.W tag is the minimun version of the base package admited in such ghc version"
+              ]
+            , Brick.txt " "
+            ])
+        <=> Brick.padRight Brick.Max (Brick.txt "Press q to exit the tutorial")

lib-tui/GHCup/BrickMain.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-
+This module contains the entrypoint for the brick application and nothing else.
+
+-}
+
+module GHCup.BrickMain where
+
+import GHCup.Types
+    ( Settings(noColor),
+      AppState(ghcupInfo, settings, keyBindings, loggerConfig) )
+import GHCup.Prelude.Logger ( logError )
+import qualified GHCup.Brick.Actions as Actions
+import qualified GHCup.Brick.Common as Common
+import qualified GHCup.Brick.App as BrickApp
+import qualified GHCup.Brick.Attributes as Attributes
+import qualified GHCup.Brick.BrickState as AppState
+import qualified Brick
+
+import Control.Monad.Reader ( ReaderT(runReaderT) )
+import Data.Functor ( ($>) )
+import           Data.IORef (writeIORef)
+import           Prelude                 hiding ( appendFile )
+import System.Exit ( ExitCode(ExitFailure), exitWith )
+
+import qualified Data.Text                     as T
+
+
+
+brickMain :: AppState
+          -> IO ()
+brickMain s = do
+  writeIORef Actions.settings' s
+
+  eAppData <- Actions.getAppData (Just $ ghcupInfo s)
+  case eAppData of
+    Right ad ->
+      Brick.defaultMain
+          (BrickApp.app (Attributes.defaultAttributes (noColor $ settings s))
+                        (Attributes.dimAttributes (noColor $ settings s)))
+          (AppState.BrickState ad
+                    Common.defaultAppSettings
+                    (Actions.constructList ad Common.defaultAppSettings Nothing)
+                    (keyBindings (s :: AppState))
+                    Common.Navigation
+
+          )
+        $> ()
+    Left e -> do
+      flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
+      exitWith $ ExitFailure 2