Use proper Name type and Modal type. Create tutorial Widget

This commit is contained in:
Luis Morillo 2023-10-10 16:32:33 +02:00
parent 1353a2fd20
commit 8f4246e716

View File

@ -40,7 +40,7 @@ import Brick
import qualified Brick import qualified Brick
import Brick.Widgets.Border ( hBorder, borderWithLabel) import Brick.Widgets.Border ( hBorder, borderWithLabel)
import Brick.Widgets.Border.Style ( unicode ) import Brick.Widgets.Border.Style ( unicode )
import Brick.Widgets.Center ( center ) import Brick.Widgets.Center ( center, centerLayer )
import qualified Brick.Widgets.List as L import qualified Brick.Widgets.List as L
import Brick.Focus (FocusRing) import Brick.Focus (FocusRing)
import qualified Brick.Focus as F import qualified Brick.Focus as F
@ -241,7 +241,13 @@ sectionListSelectedElement generic_section_list = do
-} -}
type Name = String data Name = AllTools -- The main list widget
| Singular Tool -- The particular list for each tool
| IODialog -- The pop up when installing a tool
| TutorialBox -- The tutorial widget
deriving (Eq, Ord, Show)
data Mode = Navigation | Tutorial deriving (Eq, Show, Ord)
installedSign :: String installedSign :: String
#if IS_WINDOWS #if IS_WINDOWS
@ -287,6 +293,7 @@ data BrickState = BrickState
, _appSettings :: BrickSettings , _appSettings :: BrickSettings
, _appState :: BrickInternalState , _appState :: BrickInternalState
, _appKeys :: KeyBindings , _appKeys :: KeyBindings
, _mode :: Mode
} }
--deriving Show --deriving Show
@ -295,7 +302,7 @@ makeLenses ''BrickState
keyHandlers :: KeyBindings keyHandlers :: KeyBindings
-> [ ( KeyCombination -> [ ( KeyCombination
, BrickSettings -> String , BrickSettings -> String
, EventM String BrickState () , EventM Name BrickState ()
) )
] ]
keyHandlers KeyBindings {..} = keyHandlers KeyBindings {..} =
@ -311,6 +318,7 @@ keyHandlers KeyBindings {..} =
) )
, (bUp, const "Up", appState %= moveCursor 1 Up) , (bUp, const "Up", appState %= moveCursor 1 Up)
, (bDown, const "Down", appState %= moveCursor 1 Down) , (bDown, const "Down", appState %= moveCursor 1 Down)
, (Vty.KChar 'x', const "Tutorial", mode .= Tutorial)
] ]
where where
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m () --hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
@ -337,7 +345,7 @@ showMod :: Vty.Modifier -> String
showMod = tail . show showMod = tail . show
ui :: AttrMap -> BrickState -> Widget String ui :: AttrMap -> BrickState -> Widget Name
ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..} ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
= Brick.padBottom Max = Brick.padBottom Max
( Brick.withBorderStyle unicode ( Brick.withBorderStyle unicode
@ -432,15 +440,44 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
minHSize :: Int -> Widget n -> Widget n 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 ' ')
app :: AttrMap -> AttrMap -> App BrickState () String app :: AttrMap -> AttrMap -> App BrickState () Name
app attrs dimAttrs = app attrs dimAttrs =
App { appDraw = \st -> [ui dimAttrs st] App { appDraw = drawUI dimAttrs
, appHandleEvent = eventHandler , appHandleEvent = eventHandler
, appStartEvent = return () , appStartEvent = return ()
, appAttrMap = const attrs , appAttrMap = const attrs
, appChooseCursor = Brick.showFirstCursor , appChooseCursor = Brick.showFirstCursor
} }
drawUI :: AttrMap -> BrickState -> [Widget Name]
drawUI dimAttrs st =
case st ^. mode of
Navigation -> [ui dimAttrs st]
Tutorial ->
let tutorial = centerLayer
$ Brick.hLimitPercent 75
$ Brick.vLimitPercent 50
$ Brick.withBorderStyle unicode
$ borderWithLabel (Brick.txt "Tutorial")
$ Brick.vBox
[ Brick.txt "GHCup is a tool for managing your Haskell tooling."
, center (Brick.txt "--- o ---")
, Brick.txt "This symbol "
<+> Brick.withAttr (Brick.attrName "installed") (Brick.str "")
<+> Brick.txt " means that the tool is installed but not in used"
, Brick.txt "This symbol "
<+> Brick.withAttr (Brick.attrName "set") (Brick.str "✔✔")
<+> Brick.txt " means that the tool is installed and in used"
, Brick.txt "This symbol "
<+> Brick.withAttr (Brick.attrName "not-installed") (Brick.str "")
<+> Brick.txt " means that the tool isn't installed"
, center (Brick.txt "--- o ---")
, Brick.txt "Press Enter to exit the tutorial"
]
in [tutorial, ui dimAttrs st]
defaultAttributes :: Bool -> AttrMap defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = Brick.attrMap defaultAttributes no_color = Brick.attrMap
Vty.defAttr Vty.defAttr
@ -481,8 +518,14 @@ dimAttributes no_color = Brick.attrMap
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor | otherwise = Vty.withBackColor
eventHandler :: BrickEvent String e -> EventM String BrickState () tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
eventHandler ev = do tutorialHandler ev =
case ev of
VtyEvent (Vty.EvKey Vty.KEnter _) -> mode .= Navigation
_ -> pure ()
navigationHandler :: BrickEvent Name e -> EventM Name BrickState ()
navigationHandler ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef settings' AppState { keyBindings = kb } <- liftIO $ readIORef settings'
case ev of case ev of
inner_event@(VtyEvent (Vty.EvKey key _)) -> inner_event@(VtyEvent (Vty.EvKey key _)) ->
@ -491,6 +534,13 @@ eventHandler ev = do
Just (_, _, handler) -> handler Just (_, _, handler) -> handler
inner_event -> Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event inner_event -> Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event
eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
eventHandler ev = do
m <- use mode
case m of
Navigation -> navigationHandler ev
Tutorial -> tutorialHandler ev
-- | Suspend the current UI and run an IO action in terminal. If the -- | 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. -- IO action returns a Left value, then it's thrown as userError.
withIOAction :: (Ord n, Eq n) withIOAction :: (Ord n, Eq n)
@ -524,6 +574,7 @@ updateList appD BrickState{..} =
, _appData = appD , _appData = appD
, _appSettings = _appSettings , _appSettings = _appSettings
, _appKeys = _appKeys , _appKeys = _appKeys
, _mode = Navigation
} }
constructList :: BrickData constructList :: BrickData
@ -538,8 +589,8 @@ constructList appD settings =
-- | Focus on the tool section and the predicate which matches. If no result matches, focus on index 0 -- | 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 -> (ListResult -> Bool) -> BrickInternalState -> BrickInternalState
selectBy tool predicate internal_state = selectBy tool predicate internal_state =
let new_focus = F.focusSetCurrent (show tool) (view sectionListFocusRingL internal_state) let new_focus = F.focusSetCurrent (Singular tool) (view sectionListFocusRingL internal_state)
tool_lens = sectionL (show tool) tool_lens = sectionL (Singular tool)
in internal_state in internal_state
& sectionListFocusRingL .~ new_focus & sectionListFocusRingL .~ new_focus
& tool_lens %~ L.listMoveTo 0 -- We move to 0 first & tool_lens %~ L.listMoveTo 0 -- We move to 0 first
@ -559,8 +610,8 @@ replaceLR :: (ListResult -> Bool)
-> BrickInternalState -> BrickInternalState
replaceLR filterF list_result s = replaceLR filterF list_result s =
let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e) let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e)
newVec = [(show $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)] newVec = [(Singular $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)]
newSectionList = sectionList "GHCupList" newVec 0 newSectionList = sectionList AllTools newVec 0
in case oldElem of in case oldElem of
Just (_, el) -> selectBy (lTool el) (toolEqual el) newSectionList Just (_, el) -> selectBy (lTool el) (toolEqual el) newSectionList
Nothing -> selectLatest newSectionList Nothing -> selectLatest newSectionList
@ -817,6 +868,7 @@ brickMain s = do
defaultAppSettings defaultAppSettings
(constructList ad defaultAppSettings Nothing) (constructList ad defaultAppSettings Nothing)
(keyBindings (s :: AppState)) (keyBindings (s :: AppState))
Navigation
) )
$> () $> ()