Add Named class, make List focus-aware, add experimental withFocusRing combinator

brick.cabal

@@ -256,6 +256,7 @@ executable brick-edit-demo
                        vty >= 5.3.1,
                        data-default,
                        text,
+                       vector,
                        lens
 
 executable brick-border-demo

programs/EditDemo.hs

@@ -4,6 +4,7 @@
 module Main where
 
 import Control.Lens
+import qualified Data.Vector as DV
 import qualified Graphics.Vty as V
 
 import qualified Brick.Main as M
@@ -13,9 +14,11 @@ import Brick.Widgets.Core
   , (<=>)
   , hLimit
   , vLimit
+  , fill
   , str
   )
 import qualified Brick.Widgets.Center as C
+import qualified Brick.Widgets.List as L
 import qualified Brick.Widgets.Edit as E
 import qualified Brick.AttrMap as A
 import qualified Brick.Focus as F
@@ -23,31 +26,31 @@ import Brick.Util (on)
 
 data Name = Edit1
           | Edit2
+          | List1
           deriving (Ord, Show, Eq)
 
 data St =
     St { _focusRing :: F.FocusRing Name
        , _edit1 :: E.Editor Name
        , _edit2 :: E.Editor Name
+       , _list1 :: L.List Name Int
        }
 
 makeLenses ''St
 
-currentEditorL :: St -> Lens' St (E.Editor Name)
-currentEditorL st =
-    case F.focusGetCurrent (st^.focusRing) of
-        Just Edit1 -> edit1
-        Just Edit2 -> edit2
-        Nothing -> error "BUG: focus ring had nothing selected!"
-
 drawUI :: St -> [T.Widget Name]
 drawUI st = [ui]
     where
-        ui = C.center $ (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 $ E.renderEditor $ st^.edit1)) <=>
-                        str " " <=>
-                        (str "Input 2 (limited to 2 lines): " <+> (hLimit 30 $ E.renderEditor $ st^.edit2)) <=>
-                        str " " <=>
-                        str "Press Tab to switch between editors, Esc to quit."
+        theList = F.withFocusRing (st^.focusRing) (L.renderList drawElem) (st^.list1)
+        drawElem _ i = (str $ show i) <+> (vLimit 1 $ fill ' ')
+        ui = C.center $
+            (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 $ E.renderEditor $ st^.edit1)) <=>
+            str " " <=>
+            (str "Input 2 (limited to 2 lines): " <+> (hLimit 30 $ E.renderEditor $ st^.edit2)) <=>
+            str " " <=>
+            (str "Input 3: " <+> (hLimit 30 $ vLimit 3 theList)) <=>
+            str " " <=>
+            str "Press Tab to switch between editors, Esc to quit."
 
 appEvent :: St -> V.Event -> T.EventM Name (T.Next St)
 appEvent st ev =
@@ -55,18 +58,25 @@ appEvent st ev =
         V.EvKey V.KEsc [] -> M.halt st
         V.EvKey (V.KChar '\t') [] -> M.continue $ st & focusRing %~ F.focusNext
         V.EvKey V.KBackTab [] -> M.continue $ st & focusRing %~ F.focusPrev
-        _ -> M.continue =<<
-          T.handleEventLensed st (currentEditorL st) E.handleEditorEvent ev
+
+        _ -> M.continue =<< case F.focusGetCurrent (st^.focusRing) of
+               Just Edit1 -> T.handleEventLensed st edit1 E.handleEditorEvent ev
+               Just Edit2 -> T.handleEventLensed st edit2 E.handleEditorEvent ev
+               Just List1 -> T.handleEventLensed st list1 L.handleListEvent ev
+               Nothing -> return st
 
 initialState :: St
 initialState =
-    St (F.focusRing [Edit1, Edit2])
+    St (F.focusRing [Edit1, Edit2, List1])
        (E.editor Edit1 (str . unlines) Nothing "")
        (E.editor Edit2 (str . unlines) (Just 2) "")
+       (L.list List1 (DV.fromList [1, 2, 3, 4, 5]) 1)
 
 theMap :: A.AttrMap
 theMap = A.attrMap V.defAttr
     [ (E.editAttr, V.white `on` V.blue)
+    , (L.listSelectedFocusedAttr, V.black `on` V.white)
+    , (L.listSelectedAttr, V.white `on` V.blue)
     ]
 
 appCursor :: St -> [T.CursorLocation Name] -> Maybe (T.CursorLocation Name)

programs/ListDemo.hs

@@ -38,7 +38,7 @@ drawUI l = [ui]
         box = B.borderWithLabel label $
               hLimit 25 $
               vLimit 15 $
-              L.renderList l listDrawElement
+              L.renderList listDrawElement True l
         ui = C.vCenter $ vBox [ C.hCenter box
                               , str " "
                               , C.hCenter $ str "Press +/- to add/remove list elements."

src/Brick/Focus.hs

@@ -11,6 +11,7 @@ module Brick.Focus
   , focusPrev
   , focusGetCurrent
   , focusRingCursor
+  , withFocusRing
   )
 where
 
@@ -18,6 +19,7 @@ import Control.Lens ((^.))
 import Data.Maybe (listToMaybe)
 
 import Brick.Types
+import Brick.Widgets.Core (Named(..))
 
 -- | A focus ring containing a sequence of widget names to focus and a
 -- currently-focused widget name.
@@ -43,6 +45,9 @@ focusPrev (FocusRingNonempty ns i) = FocusRingNonempty ns i'
     where
         i' = (i + (length ns) - 1) `mod` (length ns)
 
+withFocusRing :: (Eq n, Named a n) => FocusRing n -> (Bool -> a -> b) -> a -> b
+withFocusRing ring f a = f (focusGetCurrent ring == Just (getName a)) a
+
 -- | Get the currently-focused widget name from the ring. If the ring is
 -- emtpy, return 'Nothing'.
 focusGetCurrent :: FocusRing n -> Maybe n

src/Brick/Types/Internal.hs

@@ -29,7 +29,6 @@ module Brick.Types.Internal
 where
 
 import Control.Lens (Field1, Field2, _1, _2, Lens', makeLenses)
-import Data.String
 import Data.Monoid
 import qualified Data.Map as M
 import Graphics.Vty (DisplayRegion)

src/Brick/Widgets/Core.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
 -- | This module provides the core widget combinators and rendering
 -- routines. Everything this library does is in terms of these basic
 -- primitives.
@@ -42,6 +44,9 @@ module Brick.Widgets.Core
   -- * Cursor placement
   , showCursor
 
+  -- * Naming
+  , Named(..)
+
   -- * Translation
   , translateBy
 
@@ -87,6 +92,11 @@ import Brick.Util (clOffset, clamp)
 import Brick.AttrMap
 import Brick.Widgets.Internal
 
+-- | The class of types that store interface element names.
+class Named a n | a -> n where
+    -- | Get the name of the specified value.
+    getName :: a -> n
+
 -- | When rendering the specified widget, use the specified border style
 -- for any border rendering.
 withBorderStyle :: BorderStyle -> Widget n -> Widget n

src/Brick/Widgets/Edit.hs

@@ -58,6 +58,9 @@ data Editor n =
 
 suffixLenses ''Editor
 
+instance Named (Editor n) n where
+    getName = editorName
+
 handleEditorEvent :: Event -> Editor n -> EventM n (Editor n)
 handleEditorEvent e ed =
         let f = case e of

src/Brick/Widgets/List.hs

@@ -4,6 +4,8 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveFoldable#-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
 -- | This module provides a scrollable list type and functions for
 -- manipulating and rendering it.
 module Brick.Widgets.List
@@ -39,6 +41,7 @@ module Brick.Widgets.List
   -- * Attributes
   , listAttr
   , listSelectedAttr
+  , listSelectedFocusedAttr
   )
 where
 
@@ -74,6 +77,9 @@ data List n e =
 
 suffixLenses ''List
 
+instance Named (List n e) n where
+    getName = listName
+
 handleListEvent :: (Show n, Ord n) => Event -> List n e -> EventM n (List n e)
 handleListEvent e theList =
     case e of
@@ -97,11 +103,16 @@ handleListEvent e theList =
 listAttr :: AttrName
 listAttr = "list"
 
--- | The attribute used only for the currently-selected list item.
--- Extends 'listAttr'.
+-- | The attribute used only for the currently-selected list item when
+-- the list does not have focus. Extends 'listAttr'.
 listSelectedAttr :: AttrName
 listSelectedAttr = listAttr <> "selected"
 
+-- | The attribute used only for the currently-selected list item when
+-- the list has focus. Extends 'listSelectedAttr'.
+listSelectedFocusedAttr :: AttrName
+listSelectedFocusedAttr = listSelectedAttr <> "focused"
+
 -- | Construct a list in terms of an element type 'e'.
 list :: n
      -- ^ The list name (must be unique)
@@ -118,18 +129,20 @@ list name es h =
 -- | Turn a list state value into a widget given an item drawing
 -- function.
 renderList :: (Ord n, Show n)
-           => List n e
-           -- ^ The List to be rendered
-           -> (Bool -> e -> Widget n)
+           => (Bool -> e -> Widget n)
            -- ^ Rendering function, True for the selected element
+           -> Bool
+           -- ^ Whether the list has focus
+           -> List n e
+           -- ^ The List to be rendered
            -> Widget n
            -- ^ rendered widget
-renderList l drawElem =
+renderList drawElem foc l =
     withDefAttr listAttr $
-    drawListElements l drawElem
+    drawListElements foc l drawElem
 
-drawListElements :: (Ord n, Show n) => List n e -> (Bool -> e -> Widget n) -> Widget n
-drawListElements l drawElem =
+drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Bool -> e -> Widget n) -> Widget n
+drawListElements foc l drawElem =
     Widget Greedy Greedy $ do
         c <- getContext
 
@@ -145,8 +158,11 @@ drawListElements l drawElem =
             drawnElements = flip V.imap es $ \i e ->
                 let isSelected = Just (i + start) == l^.listSelectedL
                     elemWidget = drawElem isSelected e
+                    selItemAttr = if foc
+                                  then withDefAttr listSelectedFocusedAttr
+                                  else withDefAttr listSelectedAttr
                     makeVisible = if isSelected
-                                  then visible . withDefAttr listSelectedAttr
+                                  then visible . selItemAttr
                                   else id
                 in makeVisible elemWidget