Remove trailing white space
This commit is contained in:
Luis Morillo
parent
80a6c67cf3
commit
255f7c8eac
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
-}
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue