hasufell
/
ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove trailing white space

This commit is contained in:
Luis Morillo 2024-03-16 16:14:24 +01:00
parent 80a6c67cf3
commit 255f7c8eac
14 changed files with 110 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
lib-tui/GHCup/Brick/Actions.hs
View File

@ -83,7 +83,7 @@ import qualified GHCup.HLS as HLS
{- Core Logic. {- Core Logic.
This module defines the IO actions we can execute within the Brick App: This module defines the IO actions we can execute within the Brick App:
- Install - Install
@ -116,7 +116,7 @@ constructList appD settings =
selectBy :: Tool -> (ListResult -> Bool) -> BrickInternalState -> BrickInternalState selectBy :: Tool -> (ListResult -> Bool) -> BrickInternalState -> BrickInternalState
selectBy tool predicate internal_state = selectBy tool predicate internal_state =
let new_focus = F.focusSetCurrent (Singular tool) (view sectionListFocusRingL internal_state) let new_focus = F.focusSetCurrent (Singular tool) (view sectionListFocusRingL internal_state)
tool_lens = sectionL (Singular tool) tool_lens = sectionL (Singular tool)
in internal_state in internal_state
& sectionListFocusRingL .~ new_focus & sectionListFocusRingL .~ new_focus
& tool_lens %~ L.listMoveTo 0 -- We move to 0 first & tool_lens %~ L.listMoveTo 0 -- We move to 0 first
@ -184,7 +184,7 @@ installWithOptions :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFai
-> m (Either String ()) -> m (Either String ())
installWithOptions opts (_, ListResult {..}) = do installWithOptions opts (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let let
misolated = opts ^. AdvanceInstall.isolateDirL misolated = opts ^. AdvanceInstall.isolateDirL
shouldIsolate = maybe GHCupInternal IsolateDir (opts ^. AdvanceInstall.isolateDirL) shouldIsolate = maybe GHCupInternal IsolateDir (opts ^. AdvanceInstall.isolateDirL)
shouldForce = opts ^. AdvanceInstall.forceInstallL shouldForce = opts ^. AdvanceInstall.forceInstallL
@ -233,15 +233,15 @@ installWithOptions opts (_, ListResult {..}) = do
case opts ^. AdvanceInstall.instBindistL of case opts ^. AdvanceInstall.instBindistL of
Nothing -> do Nothing -> do
liftE $ liftE $
runBothE' runBothE'
(installGHCBin v shouldIsolate shouldForce extraArgs) (installGHCBin v shouldIsolate shouldForce extraArgs)
(when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing)) (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
pure (vi, dirs, ce) pure (vi, dirs, ce)
Just uri -> do Just uri -> do
liftE $ liftE $
runBothE' runBothE'
(installGHCBindist (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing) (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
v v
shouldIsolate shouldIsolate
shouldForce shouldForce
@ -253,14 +253,14 @@ installWithOptions opts (_, ListResult {..}) = do
let vi = getVersionInfo v Cabal dls let vi = getVersionInfo v Cabal dls
case opts ^. AdvanceInstall.instBindistL of case opts ^. AdvanceInstall.instBindistL of
Nothing -> do Nothing -> do
liftE $ liftE $
runBothE' runBothE'
(installCabalBin lVer shouldIsolate shouldForce) (installCabalBin lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer)) (when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
pure (vi, dirs, ce) pure (vi, dirs, ce)
Just uri -> do Just uri -> do
liftE $ liftE $
runBothE' runBothE'
(installCabalBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce) (installCabalBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer)) (when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
pure (vi, dirs, ce) pure (vi, dirs, ce)
@ -268,19 +268,19 @@ installWithOptions opts (_, ListResult {..}) = do
GHCup -> do GHCup -> do
let vi = snd <$> getLatest dls GHCup let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce) liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
HLS -> do HLS -> do
let vi = getVersionInfo v HLS dls let vi = getVersionInfo v HLS dls
case opts ^. AdvanceInstall.instBindistL of case opts ^. AdvanceInstall.instBindistL of
Nothing -> do Nothing -> do
liftE $ liftE $
runBothE' runBothE'
(installHLSBin lVer shouldIsolate shouldForce) (installHLSBin lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing)) (when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing))
pure (vi, dirs, ce) pure (vi, dirs, ce)
Just uri -> do Just uri -> do
liftE $ liftE $
runBothE' runBothE'
(installHLSBindist (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing) (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
lVer lVer
shouldIsolate shouldIsolate
@ -293,13 +293,13 @@ installWithOptions opts (_, ListResult {..}) = do
case opts ^. AdvanceInstall.instBindistL of case opts ^. AdvanceInstall.instBindistL of
Nothing -> do Nothing -> do
liftE $ liftE $
runBothE' runBothE'
(installStackBin lVer shouldIsolate shouldForce) (installStackBin lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer)) (when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
pure (vi, dirs, ce) pure (vi, dirs, ce)
Just uri -> do Just uri -> do
liftE $ liftE $
runBothE' runBothE'
(installStackBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce) (installStackBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
(when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer)) (when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
pure (vi, dirs, ce) pure (vi, dirs, ce)
@ -330,7 +330,7 @@ installWithOptions opts (_, ListResult {..}) = do
VLeft e -> pure $ Left $ prettyHFError e <> "\n" VLeft e -> pure $ Left $ prettyHFError e <> "\n"
<> "Also check the logs in ~/.ghcup/logs" <> "Also check the logs in ~/.ghcup/logs"
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> (Int, ListResult) -> m (Either String ()) => (Int, ListResult) -> m (Either String ())
install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing False []) install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing False [])
@ -461,11 +461,11 @@ changelog' (_, ListResult {..}) = do
Right _ -> pure $ Right () Right _ -> pure $ Right ()
Left e -> pure $ Left $ prettyHFError e Left e -> pure $ Left $ prettyHFError e
compileGHC :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) compileGHC :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> CompileGHC.CompileGHCOptions -> (Int, ListResult) -> m (Either String ()) => CompileGHC.CompileGHCOptions -> (Int, ListResult) -> m (Either String ())
compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do
appstate <- ask appstate <- ask
let run = let run =
runResourceT runResourceT
. runE @'[ AlreadyInstalled . runE @'[ AlreadyInstalled
, BuildFailed , BuildFailed
@ -500,7 +500,7 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do
"...waiting for 5 seconds, you can still abort..." "...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
targetVer <- liftE $ GHCup.compileGHC targetVer <- liftE $ GHCup.compileGHC
(GHC.SourceDist lVer) (GHC.SourceDist lVer)
(compopts ^. CompileGHC.crossTarget) (compopts ^. CompileGHC.crossTarget)
(compopts ^. CompileGHC.overwriteVer) (compopts ^. CompileGHC.overwriteVer)
@ -536,10 +536,10 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs (appstate & settings) of case keepDirs (appstate & settings) of
Never -> logError $ T.pack $ prettyHFError err Never -> logError $ T.pack $ prettyHFError err
_ -> logError $ T.pack (prettyHFError err) <> "\n" _ -> logError $ T.pack (prettyHFError err) <> "\n"
<> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir) <> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir)
<> " and the build directory " <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <> T.pack tmpdir <> " for more clues." <> "\n"
<> "Make sure to clean up " <> T.pack tmpdir <> " afterwards." <> "Make sure to clean up " <> T.pack tmpdir <> " afterwards."
pure $ Right () pure $ Right ()
VLeft e -> do VLeft e -> do
@ -550,11 +550,11 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do
compileGHC _ (_, ListResult{lTool = _}) = pure (Right ()) compileGHC _ (_, ListResult{lTool = _}) = pure (Right ())
compileHLS :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) compileHLS :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> CompileHLS.CompileHLSOptions -> (Int, ListResult) -> m (Either String ()) => CompileHLS.CompileHLSOptions -> (Int, ListResult) -> m (Either String ())
compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do
appstate <- ask appstate <- ask
let run = let run =
runResourceT runResourceT
. runE @'[ AlreadyInstalled . runE @'[ AlreadyInstalled
, BuildFailed , BuildFailed
@ -587,10 +587,10 @@ compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do
"...waiting for 5 seconds, you can still abort..." "...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
ghcs <- ghcs <-
liftE $ forM (compopts ^. CompileHLS.targetGHCs) liftE $ forM (compopts ^. CompileHLS.targetGHCs)
(\ghc -> fmap (_tvVersion . fst) . OptParse.fromVersion (Just ghc) $ GHC) (\ghc -> fmap (_tvVersion . fst) . OptParse.fromVersion (Just ghc) $ GHC)
targetVer <- liftE $ GHCup.compileHLS targetVer <- liftE $ GHCup.compileHLS
(HLS.SourceDist lVer) (HLS.SourceDist lVer)
ghcs ghcs
(compopts ^. CompileHLS.jobs) (compopts ^. CompileHLS.jobs)
@ -617,10 +617,10 @@ compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs (appstate & settings) of case keepDirs (appstate & settings) of
Never -> logError $ T.pack $ prettyHFError err Never -> logError $ T.pack $ prettyHFError err
_ -> logError $ T.pack (prettyHFError err) <> "\n" _ -> logError $ T.pack (prettyHFError err) <> "\n"
<> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir) <> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir)
<> " and the build directory " <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <> T.pack tmpdir <> " for more clues." <> "\n"
<> "Make sure to clean up " <> T.pack tmpdir <> " afterwards." <> "Make sure to clean up " <> T.pack tmpdir <> " afterwards."
pure $ Right () pure $ Right ()
VLeft e -> do VLeft e -> do
@ -675,7 +675,7 @@ getAppData mgi = runExceptT $ do
lV <- listVersions Nothing [] False True (Nothing, Nothing) lV <- listVersions Nothing [] False True (Nothing, Nothing)
pure $ BrickData (reverse lV) pure $ BrickData (reverse lV)
-- --
keyHandlers :: KeyBindings keyHandlers :: KeyBindings
-> [ ( KeyCombination -> [ ( KeyCombination
@ -700,7 +700,7 @@ keyHandlers KeyBindings {..} =
, (KeyCombination Vty.KEnter [], const "advance options", createMenuforTool ) , (KeyCombination Vty.KEnter [], const "advance options", createMenuforTool )
] ]
where where
createMenuforTool = do createMenuforTool = do
e <- use (appState % to sectionListSelectedElement) e <- use (appState % to sectionListSelectedElement)
case e of case e of
Nothing -> pure () Nothing -> pure ()
@ -715,9 +715,9 @@ keyHandlers KeyBindings {..} =
pure () pure ()
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m () --hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
hideShowHandler' f = do hideShowHandler' f = do
app_settings <- use appSettings app_settings <- use appSettings
let let
vers = f app_settings vers = f app_settings
newAppSettings = app_settings & Common.showAllVersions .~ vers newAppSettings = app_settings & Common.showAllVersions .~ vers
ad <- use appData ad <- use appData

26
lib-tui/GHCup/Brick/App.hs
View File

@ -79,12 +79,12 @@ app attrs dimAttrs =
drawUI :: AttrMap -> BrickState -> [Widget Name] drawUI :: AttrMap -> BrickState -> [Widget Name]
drawUI dimAttrs st = drawUI dimAttrs st =
let let
footer = Brick.withAttr Attributes.helpAttr footer = Brick.withAttr Attributes.helpAttr
. Brick.txtWrap . Brick.txtWrap
. T.pack . T.pack
. foldr1 (\x y -> x <> " " <> y) . foldr1 (\x y -> x <> " " <> y)
. fmap (\(KeyCombination key mods, pretty_setting, _) . fmap (\(KeyCombination key mods, pretty_setting, _)
-> intercalate "+" (Common.showKey key : (Common.showMod <$> mods)) <> ":" <> pretty_setting (st ^. appSettings) -> intercalate "+" (Common.showKey key : (Common.showMod <$> mods)) <> ":" <> pretty_setting (st ^. appSettings)
) )
$ Actions.keyHandlers (st ^. appKeys) $ Actions.keyHandlers (st ^. appKeys)
@ -98,7 +98,7 @@ drawUI dimAttrs st =
CompileGHCPanel -> [CompileGHC.draw (st ^. compileGHCMenu), navg] CompileGHCPanel -> [CompileGHC.draw (st ^. compileGHCMenu), navg]
CompileHLSPanel -> [CompileHLS.draw (st ^. compileHLSMenu), navg] CompileHLSPanel -> [CompileHLS.draw (st ^. compileHLSMenu), navg]
-- | On q, go back to navigation. -- | On q, go back to navigation.
-- On Enter, to go to tutorial -- On Enter, to go to tutorial
keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState () keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState ()
keyInfoHandler ev = case ev of keyInfoHandler ev = case ev of
@ -113,7 +113,7 @@ tutorialHandler ev =
VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
_ -> pure () _ -> pure ()
-- | Tab/Arrows to navigate. -- | Tab/Arrows to navigate.
navigationHandler :: BrickEvent Name e -> EventM Name BrickState () navigationHandler :: BrickEvent Name e -> EventM Name BrickState ()
navigationHandler ev = do navigationHandler ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings' AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings'
@ -126,25 +126,25 @@ navigationHandler ev = do
contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState () contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState ()
contextMenuHandler ev = do contextMenuHandler ev = do
ctx <- use contextMenu ctx <- use contextMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
buttons = ctx ^. Menu.menuButtonsL buttons = ctx ^. Menu.menuButtonsL
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of case (ev, focusedElement) of
(_ , Nothing) -> pure () (_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) (VtyEvent (Vty.EvKey k m), Just n)
| k == exitKey | k == exitKey
&& m == mods && m == mods
&& n `elem` [Menu.fieldName button | button <- buttons] && n `elem` [Menu.fieldName button | button <- buttons]
-> mode .= Navigation -> mode .= Navigation
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel (VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileGHCButton) ) -> mode .= Common.CompileGHCPanel (VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileGHCButton) ) -> mode .= Common.CompileGHCPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileHLSButton) ) -> mode .= Common.CompileHLSPanel (VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileHLSButton) ) -> mode .= Common.CompileHLSPanel
_ -> Common.zoom contextMenu $ ContextMenu.handler ev _ -> Common.zoom contextMenu $ ContextMenu.handler ev
-- --
advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState () advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState ()
advanceInstallHandler ev = do advanceInstallHandler ev = do
ctx <- use advanceInstallMenu ctx <- use advanceInstallMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
buttons = ctx ^. Menu.menuButtonsL buttons = ctx ^. Menu.menuButtonsL
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
@ -162,7 +162,7 @@ advanceInstallHandler ev = do
compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState () compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
compileGHCHandler ev = do compileGHCHandler ev = do
ctx <- use compileGHCMenu ctx <- use compileGHCMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
buttons = ctx ^. Menu.menuButtonsL buttons = ctx ^. Menu.menuButtonsL
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
@ -175,14 +175,14 @@ compileGHCHandler ev = do
-> mode .= ContextPanel -> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL let iopts = ctx ^. Menu.menuStateL
when (Menu.isValidMenu ctx) when (Menu.isValidMenu ctx)
(Actions.withIOAction $ Actions.compileGHC iopts) (Actions.withIOAction $ Actions.compileGHC iopts)
_ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev _ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
compileHLSHandler :: BrickEvent Name e -> EventM Name BrickState () compileHLSHandler :: BrickEvent Name e -> EventM Name BrickState ()
compileHLSHandler ev = do compileHLSHandler ev = do
ctx <- use compileHLSMenu ctx <- use compileHLSMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
buttons = ctx ^. Menu.menuButtonsL buttons = ctx ^. Menu.menuButtonsL
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL

2
lib-tui/GHCup/Brick/Attributes.hs
View File

@ -46,10 +46,8 @@ defaultAttributes no_color = Brick.attrMap
where where
withForeColor | no_color = const withForeColor | no_color = const
| otherwise = Vty.withForeColor | otherwise = Vty.withForeColor
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor | otherwise = Vty.withBackColor
withStyle = Vty.withStyle withStyle = Vty.withStyle

8
lib-tui/GHCup/Brick/BrickState.hs
View File

@ -14,15 +14,15 @@
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{- {-
This module contains the BrickState. One could be tempted to include this data structure in GHCup.Brick.Common, 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. 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, This happens because the BrickState is sort of a container for all widgets,
but widgets depends on common functionality, hence: but widgets depends on common functionality, hence:
BrickState `depends on` Widgets.XYZ `depends on` Common BrickState `depends on` Widgets.XYZ `depends on` Common
The linear relation above breaks if BrickState is defined in Common. The linear relation above breaks if BrickState is defined in Common.
-} -}

10
lib-tui/GHCup/Brick/Common.hs
View File

@ -121,7 +121,7 @@ pattern UpdateCabalCheckBox :: ResourceId
pattern UpdateCabalCheckBox = ResourceId 18 pattern UpdateCabalCheckBox = ResourceId 18
-- | Name data type. Uniquely identifies each widget in the TUI. -- | Name data type. Uniquely identifies each widget in the TUI.
-- some constructors might end up unused, but still is a good practise -- some constructors might end up unused, but still is a good practise
-- to have all of them defined, just in case -- to have all of them defined, just in case
data Name = AllTools -- ^ The main list widget data Name = AllTools -- ^ The main list widget
@ -129,8 +129,8 @@ data Name = AllTools -- ^ The main list widget
| KeyInfoBox -- ^ The text box widget with action informacion | KeyInfoBox -- ^ The text box widget with action informacion
| TutorialBox -- ^ The tutorial widget | TutorialBox -- ^ The tutorial widget
| ContextBox -- ^ The resource for Context Menu | ContextBox -- ^ The resource for Context Menu
| CompileGHCBox -- ^ The resource for CompileGHC Menu | CompileGHCBox -- ^ The resource for CompileGHC Menu
| AdvanceInstallBox -- ^ The resource for AdvanceInstall Menu | AdvanceInstallBox -- ^ The resource for AdvanceInstall Menu
| MenuElement ResourceId -- ^ Each element in a Menu. Resources must not be share for visible | 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 -- Menus, but MenuA and MenuB can share resources if they both are
-- invisible, or just one of them is visible. -- invisible, or just one of them is visible.
@ -142,7 +142,7 @@ data Mode = Navigation
| KeyInfo | KeyInfo
| Tutorial | Tutorial
| ContextPanel | ContextPanel
| AdvanceInstallPanel | AdvanceInstallPanel
| CompileGHCPanel | CompileGHCPanel
| CompileHLSPanel | CompileHLSPanel
deriving (Eq, Show, Ord) deriving (Eq, Show, Ord)
@ -195,7 +195,7 @@ frontwardLayer layer_name =
. Brick.withBorderStyle Border.unicode . Brick.withBorderStyle Border.unicode
. Border.borderWithLabel (Brick.txt layer_name) . Border.borderWithLabel (Brick.txt layer_name)
-- I refuse to give this a type signature. -- 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. -- | Given a lens, zoom on it. It is needed because Brick uses microlens but GHCup uses optics.
zoom l = Brick.zoom (toLensVL l) zoom l = Brick.zoom (toLensVL l)

4
lib-tui/GHCup/Brick/Widgets/KeyInfo.hs
View File

@ -9,7 +9,7 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{- {-
A very simple information-only widget with no handler. A very simple information-only widget with no handler.
-} -}
module GHCup.Brick.Widgets.KeyInfo where module GHCup.Brick.Widgets.KeyInfo where
@ -20,7 +20,7 @@ import qualified GHCup.Brick.Common as Common
import Brick import Brick
( Padding(Max), ( Padding(Max),
Widget(..), Widget(..),
(<+>), (<+>),
(<=>)) (<=>))
import qualified Brick import qualified Brick

36
lib-tui/GHCup/Brick/Widgets/Menu.hs
View File

@ -34,9 +34,9 @@ An input (type FieldInput) consist in
b) a validator function b) a validator function
c) a handler and a renderer c) a handler and a renderer
We have to use existential types to achive a composable API since every FieldInput has a different 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: internal type, and every MenuField has a different Lens. For example:
- The menu state is a record (MyRecord {uri: URI, flag : Bool}) - The menu state is a record (MyRecord {uri: URI, flag : Bool})
- Then, there are two MenuField: - Then, there are two MenuField:
- One MenuField has (Lens' MyRecord URI) and the other has (Lens' MyRecord Bool) - One MenuField has (Lens' MyRecord URI) and the other has (Lens' MyRecord Bool)
- The MenuFields has FieldInputs with internal state Text and Bool, respectively - The MenuFields has FieldInputs with internal state Text and Bool, respectively
@ -113,7 +113,7 @@ data FieldInput a b n =
-> HelpMessage -> HelpMessage
-> b -> b
-> (Widget n -> Widget n) -> (Widget n -> Widget n)
-> Widget n -- ^ How to draw the input, with focus a help message and input. -> Widget n -- ^ How to draw the input, with focus a help message and input.
-- A extension function can be applied too -- A extension function can be applied too
, inputHandler :: BrickEvent n () -> EventM n b () -- ^ The handler , inputHandler :: BrickEvent n () -> EventM n b () -- ^ The handler
} }
@ -138,7 +138,7 @@ data MenuField s n where
} -> MenuField s n } -> MenuField s n
isValidField :: MenuField s n -> Bool isValidField :: MenuField s n -> Bool
isValidField = (== Valid) . fieldStatus isValidField = (== Valid) . fieldStatus
makeLensesFor makeLensesFor
[ ("fieldLabel", "fieldLabelL") [ ("fieldLabel", "fieldLabelL")
@ -181,7 +181,7 @@ createCheckBoxInput = FieldInput False Right "" checkBoxRender checkBoxHandler
else border . Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign else border . Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign
checkBoxRender focus _ help check f = checkBoxRender focus _ help check f =
let core = f $ drawBool check let core = f $ drawBool check
in if focus in if focus
then core then core
else core <+> (Brick.padLeft (Brick.Pad 1) . centerV . renderAsHelpMsg $ help) else core <+> (Brick.padLeft (Brick.Pad 1) . centerV . renderAsHelpMsg $ help)
checkBoxHandler = \case checkBoxHandler = \case
@ -201,14 +201,14 @@ createEditableInput :: (Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a)
createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit Edit.handleEditorEvent createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit Edit.handleEditorEvent
where where
drawEdit focus errMsg help edi amp = drawEdit focus errMsg help edi amp =
let let
borderBox = amp . Border.border . Brick.padRight Brick.Max borderBox = amp . Border.border . Brick.padRight Brick.Max
editorRender = Edit.renderEditor (Brick.txt . T.unlines) focus edi editorRender = Edit.renderEditor (Brick.txt . T.unlines) focus edi
isEditorEmpty = Edit.getEditContents edi == [mempty] isEditorEmpty = Edit.getEditContents edi == [mempty]
in case errMsg of in case errMsg of
Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help
| otherwise -> borderBox editorRender | otherwise -> borderBox editorRender
Invalid msg Invalid msg
| focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help | focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help
| focus -> borderBox editorRender | focus -> borderBox editorRender
| otherwise -> borderBox $ renderAsErrMsg msg | otherwise -> borderBox $ renderAsErrMsg msg
@ -228,7 +228,7 @@ type Button = MenuField
createButtonInput :: FieldInput () () n createButtonInput :: FieldInput () () n
createButtonInput = FieldInput () Right "" drawButton (const $ pure ()) createButtonInput = FieldInput () Right "" drawButton (const $ pure ())
where where
drawButton True (Invalid err) _ _ amp = amp . centerV . renderAsErrMsg $ err drawButton True (Invalid err) _ _ amp = amp . centerV . renderAsErrMsg $ err
drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help
@ -250,14 +250,14 @@ renderAslabel t focus =
then highlighted $ Brick.txt t then highlighted $ Brick.txt t
else Brick.txt t else Brick.txt t
-- | Creates a left align column. -- | Creates a left align column.
-- Example: |- col2 is align dispite the length of col1 -- Example: |- col2 is align dispite the length of col1
-- row1_col1 row1_col2 -- row1_col1 row1_col2
-- row2_col1_large row2_col2 -- row2_col1_large row2_col2
leftify :: Int -> Brick.Widget n -> Brick.Widget n leftify :: Int -> Brick.Widget n -> Brick.Widget n
leftify i = Brick.hLimit i . Brick.padRight Brick.Max leftify i = Brick.hLimit i . Brick.padRight Brick.Max
-- | center a line in three rows. -- | center a line in three rows.
centerV :: Widget n -> Widget n centerV :: Widget n -> Widget n
centerV = Brick.padTopBottom 1 centerV = Brick.padTopBottom 1
@ -273,8 +273,8 @@ renderAsErrMsg = Brick.withAttr Attributes.errMsgAttr . Brick.txt
Menu widget 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 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. -- a form.
data Menu s n data Menu s n
= Menu = Menu
{ menuFields :: [MenuField s n] -- ^ The datatype representing the list of entries. Precisely, any array-like data type is highly unconvinient. { menuFields :: [MenuField s n] -- ^ The datatype representing the list of entries. Precisely, any array-like data type is highly unconvinient.
@ -311,7 +311,7 @@ handlerMenu ev =
fields <- use menuFieldsL fields <- use menuFieldsL
case focused of case focused of
Nothing -> pure () Nothing -> pure ()
Just n -> do Just n -> do
updated_fields <- updateFields n (VtyEvent e) fields updated_fields <- updateFields n (VtyEvent e) fields
if all isValidField updated_fields if all isValidField updated_fields
then menuButtonsL %= fmap (fieldStatusL .~ Valid) then menuButtonsL %= fmap (fieldStatusL .~ Valid)
@ -333,7 +333,7 @@ handlerMenu ev =
drawMenu :: (Eq n, Ord n, Show n, Brick.Named (MenuField s n) n) => Menu s n -> Widget n drawMenu :: (Eq n, Ord n, Show n, Brick.Named (MenuField s n) n) => Menu s n -> Widget n
drawMenu menu = drawMenu menu =
Brick.vBox Brick.vBox
[ Brick.vBox buttonWidgets [ Brick.vBox buttonWidgets
, Common.separator , Common.separator
@ -341,8 +341,8 @@ drawMenu menu =
$ Brick.viewport (menu ^. menuNameL) Brick.Vertical $ Brick.viewport (menu ^. menuNameL) Brick.Vertical
$ Brick.vBox fieldWidgets $ Brick.vBox fieldWidgets
, Brick.txt " " , Brick.txt " "
, Brick.padRight Brick.Max $ , Brick.padRight Brick.Max $
Brick.txt "Press " Brick.txt "Press "
<+> Common.keyToWidget (menu ^. menuExitKeyL) <+> Common.keyToWidget (menu ^. menuExitKeyL)
<+> Brick.txt " to go back" <+> Brick.txt " to go back"
] ]
@ -353,7 +353,7 @@ drawMenu menu =
maxWidth = foldl' max 5 (fmap Brick.textWidth allLabels) 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. -- A list of functions which draw a highlighted label with right padding at the left of a widget.
amplifiers = amplifiers =
let labelsWidgets = fmap renderAslabel fieldLabels let labelsWidgets = fmap renderAslabel fieldLabels
in fmap (\f b -> ((centerV . leftify (maxWidth + 10) $ f b) <+>) ) labelsWidgets in fmap (\f b -> ((centerV . leftify (maxWidth + 10) $ f b) <+>) ) labelsWidgets

10
lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs
View File

@ -74,15 +74,15 @@ create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields
initialState = InstallOptions Nothing False Nothing False [] initialState = InstallOptions Nothing False Nothing False []
-- Brick's internal editor representation is [mempty]. -- Brick's internal editor representation is [mempty].
emptyEditor i = T.null i || (i == "\n") emptyEditor i = T.null i || (i == "\n")
uriValidator :: T.Text -> Either Menu.ErrorMessage (Maybe URI) uriValidator :: T.Text -> Either Menu.ErrorMessage (Maybe URI)
uriValidator i = uriValidator i =
case not $ emptyEditor i of case not $ emptyEditor i of
True -> bimap (T.pack . show) Just . parseURI . UTF8.fromString . T.unpack $ i True -> bimap (T.pack . show) Just . parseURI . UTF8.fromString . T.unpack $ i
False -> Right Nothing False -> Right Nothing
filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath) filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
filepathValidator i = filepathValidator i =
case not $ emptyEditor i of case not $ emptyEditor i of
True -> absolutePathParser (T.unpack i) True -> absolutePathParser (T.unpack i)
False -> Right Nothing False -> Right Nothing
@ -95,7 +95,7 @@ create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text] additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
additionalValidator = Right . T.split isSpace additionalValidator = Right . T.split isSpace
fields = fields =
[ Menu.createEditableField (Common.MenuElement Common.UrlEditBox) uriValidator instBindistL [ Menu.createEditableField (Common.MenuElement Common.UrlEditBox) uriValidator instBindistL
& Menu.fieldLabelL .~ "url" & Menu.fieldLabelL .~ "url"
& Menu.fieldHelpMsgL .~ "Install the specified version from this bindist" & Menu.fieldHelpMsgL .~ "Install the specified version from this bindist"
@ -112,7 +112,7 @@ create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields
& Menu.fieldLabelL .~ "CONFIGURE_ARGS" & Menu.fieldLabelL .~ "CONFIGURE_ARGS"
& Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)" & Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
] ]
ok = Menu.createButtonField (Common.MenuElement Common.OkButton) ok = Menu.createButtonField (Common.MenuElement Common.OkButton)
& Menu.fieldLabelL .~ "Advance Install" & Menu.fieldLabelL .~ "Advance Install"
& Menu.fieldHelpMsgL .~ "Install with options below" & Menu.fieldHelpMsgL .~ "Install with options below"

2
lib-tui/GHCup/Brick/Widgets/Menus/CompileHLS.hs
View File

@ -112,7 +112,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
overWriteVersionParser :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern]) overWriteVersionParser :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern])
overWriteVersionParser = bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack overWriteVersionParser = bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack
jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int) jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
jobsV = jobsV =
let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack

6
lib-tui/GHCup/Brick/Widgets/Menus/Context.hs
View File

@ -50,14 +50,14 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
_ -> [advInstallButton] _ -> [advInstallButton]
draw :: ContextMenu -> Widget Name draw :: ContextMenu -> Widget Name
draw menu = draw menu =
Common.frontwardLayer Common.frontwardLayer
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL)) ("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
$ Brick.vBox $ Brick.vBox
[ Brick.vBox buttonWidgets [ Brick.vBox buttonWidgets
, Brick.txt " " , Brick.txt " "
, Brick.padRight Brick.Max $ , Brick.padRight Brick.Max $
Brick.txt "Press " Brick.txt "Press "
<+> Common.keyToWidget (menu ^. Menu.menuExitKeyL) <+> Common.keyToWidget (menu ^. Menu.menuExitKeyL)
<+> Brick.txt " to go back" <+> Brick.txt " to go back"
] ]

2
lib-tui/GHCup/Brick/Widgets/Navigation.hs
View File

@ -54,7 +54,7 @@ type BrickInternalState = SectionList.SectionList Common.Name ListResult
-- | How to create a navigation widget -- | How to create a navigation widget
create :: Common.Name -- The name of the section list create :: Common.Name -- The name of the section list
-> [(Common.Name, Vector ListResult)] -- a list of tuples (section name, collection of elements) -> [(Common.Name, Vector ListResult)] -- a list of tuples (section name, collection of elements)
-> Int -- The height of each item in a list. Commonly 1 -> Int -- The height of each item in a list. Commonly 1
-> BrickInternalState -> BrickInternalState
create = SectionList.sectionList create = SectionList.sectionList

28
lib-tui/GHCup/Brick/Widgets/SectionList.hs
View File

@ -15,8 +15,8 @@
{- A general system for lists with sections {- 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 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). 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 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 - To access sections use the lens provider sectionL and the name of the section you'd like to access
@ -33,7 +33,7 @@ import Brick
( BrickEvent(VtyEvent, MouseDown), ( BrickEvent(VtyEvent, MouseDown),
EventM, EventM,
Size(..), Size(..),
Widget(..), Widget(..),
ViewportType (Vertical), ViewportType (Vertical),
(<=>)) (<=>))
import qualified Brick import qualified Brick
@ -68,8 +68,8 @@ makeLensesFor [("sectionListFocusRing", "sectionListFocusRingL"), ("sectionListE
type SectionList n e = GenericSectionList n V.Vector e type SectionList n e = GenericSectionList n V.Vector e
-- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses. -- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses.
sectionList :: Foldable t sectionList :: Foldable t
=> n -- The name of the section list => n -- The name of the section list
-> [(n, t e)] -- a list of tuples (section name, collection of elements) -> [(n, t e)] -- a list of tuples (section name, collection of elements)
-> Int -> Int
@ -81,14 +81,14 @@ sectionList name elements height
, sectionListName = name , sectionListName = name
} }
-- | This lens constructor, takes a name and looks if a section has such a 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 -- Used to dispatch events to sections. It is a partial function only meant to
-- be used with the FocusRing inside GenericSectionList -- be used with the FocusRing inside GenericSectionList
sectionL :: Eq n => n -> Lens' (GenericSectionList n t e) (L.GenericList n t e) sectionL :: Eq n => n -> Lens' (GenericSectionList n t e) (L.GenericList n t e)
sectionL section_name = lens g s sectionL section_name = lens g s
where is_section_name = (== section_name) . L.listName where is_section_name = (== section_name) . L.listName
g section_list = g section_list =
let elms = section_list ^. sectionListElementsL let elms = section_list ^. sectionListElementsL
zeroth = elms V.! 0 -- TODO: This crashes for empty vectors. zeroth = elms V.! 0 -- TODO: This crashes for empty vectors.
in fromMaybe zeroth (V.find is_section_name elms) in fromMaybe zeroth (V.find is_section_name elms)
s gl@(GenericSectionList _ elms _) list = s gl@(GenericSectionList _ elms _) list =
case V.findIndex is_section_name elms of case V.findIndex is_section_name elms of
@ -97,16 +97,16 @@ sectionL section_name = lens g s
in gl & sectionListElementsL .~ new_elms in gl & sectionListElementsL .~ new_elms
moveDown :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) () moveDown :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) ()
moveDown = do moveDown = do
ring <- use sectionListFocusRingL ring <- use sectionListFocusRingL
case F.focusGetCurrent ring of case F.focusGetCurrent ring of
Nothing -> pure () 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. 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) current_list <- use (sectionL l)
let current_idx = L.listSelected current_list let current_idx = L.listSelected current_list
list_length = current_list & length list_length = current_list & length
if current_idx == Just (list_length - 1) if current_idx == Just (list_length - 1)
then do then do
new_focus <- sectionListFocusRingL <%= F.focusNext new_focus <- sectionListFocusRingL <%= F.focusNext
case F.focusGetCurrent new_focus of 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 Nothing -> pure () -- |- Optic.Zoom.zoom doesn't typecheck but Lens.Micro.Mtl.zoom does. It is re-exported by Brick
@ -122,10 +122,10 @@ moveUp = do
current_list <- use (sectionL l) current_list <- use (sectionL l)
let current_idx = L.listSelected current_list let current_idx = L.listSelected current_list
if current_idx == Just 0 if current_idx == Just 0
then do then do
new_focus <- sectionListFocusRingL <%= F.focusPrev new_focus <- sectionListFocusRingL <%= F.focusPrev
case F.focusGetCurrent new_focus of case F.focusGetCurrent new_focus of
Nothing -> pure () Nothing -> pure ()
Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToEnd) Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToEnd)
else Common.zoom (sectionL l) $ Brick.modify L.listMoveUp else Common.zoom (sectionL l) $ Brick.modify L.listMoveUp
@ -188,6 +188,6 @@ renderSectionList renderElem sectionFocus ge@(GenericSectionList focus elms slNa
-- | Equivalent to listSelectedElement -- | Equivalent to listSelectedElement
sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e) sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e)
sectionListSelectedElement generic_section_list = do sectionListSelectedElement generic_section_list = do
current_focus <- generic_section_list ^. sectionListFocusRingL & F.focusGetCurrent current_focus <- generic_section_list ^. sectionListFocusRingL & F.focusGetCurrent
let current_section = generic_section_list ^. sectionL current_focus let current_section = generic_section_list ^. sectionL current_focus
L.listSelectedElement current_section L.listSelectedElement current_section

2
lib-tui/GHCup/Brick/Widgets/Tutorial.hs
View File

@ -9,7 +9,7 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{- {-
A very simple information-only widget with no handler. A very simple information-only widget with no handler.
-} -}
module GHCup.Brick.Widgets.Tutorial (draw) where module GHCup.Brick.Widgets.Tutorial (draw) where

10
lib-tui/GHCup/BrickMain.hs
View File

@ -51,14 +51,14 @@ brickMain s = do
Right ad -> do Right ad -> do
let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing
current_element = Navigation.sectionListSelectedElement initial_list current_element = Navigation.sectionListSelectedElement initial_list
exit_key = bQuit . keyBindings $ s exit_key = bQuit . keyBindings $ s
case current_element of case current_element of
Nothing -> do Nothing -> do
flip runReaderT s $ logError "Error building app state: empty ResultList" flip runReaderT s $ logError "Error building app state: empty ResultList"
exitWith $ ExitFailure 2 exitWith $ ExitFailure 2
Just (_, e) -> Just (_, e) ->
let initapp = let initapp =
BrickApp.app BrickApp.app
(Attributes.defaultAttributes $ noColor $ settings s) (Attributes.defaultAttributes $ noColor $ settings s)
(Attributes.dimAttributes $ noColor $ settings s) (Attributes.dimAttributes $ noColor $ settings s)
initstate = initstate =
@ -71,7 +71,7 @@ brickMain s = do
(CompileHLS.create exit_key) (CompileHLS.create exit_key)
(keyBindings s) (keyBindings s)
Common.Navigation Common.Navigation
in Brick.defaultMain initapp initstate in Brick.defaultMain initapp initstate
$> () $> ()
Left e -> do Left e -> do
flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e) flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)