AttrName: remove IsString instance

This change is motivated by the API wart that results from the
overloading of both "<>" and string literals that resulted in code like
this:

  a :: AttrName
  a = "blah" <> "things"

While this worked to create an AttrName with two segments, it is far too
easy to read this as two strings concatenated. The overloading hides
what is really going on with the segments of the attribute name. The way
to write the above example after this change is:

  a :: AttrName
  a = attrName "blah" <> attrName "things"
This commit is contained in:
Jonathan Daugherty 2022-08-04 18:44:57 -07:00
parent bf58926132
commit 6f1b62ae53
19 changed files with 67 additions and 78 deletions

View File

@ -23,28 +23,28 @@ import Brick.Widgets.Core
, modifyDefAttr
)
import Brick.Util (on, fg)
import Brick.AttrMap (attrMap, AttrMap)
import Brick.AttrMap (attrMap, AttrMap, attrName)
ui :: Widget n
ui =
vBox [ str "This text uses the global default attribute."
, withAttr "foundFull" $
, withAttr (attrName "foundFull") $
str "Specifying an attribute name means we look it up in the attribute tree."
, (withAttr "foundFgOnly" $
, (withAttr (attrName "foundFgOnly") $
str ("When we find a value, we merge it with its parent in the attribute")
<=> str "name tree all the way to the root (the global default).")
, withAttr "missing" $
, withAttr (attrName "missing") $
str "A missing attribute name just resumes the search at its parent."
, withAttr ("general" <> "specific") $
, withAttr (attrName "general" <> attrName "specific") $
str "In this way we build complete attribute values by using an inheritance scheme."
, withAttr "foundFull" $
, withAttr (attrName "foundFull") $
str "You can override everything ..."
, withAttr "foundFgOnly" $
, withAttr (attrName "foundFgOnly") $
str "... or only what you want to change and inherit the rest."
, str "Attribute names are assembled with the Monoid append operation to indicate"
, str "hierarchy levels, e.g. \"window\" <> \"title\"."
, str " "
, withAttr "linked" $
, withAttr (attrName "linked") $
str "This text is hyperlinked in terminals that support hyperlinking."
, str " "
, hyperlink "http://www.google.com/" $
@ -59,11 +59,12 @@ globalDefault = white `on` blue
theMap :: AttrMap
theMap = attrMap globalDefault
[ ("foundFull", white `on` green)
, ("foundFgOnly", fg red)
, ("general", yellow `on` black)
, ("general" <> "specific", fg cyan)
, ("linked", fg yellow `withURL` "http://www.google.com/")
[ (attrName "foundFull", white `on` green)
, (attrName "foundFgOnly", fg red)
, (attrName "general", yellow `on` black)
, (attrName "general" <> attrName "specific",
fg cyan)
, (attrName "linked", fg yellow `withURL` "http://www.google.com/")
]
app :: App () e ()

View File

@ -68,7 +68,7 @@ mkBorderDemo (styleName, sty) =
txt $ " " <> styleName <> " style "
titleAttr :: A.AttrName
titleAttr = "title"
titleAttr = A.attrName "title"
borderMappings :: [(A.AttrName, V.Attr)]
borderMappings =

View File

@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad (void)
@ -31,6 +30,7 @@ import Brick.Widgets.Center
)
import Brick.AttrMap
( AttrName
, attrName
, attrMap
)
@ -66,7 +66,7 @@ appEvent (VtyEvent (V.EvKey V.KEsc [])) = M.halt
appEvent _ = return ()
emphAttr :: AttrName
emphAttr = "emphasis"
emphAttr = attrName "emphasis"
app :: M.App Int e Name
app =

View File

@ -12,7 +12,7 @@ import Control.Monad.State (get)
import qualified Data.Text as Text
import qualified Brick.Main as M
import qualified Brick.Widgets.List as L
import Brick.AttrMap (AttrName)
import Brick.AttrMap (AttrName, attrName)
import Brick.Types
( Widget
, BrickEvent(..)
@ -77,7 +77,7 @@ appEvent (VtyEvent ev) = do
appEvent _ = return ()
errorAttr :: AttrName
errorAttr = "error"
errorAttr = attrName "error"
theMap :: A.AttrMap
theMap = A.attrMap V.defAttr

View File

@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
@ -31,6 +30,7 @@ import Brick.Util (fg)
import Brick.AttrMap
( attrMap
, AttrName
, attrName
)
data St =
@ -96,7 +96,7 @@ appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt
appEvent _ = return ()
arrowAttr :: AttrName
arrowAttr = "attr"
arrowAttr = attrName "attr"
app :: M.App St e Name
app =

View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Main where
@ -84,7 +83,7 @@ initialState :: L.List () Char
initialState = L.list () (Vec.fromList ['a','b','c']) 1
customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> "custom"
customAttr = L.listSelectedAttr <> A.attrName "custom"
theMap :: A.AttrMap
theMap = A.attrMap V.defAttr

View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Main where
@ -75,7 +74,7 @@ initialState :: L.List () Char
initialState = L.list () (Vec.fromList ['a','b','c']) 1
customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> "custom"
customAttr = L.listSelectedAttr <> A.attrName "custom"
theMap :: A.AttrMap
theMap = A.attrMap V.defAttr

View File

@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
@ -51,9 +50,9 @@ buttonLayer st =
C.hCenterLayer (vLimit 3 $ hLimit 50 $ E.renderEditor (str . unlines) True (st^.edit))
where
buttons = mkButton <$> buttonData
buttonData = [ (Button1, "Button 1", "button1")
, (Button2, "Button 2", "button2")
, (Button3, "Button 3", "button3")
buttonData = [ (Button1, "Button 1", attrName "button1")
, (Button2, "Button 2", attrName "button2")
, (Button3, "Button 3", attrName "button3")
]
mkButton (name, label, attr) =
let wasClicked = (fst <$> st^.lastReportedClick) == Just name
@ -82,7 +81,7 @@ infoLayer st = T.Widget T.Fixed T.Fixed $ do
Just (name, T.Location l) ->
"Mouse down at " <> show name <> " @ " <> show l
T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $
withDefAttr "info" $
withDefAttr (attrName "info") $
C.hCenter $ str msg
appEvent :: T.BrickEvent Name e -> T.EventM Name St ()
@ -104,10 +103,10 @@ appEvent ev =
aMap :: AttrMap
aMap = attrMap V.defAttr
[ ("info", V.white `on` V.magenta)
, ("button1", V.white `on` V.cyan)
, ("button2", V.white `on` V.green)
, ("button3", V.white `on` V.blue)
[ (attrName "info", V.white `on` V.magenta)
, (attrName "button1", V.white `on` V.cyan)
, (attrName "button2", V.white `on` V.green)
, (attrName "button3", V.white `on` V.blue)
, (E.editFocusedAttr, V.black `on` V.yellow)
]

View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad (void)
@ -32,7 +31,7 @@ import Brick.Widgets.Core
, withDefAttr
)
import Brick.Util (on, fg)
import Brick.AttrMap (AttrName)
import Brick.AttrMap (AttrName, attrName)
ui :: Widget n
ui =
@ -44,7 +43,7 @@ ui =
]
keybindingAttr :: AttrName
keybindingAttr = "keybinding"
keybindingAttr = attrName "keybinding"
theme1 :: Theme
theme1 =

View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
module Main where
@ -16,7 +15,7 @@ import qualified Brick.Types as T
import qualified Brick.Main as M
import qualified Brick.Widgets.Center as C
import qualified Brick.Widgets.Border as B
import Brick.AttrMap (AttrMap, AttrName, attrMap)
import Brick.AttrMap (AttrMap, AttrName, attrMap, attrName)
import Brick.Util (on)
import Brick.Types
( Widget
@ -56,7 +55,7 @@ vp3Size :: (Int, Int)
vp3Size = (25, 25)
selectedAttr :: AttrName
selectedAttr = "selected"
selectedAttr = attrName "selected"
drawUi :: St -> [Widget Name]
drawUi st = [ui]

View File

@ -2,9 +2,6 @@
{-# LANGUAGE DeriveGeneric #-}
-- | This module provides types and functions for managing an attribute
-- map which maps attribute names ('AttrName') to attributes ('Attr').
-- This module is designed to be used with the 'OverloadedStrings'
-- language extension to permit easy construction of 'AttrName' values
-- and you should also use 'mappend' ('<>') to combine names.
--
-- Attribute maps work by mapping hierarchical attribute names to
-- attributes and inheriting parent names' attributes when child names
@ -52,7 +49,6 @@ import Data.Bits ((.|.))
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Data.List (inits)
import Data.String (IsString(..))
import GHC.Generics (Generic)
import Graphics.Vty (Attr(..), MaybeDefault(..), Style)
@ -65,9 +61,9 @@ import Graphics.Vty (Attr(..), MaybeDefault(..), Style)
-- example:
--
-- @
-- "window" <> "border"
-- "window" <> "title"
-- "header" <> "clock" <> "seconds"
-- attrName "window" <> attrName "border"
-- attrName "window" <> attrName "title"
-- attrName "header" <> attrName "clock" <> attrName "seconds"
-- @
data AttrName = AttrName [String]
deriving (Show, Read, Eq, Ord, Generic, NFData)
@ -79,9 +75,6 @@ instance Monoid AttrName where
mempty = AttrName []
mappend = (Sem.<>)
instance IsString AttrName where
fromString = AttrName . (:[])
-- | An attribute map which maps 'AttrName' values to 'Attr' values.
data AttrMap = AttrMap Attr (M.Map AttrName Attr)
| ForceAttr Attr

View File

@ -642,15 +642,15 @@ toPassword s = txt $ T.replicate (T.length $ T.concat s) "*"
-- | The namespace for the other form attributes.
formAttr :: AttrName
formAttr = "brickForm"
formAttr = attrName "brickForm"
-- | The attribute for form input fields with invalid values.
invalidFormInputAttr :: AttrName
invalidFormInputAttr = formAttr <> "invalidInput"
invalidFormInputAttr = formAttr <> attrName "invalidInput"
-- | The attribute for form input fields that have the focus.
focusedFormInputAttr :: AttrName
focusedFormInputAttr = formAttr <> "focusedInput"
focusedFormInputAttr = formAttr <> attrName "focusedInput"
-- | Returns whether all form fields in the form currently have valid
-- values according to the fields' validation functions. This is useful

View File

@ -39,7 +39,7 @@ import qualified Brick.BorderMap as BM
-- | The top-level border attribute name.
borderAttr :: AttrName
borderAttr = "border"
borderAttr = attrName "border"
-- | Draw the specified border element using the active border style
-- using 'borderAttr'.

View File

@ -1544,17 +1544,17 @@ viewport vpname typ p =
-- | The base attribute for scroll bars.
scrollbarAttr :: AttrName
scrollbarAttr = "scrollbar"
scrollbarAttr = attrName "scrollbar"
-- | The attribute for scroll bar troughs. This attribute is a
-- specialization of @scrollbarAttr@.
scrollbarTroughAttr :: AttrName
scrollbarTroughAttr = scrollbarAttr <> "trough"
scrollbarTroughAttr = scrollbarAttr <> attrName "trough"
-- | The attribute for scroll bar handles. This attribute is a
-- specialization of @scrollbarAttr@.
scrollbarHandleAttr :: AttrName
scrollbarHandleAttr = scrollbarAttr <> "handle"
scrollbarHandleAttr = scrollbarAttr <> attrName "handle"
maybeClick :: (Ord n)
=> n

View File

@ -99,15 +99,15 @@ dialog title buttonData w =
-- | The default attribute of the dialog
dialogAttr :: AttrName
dialogAttr = "dialog"
dialogAttr = attrName "dialog"
-- | The default attribute for all dialog buttons
buttonAttr :: AttrName
buttonAttr = "button"
buttonAttr = attrName "button"
-- | The attribute for the selected dialog button (extends 'dialogAttr')
buttonSelectedAttr :: AttrName
buttonSelectedAttr = buttonAttr <> "selected"
buttonSelectedAttr = buttonAttr <> attrName "selected"
-- | Render a dialog with the specified body widget. This renders the
-- dialog as a layer, which makes this suitable as a top-level layer in

View File

@ -193,12 +193,12 @@ applyEdit f e = e & editContentsL %~ f
-- | The attribute assigned to the editor when it does not have focus.
editAttr :: AttrName
editAttr = "edit"
editAttr = attrName "edit"
-- | The attribute assigned to the editor when it has focus. Extends
-- 'editAttr'.
editFocusedAttr :: AttrName
editFocusedAttr = editAttr <> "focused"
editFocusedAttr = editAttr <> attrName "focused"
-- | Get the contents of the editor.
getEditContents :: Monoid t => Editor t n -> [t]

View File

@ -165,7 +165,7 @@ import qualified System.FilePath as FP
import Text.Printf (printf)
import Brick.Types
import Brick.AttrMap (AttrName)
import Brick.AttrMap (AttrName, attrName)
import Brick.Widgets.Core
import Brick.Widgets.List
@ -837,49 +837,49 @@ attrForFileType UnixSocket = fileBrowserUnixSocketAttr
-- | The base attribute for all file browser attributes.
fileBrowserAttr :: AttrName
fileBrowserAttr = "fileBrowser"
fileBrowserAttr = attrName "fileBrowser"
-- | The attribute used for the current directory displayed at the top
-- of the browser.
fileBrowserCurrentDirectoryAttr :: AttrName
fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> "currentDirectory"
fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> attrName "currentDirectory"
-- | The attribute used for the entry information displayed at the
-- bottom of the browser.
fileBrowserSelectionInfoAttr :: AttrName
fileBrowserSelectionInfoAttr = fileBrowserAttr <> "selectionInfo"
fileBrowserSelectionInfoAttr = fileBrowserAttr <> attrName "selectionInfo"
-- | The attribute used to render directory entries.
fileBrowserDirectoryAttr :: AttrName
fileBrowserDirectoryAttr = fileBrowserAttr <> "directory"
fileBrowserDirectoryAttr = fileBrowserAttr <> attrName "directory"
-- | The attribute used to render block device entries.
fileBrowserBlockDeviceAttr :: AttrName
fileBrowserBlockDeviceAttr = fileBrowserAttr <> "block"
fileBrowserBlockDeviceAttr = fileBrowserAttr <> attrName "block"
-- | The attribute used to render regular file entries.
fileBrowserRegularFileAttr :: AttrName
fileBrowserRegularFileAttr = fileBrowserAttr <> "regular"
fileBrowserRegularFileAttr = fileBrowserAttr <> attrName "regular"
-- | The attribute used to render character device entries.
fileBrowserCharacterDeviceAttr :: AttrName
fileBrowserCharacterDeviceAttr = fileBrowserAttr <> "char"
fileBrowserCharacterDeviceAttr = fileBrowserAttr <> attrName "char"
-- | The attribute used to render named pipe entries.
fileBrowserNamedPipeAttr :: AttrName
fileBrowserNamedPipeAttr = fileBrowserAttr <> "pipe"
fileBrowserNamedPipeAttr = fileBrowserAttr <> attrName "pipe"
-- | The attribute used to render symbolic link entries.
fileBrowserSymbolicLinkAttr :: AttrName
fileBrowserSymbolicLinkAttr = fileBrowserAttr <> "symlink"
fileBrowserSymbolicLinkAttr = fileBrowserAttr <> attrName "symlink"
-- | The attribute used to render Unix socket entries.
fileBrowserUnixSocketAttr :: AttrName
fileBrowserUnixSocketAttr = fileBrowserAttr <> "unixSocket"
fileBrowserUnixSocketAttr = fileBrowserAttr <> attrName "unixSocket"
-- | The attribute used for selected entries in the file browser.
fileBrowserSelectedAttr :: AttrName
fileBrowserSelectedAttr = fileBrowserAttr <> "selected"
fileBrowserSelectedAttr = fileBrowserAttr <> attrName "selected"
-- | A file type filter for use with 'setFileBrowserEntryFilter'. This
-- filter permits entries whose file types are in the specified list.

View File

@ -250,17 +250,17 @@ listMoveToEnd l = listMoveTo (max 0 $ length (listElements l) - 1) l
-- | The top-level attribute used for the entire list.
listAttr :: AttrName
listAttr = "list"
listAttr = attrName "list"
-- | The attribute used only for the currently-selected list item when
-- the list does not have focus. Extends 'listAttr'.
listSelectedAttr :: AttrName
listSelectedAttr = listAttr <> "selected"
listSelectedAttr = listAttr <> attrName "selected"
-- | The attribute used only for the currently-selected list item when
-- the list has focus. Extends 'listSelectedAttr'.
listSelectedFocusedAttr :: AttrName
listSelectedFocusedAttr = listSelectedAttr <> "focused"
listSelectedFocusedAttr = listSelectedAttr <> attrName "focused"
-- | Construct a list in terms of container 't' with element type 'e'.
list :: (Foldable t)

View File

@ -22,11 +22,11 @@ import Brick.Widgets.Core
-- | The attribute of the completed portion of the progress bar.
progressCompleteAttr :: AttrName
progressCompleteAttr = "progressComplete"
progressCompleteAttr = attrName "progressComplete"
-- | The attribute of the incomplete portion of the progress bar.
progressIncompleteAttr :: AttrName
progressIncompleteAttr = "progressIncomplete"
progressIncompleteAttr = attrName "progressIncomplete"
-- | Draw a progress bar with the specified (optional) label and
-- progress value. This fills available horizontal space and is one row