From 5c3dad1bb9199abaf815bfcae563eeb8274a4fcb Mon Sep 17 00:00:00 2001 From: Luis Morillo Date: Sat, 18 Nov 2023 10:55:16 +0100 Subject: [PATCH] reorganize code by sections --- app/ghcup/BrickMain.hs | 228 +++++++++++++++++++++++------------------ 1 file changed, 128 insertions(+), 100 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index a9a42e3..30fe099 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -238,7 +238,9 @@ sectionListSelectedElement generic_section_list = do let current_section = generic_section_list ^. sectionL current_focus L.listSelectedElement current_section -{- GHCUp State +{- Brick app data structures. + +In this section we define the state, the widgets and the core data structures which we will be using for the brick app. -} @@ -299,41 +301,21 @@ data BrickState = BrickState makeLenses ''BrickState -keyHandlers :: KeyBindings - -> [ ( KeyCombination - , BrickSettings -> String - , 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) _showAllTools - ) - , (bUp, const "Up", appState %= moveCursor 1 Up) - , (bDown, const "Down", appState %= moveCursor 1 Down) - , (KeyCombination (Vty.KChar 'x') [], const "Tutorial", mode .= Tutorial) - ] - where - --hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m () - hideShowHandler' f p = do - app_settings <- use appSettings - let - vers = f app_settings - tools = p app_settings - newAppSettings = app_settings & showAllVersions .~ vers & showAllTools .~ tools - ad <- use appData - current_app_state <- use appState - appSettings .= newAppSettings - appState .= constructList ad newAppSettings (Just current_app_state) +app :: AttrMap -> AttrMap -> App BrickState () Name +app attrs dimAttrs = + App { appDraw = drawUI dimAttrs + , appHandleEvent = eventHandler + , appStartEvent = return () + , appAttrMap = const attrs + , appChooseCursor = Brick.showFirstCursor + } +{- Drawing. + +The section for creating our widgets. + +-} showKey :: Vty.Key -> String showKey (Vty.KChar c) = [c] @@ -345,8 +327,8 @@ showMod :: Vty.Modifier -> String showMod = tail . show -ui :: AttrMap -> BrickState -> Widget Name -ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..} +drawNavigation :: AttrMap -> BrickState -> Widget Name +drawNavigation dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..} = Brick.padBottom Max ( Brick.withBorderStyle unicode $ borderWithLabel (Brick.str "GHCup") @@ -435,81 +417,79 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..} Nothing -> mempty Just d -> [Brick.withAttr dayAttr $ Brick.str (show d)]) -minHSize :: Int -> Widget n -> Widget n -minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ') + minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ') + +drawTutorial :: AttrMap -> BrickState -> Widget Name +drawTutorial dimAttrs st = + let + mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max) + txt_separator = hBorder <+> Brick.str " o " <+> hBorder + in centerLayer + $ Brick.hLimitPercent 75 + $ Brick.vLimitPercent 50 + $ Brick.withBorderStyle unicode + $ borderWithLabel (Brick.txt "Tutorial") + $ Brick.vBox + (fmap center + [ mkTextBox [Brick.txt "GHCup is a distribution channel for Haskell's tools."] + , txt_separator + , mkTextBox [ + Brick.hBox [ + Brick.txt "This symbol " + , Brick.withAttr installedAttr (Brick.str installedSign) + , Brick.txt " means that the tool is installed but not in used" + ] + , Brick.hBox [ + Brick.txt "This symbol " + , Brick.withAttr setAttr (Brick.str setSign) + , Brick.txt " means that the tool is installed and in used" + ] + , Brick.hBox [ + Brick.txt "This symbol " + , Brick.withAttr notInstalledAttr (Brick.str notInstalledSign) + , Brick.txt " means that the tool isn't installed" + ] + ] + , txt_separator + , mkTextBox [ + Brick.hBox [ + Brick.withAttr recommendedAttr $ Brick.str "recommended" + , Brick.txt " tag is based on ..." + ] + , Brick.hBox [ + Brick.withAttr latestAttr $ Brick.str "latest" + , Brick.txt " tag is for the latest distributed version of the tool" + ] + , Brick.hBox [ + Brick.withAttr latestAttr $ Brick.str "hls-powered" + , Brick.txt " denotes the compiler version supported by the currently set (" + , Brick.withAttr setAttr (Brick.str setSign) + , Brick.txt ") hls" + ] + , Brick.txt "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 Enter to exit the tutorial") -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 = case st ^. mode of - Navigation -> [ui dimAttrs st] - Tutorial -> - let mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max) - txt_separator = hBorder <+> Brick.str " o " <+> hBorder - tutorial = centerLayer - $ Brick.hLimitPercent 75 - $ Brick.vLimitPercent 50 - $ Brick.withBorderStyle unicode - $ borderWithLabel (Brick.txt "Tutorial") - $ Brick.vBox - (fmap center - [ mkTextBox [Brick.txt "GHCup is a distribution channel for Haskell's tools."] - , txt_separator - , mkTextBox [ - Brick.hBox [ - Brick.txt "This symbol " - , Brick.withAttr installedAttr (Brick.str installedSign) - , Brick.txt " means that the tool is installed but not in used" - ] - , Brick.hBox [ - Brick.txt "This symbol " - , Brick.withAttr setAttr (Brick.str setSign) - , Brick.txt " means that the tool is installed and in used" - ] - , Brick.hBox [ - Brick.txt "This symbol " - , Brick.withAttr notInstalledAttr (Brick.str notInstalledSign) - , Brick.txt " means that the tool isn't installed" - ] - ] - , txt_separator - , mkTextBox [ - Brick.hBox [ - Brick.withAttr recommendedAttr $ Brick.str "recommended" - , Brick.txt " tag is based on ..." - ] - , Brick.hBox [ - Brick.withAttr latestAttr $ Brick.str "latest" - , Brick.txt " tag is for the latest distributed version of the tool" - ] - , Brick.hBox [ - Brick.withAttr latestAttr $ Brick.str "hls-powered" - , Brick.txt " denotes the compiler version supported by the currently set (" - , Brick.withAttr setAttr (Brick.str setSign) - , Brick.txt ") hls" - ] - , Brick.txt "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 Enter to exit the tutorial") - in [tutorial, ui dimAttrs st] + Navigation -> [drawNavigation dimAttrs st] + Tutorial -> [drawTutorial dimAttrs st, drawNavigation dimAttrs st] + +{- Attributes + +-} defaultAttributes :: Bool -> AttrMap defaultAttributes no_color = Brick.attrMap Vty.defAttr - [ (L.listSelectedFocusedAttr , Vty.defAttr `withBackColor` Vty.blue) --, (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) - , (L.listSelectedAttr , Vty.defAttr) -- we use list attributes for active. + [ (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) @@ -566,6 +546,43 @@ dimAttributes no_color = Brick.attrMap withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo | otherwise = Vty.withBackColor +{- Handlers + +-} + +keyHandlers :: KeyBindings + -> [ ( KeyCombination + , BrickSettings -> String + , 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) _showAllTools + ) + , (KeyCombination (Vty.KChar 'x') [], const "Tutorial", mode .= Tutorial) + ] + where + --hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m () + hideShowHandler' f p = do + app_settings <- use appSettings + let + vers = f app_settings + tools = p app_settings + newAppSettings = app_settings & showAllVersions .~ vers & showAllTools .~ tools + ad <- use appData + current_app_state <- use appState + appSettings .= newAppSettings + appState .= constructList ad newAppSettings (Just current_app_state) + + tutorialHandler :: BrickEvent Name e -> EventM Name BrickState () tutorialHandler ev = case ev of @@ -589,6 +606,17 @@ eventHandler ev = do Navigation -> navigationHandler ev Tutorial -> tutorialHandler ev + +{- Core Logic. + +This section defines the IO actions we can execute within the Brick App: + - Install + - Set + - UnInstall + - Launch the Changelog + +-} + -- | 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)