packages feed

ghc-debug-brick-0.8.0.0: src/GHC/Debug/Brick/Render/Utils.hs

{-# LANGUAGE OverloadedStrings #-}
module GHC.Debug.Brick.Render.Utils where

import Brick
import Data.ByteUnits
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Graphics.Vty as Vty

import GHC.Debug.Brick.Namespace

-- | Vertical space used to separate elements on the same line.
--
-- This is standardised for a consistent UI.
vSpace :: Widget n
vSpace = txt "   "

menuAttr :: AttrName
menuAttr = attrName "menu"

inputAttr :: AttrName
inputAttr = attrName "input"

labelAttr :: AttrName
labelAttr = attrName "label"

treeAttr :: AttrName
treeAttr = attrName "tree"

highlightAttr :: AttrName
highlightAttr = attrName "highlighted"

disabledMenuAttr :: AttrName
disabledMenuAttr = attrName "disabledMenu"

txtLabel :: Text -> Widget n
txtLabel = withAttr labelAttr . txt

strLabel :: String -> Widget n
strLabel = withAttr labelAttr . str

highlighted :: Widget n -> Widget n
highlighted = forceAttr highlightAttr

disabledMenuItem :: Widget n -> Widget n
disabledMenuItem = forceAttr disabledMenuAttr

labelled :: Text -> Widget Name -> Widget Name
labelled = labelled' 20

labelled' :: Int -> Text -> Widget Name -> Widget Name
labelled' leftSize lbl w =
  hLimit leftSize  (txtLabel lbl <+> vLimit 1 (fill ' ')) <+> w <+> vLimit 1 (fill ' ')

renderBytes :: Real a => a -> Widget n
renderBytes n =
  txt (showBytes n)

showBytes :: Real a => a -> Text
showBytes n = Text.pack $ getShortHand (getAppropriateUnits (ByteValue (realToFrac n) Bytes))

grey :: Vty.Color
grey = Vty.rgbColor (158 :: Int) 158 158