Avance Install Functionality. Bug

Better aesth for context menu
Add visuals for compile Menu
2024-03-02 01:04:03 +08:00 · 2024-03-02 01:04:03 +08:00 · 2024-03-02 01:04:03 +08:00 · 2024-03-02 01:04:03 +08:00 · 2024-03-02 01:04:02 +08:00 · 2024-03-02 01:04:02 +08:00
17 changed files with 2438 additions and 1 deletions
--- a/app/ghcup/Main.hs
+++ b/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
--- a/ghcup.cabal
+++ b/ghcup.cabal
@ -323,6 +323,61 @@ 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.Widgets.Menu
    GHCup.Brick.Widgets.Menus.Context
    GHCup.Brick.Widgets.Menus.AdvanceInstall
    GHCup.Brick.Widgets.Menus.CompileGHC
    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 +401,7 @@ executable ghcup
  build-depends:
    , ghcup
    , ghcup-optparse
    , ghcup-tui
  if flag(internal-downloader)
    cpp-options: -DINTERNAL_DOWNLOADER
--- a/hie.yaml
+++ b/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"
--- a/lib-tui/GHCup/Brick/Actions.hs
+++ b/lib-tui/GHCup/Brick/Actions.hs
@ -0,0 +1,551 @@
 {-# 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, runBothE' )
 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 qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
 import           GHCup.Brick.Widgets.Navigation (BrickInternalState)
 import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
 import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
 import qualified Brick
 import qualified Brick.Widgets.List as L
 import qualified Brick.Focus as F
 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)
 import Optics.Optic ((%))
 import Optics ((^.), to)
 {- 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 bst =
  let newInternalState = constructList appD (bst ^. appSettings) (Just (bst ^. appState))
  in  bst
        & appState .~ newInternalState
        & appData .~ appD
        & 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
 installWithOptions :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
         => AdvanceInstall.InstallOptions
         -> (Int, ListResult)
         -> m (Either String ())
 installWithOptions opts (_, ListResult {..}) = do
  AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
  let 
    misolated = opts ^. AdvanceInstall.isolateDirL
    shouldIsolate = maybe GHCupInternal IsolateDir (opts ^. AdvanceInstall.isolateDirL)
    shouldForce   = opts ^. AdvanceInstall.forceInstallL
    shouldSet     = opts ^. AdvanceInstall.instSetL
    extraArgs     = opts ^. AdvanceInstall.addConfArgsL
    v = GHCTargetVersion lCross lVer
  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
              , InstallSetError
              ]
  run (do
      ce <- liftIO $ fmap (either (const Nothing) Just) $
        try @_ @SomeException $ getExecutablePath >>= canonicalizePath
      dirs <- lift getDirs
      case lTool of
        GHC   -> do
          let vi = getVersionInfo v GHC dls
          case opts ^. AdvanceInstall.instBindistL of
            Nothing -> do
              liftE $
                runBothE' 
                  (installGHCBin v shouldIsolate shouldForce  extraArgs)
                  (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
              pure (vi, dirs, ce) 
            Just uri -> do
              liftE $
                runBothE' 
                  (installGHCBindist
                      (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing) 
                      v
                      shouldIsolate
                      shouldForce
                      extraArgs)
                  (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
              pure (vi, dirs, ce)
        Cabal -> do
          let vi = getVersionInfo v Cabal dls
          case opts ^. AdvanceInstall.instBindistL of
            Nothing -> do
              liftE $ 
                runBothE' 
                  (installCabalBin lVer shouldIsolate shouldForce)
                  (when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
              pure (vi, dirs, ce)
            Just uri -> do
              liftE $ 
                runBothE' 
                  (installCabalBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
                  (when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
              pure (vi, dirs, ce)
        GHCup -> do
          let vi = snd <$> getLatest dls GHCup
          liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
        HLS   -> do          
          let vi = getVersionInfo v HLS dls
          case opts ^. AdvanceInstall.instBindistL of
            Nothing -> do
              liftE $ 
                runBothE' 
                  (installHLSBin lVer shouldIsolate shouldForce)
                  (when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing))
              pure (vi, dirs, ce) 
            Just uri -> do
              liftE $ 
                runBothE'                 
                  (installHLSBindist 
                    (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
                    lVer
                    shouldIsolate
                    shouldForce)
                  (when (shouldSet && isNothing misolated)  (liftE $ void $ setHLS lVer SetHLSOnly Nothing))
              pure (vi, dirs, ce)
        Stack -> do
          let vi = getVersionInfo v Stack dls
          case opts ^. AdvanceInstall.instBindistL of
            Nothing -> do
              liftE $
                runBothE' 
                  (installStackBin lVer shouldIsolate shouldForce)
                  (when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
              pure (vi, dirs, ce)
            Just uri -> do
              liftE $
                runBothE' 
                  (installStackBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
                  (when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
              pure (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"
 install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) 
         => (Int, ListResult) -> m (Either String ())
 install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing False [])
 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)
  , (KeyCombination Vty.KEnter [], const "advance options", createMenuforTool )
  ]
 where
  createMenuforTool = do 
    e <- use (appState % to sectionListSelectedElement)
    case e of
      Nothing     -> pure ()
      Just (_, r) -> do
        -- Create new menus
        contextMenu .= ContextMenu.create r bQuit
        advanceInstallMenu .= AdvanceInstall.create bQuit
        compileGHCMenu .= CompileGHC.create bQuit
        -- Set mode to context
        mode           .= ContextPanel
    pure ()
  --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)
--- a/lib-tui/GHCup/Brick/App.hs
+++ b/lib-tui/GHCup/Brick/App.hs
@ -0,0 +1,184 @@
 {-# 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 qualified GHCup.Brick.Actions as Actions
 import qualified GHCup.Brick.Attributes as Attributes
 import GHCup.Brick.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode, compileGHCMenu)
 import GHCup.Brick.Common (Mode (..), Name (..))
 import qualified GHCup.Brick.Common as Common
 import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo
 import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
 import qualified GHCup.Brick.Widgets.Navigation as Navigation
 import qualified GHCup.Brick.Widgets.Tutorial as Tutorial
 import qualified GHCup.Brick.Widgets.Menu as Menu
 import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
 import GHCup.Types (AppState (AppState, keyBindings), KeyCombination (KeyCombination))
 import qualified Brick.Focus as F
 import Brick (
  App (..),
  AttrMap,
  BrickEvent (VtyEvent),
  EventM,
  Widget (..),
  (<=>),
 )
 import qualified Brick
 import Control.Monad.Reader (
  MonadIO (liftIO),
  void,
 )
 import Data.IORef (readIORef)
 import Data.List (find, intercalate)
 import Prelude hiding (appendFile)
 import qualified Graphics.Vty as Vty
 import qualified Data.Text as T
 import Optics.Getter (to)
 import Optics.Operators ((^.))
 import Optics.Optic ((%))
 import Optics.State (use)
 import Optics.State.Operators ((.=))
 import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
 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]
       ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg]
       AdvanceInstallPanel -> [AdvanceInstall.draw (st ^. advanceInstallMenu), navg]
       CompileGHCPanel     -> [CompileGHC.draw (st ^. compileGHCMenu), 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
 contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState ()
 contextMenuHandler ev = do
  ctx <- use contextMenu 
  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
      buttons = ctx ^. Menu.menuButtonsL
      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
  case (ev, focusedElement) of
    (_ , Nothing) -> pure ()
    (VtyEvent (Vty.EvKey k m), Just n) 
      |  k == exitKey 
          && m == mods 
          && n `elem` [Menu.fieldName button | button <- buttons]
      -> mode .= Navigation
    (VtyEvent (Vty.EvKey Vty.KEnter []),  Just (Common.MenuElement Common.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel
    (VtyEvent (Vty.EvKey Vty.KEnter []),  Just (Common.MenuElement Common.CompilieButton) ) -> mode .= Common.CompileGHCPanel
    _ -> Common.zoom contextMenu $ ContextMenu.handler ev
 -- 
 advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState ()
 advanceInstallHandler ev = do
  ctx <- use advanceInstallMenu 
  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
      buttons = ctx ^. Menu.menuButtonsL
      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
  case (ev, focusedElement) of
    (_ , Nothing) -> pure ()
    (VtyEvent (Vty.EvKey k m), Just n)
        | k == exitKey
            && m == mods
            && n `elem` [Menu.fieldName button | button <- buttons]
        -> mode .= ContextPanel
    (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
        let iopts = ctx ^. Menu.menuStateL
        Actions.withIOAction $ Actions.installWithOptions iopts
    _ -> Common.zoom advanceInstallMenu $ AdvanceInstall.handler ev
 compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
 compileGHCHandler ev = do
  ctx <- use compileGHCMenu 
  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
      buttons = ctx ^. Menu.menuButtonsL
      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
  case (ev, focusedElement) of
    (_ , Nothing) -> pure ()
    (VtyEvent (Vty.EvKey k m), Just n)
      | k == exitKey
          && m == mods
          && n `elem` [Menu.fieldName button | button <- buttons]
      -> mode .= ContextPanel
    _ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
 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
    ContextPanel -> contextMenuHandler ev
    AdvanceInstallPanel -> advanceInstallHandler ev
    CompileGHCPanel     -> compileGHCHandler ev
--- a/lib-tui/GHCup/Brick/Attributes.hs
+++ b/lib-tui/GHCup/Brick/Attributes.hs
@ -0,0 +1,86 @@
 {-# 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)
  , (helpMsgAttr               , Vty.defAttr `withForeColor` Vty.brightBlack)
  , (errMsgAttr                , Vty.defAttr `withForeColor` Vty.red)
  ]
  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, helpMsgAttr, errMsgAttr :: 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"
 helpMsgAttr = Brick.attrName "helpMsg"
 errMsgAttr = Brick.attrName "errMsg"
 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
--- a/lib-tui/GHCup/Brick/BrickState.hs
+++ b/lib-tui/GHCup/Brick/BrickState.hs
@ -0,0 +1,52 @@
 {-# 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 GHCup.Brick.Widgets.Menus.Context (ContextMenu)
 import GHCup.Brick.Widgets.Menus.AdvanceInstall (AdvanceInstallMenu)
 import GHCup.Brick.Widgets.Menus.CompileGHC (CompileGHCMenu)
 import Optics.TH                      (makeLenses)
 data BrickState = BrickState
  { _appData            :: BrickData
  , _appSettings        :: BrickSettings
  , _appState           :: BrickInternalState
  , _contextMenu        :: ContextMenu
  , _advanceInstallMenu :: AdvanceInstallMenu
  , _compileGHCMenu     :: CompileGHCMenu
  , _appKeys            :: KeyBindings
  , _mode               :: Mode
  }
  --deriving Show
 makeLenses ''BrickState
--- a/lib-tui/GHCup/Brick/Common.hs
+++ b/lib-tui/GHCup/Brick/Common.hs
@ -0,0 +1,204 @@
 {-# 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 #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-
 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  (
  installedSign,
  setSign,
  notInstalledSign,
  showKey,
  showMod,
  keyToWidget,
  separator,
  frontwardLayer,
  zoom,
  defaultAppSettings,
  lr,
  showAllVersions,
  Name(..),
  Mode(..),
  BrickData(..),
  BrickSettings(..),
  ResourceId (
      UrlEditBox, SetCheckBox, IsolateEditBox, ForceCheckBox, AdditionalEditBox
    , TargetGhcEditBox, BootstrapGhcEditBox, JobsEditBox, BuildConfigEditBox
    , PatchesEditBox, CrossTargetEditBox, AddConfArgsEditBox, OvewrwiteVerEditBox
    , BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
    , CompilieButton
  ) ) where
 import           GHCup.List ( ListResult )
 import           GHCup.Types ( Tool, KeyCombination (KeyCombination) )
 import Data.List (intercalate)
 import           Prelude                 hiding ( appendFile )
 import qualified Graphics.Vty                  as Vty
 import           Optics.TH (makeLenses)
 import           Optics.Lens (toLensVL)
 import qualified Brick
 import qualified Brick.Widgets.Border as Border
 import Brick ((<+>))
 import qualified Data.Text as T
 import qualified Brick.Widgets.Center as Brick
 import qualified Brick.Widgets.Border.Style as Border
 -- We could use regular ADTs but different menus share the same options.
 -- example: all of ghcup compile ghc, ghcup compile hls, ghcup install cabal, etc...
 -- all have a --set, --force, etc... common arguments. If we went for the ADT we'd end up
 -- with SetCompileHLSOption, SetCompileGHCOption, SetInstallCabalOption, etc...
 -- which isn't terrible, but verbose enough to reject it.
 -- | A newtype for labeling resources in menus. It is bundled along with pattern synonyms
 newtype ResourceId = ResourceId Int deriving (Eq, Ord, Show)
 pattern OkButton :: ResourceId
 pattern OkButton = ResourceId 0
 pattern AdvanceInstallButton :: ResourceId
 pattern AdvanceInstallButton = ResourceId 100
 pattern CompilieButton :: ResourceId
 pattern CompilieButton = ResourceId 101
 pattern UrlEditBox :: ResourceId
 pattern UrlEditBox = ResourceId 1
 pattern SetCheckBox :: ResourceId
 pattern SetCheckBox = ResourceId 2
 pattern IsolateEditBox :: ResourceId
 pattern IsolateEditBox = ResourceId 3
 pattern ForceCheckBox :: ResourceId
 pattern ForceCheckBox = ResourceId 4
 pattern AdditionalEditBox :: ResourceId
 pattern AdditionalEditBox = ResourceId 5
 pattern TargetGhcEditBox :: ResourceId
 pattern TargetGhcEditBox = ResourceId 6
 pattern BootstrapGhcEditBox :: ResourceId
 pattern BootstrapGhcEditBox = ResourceId 7
 pattern JobsEditBox :: ResourceId
 pattern JobsEditBox = ResourceId 8
 pattern BuildConfigEditBox :: ResourceId
 pattern BuildConfigEditBox = ResourceId 9
 pattern PatchesEditBox :: ResourceId
 pattern PatchesEditBox = ResourceId 10
 pattern CrossTargetEditBox :: ResourceId
 pattern CrossTargetEditBox = ResourceId 11
 pattern AddConfArgsEditBox :: ResourceId
 pattern AddConfArgsEditBox = ResourceId 12
 pattern OvewrwiteVerEditBox :: ResourceId
 pattern OvewrwiteVerEditBox = ResourceId 13
 pattern BuildFlavourEditBox :: ResourceId
 pattern BuildFlavourEditBox = ResourceId 14
 pattern BuildSystemEditBox :: ResourceId
 pattern BuildSystemEditBox = ResourceId 15
 -- | 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
          | ContextBox                 -- ^ The resource for Context Menu
          | CompileGHCBox              -- ^ The resource for CompileGHC Menu 
          | AdvanceInstallBox          -- ^ The resource for AdvanceInstall Menu 
          | MenuElement ResourceId     -- ^ Each element in a Menu. Resources must not be share for visible
                                       --   Menus, but MenuA and MenuB can share resources if they both are
                                       --   invisible, or just one of them is visible.
          deriving (Eq, Ord, Show)
 -- | Mode type. It helps to dispatch events to different handlers.
 data Mode = Navigation
          | KeyInfo
          | Tutorial
          | ContextPanel
          | AdvanceInstallPanel 
          | CompileGHCPanel
          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
 -- | Given a KeyComb, produces a string widget with and user friendly text
 keyToWidget :: KeyCombination -> Brick.Widget n
 keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (showKey key : (showMod <$> mods))
 -- | A section separator with max width. Looks like this:    -------- o --------
 separator :: Brick.Widget n
 separator = Border.hBorder <+> Brick.str " o " <+> Border.hBorder
 -- | Used to create a layer on top of the main navigation widget (tutorial, info, menus...)
 frontwardLayer :: T.Text -> Brick.Widget n -> Brick.Widget n
 frontwardLayer layer_name =
    Brick.centerLayer
      . Brick.hLimitPercent 75
      . Brick.vLimitPercent 50
      . Brick.withBorderStyle Border.unicode
      . Border.borderWithLabel (Brick.txt layer_name)
 -- 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 False
--- a/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs
+++ b/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs
@ -0,0 +1,72 @@
 {-# 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(..) )
 import qualified GHCup.Brick.Common as Common
 import Brick
    ( Padding(Max),
      Widget(..), 
      (<+>),
      (<=>))
 import qualified Brick
 import           Brick.Widgets.Center ( center )
 import           Prelude                 hiding ( appendFile )
 draw :: KeyBindings -> Widget Common.Name
 draw KeyBindings {..} =
  let
    mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
  in Common.frontwardLayer "Key Actions"
      $ Brick.vBox [
        center $
         mkTextBox [
            Brick.hBox [
              Brick.txt "Press "
            , Common.keyToWidget bUp, Brick.txt " and ", Common.keyToWidget bDown
            , Brick.txtWrap " to navigate the list of tools"
            ]
          , Brick.hBox [
              Brick.txt "Press "
            , Common.keyToWidget bInstall
            , Brick.txtWrap " to install the selected tool. Notice, you may need to set it as default afterwards"
            ]
          , Brick.hBox [
              Brick.txt "Press "
            , Common.keyToWidget bSet
            , Brick.txtWrap " to set a tool as the one for use"
            ]
          , Brick.hBox [
              Brick.txt "Press "
            , Common.keyToWidget bUninstall
            , Brick.txtWrap " to uninstall a tool"
            ]
          , Brick.hBox [
              Brick.txt "Press "
            , Common.keyToWidget bChangelog
            , Brick.txtWrap " to open the tool's changelog. It will open a web browser"
            ]
          , Brick.hBox [
              Brick.txt "Press "
            , Common.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"]
--- a/lib-tui/GHCup/Brick/Widgets/Menu.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Menu.hs
@ -0,0 +1,360 @@
 {-# 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 #-}
 {-# LANGUAGE GADTs #-}
 {- **************
 A general system inspired by Brick.Form. It uses optics instead of microlenses and it is less generic than
 Brick.Form, but generic enough to serve our purpose.
 A Menu consists in
  a) A state value
  b) A list of fields. Each field is capable of modifying a part of the state
  c) some metadata
 A field (type MenuField) consists in
  a) a Lens to a part of the Menu state, so the Menu can call that lens to modify its own state
  b) an input widget
 An input (type FieldInput) consist in
  a) some state
  b) a validator function
  c) a handler and a renderer
 We have to use existential types to achive a composable API since every FieldInput has a different 
 internal type, and every MenuField has a different Lens. For example: 
  - The menu state is a record (MyRecord {uri: URI, flag : Bool}) 
  - Then, there are two MenuField:
    - One MenuField has (Lens' MyRecord URI) and the other has (Lens' MyRecord Bool)
    - The MenuFields has FieldInputs with internal state Text and Bool, respectively
  - Obviously, the MenuField has to be polimorphic in the Lens' and in the Input internal state,
    But we must hide that polimorphisim (existential), in order to store all MenuField in a List
 ************** -}
 module GHCup.Brick.Widgets.Menu where
 import qualified GHCup.Brick.Attributes as Attributes
 import qualified GHCup.Brick.Common as Common
 import Brick
    ( BrickEvent(..),
      EventM,
      Widget(..),
      (<+>))
 import qualified Brick
 import qualified Brick.Widgets.Border as Border
 import qualified Brick.Widgets.List as L
 import qualified Brick.Widgets.Edit as Edit
 import           Brick.Focus (FocusRing)
 import qualified Brick.Focus as F
 import           Data.Function ( (&))
 import           Prelude             hiding ( appendFile )
 import qualified Data.Text                     as T
 import           Optics.TH (makeLensesFor)
 import qualified Graphics.Vty as Vty
 import Optics.State.Operators ((%=), (.=))
 import Optics.Optic ((%))
 import Optics.State (use)
 import GHCup.Types (KeyCombination)
 import Optics (Lens', to, lens)
 import Optics.Operators ( (^.), (.~) )
 import Data.Foldable (foldl')
 -- | Just some type synonym to make things explicit
 type Formatter n = Bool -> Widget n -> Widget n
 -- | A label
 type Label = T.Text
 -- | A help message of an entry
 type HelpMessage = T.Text
 -- | A button name
 type ButtonName n = n
 idFormatter :: Formatter n
 idFormatter = const id
 -- | An error message
 type ErrorMessage = T.Text
 data ErrorStatus = Valid | Invalid ErrorMessage
 -- | A lens which does nothing. Usefull to defined no-op fields
 emptyLens :: Lens' s ()
 emptyLens = lens (const ()) (\s _ -> s)
 -- | A FieldInput is a pair label-content
 --   a - is the type of the field it manipulates
 --   b - is its internal state (modified in the gui)
 --   n - your application's resource name type
 data FieldInput a b n =
  FieldInput
    { inputState :: b                                     -- ^ The state of the input field (what's rendered in the screen)
    , inputValidator :: b -> Either ErrorMessage a        -- ^ A validator function
    , inputHelp   :: HelpMessage                          -- ^ The input helpMessage
    , inputRender :: Bool
                  -> ErrorStatus
                  -> HelpMessage
                  -> b
                  -> (Widget n -> Widget n)
                  -> Widget n                             -- ^ How to draw the input, with focus a help message and input. 
                                                          --   A extension function can be applied too
    , inputHandler :: BrickEvent n () -> EventM n b ()    -- ^ The handler
    }
 makeLensesFor
  [ ("inputState", "inputStateL")
  , ("inputValidator", "inputValidatorL")
  , ("inputName", "inputNameL")
  , ("inputHelp", "inputHelpL")
  ]
  ''FieldInput
 -- | The MenuField is an existential type which stores a Lens' to a part of the Menu state.
 --   In also contains a Field input which internal state is hidden
 data MenuField s n where
  MenuField ::
      { fieldAccesor   :: Lens' s a                   -- ^ A Lens pointing to some part of the state
      , fieldInput     :: FieldInput a b n            -- ^ The input which modifies the state
      , fieldLabel     :: Label                       -- ^ The label
      , fieldStatus    :: ErrorStatus                 -- ^ Whether the current is valid or not.
      , fieldName      :: n
      } -> MenuField s n
 makeLensesFor
  [ ("fieldLabel", "fieldLabelL")
  , ("fieldStatus", "fieldStatusL")
  ]
  ''MenuField
 -- | A fancy lens to the help message
 fieldHelpMsgL :: Lens' (MenuField s n) HelpMessage
 fieldHelpMsgL = lens g s
  where g (MenuField {..})= fieldInput ^. inputHelpL
        s (MenuField{..}) msg = MenuField {fieldInput = fieldInput & inputHelpL .~ msg , ..}
 -- | How to draw a field given a formater
 drawField :: Formatter n -> Bool -> MenuField s n -> Widget n
 drawField amp focus (MenuField { fieldInput = FieldInput {..}, ..}) =
  let input = inputRender focus fieldStatus inputHelp inputState (amp focus)
    in if focus
        then Brick.visible input
        else input
 instance Brick.Named (MenuField s n) n where
  getName :: MenuField s n -> n
  getName entry = entry & fieldName
 {- *****************
  CheckBox widget
 ***************** -}
 type CheckBoxField = MenuField
 createCheckBoxInput :: FieldInput Bool Bool n
 createCheckBoxInput = FieldInput False Right "" checkBoxRender checkBoxHandler
  where
    border = Border.border . Brick.padRight (Brick.Pad 1) . Brick.padLeft (Brick.Pad 2)
    drawBool b =
        if b
          then border . Brick.withAttr Attributes.installedAttr    $ Brick.str Common.installedSign
          else border . Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign
    checkBoxRender focus _ help check f =
      let core = f $ drawBool check
      in if focus 
        then core
        else core <+> (Brick.padLeft (Brick.Pad 1) . centerV . renderAsHelpMsg $ help)
    checkBoxHandler = \case
        VtyEvent (Vty.EvKey Vty.KEnter []) -> Brick.modify not
        _ -> pure ()
 createCheckBoxField :: n -> Lens' s Bool -> CheckBoxField s n
 createCheckBoxField name access = MenuField access createCheckBoxInput "" Valid name
 {- *****************
  Editable widget
 ***************** -}
 type EditableField = MenuField
 createEditableInput :: (Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (Edit.Editor T.Text n) n
 createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit Edit.handleEditorEvent
  where
    drawEdit focus errMsg help edi amp =
      let 
        borderBox = amp . Border.border . Brick.padRight Brick.Max
        editorRender = Edit.renderEditor (Brick.txt . T.unlines) focus edi
        isEditorEmpty = Edit.getEditContents edi == [mempty]
      in case errMsg of
           Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help
                 | otherwise -> borderBox editorRender
           Invalid msg 
             | focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help
             | focus     -> borderBox editorRender
             | otherwise -> borderBox $ renderAsErrMsg msg
    validateEditContent = validator . T.unlines . Edit.getEditContents
    initEdit = Edit.editorText name (Just 1) ""
 createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a  -> EditableField s n
 createEditableField name validator access = MenuField access input "" Valid name
  where
    input = createEditableInput name validator
 {- *****************
  Button widget
 ***************** -}
 type Button = MenuField
 createButtonInput :: FieldInput () () n
 createButtonInput = FieldInput () Right "" drawButton (const $ pure ())
  where drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help
 createButtonField :: n -> Button s n
 createButtonField = MenuField emptyLens createButtonInput "" Valid
 {- *****************
  Utilities
 ***************** -}
 -- | highlights a widget (using List.listSelectedFocusedAttr)
 highlighted :: Widget n -> Widget n
 highlighted = Brick.withAttr L.listSelectedFocusedAttr
 -- | Given a text, crates a highlighted label on focus. An amplifier can be passed
 renderAslabel :: T.Text -> Bool -> Widget n
 renderAslabel t focus =
  if focus
    then highlighted $ Brick.txt t
    else Brick.txt t
 -- | Creates a left align column. 
 -- Example:       |- col2 is align dispite the length of col1
 --   row1_col1         row1_col2
 --   row2_col1_large   row2_col2
 leftify :: Int -> Brick.Widget n -> Brick.Widget n
 leftify i = Brick.hLimit i . Brick.padRight Brick.Max
 -- | center a line in three rows. 
 centerV :: Widget n -> Widget n
 centerV = Brick.padTopBottom 1
 -- | render some Text using helpMsgAttr
 renderAsHelpMsg :: T.Text -> Widget n
 renderAsHelpMsg = Brick.withAttr Attributes.helpMsgAttr . Brick.txt
 -- | render some Text using errMsgAttr
 renderAsErrMsg :: T.Text -> Widget n
 renderAsErrMsg = Brick.withAttr Attributes.errMsgAttr . Brick.txt
 {- *****************
  Menu widget
 ***************** -}
 -- | A menu is a list of Fields and a state. Informally we can think about s in terms of the record type returned by 
 -- a form. 
 data Menu s n
    = Menu
    { menuFields    :: [MenuField s n]   -- ^ The datatype representing the list of entries. Precisely, any array-like data type is highly unconvinient.
    , menuState     :: s
    , menuButtons   :: [Button s n]      -- ^ The buttons. Commonly, the handlers for buttons are defined outside the menu handler.
    , menuFocusRing :: FocusRing n       -- ^ The focus ring with the resource name for each entry and each button, in the order you want to loop them.
    , menuExitKey   :: KeyCombination    -- ^ The key to exit the Menu
    , menuName      :: n                 -- ^ The resource Name.
    }
 makeLensesFor
  [ ("menuFields", "menuFieldsL"), ("menuState", "menuStateL")
  , ("menuButtons", "menuButtonsL"), ("menuFocusRing", "menuFocusRingL")
  , ("menuExitKey", "menuExitKeyL"), ("menuName", "menuNameL")
  ]
  ''Menu
 createMenu :: n -> s -> KeyCombination -> [Button s n] -> [MenuField s n] -> Menu s n
 createMenu n initial exitK buttons fields = Menu fields initial buttons ring exitK n
  where ring = F.focusRing $ [field & fieldName | field <- fields] ++ [button & fieldName | button <- buttons]
 handlerMenu :: forall n e s. Eq n => BrickEvent n e -> EventM n (Menu s n) ()
 handlerMenu ev =
  case ev of
    VtyEvent (Vty.EvKey (Vty.KChar '\t') [])  -> menuFocusRingL %= F.focusNext
    VtyEvent (Vty.EvKey Vty.KBackTab [])      -> menuFocusRingL %= F.focusPrev
    VtyEvent (Vty.EvKey Vty.KDown [])         -> menuFocusRingL %= F.focusNext
    VtyEvent (Vty.EvKey Vty.KUp [])           -> menuFocusRingL %= F.focusPrev
    VtyEvent e -> do
      focused <- use $ menuFocusRingL % to F.focusGetCurrent
      fields  <- use menuFieldsL
      case focused of
        Nothing -> pure ()
        Just n  -> do 
          updated_fields <- updateFields n (VtyEvent e) fields
          menuFieldsL .= updated_fields
    _ -> pure ()
 where
  updateFields :: n -> BrickEvent n () -> [MenuField s n] -> EventM n (Menu s n) [MenuField s n]
  updateFields n e [] = pure []
  updateFields n e (x@(MenuField {fieldInput = i@(FieldInput {..}) , ..}):xs) =
    if Brick.getName x == n
      then do
       newb <- Brick.nestEventM' inputState (inputHandler e)
       let newField = MenuField {fieldInput = (FieldInput {inputState=newb, ..}) , ..}
       case inputValidator newb of
        Left errmsg -> pure $ (newField & fieldStatusL .~ Invalid errmsg):xs
        Right a     -> menuStateL % fieldAccesor .= a >> pure ((newField & fieldStatusL .~ Valid):xs)
      else fmap (x:) (updateFields n e xs)
 drawMenu :: (Eq n, Ord n, Show n, Brick.Named (MenuField s n) n) => Menu s n -> Widget n
 drawMenu menu = 
  Brick.vBox
      [ Brick.vBox buttonWidgets
      , Common.separator
      , Brick.withVScrollBars Brick.OnRight
          $ Brick.viewport (menu ^. menuNameL) Brick.Vertical
          $ Brick.vBox fieldWidgets
      , Brick.txt " "
      , Brick.padRight Brick.Max $ 
          Brick.txt "Press " 
          <+> Common.keyToWidget (menu ^. menuExitKeyL)
          <+> Brick.txt " to go back"
      ]
  where
    fieldLabels  = [field & fieldLabel | field <- menu ^. menuFieldsL]
    buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL]
    allLabels    = fieldLabels ++ buttonLabels
    maxWidth = foldl' max 5 (fmap Brick.textWidth allLabels)
    -- A list of functions which draw a highlighted label with right padding at the left of a widget. 
    amplifiers =
      let labelsWidgets = fmap renderAslabel fieldLabels
       in fmap (\f b -> ((centerV . leftify (maxWidth + 10) $ f b) <+>) ) labelsWidgets
    drawFields = fmap drawField amplifiers
    fieldWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawFields (menu ^. menuFieldsL)
    buttonAmplifiers =
      let buttonAsWidgets = fmap renderAslabel buttonLabels
       in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
    drawButtons = fmap drawField buttonAmplifiers
    buttonWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawButtons (menu ^. menuButtonsL)
--- a/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs
@ -0,0 +1,118 @@
 {-# 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 #-}
 {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 module GHCup.Brick.Widgets.Menus.AdvanceInstall (
  InstallOptions (..),
  AdvanceInstallMenu,
  create,
  handler,
  draw,
  instBindistL,
  instSetL,
  isolateDirL,
  forceInstallL,
  addConfArgsL,
 ) where
 import GHCup.Brick.Widgets.Menu (Menu)
 import qualified GHCup.Brick.Widgets.Menu as Menu
 import           GHCup.Brick.Common(Name(..))
 import Brick
    ( BrickEvent(..),
      EventM,
      Widget(..))
 import           Prelude                 hiding ( appendFile )
 import           Optics.TH (makeLensesFor)
 import qualified GHCup.Brick.Common as Common
 import GHCup.Types (KeyCombination)
 import URI.ByteString (URI)
 import qualified Data.Text as T
 import qualified Data.ByteString.UTF8 as UTF8
 import GHCup.Utils (parseURI)
 import Data.Bifunctor (Bifunctor(..))
 import Data.Function ((&))
 import Optics ((.~))
 import Data.Char (isSpace)
 data InstallOptions = InstallOptions
  { instBindist  :: Maybe URI
  , instSet      :: Bool
  , isolateDir   :: Maybe FilePath
  , forceInstall :: Bool
  , addConfArgs  :: [T.Text]
  } deriving (Eq, Show)
 makeLensesFor [
   ("instBindist", "instBindistL")
  , ("instSet", "instSetL")
  , ("isolateDir", "isolateDirL")
  , ("forceInstall", "forceInstallL")
  , ("addConfArgs", "addConfArgsL")
  ]
  ''InstallOptions
 type AdvanceInstallMenu = Menu InstallOptions Name
 create :: KeyCombination -> AdvanceInstallMenu
 create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields
  where
    initialState = InstallOptions Nothing False Nothing False []
    -- Brick's internal editor representation is [mempty].
    emptyEditor i = T.null i || (i == "\n")
    uriValidator :: T.Text -> Either Menu.ErrorMessage (Maybe URI)
    uriValidator i = 
      case not $ emptyEditor i of
        True  -> bimap (T.pack . show) Just . parseURI . UTF8.fromString . T.unpack $ i
        False -> Right Nothing
    filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
    filepathValidator i = 
      case not $ emptyEditor i of
        True  -> Right . Just . T.unpack $ i
        False -> Right Nothing
    additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
    additionalValidator = Right . T.split isSpace
    fields = 
      [ Menu.createEditableField (Common.MenuElement Common.UrlEditBox) uriValidator instBindistL
          & Menu.fieldLabelL .~ "url"
          & Menu.fieldHelpMsgL .~ "Install the specified version from this bindist"
      , Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) instSetL
          & Menu.fieldLabelL .~ "set"
          & Menu.fieldHelpMsgL .~ "Set as active version after install"
      , Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathValidator isolateDirL
          & Menu.fieldLabelL .~ "isolated"
          & Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
      , Menu.createCheckBoxField (Common.MenuElement Common.ForceCheckBox) forceInstallL
          & Menu.fieldLabelL .~ "force"
          & Menu.fieldHelpMsgL .~ "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)"
      , Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgsL
          & Menu.fieldLabelL .~ "CONFIGURE_ARGS"
          & Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
      ]
    ok = Menu.createButtonField (Common.MenuElement Common.OkButton)
          & Menu.fieldLabelL .~ "Advance Install"
          & Menu.fieldHelpMsgL .~ "Install with options below"
 handler :: BrickEvent Name e -> EventM Name AdvanceInstallMenu ()
 handler = Menu.handlerMenu
 draw :: AdvanceInstallMenu -> Widget Name
 draw = Common.frontwardLayer "Advance Install" . Menu.drawMenu
--- a/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs
@ -0,0 +1,177 @@
 {-# 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 #-}
 {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 module GHCup.Brick.Widgets.Menus.CompileGHC (CompileGHCOptions, CompileGHCMenu, create, handler, draw) where
 import GHCup.Brick.Widgets.Menu (Menu)
 import qualified GHCup.Brick.Widgets.Menu as Menu
 import           GHCup.Brick.Common(Name(..))
 import Brick
    ( BrickEvent(..),
      EventM,
      Widget(..))
 import           Prelude                 hiding ( appendFile )
 import           Optics.TH (makeLenses)
 import qualified GHCup.Brick.Common as Common
 import GHCup.Types (KeyCombination, BuildSystem (Hadrian))
 import URI.ByteString (URI)
 import qualified Data.Text as T
 import qualified Data.ByteString.UTF8 as UTF8
 import GHCup.Utils (parseURI)
 import Data.Bifunctor (Bifunctor(..))
 import Data.Function ((&))
 import Optics ((.~))
 import Data.Char (isSpace)
 import Data.Versions (Version, version)
 import System.FilePath (isPathSeparator)
 import Control.Applicative (Alternative((<|>)))
 import Text.Read (readEither)
 data CompileGHCOptions = CompileGHCOptions
  { _bootstrapGhc :: Either Version FilePath
  , _jobs         :: Maybe Int
  , _buildConfig  :: Maybe FilePath
  , _patches      :: Maybe (Either FilePath [URI])
  , _crossTarget  :: Maybe T.Text
  , _addConfArgs  :: [T.Text]
  , _setCompile   :: Bool
  , _ovewrwiteVer :: Maybe Version
  , _buildFlavour :: Maybe String
  , _buildSystem  :: Maybe BuildSystem
  , _isolateDir   :: Maybe FilePath
  } deriving (Eq, Show)
 makeLenses ''CompileGHCOptions
 type CompileGHCMenu = Menu CompileGHCOptions Name
 create :: KeyCombination -> CompileGHCMenu
 create k = Menu.createMenu CompileGHCBox initialState k buttons fields
  where
    initialState = 
      CompileGHCOptions 
        (Right "")
        Nothing
        Nothing
        Nothing
        Nothing
        []
        False
        Nothing
        Nothing
        Nothing
        Nothing
    -- Brick's internal editor representation is [mempty].
    emptyEditor i = T.null i || (i == "\n")
    whenEmpty :: a -> (T.Text -> Either Menu.ErrorMessage a) -> T.Text -> Either Menu.ErrorMessage a
    whenEmpty emptyval f i = if not (emptyEditor i) then f i else Right emptyval
    bootstrapV :: T.Text -> Either Menu.ErrorMessage (Either Version FilePath)
    bootstrapV i =
      case not $ emptyEditor i of
        True  -> 
          let readVersion = bimap (const "Not a valid version") Left (version (T.init i)) -- Brick adds \n at the end, hence T.init
              readPath
                 = if isPathSeparator (T.head i) 
                    then pure $ Right (T.unpack i)
                    else Left "Not an absolute Path"
           in if T.any isPathSeparator i 
                then readPath
                else readVersion
        False -> Left "Invalid Empty value"
    versionV :: T.Text -> Either Menu.ErrorMessage (Maybe Version)
    versionV = bimap (const "Not a valid version") Just . version . T.init  -- Brick adds \n at the end, hence T.init
    jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
    jobsV = 
      let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack
       in whenEmpty Nothing parseInt 
    patchesV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath [URI]))
    patchesV = whenEmpty Nothing readPatches
      where 
        readUri :: T.Text -> Either String URI
        readUri = first show . parseURI . UTF8.fromString . T.unpack 
        readPatches j = 
          let 
            x = (bimap T.unpack (fmap Left) $ filepathV j)
            y = second (Just . Right) $ traverse readUri (T.split isSpace j)
          in first T.pack $ x <|> y
    filepathV :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
    filepathV = whenEmpty Nothing (Right . Just . T.unpack)
    additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
    additionalValidator = Right . T.split isSpace
    systemV :: T.Text -> Either Menu.ErrorMessage (Maybe BuildSystem)
    systemV = whenEmpty Nothing readSys
      where 
        readSys i
          | T.toLower i == "hadrian" = Right $ Just Hadrian
          | T.toLower i == "make"    = Right $ Just Hadrian
          | otherwise = Left "Not a valid Build System"
    fields = 
      [ Menu.createEditableField (Common.MenuElement Common.BootstrapGhcEditBox) bootstrapV bootstrapGhc
           & Menu.fieldLabelL .~ "bootstrap-ghc"
           & Menu.fieldHelpMsgL .~ "The GHC version (or full path) to bootstrap with (must be installed)"
           & Menu.fieldStatusL .~ Menu.Invalid "Invalid Empty value"
      , Menu.createEditableField (Common.MenuElement Common.JobsEditBox) jobsV jobs
          & Menu.fieldLabelL .~ "jobs"
          & Menu.fieldHelpMsgL .~ "How many jobs to use for make"
      , Menu.createEditableField (Common.MenuElement Common.BuildConfigEditBox) filepathV buildConfig
          & Menu.fieldLabelL .~ "build config"
          & Menu.fieldHelpMsgL .~ "Absolute path to build config file"
      , Menu.createEditableField (Common.MenuElement Common.PatchesEditBox) patchesV patches
          & Menu.fieldLabelL .~ "patches"
          & Menu.fieldHelpMsgL .~ "Either a URI to a patch (https/http/file) or Absolute path to patch directory"
      , Menu.createEditableField (Common.MenuElement Common.CrossTargetEditBox) (Right . Just) crossTarget
          & Menu.fieldLabelL .~ "cross target"
          & Menu.fieldHelpMsgL .~ "Build cross-compiler for this platform"
      , Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgs
          & Menu.fieldLabelL .~ "CONFIGURE_ARGS"
          & Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
      , Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) setCompile
          & Menu.fieldLabelL .~ "set"
          & Menu.fieldHelpMsgL .~ "Set as active version after install"
      , Menu.createEditableField (Common.MenuElement Common.OvewrwiteVerEditBox) versionV ovewrwiteVer
          & Menu.fieldLabelL .~ "overwrite-version"
          & Menu.fieldHelpMsgL .~ "Allows to overwrite the finally installed VERSION with a different one"
      , Menu.createEditableField (Common.MenuElement Common.BuildFlavourEditBox) (Right . Just . T.unpack) buildFlavour
          & Menu.fieldLabelL .~ "flavour"
          & Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
      , Menu.createEditableField (Common.MenuElement Common.BuildSystemEditBox) systemV buildSystem
          & Menu.fieldLabelL .~ "build system"
          & Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
      , Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathV isolateDir
          & Menu.fieldLabelL .~ "isolated"
          & Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
      ]
    buttons = [
       Menu.createButtonField (Common.MenuElement Common.OkButton)
           & Menu.fieldLabelL .~ "Compile"
           & Menu.fieldHelpMsgL .~ "Compile GHC from source with options below"
      ]
 handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()
 handler = Menu.handlerMenu
 draw :: CompileGHCMenu -> Widget Name
 draw = Common.frontwardLayer "Compile GHC" . Menu.drawMenu
--- a/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs
@ -0,0 +1,78 @@
 {-# LANGUAGE OverloadedStrings #-}
 module GHCup.Brick.Widgets.Menus.Context (ContextMenu, create, draw, handler) where
 import Brick (
  Widget (..), BrickEvent, EventM,
 )
 import Data.Function ((&))
 import Prelude hiding (appendFile)
 import Data.Versions (prettyVer)
 import GHCup.List ( ListResult(..) )
 import GHCup.Types (KeyCombination, Tool (..))
 import qualified GHCup.Brick.Common as Common
 import qualified GHCup.Brick.Widgets.Menu as Menu
 import GHCup.Brick.Common (Name (..))
 import GHCup.Brick.Widgets.Menu (Menu)
 import qualified Brick.Widgets.Core as Brick
 import qualified Brick.Widgets.Border as Border
 import qualified Brick.Focus as F
 import Brick.Widgets.Core ((<+>))
 import Optics (to)
 import Optics.Operators ((.~), (^.))
 import Optics.Optic ((%))
 import Data.Foldable (foldl')
 type ContextMenu = Menu ListResult Name
 create :: ListResult -> KeyCombination -> ContextMenu
 create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
 where
  advInstallButton =
    Menu.createButtonField (MenuElement Common.AdvanceInstallButton)
      & Menu.fieldLabelL .~ "Install"
      & Menu.fieldHelpMsgL .~ "Advance Installation Settings"
  compileButton =
    Menu.createButtonField (MenuElement Common.CompilieButton)
      & Menu.fieldLabelL .~ "Compile"
      & Menu.fieldHelpMsgL .~ "Compile tool from source"
  buttons =
    case lTool lr of
      GHC -> [advInstallButton, compileButton]
      HLS -> [advInstallButton, compileButton]
      _ -> [advInstallButton]
 draw :: ContextMenu -> Widget Name
 draw menu = 
  Common.frontwardLayer
    ("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
    $ Brick.vBox
        [ Brick.vBox buttonWidgets
        , Brick.txt " "
        , Brick.padRight Brick.Max $ 
            Brick.txt "Press " 
            <+> Common.keyToWidget (menu ^. Menu.menuExitKeyL)
            <+> Brick.txt " to go back"
        ]
  where
    buttonLabels = [button & Menu.fieldLabel | button <- menu ^. Menu.menuButtonsL]
    maxWidth = foldl' max 5 (fmap Brick.textWidth buttonLabels)
    buttonAmplifiers =
      let buttonAsWidgets = fmap Menu.renderAslabel buttonLabels
       in fmap (\f b -> ((Menu.leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
    drawButtons = fmap Menu.drawField buttonAmplifiers
    buttonWidgets = zipWith (F.withFocusRing (menu ^. Menu.menuFocusRingL)) drawButtons (menu ^. Menu.menuButtonsL)
    tool_str =
      case menu ^. Menu.menuStateL % to lTool of
        GHC -> "GHC"
        GHCup -> "GHCup"
        Cabal -> "Cabal"
        HLS -> "HLS"
        Stack -> "Stack"
 handler :: BrickEvent Name e -> EventM Name ContextMenu ()
 handler = Menu.handlerMenu
--- a/lib-tui/GHCup/Brick/Widgets/Navigation.hs
+++ b/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 ' ')
--- a/lib-tui/GHCup/Brick/Widgets/SectionList.hs
+++ b/lib-tui/GHCup/Brick/Widgets/SectionList.hs
@ -0,0 +1,193 @@
 {-# 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 :: forall n t e . (Traversable t, Ord n, Show n, Eq n, L.Splittable t, Semigroup (t e))
                  => (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 renderElem sectionFocus ge@(GenericSectionList focus elms slName) =
    Brick.Widget Brick.Greedy Brick.Greedy $ Brick.render $ Brick.viewport slName Brick.Vertical $
      V.ifoldl' (\(!accWidget) !i list ->
                      let hasFocusList = sectionIsFocused list
                          makeVisible = if hasFocusList then Brick.visibleRegion (Brick.Location (c, r)) (1, 1) else id
                          appendBorder = if i == 0 then id else (hBorder <=>)
                          newWidget = appendBorder (makeVisible $ renderInnerList hasFocusList list)
                      in accWidget <=> newWidget
                      )
      Brick.emptyWidget
      elms
 where
  -- A section is focused if the whole thing is focused, and the inner list has focus
  sectionIsFocused :: L.GenericList n t e -> Bool
  sectionIsFocused l = sectionFocus && (Just (L.listName l) == F.focusGetCurrent focus)
  renderInnerList :: Bool -> L.GenericList n t e -> Widget n
  renderInnerList hasFocus l = Brick.vLimit (length l) $ L.renderList (\b -> renderElem (b && hasFocus)) hasFocus l
  -- compute the location to focus on within the active section
  (c, r) :: (Int, Int) = case sectionListSelectedElement ge of
                           Nothing -> (0, 0)
                           Just (selElIx, _) -> (0, selElIx)
 -- | 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 
--- a/lib-tui/GHCup/Brick/Widgets/Tutorial.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Tutorial.hs
@ -0,0 +1,77 @@
 {-# 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.Center ( center )
 import           Prelude                 hiding ( appendFile )
 draw :: Widget Common.Name
 draw =
  let
    mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
  in Common.frontwardLayer "Tutorial"
      $ Brick.vBox
          (fmap center
            [ mkTextBox [Brick.txtWrap "GHCup is a distribution channel for Haskell's tools."]
            , Common.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"
                ]
              ]
            , Common.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")
--- a/lib-tui/GHCup/BrickMain.hs
+++ b/lib-tui/GHCup/BrickMain.hs
@ -0,0 +1,76 @@
 {-# 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), KeyBindings (..) )
 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 GHCup.Brick.Widgets.Menus.Context as ContextMenu
 import qualified GHCup.Brick.Widgets.SectionList as Navigation
 import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
 import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
 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 -> do
      let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing
          current_element = Navigation.sectionListSelectedElement initial_list
          exit_key = bQuit . keyBindings $ s 
      case current_element of
        Nothing -> do
          flip runReaderT s $ logError "Error building app state: empty ResultList" 
          exitWith $ ExitFailure 2
        Just (_, e) ->
          let initapp = 
                BrickApp.app 
                  (Attributes.defaultAttributes $ noColor $ settings s)
                  (Attributes.dimAttributes $ noColor $ settings s)
              initstate =
                AppState.BrickState ad
                      Common.defaultAppSettings
                      initial_list
                      (ContextMenu.create e exit_key)
                      (AdvanceInstall.create (bQuit . keyBindings $ s ))
                      (CompileGHC.create exit_key)
                      (keyBindings s)
                      Common.Navigation
          in Brick.defaultMain initapp initstate 
          $> ()
    Left e -> do
      flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
      exitWith $ ExitFailure 2
Author	SHA1	Message	Date
Luis Morillo	e1454d0551	Avance Install Functionality. Bug	2024-03-02 01:04:03 +08:00
Luis Morillo	06ace5324f	Better aesth for context menu	2024-03-02 01:04:03 +08:00
Luis Morillo	b619a65ede	Add visuals for compile Menu	2024-03-02 01:04:03 +08:00
Luis Morillo	33ace9557e	migrate #987 to new library	2024-03-02 01:04:03 +08:00
Luis Morillo	2a2385731b	Add visuals for Advance Install	2024-03-02 01:04:02 +08:00
Luis Morillo	16967bdc5f	Context Menu visuals	2024-03-02 01:04:02 +08:00
Luis Morillo	3298f2293b	Extract common functionality	2024-03-02 01:04:02 +08:00
Luis Morillo	ddd76ab7ee	Create Menu system. Similar to Brick.Forms	2024-03-02 01:04:02 +08:00
Luis Morillo	e768fcb46c	Move tui code into its own library.	2024-03-02 01:03:56 +08:00