diff --git a/lib-tui/GHCup/Brick/Actions.hs b/lib-tui/GHCup/Brick/Actions.hs index 57a13d0..dc1facb 100644 --- a/lib-tui/GHCup/Brick/Actions.hs +++ b/lib-tui/GHCup/Brick/Actions.hs @@ -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: - Install @@ -116,7 +116,7 @@ constructList appD settings = 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) + tool_lens = sectionL (Singular tool) in internal_state & sectionListFocusRingL .~ new_focus & 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 ()) installWithOptions opts (_, ListResult {..}) = do AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask - let + let misolated = opts ^. AdvanceInstall.isolateDirL shouldIsolate = maybe GHCupInternal IsolateDir (opts ^. AdvanceInstall.isolateDirL) shouldForce = opts ^. AdvanceInstall.forceInstallL @@ -233,15 +233,15 @@ installWithOptions opts (_, ListResult {..}) = do case opts ^. AdvanceInstall.instBindistL of Nothing -> do liftE $ - runBothE' + runBothE' (installGHCBin v shouldIsolate shouldForce extraArgs) (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing)) - pure (vi, dirs, ce) + pure (vi, dirs, ce) Just uri -> do liftE $ - runBothE' + runBothE' (installGHCBindist - (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing) + (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing) v shouldIsolate shouldForce @@ -253,14 +253,14 @@ installWithOptions opts (_, ListResult {..}) = do let vi = getVersionInfo v Cabal dls case opts ^. AdvanceInstall.instBindistL of Nothing -> do - liftE $ - runBothE' + liftE $ + runBothE' (installCabalBin lVer shouldIsolate shouldForce) (when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer)) pure (vi, dirs, ce) Just uri -> do - liftE $ - runBothE' + liftE $ + runBothE' (installCabalBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce) (when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer)) pure (vi, dirs, ce) @@ -268,19 +268,19 @@ installWithOptions opts (_, ListResult {..}) = do GHCup -> do let vi = snd <$> getLatest dls GHCup liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce) - HLS -> do + HLS -> do let vi = getVersionInfo v HLS dls case opts ^. AdvanceInstall.instBindistL of Nothing -> do - liftE $ - runBothE' + liftE $ + runBothE' (installHLSBin lVer shouldIsolate shouldForce) (when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing)) - pure (vi, dirs, ce) + pure (vi, dirs, ce) Just uri -> do - liftE $ - runBothE' - (installHLSBindist + liftE $ + runBothE' + (installHLSBindist (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing) lVer shouldIsolate @@ -293,13 +293,13 @@ installWithOptions opts (_, ListResult {..}) = do case opts ^. AdvanceInstall.instBindistL of Nothing -> do liftE $ - runBothE' + runBothE' (installStackBin lVer shouldIsolate shouldForce) (when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer)) pure (vi, dirs, ce) Just uri -> do liftE $ - runBothE' + runBothE' (installStackBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce) (when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer)) pure (vi, dirs, ce) @@ -330,7 +330,7 @@ installWithOptions opts (_, ListResult {..}) = do 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) +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 []) @@ -461,11 +461,11 @@ changelog' (_, ListResult {..}) = do Right _ -> pure $ Right () 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 compopts (_, lr@ListResult{lTool = GHC, ..}) = do appstate <- ask - let run = + let run = runResourceT . runE @'[ AlreadyInstalled , BuildFailed @@ -500,7 +500,7 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do "...waiting for 5 seconds, you can still abort..." liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene - targetVer <- liftE $ GHCup.compileGHC + targetVer <- liftE $ GHCup.compileGHC (GHC.SourceDist lVer) (compopts ^. CompileGHC.crossTarget) (compopts ^. CompileGHC.overwriteVer) @@ -536,10 +536,10 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do VLeft err@(V (BuildFailed tmpdir _)) -> do case keepDirs (appstate & settings) of Never -> logError $ T.pack $ prettyHFError err - _ -> logError $ T.pack (prettyHFError err) <> "\n" - <> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir) + _ -> logError $ T.pack (prettyHFError err) <> "\n" + <> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir) <> " 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." pure $ Right () VLeft e -> do @@ -550,11 +550,11 @@ compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do 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 compopts (_, lr@ListResult{lTool = HLS, ..}) = do appstate <- ask - let run = + let run = runResourceT . runE @'[ AlreadyInstalled , BuildFailed @@ -587,10 +587,10 @@ compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do "...waiting for 5 seconds, you can still abort..." liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene - ghcs <- - liftE $ forM (compopts ^. CompileHLS.targetGHCs) + ghcs <- + liftE $ forM (compopts ^. CompileHLS.targetGHCs) (\ghc -> fmap (_tvVersion . fst) . OptParse.fromVersion (Just ghc) $ GHC) - targetVer <- liftE $ GHCup.compileHLS + targetVer <- liftE $ GHCup.compileHLS (HLS.SourceDist lVer) ghcs (compopts ^. CompileHLS.jobs) @@ -617,10 +617,10 @@ compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do VLeft err@(V (BuildFailed tmpdir _)) -> do case keepDirs (appstate & settings) of 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) <> " 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." pure $ Right () VLeft e -> do @@ -675,7 +675,7 @@ getAppData mgi = runExceptT $ do lV <- listVersions Nothing [] False True (Nothing, Nothing) pure $ BrickData (reverse lV) --- +-- keyHandlers :: KeyBindings -> [ ( KeyCombination @@ -700,7 +700,7 @@ keyHandlers KeyBindings {..} = , (KeyCombination Vty.KEnter [], const "advance options", createMenuforTool ) ] where - createMenuforTool = do + createMenuforTool = do e <- use (appState % to sectionListSelectedElement) case e of Nothing -> pure () @@ -715,9 +715,9 @@ keyHandlers KeyBindings {..} = pure () --hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m () - hideShowHandler' f = do + hideShowHandler' f = do app_settings <- use appSettings - let + let vers = f app_settings newAppSettings = app_settings & Common.showAllVersions .~ vers ad <- use appData diff --git a/lib-tui/GHCup/Brick/App.hs b/lib-tui/GHCup/Brick/App.hs index fc1fc7a..bde89e8 100644 --- a/lib-tui/GHCup/Brick/App.hs +++ b/lib-tui/GHCup/Brick/App.hs @@ -79,12 +79,12 @@ app attrs dimAttrs = drawUI :: AttrMap -> BrickState -> [Widget Name] drawUI dimAttrs st = - let + let footer = Brick.withAttr Attributes.helpAttr . Brick.txtWrap . T.pack . 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) ) $ Actions.keyHandlers (st ^. appKeys) @@ -98,7 +98,7 @@ drawUI dimAttrs st = CompileGHCPanel -> [CompileGHC.draw (st ^. compileGHCMenu), 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 keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState () keyInfoHandler ev = case ev of @@ -113,7 +113,7 @@ tutorialHandler ev = VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation _ -> pure () --- | Tab/Arrows to navigate. +-- | Tab/Arrows to navigate. navigationHandler :: BrickEvent Name e -> EventM Name BrickState () navigationHandler ev = do AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings' @@ -126,25 +126,25 @@ navigationHandler ev = do contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState () contextMenuHandler ev = do - ctx <- use contextMenu + 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 + (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.CompileGHCButton) ) -> mode .= Common.CompileGHCPanel (VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileHLSButton) ) -> mode .= Common.CompileHLSPanel _ -> Common.zoom contextMenu $ ContextMenu.handler ev --- +-- advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState () advanceInstallHandler ev = do - ctx <- use advanceInstallMenu + ctx <- use advanceInstallMenu let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent buttons = ctx ^. Menu.menuButtonsL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL @@ -162,7 +162,7 @@ advanceInstallHandler ev = do compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState () compileGHCHandler ev = do - ctx <- use compileGHCMenu + ctx <- use compileGHCMenu let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent buttons = ctx ^. Menu.menuButtonsL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL @@ -175,14 +175,14 @@ compileGHCHandler ev = do -> mode .= ContextPanel (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do let iopts = ctx ^. Menu.menuStateL - when (Menu.isValidMenu ctx) + when (Menu.isValidMenu ctx) (Actions.withIOAction $ Actions.compileGHC iopts) _ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev compileHLSHandler :: BrickEvent Name e -> EventM Name BrickState () compileHLSHandler ev = do - ctx <- use compileHLSMenu + ctx <- use compileHLSMenu let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent buttons = ctx ^. Menu.menuButtonsL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL diff --git a/lib-tui/GHCup/Brick/Attributes.hs b/lib-tui/GHCup/Brick/Attributes.hs index 46333af..f7641be 100644 --- a/lib-tui/GHCup/Brick/Attributes.hs +++ b/lib-tui/GHCup/Brick/Attributes.hs @@ -46,10 +46,8 @@ defaultAttributes no_color = Brick.attrMap where withForeColor | no_color = const | otherwise = Vty.withForeColor - withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo | otherwise = Vty.withBackColor - withStyle = Vty.withStyle diff --git a/lib-tui/GHCup/Brick/BrickState.hs b/lib-tui/GHCup/Brick/BrickState.hs index a88d61c..ab59b74 100644 --- a/lib-tui/GHCup/Brick/BrickState.hs +++ b/lib-tui/GHCup/Brick/BrickState.hs @@ -14,15 +14,15 @@ {-# 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. -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: - 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. -} diff --git a/lib-tui/GHCup/Brick/Common.hs b/lib-tui/GHCup/Brick/Common.hs index 5d6b5af..7f769c0 100644 --- a/lib-tui/GHCup/Brick/Common.hs +++ b/lib-tui/GHCup/Brick/Common.hs @@ -121,7 +121,7 @@ pattern UpdateCabalCheckBox :: ResourceId 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 -- to have all of them defined, just in case 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 | TutorialBox -- ^ The tutorial widget | ContextBox -- ^ The resource for Context Menu - | CompileGHCBox -- ^ The resource for CompileGHC Menu - | AdvanceInstallBox -- ^ The resource for AdvanceInstall 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. @@ -142,7 +142,7 @@ data Mode = Navigation | KeyInfo | Tutorial | ContextPanel - | AdvanceInstallPanel + | AdvanceInstallPanel | CompileGHCPanel | CompileHLSPanel deriving (Eq, Show, Ord) @@ -195,7 +195,7 @@ frontwardLayer layer_name = . Brick.withBorderStyle Border.unicode . 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. zoom l = Brick.zoom (toLensVL l) diff --git a/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs b/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs index 8d07546..6f97638 100644 --- a/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs +++ b/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs @@ -9,7 +9,7 @@ {-# 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 @@ -20,7 +20,7 @@ import qualified GHCup.Brick.Common as Common import Brick ( Padding(Max), - Widget(..), + Widget(..), (<+>), (<=>)) import qualified Brick diff --git a/lib-tui/GHCup/Brick/Widgets/Menu.hs b/lib-tui/GHCup/Brick/Widgets/Menu.hs index 6443abc..265379a 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menu.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menu.hs @@ -34,9 +34,9 @@ An input (type FieldInput) consist in 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}) +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 @@ -113,7 +113,7 @@ data FieldInput a b n = -> HelpMessage -> b -> (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 , inputHandler :: BrickEvent n () -> EventM n b () -- ^ The handler } @@ -138,7 +138,7 @@ data MenuField s n where } -> MenuField s n isValidField :: MenuField s n -> Bool -isValidField = (== Valid) . fieldStatus +isValidField = (== Valid) . fieldStatus makeLensesFor [ ("fieldLabel", "fieldLabelL") @@ -181,7 +181,7 @@ createCheckBoxInput = FieldInput False Right "" checkBoxRender checkBoxHandler else border . Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign checkBoxRender focus _ help check f = let core = f $ drawBool check - in if focus + in if focus then core else core <+> (Brick.padLeft (Brick.Pad 1) . centerV . renderAsHelpMsg $ help) 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 where drawEdit focus errMsg help edi amp = - let + 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 + Invalid msg | focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help | focus -> borderBox editorRender | otherwise -> borderBox $ renderAsErrMsg msg @@ -228,7 +228,7 @@ type Button = MenuField createButtonInput :: FieldInput () () n createButtonInput = FieldInput () Right "" drawButton (const $ pure ()) - where + where drawButton True (Invalid err) _ _ amp = amp . centerV . renderAsErrMsg $ err drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help @@ -250,14 +250,14 @@ renderAslabel t focus = then highlighted $ 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 -- 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. +-- | center a line in three rows. centerV :: Widget n -> Widget n centerV = Brick.padTopBottom 1 @@ -273,8 +273,8 @@ 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. +-- | 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. @@ -311,7 +311,7 @@ handlerMenu ev = fields <- use menuFieldsL case focused of Nothing -> pure () - Just n -> do + Just n -> do updated_fields <- updateFields n (VtyEvent e) fields if all isValidField updated_fields 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 menu = +drawMenu menu = Brick.vBox [ Brick.vBox buttonWidgets , Common.separator @@ -341,8 +341,8 @@ drawMenu menu = $ Brick.viewport (menu ^. menuNameL) Brick.Vertical $ Brick.vBox fieldWidgets , Brick.txt " " - , Brick.padRight Brick.Max $ - Brick.txt "Press " + , Brick.padRight Brick.Max $ + Brick.txt "Press " <+> Common.keyToWidget (menu ^. menuExitKeyL) <+> Brick.txt " to go back" ] @@ -353,7 +353,7 @@ drawMenu menu = 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 = let labelsWidgets = fmap renderAslabel fieldLabels in fmap (\f b -> ((centerV . leftify (maxWidth + 10) $ f b) <+>) ) labelsWidgets diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs b/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs index 5298343..d88945d 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs @@ -74,15 +74,15 @@ create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields 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 = + 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 = + filepathValidator i = case not $ emptyEditor i of True -> absolutePathParser (T.unpack i) 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 = Right . T.split isSpace - fields = + fields = [ Menu.createEditableField (Common.MenuElement Common.UrlEditBox) uriValidator instBindistL & Menu.fieldLabelL .~ "url" & 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.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" diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/CompileHLS.hs b/lib-tui/GHCup/Brick/Widgets/Menus/CompileHLS.hs index 1bcd2fd..c4e8e1a 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menus/CompileHLS.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menus/CompileHLS.hs @@ -112,7 +112,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields overWriteVersionParser :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern]) overWriteVersionParser = bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack - + jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int) jobsV = let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs b/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs index 1302231..f9e11d3 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs @@ -50,14 +50,14 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons [] _ -> [advInstallButton] draw :: ContextMenu -> Widget Name -draw menu = +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 " + , Brick.padRight Brick.Max $ + Brick.txt "Press " <+> Common.keyToWidget (menu ^. Menu.menuExitKeyL) <+> Brick.txt " to go back" ] diff --git a/lib-tui/GHCup/Brick/Widgets/Navigation.hs b/lib-tui/GHCup/Brick/Widgets/Navigation.hs index f4826eb..77de48e 100644 --- a/lib-tui/GHCup/Brick/Widgets/Navigation.hs +++ b/lib-tui/GHCup/Brick/Widgets/Navigation.hs @@ -54,7 +54,7 @@ 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 + -> Int -- The height of each item in a list. Commonly 1 -> BrickInternalState create = SectionList.sectionList diff --git a/lib-tui/GHCup/Brick/Widgets/SectionList.hs b/lib-tui/GHCup/Brick/Widgets/SectionList.hs index 378f6ea..ade14f2 100644 --- a/lib-tui/GHCup/Brick/Widgets/SectionList.hs +++ b/lib-tui/GHCup/Brick/Widgets/SectionList.hs @@ -15,8 +15,8 @@ {- 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). +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 @@ -33,7 +33,7 @@ import Brick ( BrickEvent(VtyEvent, MouseDown), EventM, Size(..), - Widget(..), + Widget(..), ViewportType (Vertical), (<=>)) import qualified Brick @@ -68,8 +68,8 @@ makeLensesFor [("sectionListFocusRing", "sectionListFocusRingL"), ("sectionListE 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 +-- | 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 @@ -81,14 +81,14 @@ sectionList name elements height , 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 +-- 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. + 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 @@ -97,16 +97,16 @@ sectionL section_name = lens g s in gl & sectionListElementsL .~ new_elms moveDown :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) () -moveDown = do +moveDown = do ring <- use sectionListFocusRingL - case F.focusGetCurrent ring of + 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 + 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 @@ -122,10 +122,10 @@ moveUp = do current_list <- use (sectionL l) let current_idx = L.listSelected current_list if current_idx == Just 0 - then do + then do new_focus <- sectionListFocusRingL <%= F.focusPrev case F.focusGetCurrent new_focus of - Nothing -> pure () + Nothing -> pure () Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToEnd) else Common.zoom (sectionL l) $ Brick.modify L.listMoveUp @@ -188,6 +188,6 @@ renderSectionList renderElem sectionFocus ge@(GenericSectionList focus elms slNa -- | 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 + current_focus <- generic_section_list ^. sectionListFocusRingL & F.focusGetCurrent let current_section = generic_section_list ^. sectionL current_focus - L.listSelectedElement current_section + L.listSelectedElement current_section diff --git a/lib-tui/GHCup/Brick/Widgets/Tutorial.hs b/lib-tui/GHCup/Brick/Widgets/Tutorial.hs index cba19a2..ad3e40b 100644 --- a/lib-tui/GHCup/Brick/Widgets/Tutorial.hs +++ b/lib-tui/GHCup/Brick/Widgets/Tutorial.hs @@ -9,7 +9,7 @@ {-# 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 diff --git a/lib-tui/GHCup/BrickMain.hs b/lib-tui/GHCup/BrickMain.hs index 8875d5e..ffd2ea2 100644 --- a/lib-tui/GHCup/BrickMain.hs +++ b/lib-tui/GHCup/BrickMain.hs @@ -51,14 +51,14 @@ brickMain s = do Right ad -> do let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing current_element = Navigation.sectionListSelectedElement initial_list - exit_key = bQuit . keyBindings $ s + exit_key = bQuit . keyBindings $ s case current_element of 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 Just (_, e) -> - let initapp = - BrickApp.app + let initapp = + BrickApp.app (Attributes.defaultAttributes $ noColor $ settings s) (Attributes.dimAttributes $ noColor $ settings s) initstate = @@ -71,7 +71,7 @@ brickMain s = do (CompileHLS.create exit_key) (keyBindings s) Common.Navigation - in Brick.defaultMain initapp initstate + in Brick.defaultMain initapp initstate $> () Left e -> do flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)