136 lines
4.6 KiB
Haskell
136 lines
4.6 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
|
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
|
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# 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:
|
|
|
|
- Name: List all resources (widgets) used by the app. see https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#resource-names
|
|
- Mode: Use to dispatch events and drawings. see: https://github.com/jtdaugherty/brick/issues/476#issuecomment-1629151920
|
|
|
|
-}
|
|
|
|
module GHCup.Brick.Common where
|
|
|
|
import GHCup.List ( ListResult )
|
|
import GHCup.Types ( Tool, KeyCombination (KeyCombination) )
|
|
import Data.List (intercalate)
|
|
import Prelude hiding ( appendFile )
|
|
import qualified Graphics.Vty as Vty
|
|
import Optics.TH (makeLenses)
|
|
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
|
|
|
|
|
|
-- | 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
|
|
| Singular Tool -- ^ The particular list for each tool
|
|
| KeyInfoBox -- ^ The text box widget with action informacion
|
|
| TutorialBox -- ^ The tutorial widget
|
|
| 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.
|
|
data Mode = Navigation | KeyInfo | Tutorial | ContextPanel deriving (Eq, Show, Ord)
|
|
|
|
installedSign :: String
|
|
#if IS_WINDOWS
|
|
installedSign = "I "
|
|
#else
|
|
installedSign = "✓ "
|
|
#endif
|
|
|
|
setSign :: String
|
|
#if IS_WINDOWS
|
|
setSign = "IS"
|
|
#else
|
|
setSign = "✔✔"
|
|
#endif
|
|
|
|
notInstalledSign :: String
|
|
#if IS_WINDOWS
|
|
notInstalledSign = "X "
|
|
#else
|
|
notInstalledSign = "✗ "
|
|
#endif
|
|
|
|
showKey :: Vty.Key -> String
|
|
showKey (Vty.KChar c) = [c]
|
|
showKey Vty.KUp = "↑"
|
|
showKey Vty.KDown = "↓"
|
|
showKey key = tail (show key)
|
|
|
|
showMod :: Vty.Modifier -> String
|
|
showMod = tail . show
|
|
|
|
-- | Given a KeyComb, produces a string widget with and user friendly text
|
|
keyToWidget :: KeyCombination -> Brick.Widget n
|
|
keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (showKey key : (showMod <$> mods))
|
|
|
|
-- | A section separator with max width. Looks like this: -------- o --------
|
|
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.
|
|
zoom l = Brick.zoom (toLensVL l)
|
|
|
|
data BrickData = BrickData
|
|
{ _lr :: [ListResult]
|
|
}
|
|
deriving Show
|
|
|
|
makeLenses ''BrickData
|
|
|
|
data BrickSettings = BrickSettings { _showAllVersions :: Bool}
|
|
--deriving Show
|
|
|
|
makeLenses ''BrickSettings
|
|
|
|
defaultAppSettings :: BrickSettings
|
|
defaultAppSettings = BrickSettings { _showAllVersions = False}
|