Extract common functionality
This commit is contained in:
parent
ddd76ab7ee
commit
3298f2293b
@ -13,6 +13,7 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
{-# LANGUAGE InstanceSigs #-}
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
|
{-# LANGUAGE PatternSynonyms #-}
|
||||||
|
|
||||||
{-
|
{-
|
||||||
This module contains common values used across the library. Crucially it contains two important types for the brick app:
|
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
|
||||||
import qualified Brick.Widgets.Border as Border
|
import qualified Brick.Widgets.Border as Border
|
||||||
import Brick ((<+>))
|
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.
|
-- | Name data type. Uniquely identifies each widget in the TUI.
|
||||||
-- some constructors might end up unused, but still is a good practise
|
-- 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
|
| Singular Tool -- ^ The particular list for each tool
|
||||||
| KeyInfoBox -- ^ The text box widget with action informacion
|
| KeyInfoBox -- ^ The text box widget with action informacion
|
||||||
| TutorialBox -- ^ The tutorial widget
|
| TutorialBox -- ^ The tutorial widget
|
||||||
-- | PopUpBox -- ^ The whole popUp widget
|
| ContextBox -- ^ The resource for the context menu
|
||||||
-- | PopUpElement PopUpResources -- ^ each element in the popUp
|
| MenuElement ResourceId -- ^ The resource for field/buttons in a menu
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
-- | Mode type. It helps to dispatch events to different handlers.
|
-- | 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 :: Brick.Widget n
|
||||||
separator = Border.hBorder <+> Brick.str " o " <+> Border.hBorder
|
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.
|
-- 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.
|
-- | 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
|
module GHCup.Brick.Widgets.KeyInfo where
|
||||||
|
|
||||||
import GHCup.Types ( KeyBindings(..), KeyCombination(KeyCombination) )
|
import GHCup.Types ( KeyBindings(..) )
|
||||||
import qualified GHCup.Brick.Common as Common
|
import qualified GHCup.Brick.Common as Common
|
||||||
|
|
||||||
|
|
||||||
@ -24,10 +24,7 @@ import Brick
|
|||||||
(<+>),
|
(<+>),
|
||||||
(<=>))
|
(<=>))
|
||||||
import qualified Brick
|
import qualified Brick
|
||||||
import Brick.Widgets.Border ( borderWithLabel)
|
import Brick.Widgets.Center ( center )
|
||||||
import Brick.Widgets.Border.Style ( unicode )
|
|
||||||
import Brick.Widgets.Center ( center, centerLayer )
|
|
||||||
import Data.List ( intercalate )
|
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
|
|
||||||
|
|
||||||
@ -36,43 +33,38 @@ draw :: KeyBindings -> Widget Common.Name
|
|||||||
draw KeyBindings {..} =
|
draw KeyBindings {..} =
|
||||||
let
|
let
|
||||||
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
|
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 Common.frontwardLayer "Key Actions"
|
||||||
in centerLayer
|
|
||||||
$ Brick.hLimitPercent 75
|
|
||||||
$ Brick.vLimitPercent 50
|
|
||||||
$ Brick.withBorderStyle unicode
|
|
||||||
$ borderWithLabel (Brick.txt "Key Actions")
|
|
||||||
$ Brick.vBox [
|
$ Brick.vBox [
|
||||||
center $
|
center $
|
||||||
mkTextBox [
|
mkTextBox [
|
||||||
Brick.hBox [
|
Brick.hBox [
|
||||||
Brick.txt "Press "
|
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.txtWrap " to navigate the list of tools"
|
||||||
]
|
]
|
||||||
, Brick.hBox [
|
, Brick.hBox [
|
||||||
Brick.txt "Press "
|
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.txtWrap " to install the selected tool. Notice, you may need to set it as default afterwards"
|
||||||
]
|
]
|
||||||
, Brick.hBox [
|
, Brick.hBox [
|
||||||
Brick.txt "Press "
|
Brick.txt "Press "
|
||||||
, keyToWidget bSet
|
, Common.keyToWidget bSet
|
||||||
, Brick.txtWrap " to set a tool as the one for use"
|
, Brick.txtWrap " to set a tool as the one for use"
|
||||||
]
|
]
|
||||||
, Brick.hBox [
|
, Brick.hBox [
|
||||||
Brick.txt "Press "
|
Brick.txt "Press "
|
||||||
, keyToWidget bUninstall
|
, Common.keyToWidget bUninstall
|
||||||
, Brick.txtWrap " to uninstall a tool"
|
, Brick.txtWrap " to uninstall a tool"
|
||||||
]
|
]
|
||||||
, Brick.hBox [
|
, Brick.hBox [
|
||||||
Brick.txt "Press "
|
Brick.txt "Press "
|
||||||
, keyToWidget bChangelog
|
, Common.keyToWidget bChangelog
|
||||||
, Brick.txtWrap " to open the tool's changelog. It will open a web browser"
|
, Brick.txtWrap " to open the tool's changelog. It will open a web browser"
|
||||||
]
|
]
|
||||||
, Brick.hBox [
|
, Brick.hBox [
|
||||||
Brick.txt "Press "
|
Brick.txt "Press "
|
||||||
, keyToWidget bShowAllVersions
|
, Common.keyToWidget bShowAllVersions
|
||||||
, Brick.txtWrap " to show older version of each tool"
|
, Brick.txtWrap " to show older version of each tool"
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -23,9 +23,8 @@ import Brick
|
|||||||
(<+>),
|
(<+>),
|
||||||
(<=>))
|
(<=>))
|
||||||
import qualified Brick
|
import qualified Brick
|
||||||
import Brick.Widgets.Border ( hBorder, borderWithLabel)
|
import Brick.Widgets.Border ( hBorder)
|
||||||
import Brick.Widgets.Border.Style ( unicode )
|
import Brick.Widgets.Center ( center )
|
||||||
import Brick.Widgets.Center ( center, centerLayer )
|
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
|
|
||||||
|
|
||||||
@ -34,16 +33,12 @@ draw :: Widget Common.Name
|
|||||||
draw =
|
draw =
|
||||||
let
|
let
|
||||||
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
|
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
|
||||||
txt_separator = hBorder <+> Brick.str " o " <+> hBorder
|
|
||||||
in centerLayer
|
in Common.frontwardLayer "Tutorial"
|
||||||
$ Brick.hLimitPercent 75
|
|
||||||
$ Brick.vLimitPercent 50
|
|
||||||
$ Brick.withBorderStyle unicode
|
|
||||||
$ borderWithLabel (Brick.txt "Tutorial")
|
|
||||||
$ Brick.vBox
|
$ Brick.vBox
|
||||||
(fmap center
|
(fmap center
|
||||||
[ mkTextBox [Brick.txtWrap "GHCup is a distribution channel for Haskell's tools."]
|
[ mkTextBox [Brick.txtWrap "GHCup is a distribution channel for Haskell's tools."]
|
||||||
, txt_separator
|
, Common.separator
|
||||||
, mkTextBox [
|
, mkTextBox [
|
||||||
Brick.hBox [
|
Brick.hBox [
|
||||||
Brick.txt "This symbol "
|
Brick.txt "This symbol "
|
||||||
@ -61,7 +56,7 @@ draw =
|
|||||||
, Brick.txt " means that the tool isn't installed"
|
, Brick.txt " means that the tool isn't installed"
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, txt_separator
|
, Common.separator
|
||||||
, mkTextBox [
|
, mkTextBox [
|
||||||
Brick.hBox [
|
Brick.hBox [
|
||||||
Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
|
Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
|
||||||
|
Loading…
Reference in New Issue
Block a user