Skip to content

Commit

Permalink
add KeyInfo handler and widget. Improve tutorial
Browse files Browse the repository at this point in the history
  • Loading branch information
lsmor committed Nov 18, 2023
1 parent bb41101 commit 2e1a6aa
Showing 1 changed file with 78 additions and 17 deletions.
95 changes: 78 additions & 17 deletions app/ghcup/BrickMain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -246,10 +246,11 @@ In this section we define the state, the widgets and the core data structures wh

data Name = AllTools -- The main list widget
| Singular Tool -- The particular list for each tool
| KeyInfoBox -- The text box widget with action informacion
| TutorialBox -- The tutorial widget
deriving (Eq, Ord, Show)

data Mode = Navigation | Tutorial deriving (Eq, Show, Ord)
data Mode = Navigation | KeyInfo | Tutorial deriving (Eq, Show, Ord)

installedSign :: String
#if IS_WINDOWS
Expand Down Expand Up @@ -421,8 +422,8 @@ drawNavigation dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}

minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ')

drawTutorial :: AttrMap -> BrickState -> Widget Name
drawTutorial dimAttrs st =
drawTutorial :: Widget Name
drawTutorial =
let
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
txt_separator = hBorder <+> Brick.str " o " <+> hBorder
Expand All @@ -433,18 +434,18 @@ drawTutorial dimAttrs st =
$ borderWithLabel (Brick.txt "Tutorial")
$ Brick.vBox
(fmap center
[ mkTextBox [Brick.txt "GHCup is a distribution channel for Haskell's tools."]
[ mkTextBox [Brick.txtWrap "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.txtWrap " 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.txtWrap " means that the tool is installed and in used"
]
, Brick.hBox [
Brick.txt "This symbol "
Expand All @@ -456,31 +457,83 @@ drawTutorial dimAttrs st =
, mkTextBox [
Brick.hBox [
Brick.withAttr recommendedAttr $ Brick.str "recommended"
, Brick.txt " tag is based on ..."
, Brick.txtWrap " 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.txtWrap " 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.txtWrap "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")

<=> Brick.padRight Brick.Max (Brick.txt "Press q to exit the tutorial")

drawKeyInfo :: KeyBindings -> Widget Name
drawKeyInfo KeyBindings {..} =
let
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (showKey key : (showMod <$> mods))
in centerLayer
$ Brick.hLimitPercent 75
$ Brick.vLimitPercent 50
$ Brick.withBorderStyle unicode
$ borderWithLabel (Brick.txt "Key Actions")
$ Brick.vBox [
center $
mkTextBox [
Brick.hBox [
Brick.txt "Press "
, keyToWidget bUp, Brick.txt " and ", keyToWidget bDown
, Brick.txtWrap " to navigate the list of tools"
]
, Brick.hBox [
Brick.txt "Press "
, keyToWidget bInstall
, Brick.txtWrap " to install the selected tool. Notice, you may need to set it as default afterwards"
]
, Brick.hBox [
Brick.txt "Press "
, keyToWidget bSet
, Brick.txtWrap " to set a tool as the one for use"
]
, Brick.hBox [
Brick.txt "Press "
, keyToWidget bUninstall
, Brick.txtWrap " to uninstall a tool"
]
, Brick.hBox [
Brick.txt "Press "
, keyToWidget bChangelog
, Brick.txtWrap " to open the tool's changelog. It will open a web browser"
]
, Brick.hBox [
Brick.txt "Press "
, keyToWidget bShowAllVersions
, Brick.txtWrap " to show older version of each tool"
]
, Brick.hBox [
Brick.txt "Press "
, keyToWidget bShowAllTools
, Brick.txtWrap " to ??? "
]
]
]
<=> Brick.hBox [Brick.txt "Press q to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]

drawUI :: AttrMap -> BrickState -> [Widget Name]
drawUI dimAttrs st =
case st ^. mode of
Navigation -> [drawNavigation dimAttrs st]
Tutorial -> [drawTutorial dimAttrs st, drawNavigation dimAttrs st]
let navg = drawNavigation dimAttrs st
in case st ^. mode of
Navigation -> [navg]
Tutorial -> [drawTutorial, navg]
KeyInfo -> [drawKeyInfo (st ^. appKeys), navg]

{- Attributes
Expand Down Expand Up @@ -574,7 +627,7 @@ keyHandlers KeyBindings {..} =
if _showAllTools then "Don't show all tools" else "Show all tools"
, hideShowHandler' _showAllVersions (not . _showAllTools)
)
, (KeyCombination (Vty.KChar 'x') [], const "Tutorial", mode .= Tutorial)
, (KeyCombination (Vty.KChar 'h') [], const "help", mode .= KeyInfo)
]
where
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
Expand All @@ -593,7 +646,14 @@ keyHandlers KeyBindings {..} =
tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
tutorialHandler ev =
case ev of
VtyEvent (Vty.EvKey Vty.KEnter _) -> mode .= Navigation
VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
_ -> pure ()

keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState ()
keyInfoHandler ev = do
case ev of
VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
VtyEvent (Vty.EvKey Vty.KEnter _ ) -> mode .= Tutorial
_ -> pure ()

navigationHandler :: BrickEvent Name e -> EventM Name BrickState ()
Expand All @@ -610,8 +670,9 @@ eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
eventHandler ev = do
m <- use mode
case m of
Navigation -> navigationHandler ev
KeyInfo -> keyInfoHandler ev
Tutorial -> tutorialHandler ev
Navigation -> navigationHandler ev


{- Core Logic.
Expand Down

0 comments on commit 2e1a6aa

Please sign in to comment.