From 1353a2fd2077b3d328b445b188adaed1d7957aa7 Mon Sep 17 00:00:00 2001 From: Luis Morillo Date: Sun, 8 Oct 2023 17:11:32 +0200 Subject: [PATCH] use map-like data structure --- app/ghcup/BrickMain.hs | 397 +++++++++++++++++------------------------ ghcup.cabal | 2 +- 2 files changed, 164 insertions(+), 235 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 46eabc2..456c8b4 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -26,53 +26,21 @@ import GHCup.Prelude.Process import GHCup.Prompts import Brick - ( defaultMain, - suspendAndResume, - attrMap, - showFirstCursor, - hLimit, - vBox, - viewport, - visible, - fill, - vLimit, - forceAttr, - putCursor, - updateAttrMap, - withDefAttr, - padLeft, - (<+>), - emptyWidget, - txtWrap, - attrName, - withAttr, - (<=>), - str, - withBorderStyle, - padBottom, - halt, - BrickEvent(VtyEvent, MouseDown), + ( BrickEvent(VtyEvent, MouseDown), App(..), - ViewportType(Vertical), - Size(Greedy), - Location(Location), Padding(Max, Pad), - Widget(Widget, render), AttrMap, - Direction(..), - get, - zoom, EventM, - suffixLenses, - Named(..), modify ) -import Brick.Widgets.Border ( hBorder, borderWithLabel ) + Size(..), + Named(..), + Widget(..), + ViewportType (Vertical), + (<+>), + (<=>)) +import qualified Brick +import Brick.Widgets.Border ( hBorder, borderWithLabel) import Brick.Widgets.Border.Style ( unicode ) import Brick.Widgets.Center ( center ) -import Brick.Widgets.Dialog (buttonSelectedAttr) -import Brick.Widgets.List ( listSelectedFocusedAttr - , listSelectedAttr - , listAttr - ) import qualified Brick.Widgets.List as L import Brick.Focus (FocusRing) import qualified Brick.Focus as F @@ -87,12 +55,12 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Resource import Data.Bool import Data.Functor -import Data.Function ( (&)) +import Data.Function ( (&), on) import Data.List import Data.Maybe import Data.IORef (IORef, readIORef, newIORef, writeIORef, modifyIORef) import Data.Vector ( Vector - , (!?) + ) import Data.Versions import Haskus.Utils.Variant.Excepts @@ -117,10 +85,9 @@ import qualified System.Posix.Process as SPP import Optics.TH (makeLenses, makeLensesFor) import Optics.State (use) import Optics.State.Operators ( (.=), (%=), (<%=)) -import Optics.Optic ((%)) -import Optics.Operators ((.~), (^.)) +import Optics.Operators ((.~), (^.), (%~)) import Optics.Getter (view) -import Optics.Lens (Lens', lens, toLensVL, lensVL) +import Optics.Lens (Lens', lens, toLensVL) {- Brick's 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) @@ -179,20 +146,8 @@ sectionL section_name = lens g s Just i -> let new_elms = V.update elms (V.fromList [(i, list)]) in gl & sectionListElementsL .~ new_elms --- | 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 () - -> EventM n (GenericSectionList n t e) () -handleGenericListEvent (VtyEvent (Vty.EvKey (Vty.KChar '\t') [])) = sectionListFocusRingL %= F.focusNext -handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KBackTab [])) = sectionListFocusRingL %= F.focusPrev -handleGenericListEvent (VtyEvent ev@(Vty.EvKey Vty.KDown [])) = do +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 () @@ -205,9 +160,11 @@ handleGenericListEvent (VtyEvent ev@(Vty.EvKey Vty.KDown [])) = 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 -> zoom (toLensVL $ sectionL new_l) (modify L.listMoveToBeginning) - else zoom (toLensVL $ sectionL l) $ L.handleListEvent ev -handleGenericListEvent (VtyEvent ev@(Vty.EvKey Vty.KUp [])) = do + Just new_l -> Brick.zoom (toLensVL $ sectionL new_l) (Brick.modify L.listMoveToBeginning) + else Brick.zoom (toLensVL $ 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 () @@ -219,13 +176,32 @@ handleGenericListEvent (VtyEvent ev@(Vty.EvKey Vty.KUp [])) = do new_focus <- sectionListFocusRingL <%= F.focusPrev case F.focusGetCurrent new_focus of Nothing -> pure () - Just new_l -> zoom (toLensVL $ sectionL new_l) (modify L.listMoveToEnd) - else zoom (toLensVL $ sectionL l) $ L.handleListEvent ev + Just new_l -> Brick.zoom (toLensVL $ sectionL new_l) (Brick.modify L.listMoveToEnd) + else Brick.zoom (toLensVL $ 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 -> zoom (toLensVL $ sectionL l) $ L.handleListEvent ev + Just l -> Brick.zoom (toLensVL $ sectionL l) $ L.handleListEvent ev handleGenericListEvent _ = pure () -- This re-uses Brick.Widget.List.renderList @@ -236,18 +212,22 @@ renderSectionList :: (Traversable t, Ord n, Show n, Eq n, L.Splittable t) -> Bool -- ^ Whether the section list has focus -> GenericSectionList n t e -- ^ The section list to render -> Widget n -renderSectionList render_separator render_border render_elem section_focus (GenericSectionList focus elms _) = - V.foldl' (\wacc list -> - let has_focus = is_focused_section list - list_name = L.listName list - in wacc - <=> render_separator has_focus list_name - <=> inner_widget has_focus list_name list - ) - emptyWidget elms +renderSectionList render_separator render_border render_elem section_focus (GenericSectionList focus elms sl_name) = + Widget Greedy Greedy $ render $ + Brick.viewport sl_name Vertical $ + V.foldl' (\wacc list -> + let has_focus_list = is_focused_section list + list_name = L.listName list + in wacc + <=> render_separator has_focus_list list_name + <=> inner_widget has_focus_list list_name list + ) + Brick.emptyWidget elms where is_focused_section l = section_focus && Just (L.listName l) == F.focusGetCurrent focus - inner_widget has_focus k l = render_border has_focus k (L.renderList render_elem has_focus l) + inner_widget has_focus k l = + let w = render_border has_focus k (Brick.vLimit (length l) $ L.renderList render_elem has_focus l) + in if has_focus then Brick.visible w else w -- | Equivalent to listSelectedElement @@ -261,6 +241,7 @@ sectionListSelectedElement generic_section_list = do -} +type Name = String installedSign :: String #if IS_WINDOWS @@ -299,13 +280,7 @@ data BrickSettings = BrickSettings makeLenses ''BrickSettings -data BrickInternalState = BrickInternalState - { _clr :: Vector ListResult - , _ix :: Int - } - --deriving Show - -makeLenses ''BrickInternalState +type BrickInternalState = SectionList Name ListResult data BrickState = BrickState { _appData :: BrickData @@ -324,7 +299,7 @@ keyHandlers :: KeyBindings ) ] keyHandlers KeyBindings {..} = - [ (bQuit, const "Quit" , halt) + [ (bQuit, const "Quit" , Brick.halt) , (bInstall, const "Install" , withIOAction install') , (bUninstall, const "Uninstall", withIOAction del') , (bSet, const "Set" , withIOAction set') @@ -348,7 +323,7 @@ keyHandlers KeyBindings {..} = ad <- use appData current_app_state <- use appState appSettings .= newAppSettings - appState .= constructList ad app_settings (Just current_app_state) + appState .= constructList ad newAppSettings (Just current_app_state) @@ -364,36 +339,38 @@ showMod = tail . show ui :: AttrMap -> BrickState -> Widget String ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..} - = padBottom Max - ( withBorderStyle unicode - $ borderWithLabel (str "GHCup") - (center (header <=> hBorder <=> renderList' _appState)) + = Brick.padBottom Max + ( Brick.withBorderStyle unicode + $ borderWithLabel (Brick.str "GHCup") + (center (header <=> renderList' _appState)) ) <=> footer - where footer = - withAttr (attrName "help") - . txtWrap + Brick.withAttr (Brick.attrName "help") + . Brick.txtWrap . T.pack . foldr1 (\x y -> x <> " " <> y) . fmap (\(KeyCombination key mods, s, _) -> intercalate "+" (showKey key : (showMod <$> mods)) <> ":" <> s as) $ keyHandlers _appKeys header = - minHSize 2 emptyWidget - <+> padLeft (Pad 2) (minHSize 6 $ str "Tool") - <+> minHSize 15 (str "Version") - <+> padLeft (Pad 1) (minHSize 25 $ str "Tags") - <+> padLeft (Pad 5) (str "Notes") - renderList' bis@BrickInternalState{..} = - let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) _clr - minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) _clr - in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis - renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} = + 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 $ 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 + render_separator _ _ = hBorder + render_border _ _ = id + in Brick.withDefAttr L.listAttr $ renderSectionList render_separator render_border (renderItem minTagSize minVerSize) True bis + renderItem minTagSize minVerSize b listResult@ListResult{lTag = lTag', ..} = let marks = if - | lSet -> (withAttr (attrName "set") $ str setSign) - | lInstalled -> (withAttr (attrName "installed") $ str installedSign) - | otherwise -> (withAttr (attrName "not-installed") $ str notInstalledSign) + | lSet -> (Brick.withAttr (Brick.attrName "set") $ str setSign) + | lInstalled -> (Brick.withAttr (Brick.attrName "installed") $ str installedSign) + | otherwise -> (Brick.withAttr (Brick.attrName "not-installed") $ str notInstalledSign) ver = case lCross of Nothing -> T.unpack . prettyVer $ lVer Just c -> T.unpack (c <> "-" <> prettyVer lVer) @@ -401,97 +378,59 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..} | lNoBindist && not lInstalled && not b -- TODO: overloading dim and active ignores active -- so we hack around it here - = updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist") + = Brick.updateAttrMap (const dimAttrs) . Brick.withAttr (Brick.attrName "no-bindist") | otherwise = id hooray | elem Latest lTag' && not lInstalled = - withAttr (attrName "hooray") + Brick.withAttr (Brick.attrName "hooray") | otherwise = id - active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id - in hooray $ active $ dim + in hooray $ dim ( marks - <+> padLeft (Pad 2) + <+> Brick.padLeft (Pad 2) ( minHSize 6 (printTool lTool) ) - <+> minHSize minVerSize (str ver) + <+> minHSize minVerSize (Brick.str ver) <+> (let l = catMaybes . fmap printTag $ sort lTag' - in padLeft (Pad 1) $ minHSize minTagSize $ if null l - then emptyWidget - else foldr1 (\x y -> x <+> str "," <+> y) l + in Brick.padLeft (Pad 1) $ minHSize minTagSize $ if null l + then Brick.emptyWidget + else foldr1 (\x y -> x <+> Brick.str "," <+> y) l ) - <+> padLeft (Pad 5) + <+> Brick.padLeft (Pad 5) ( let notes = printNotes listResult in if null notes - then emptyWidget - else foldr1 (\x y -> x <+> str "," <+> y) notes + then Brick.emptyWidget + else foldr1 (\x y -> x <+> Brick.str "," <+> y) notes ) - <+> vLimit 1 (fill ' ') + <+> Brick.vLimit 1 (Brick.fill ' ') ) - printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended" - printTag Latest = Just $ withAttr (attrName "latest") $ str "latest" - printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease" - printTag Nightly = Just $ withAttr (attrName "nightly") $ str "nightly" - printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp'')) + printTag Recommended = Just $ Brick.withAttr (Brick.attrName "recommended") $ Brick.str "recommended" + printTag Latest = Just $ Brick.withAttr (Brick.attrName "latest") $ Brick.str "latest" + printTag Prerelease = Just $ Brick.withAttr (Brick.attrName "prerelease") $ Brick.str "prerelease" + printTag Nightly = Just $ Brick.withAttr (Brick.attrName "nightly") $ Brick.str "nightly" + printTag (Base pvp'') = Just $ Brick.str ("base-" ++ T.unpack (prettyPVP pvp'')) printTag Old = Nothing - printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease" - printTag LatestNightly = Just $ withAttr (attrName "latest-nightly") $ str "latest-nightly" - printTag (UnknownTag t) = Just $ str t + printTag LatestPrerelease = Just $ Brick.withAttr (Brick.attrName "latest-prerelease") $ Brick.str "latest-prerelease" + printTag LatestNightly = Just $ Brick.withAttr (Brick.attrName "latest-nightly") $ Brick.str "latest-nightly" + printTag (UnknownTag t) = Just $ Brick.str t - printTool Cabal = str "cabal" - printTool GHC = str "GHC" - printTool GHCup = str "GHCup" - printTool HLS = str "HLS" - printTool Stack = str "Stack" + 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 [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty + (if hlsPowered then [Brick.withAttr (Brick.attrName "hls-powered") $ Brick.str "hls-powered"] else mempty ) - ++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty) + ++ (if lStray then [Brick.withAttr (Brick.attrName "stray") $ Brick.str "stray"] else mempty) ++ (case lReleaseDay of Nothing -> mempty - Just d -> [withAttr (attrName "day") $ str (show d)]) - - -- | Draws the list elements. - -- - -- Evaluates the underlying container up to, and a bit beyond, the - -- selected element. The exact amount depends on available height - -- for drawing and 'listItemHeight'. At most, it will evaluate up to - -- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the - -- available height. - drawListElements :: (Int -> Bool -> ListResult -> Widget String) - -> Bool - -> BrickInternalState - -> Widget String - drawListElements drawElem foc is@(BrickInternalState clr _) = - Widget Greedy Greedy $ - let - es = clr - listSelected = fmap fst $ listSelectedElement' is - - drawnElements = flip V.imap es $ \i' e -> - let addSeparator w = case es !? (i' - 1) of - Just e' | lTool e' /= lTool e -> - hBorder <=> w - _ -> w - - isSelected = Just i' == listSelected - elemWidget = drawElem i' isSelected e - selItemAttr = if foc - then withDefAttr listSelectedFocusedAttr - else withDefAttr listSelectedAttr - makeVisible' = if isSelected then visible . selItemAttr else id - in addSeparator $ makeVisible' elemWidget - - in render - $ viewport "GHCup" Vertical - $ vBox - $ V.toList drawnElements - + Just d -> [Brick.withAttr (Brick.attrName "day") $ Brick.str (show d)]) minHSize :: Int -> Widget n -> Widget n -minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ') +minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ') app :: AttrMap -> AttrMap -> App BrickState () String app attrs dimAttrs = @@ -499,29 +438,29 @@ app attrs dimAttrs = , appHandleEvent = eventHandler , appStartEvent = return () , appAttrMap = const attrs - , appChooseCursor = showFirstCursor + , appChooseCursor = Brick.showFirstCursor } defaultAttributes :: Bool -> AttrMap -defaultAttributes no_color = attrMap +defaultAttributes no_color = Brick.attrMap Vty.defAttr - [ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) - , (attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red) - , (attrName "set" , Vty.defAttr `withForeColor` Vty.green) - , (attrName "installed" , Vty.defAttr `withForeColor` Vty.green) - , (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green) - , (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green) - , (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow) - , (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red) - , (attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red) - , (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red) - , (attrName "nightly" , Vty.defAttr `withForeColor` Vty.red) - , (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue) - , (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue) - , (attrName "day" , Vty.defAttr `withForeColor` Vty.blue) - , (attrName "help" , Vty.defAttr `withStyle` Vty.italic) - , (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite) - , (buttonSelectedAttr , Vty.defAttr `withBackColor` Vty.brightWhite) + [ (L.listSelectedFocusedAttr , Vty.defAttr `withBackColor` Vty.blue) --, (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) + , (L.listSelectedAttr , Vty.defAttr) -- we use list attributes for active. + , (Brick.attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red) + , (Brick.attrName "set" , Vty.defAttr `withForeColor` Vty.green) + , (Brick.attrName "installed" , Vty.defAttr `withForeColor` Vty.green) + , (Brick.attrName "recommended" , Vty.defAttr `withForeColor` Vty.green) + , (Brick.attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green) + , (Brick.attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow) + , (Brick.attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red) + , (Brick.attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red) + , (Brick.attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red) + , (Brick.attrName "nightly" , Vty.defAttr `withForeColor` Vty.red) + , (Brick.attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue) + , (Brick.attrName "stray" , Vty.defAttr `withForeColor` Vty.blue) + , (Brick.attrName "day" , Vty.defAttr `withForeColor` Vty.blue) + , (Brick.attrName "help" , Vty.defAttr `withStyle` Vty.italic) + , (Brick.attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite) ] where withForeColor | no_color = const @@ -533,10 +472,10 @@ defaultAttributes no_color = attrMap withStyle = Vty.withStyle dimAttributes :: Bool -> AttrMap -dimAttributes no_color = attrMap +dimAttributes no_color = Brick.attrMap (Vty.defAttr `Vty.withStyle` Vty.dim) - [ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ?? - , (attrName "no-bindist", 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 @@ -546,37 +485,23 @@ eventHandler :: BrickEvent String e -> EventM String BrickState () eventHandler ev = do AppState { keyBindings = kb } <- liftIO $ readIORef settings' case ev of - (MouseDown _ Vty.BScrollUp _ _) -> appState %= moveCursor 1 Up - (MouseDown _ Vty.BScrollDown _ _) -> appState %= moveCursor 1 Down - (VtyEvent (Vty.EvResize _ _)) -> pure () - (VtyEvent (Vty.EvKey Vty.KUp _)) -> appState %= moveCursor 1 Up - (VtyEvent (Vty.EvKey Vty.KDown _)) -> appState %= moveCursor 1 Down - (VtyEvent (Vty.EvKey key _)) -> + inner_event@(VtyEvent (Vty.EvKey key _)) -> case find (\(key', _, _) -> key' == key) (keyHandlers kb) of - Nothing -> pure () + Nothing -> void $ Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event Just (_, _, handler) -> handler - _ -> pure () - - -moveCursor :: Int -> Direction -> BrickInternalState -> BrickInternalState -moveCursor steps direction ais@BrickInternalState{..} = - let newIx = if direction == Down then _ix + steps else _ix - steps - in case _clr !? newIx of - Just _ -> ais & ix .~ newIx - Nothing -> ais - + inner_event -> Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event -- | 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 +withIOAction :: (Ord n, Eq n) => ( (Int, ListResult) -> ReaderT AppState IO (Either String a)) -> EventM n BrickState () withIOAction action = do - as <- get - case listSelectedElement' (view appState as) of + as <- Brick.get + case sectionListSelectedElement (view appState as) of Nothing -> pure () Just (curr_ix, e) -> do - suspendAndResume $ do + Brick.suspendAndResume $ do settings <- readIORef settings' flip runReaderT settings $ action (curr_ix, e) >>= \case Left err -> liftIO $ putStrLn ("Error: " <> err) @@ -601,22 +526,28 @@ updateList appD BrickState{..} = , _appKeys = _appKeys } - constructList :: BrickData -> BrickSettings -> Maybe BrickInternalState -> BrickInternalState -constructList appD appSettings = - replaceLR (filterVisible (_showAllVersions appSettings) - (_showAllTools appSettings)) +constructList appD settings = + replaceLR (filterVisible (_showAllVersions settings) + (_showAllTools settings)) (_lr appD) -listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult) -listSelectedElement' BrickInternalState{..} = fmap (_ix, ) $ _clr !? _ix +-- | 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 (show tool) (view sectionListFocusRingL internal_state) + tool_lens = sectionL (show 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. - -selectLatest :: Vector ListResult -> Int -selectLatest = fromMaybe 0 . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) +-- | 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 @@ -626,14 +557,13 @@ replaceLR :: (ListResult -> Bool) -> [ListResult] -> Maybe BrickInternalState -> BrickInternalState -replaceLR filterF lr s = - let oldElem = s >>= listSelectedElement' - newVec = V.fromList . filter filterF $ lr - newSelected = - case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of - Just ix -> ix - Nothing -> selectLatest newVec - in BrickInternalState newVec newSelected +replaceLR filterF list_result s = + let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e) + newVec = [(show $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)] + newSectionList = sectionList "GHCupList" newVec 0 + 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 @@ -881,7 +811,7 @@ brickMain s = do eAppData <- getAppData (Just $ ghcupInfo s) case eAppData of Right ad -> - defaultMain + Brick.defaultMain (app (defaultAttributes (noColor $ settings s)) (dimAttributes (noColor $ settings s))) (BrickState ad defaultAppSettings @@ -925,4 +855,3 @@ getAppData mgi = runExceptT $ do flip runReaderT settings $ do lV <- listVersions Nothing [] False True (Nothing, Nothing) pure $ BrickData (reverse lV) - diff --git a/ghcup.cabal b/ghcup.cabal index 6ec8a4f..476eb8e 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -354,7 +354,7 @@ test-suite ghcup-test default-language: Haskell2010 default-extensions: LambdaCase - MultiWayIf++- + MultiWayIf PackageImports RecordWildCards ScopedTypeVariables