Support attribute modification with modifyDefAttr, rename setDefault to setDefaultAttr

programs/AttrDemo.hs

@@ -17,6 +17,7 @@ import Brick.Widgets.Core
   , vBox
   , str
   , hyperlink
+  , modifyDefAttr
   )
 import Brick.Util (on, fg)
 import Brick.AttrMap (attrMap, AttrMap)
@@ -45,6 +46,9 @@ ui =
          , str " "
          , hyperlink "http://www.google.com/" $
            str "This text is also hyperlinked in terminals that support hyperlinking."
+         , str " "
+         , modifyDefAttr (`withURL` "http://www.google.com/") $
+           str "This text is hyperlinked by modifying the default attribute."
          ]
 
 globalDefault :: Attr

src/Brick/AttrMap.hs

@@ -32,7 +32,8 @@ module Brick.AttrMap
   -- * Finding attributes from names
   , attrMapLookup
   -- * Manipulating attribute maps
-  , setDefault
+  , setDefaultAttr
+  , getDefaultAttr
   , applyAttrMappings
   , mergeWithDefault
   , mapAttrName
@@ -145,9 +146,14 @@ attrMapLookup (AttrName ns) (AttrMap theDefault m) =
     in foldl combineAttrs theDefault results
 
 -- | Set the default attribute value in an attribute map.
-setDefault :: Attr -> AttrMap -> AttrMap
-setDefault _ (ForceAttr a) = ForceAttr a
-setDefault newDefault (AttrMap _ m) = AttrMap newDefault m
+setDefaultAttr :: Attr -> AttrMap -> AttrMap
+setDefaultAttr _ (ForceAttr a) = ForceAttr a
+setDefaultAttr newDefault (AttrMap _ m) = AttrMap newDefault m
+
+-- | Get the default attribute value in an attribute map.
+getDefaultAttr :: AttrMap -> Attr
+getDefaultAttr (ForceAttr a) = a
+getDefaultAttr (AttrMap d _) = d
 
 combineAttrs :: Attr -> Attr -> Attr
 combineAttrs (Attr s1 f1 b1 u1) (Attr s2 f2 b2 u2) =

src/Brick/Widgets/Core.hs

@@ -42,6 +42,7 @@ module Brick.Widgets.Core
 
   -- * Attribute management
   , withDefAttr
+  , modifyDefAttr
   , withAttr
   , forceAttr
   , overrideAttr
@@ -274,7 +275,7 @@ hyperlink url p =
     Widget (hSize p) (vSize p) $ do
         c <- getContext
         let attr = attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL) `V.withURL` url
-        withReaderT (& ctxAttrMapL %~ setDefault attr) (render p)
+        withReaderT (& ctxAttrMapL %~ setDefaultAttr attr) (render p)
 
 -- | Pad the specified widget on the left. If max padding is used, this
 -- grows greedily horizontally; otherwise it defers to the padded
@@ -586,6 +587,16 @@ withAttr an p =
     Widget (hSize p) (vSize p) $
       withReaderT (& ctxAttrNameL .~ an) (render p)
 
+-- | Update the attribute map while rendering the specified widget: set
+-- its new default attribute to the one that we get by looking up the
+-- specified attribute name in the map and then modifying it with the
+-- specified function.
+modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n
+modifyDefAttr f p =
+    Widget (hSize p) (vSize p) $ do
+        c <- getContext
+        withReaderT (& ctxAttrMapL %~ (setDefaultAttr (f $ getDefaultAttr (c^.ctxAttrMapL)))) (render p)
+
 -- | Update the attribute map while rendering the specified widget: set
 -- its new default attribute to the one that we get by looking up the
 -- specified attribute name in the map.
@@ -593,7 +604,7 @@ withDefAttr :: AttrName -> Widget n -> Widget n
 withDefAttr an p =
     Widget (hSize p) (vSize p) $ do
         c <- getContext
-        withReaderT (& ctxAttrMapL %~ (setDefault (attrMapLookup an (c^.ctxAttrMapL)))) (render p)
+        withReaderT (& ctxAttrMapL %~ (setDefaultAttr (attrMapLookup an (c^.ctxAttrMapL)))) (render p)
 
 -- | When rendering the specified widget, update the attribute map with
 -- the specified transformation.