Extract common functionality
This commit is contained in:
Luis Morillo
parent
ddd76ab7ee
commit
3298f2293b
@ -13,6 +13,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
{-
|
||||
This module contains common values used across the library. Crucially it contains two important types for the brick app:
|
||||
@ -34,20 +35,23 @@ import Optics.Lens (toLensVL)
|
||||
import qualified Brick
|
||||
import qualified Brick.Widgets.Border as Border
|
||||
import Brick ((<+>))
|
||||
import qualified Data.Text as T
|
||||
import qualified Brick.Widgets.Center as Brick
|
||||
import qualified Brick.Widgets.Border.Style as Border
|
||||
|
||||
-- We could use regular ADTs but different menus share the same options.
|
||||
-- example: all of ghcup compile ghc, ghcup compile hls, ghcup install cabal, etc...
|
||||
-- all have a --set, --force, etc... common arguments. If we went for the ADT we'd end up
|
||||
-- with SetCompileHLSOption, SetCompileGHCOption, SetInstallCabalOption, etc...
|
||||
-- which isn't terrible, but verbose enough to reject it.
|
||||
|
||||
-- | A newtype for labeling resources in menus. It is bundled along with pattern synonyms
|
||||
newtype ResourceId = ResourceId Int deriving (Eq, Ord, Show)
|
||||
|
||||
pattern OkButton = ResourceId 0
|
||||
pattern AdvanceInstallButton = ResourceId 100
|
||||
pattern CompilieButton = ResourceId 101
|
||||
|
||||
-- | Some verbosity. A FocusRing (to loop through advance options), needs an set of resource names to be able to
|
||||
-- dtermine focus. See https://hackage.haskell.org/package/brick-2.1.1/docs/Brick-Focus.html#t:FocusRing
|
||||
{- data PopUpResources
|
||||
= UrlEditBox
|
||||
| SetCheckBox
|
||||
| IsolateEditBox
|
||||
| ForceCheckBox
|
||||
| AdditionalEditBox
|
||||
| RegularInstallButton
|
||||
| AdvanceInstallButton
|
||||
| CancellInstallButton
|
||||
deriving (Eq, Ord, Show)
|
||||
-}
|
||||
|
||||
-- | Name data type. Uniquely identifies each widget in the TUI.
|
||||
-- some constructors might end up unused, but still is a good practise
|
||||
@ -56,8 +60,8 @@ 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
|
||||
-- | PopUpBox -- ^ The whole popUp widget
|
||||
-- | PopUpElement PopUpResources -- ^ each element in the popUp
|
||||
| ContextBox -- ^ The resource for the context menu
|
||||
| MenuElement ResourceId -- ^ The resource for field/buttons in a menu
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
-- | Mode type. It helps to dispatch events to different handlers.
|
||||
@ -101,6 +105,15 @@ keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (showKey key
|
||||
separator :: Brick.Widget n
|
||||
separator = Border.hBorder <+> Brick.str " o " <+> Border.hBorder
|
||||
|
||||
-- | Used to create a layer on top of the main navigation widget (tutorial, info, menus...)
|
||||
frontwardLayer :: T.Text -> Brick.Widget n -> Brick.Widget n
|
||||
frontwardLayer layer_name =
|
||||
Brick.centerLayer
|
||||
. Brick.hLimitPercent 75
|
||||
. Brick.vLimitPercent 50
|
||||
. Brick.withBorderStyle Border.unicode
|
||||
. Border.borderWithLabel (Brick.txt layer_name)
|
||||
|
||||
-- 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.
|
||||
|
||||
@ -14,7 +14,7 @@ A very simple information-only widget with no handler.
|
||||
|
||||
module GHCup.Brick.Widgets.KeyInfo where
|
||||
|
||||
import GHCup.Types ( KeyBindings(..), KeyCombination(KeyCombination) )
|
||||
import GHCup.Types ( KeyBindings(..) )
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
|
||||
|
||||
@ -24,10 +24,7 @@ import Brick
|
||||
(<+>),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Border ( borderWithLabel)
|
||||
import Brick.Widgets.Border.Style ( unicode )
|
||||
import Brick.Widgets.Center ( center, centerLayer )
|
||||
import Data.List ( intercalate )
|
||||
import Brick.Widgets.Center ( center )
|
||||
import Prelude hiding ( appendFile )
|
||||
|
||||
|
||||
@ -36,43 +33,38 @@ draw :: KeyBindings -> Widget Common.Name
|
||||
draw KeyBindings {..} =
|
||||
let
|
||||
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
|
||||
keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (Common.showKey key : (Common.showMod <$> mods))
|
||||
in centerLayer
|
||||
$ Brick.hLimitPercent 75
|
||||
$ Brick.vLimitPercent 50
|
||||
$ Brick.withBorderStyle unicode
|
||||
$ borderWithLabel (Brick.txt "Key Actions")
|
||||
in Common.frontwardLayer "Key Actions"
|
||||
$ Brick.vBox [
|
||||
center $
|
||||
mkTextBox [
|
||||
Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, keyToWidget bUp, Brick.txt " and ", keyToWidget bDown
|
||||
, Common.keyToWidget bUp, Brick.txt " and ", Common.keyToWidget bDown
|
||||
, Brick.txtWrap " to navigate the list of tools"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, keyToWidget bInstall
|
||||
, Common.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
|
||||
, Common.keyToWidget bSet
|
||||
, Brick.txtWrap " to set a tool as the one for use"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, keyToWidget bUninstall
|
||||
, Common.keyToWidget bUninstall
|
||||
, Brick.txtWrap " to uninstall a tool"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, keyToWidget bChangelog
|
||||
, Common.keyToWidget bChangelog
|
||||
, Brick.txtWrap " to open the tool's changelog. It will open a web browser"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, keyToWidget bShowAllVersions
|
||||
, Common.keyToWidget bShowAllVersions
|
||||
, Brick.txtWrap " to show older version of each tool"
|
||||
]
|
||||
]
|
||||
|
||||
@ -23,9 +23,8 @@ import Brick
|
||||
(<+>),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Border ( hBorder, borderWithLabel)
|
||||
import Brick.Widgets.Border.Style ( unicode )
|
||||
import Brick.Widgets.Center ( center, centerLayer )
|
||||
import Brick.Widgets.Border ( hBorder)
|
||||
import Brick.Widgets.Center ( center )
|
||||
import Prelude hiding ( appendFile )
|
||||
|
||||
|
||||
@ -34,16 +33,12 @@ draw :: Widget Common.Name
|
||||
draw =
|
||||
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")
|
||||
|
||||
in Common.frontwardLayer "Tutorial"
|
||||
$ Brick.vBox
|
||||
(fmap center
|
||||
[ mkTextBox [Brick.txtWrap "GHCup is a distribution channel for Haskell's tools."]
|
||||
, txt_separator
|
||||
, Common.separator
|
||||
, mkTextBox [
|
||||
Brick.hBox [
|
||||
Brick.txt "This symbol "
|
||||
@ -61,7 +56,7 @@ draw =
|
||||
, Brick.txt " means that the tool isn't installed"
|
||||
]
|
||||
]
|
||||
, txt_separator
|
||||
, Common.separator
|
||||
, mkTextBox [
|
||||
Brick.hBox [
|
||||
Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user