mirror of
https://github.com/jtdaugherty/brick.git
synced 2025-01-07 14:36:59 +03:00
Add docstrings to Brick.AttrMap
This commit is contained in:
parent
a64f9db96f
commit
868bdd694f
@ -1,10 +1,18 @@
|
|||||||
|
-- | 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.
|
||||||
module Brick.AttrMap
|
module Brick.AttrMap
|
||||||
( AttrMap
|
( AttrMap
|
||||||
, AttrName
|
, AttrName
|
||||||
, attrName
|
-- * Construction
|
||||||
, attrMap
|
, attrMap
|
||||||
, forceAttrMap
|
, forceAttrMap
|
||||||
|
, attrName
|
||||||
|
-- * Finding attributes from names
|
||||||
, attrMapLookup
|
, attrMapLookup
|
||||||
|
-- * Manipulating attribute maps
|
||||||
, setDefault
|
, setDefault
|
||||||
, applyAttrMappings
|
, applyAttrMappings
|
||||||
, mergeWithDefault
|
, mergeWithDefault
|
||||||
@ -21,6 +29,18 @@ import Data.Default (Default(..))
|
|||||||
|
|
||||||
import Graphics.Vty (Attr(..), MaybeDefault(..))
|
import Graphics.Vty (Attr(..), MaybeDefault(..))
|
||||||
|
|
||||||
|
-- | An attribute name. Attribute names are hierarchical; use 'mappend'
|
||||||
|
-- ('<>') to assemble them. Hierachy in an attribute name is used to
|
||||||
|
-- represent increasing levels of specificity in referring to the
|
||||||
|
-- attribute you want to use for a visual element, with names to the
|
||||||
|
-- left being general and names to the right being more specific. For
|
||||||
|
-- example:
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- "window" <> "border"
|
||||||
|
-- "window" <> "title"
|
||||||
|
-- "header" <> "clock" <> "seconds"
|
||||||
|
-- @
|
||||||
data AttrName = AttrName [String]
|
data AttrName = AttrName [String]
|
||||||
deriving (Show, Eq, Ord)
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
@ -34,6 +54,7 @@ instance Monoid AttrName where
|
|||||||
instance IsString AttrName where
|
instance IsString AttrName where
|
||||||
fromString = AttrName . (:[])
|
fromString = AttrName . (:[])
|
||||||
|
|
||||||
|
-- | An attribute map which maps 'AttrName' values to 'Attr' values.
|
||||||
data AttrMap = AttrMap Attr (M.Map AttrName Attr)
|
data AttrMap = AttrMap Attr (M.Map AttrName Attr)
|
||||||
| ForceAttr Attr
|
| ForceAttr Attr
|
||||||
deriving Show
|
deriving Show
|
||||||
@ -41,19 +62,64 @@ data AttrMap = AttrMap Attr (M.Map AttrName Attr)
|
|||||||
instance Default AttrMap where
|
instance Default AttrMap where
|
||||||
def = AttrMap def mempty
|
def = AttrMap def mempty
|
||||||
|
|
||||||
|
-- | Create an attribute name from a string.
|
||||||
attrName :: String -> AttrName
|
attrName :: String -> AttrName
|
||||||
attrName = AttrName . (:[])
|
attrName = AttrName . (:[])
|
||||||
|
|
||||||
attrMap :: Attr -> [(AttrName, Attr)] -> AttrMap
|
-- | Create an attribute map.
|
||||||
|
attrMap :: Attr
|
||||||
|
-- ^ The map's default attribute to be returned when a name
|
||||||
|
-- lookup fails, and the attribute that will be merged with
|
||||||
|
-- successful lookups.
|
||||||
|
-> [(AttrName, Attr)]
|
||||||
|
-- ^ The map's initial contents.
|
||||||
|
-> AttrMap
|
||||||
attrMap theDefault pairs = AttrMap theDefault (M.fromList pairs)
|
attrMap theDefault pairs = AttrMap theDefault (M.fromList pairs)
|
||||||
|
|
||||||
|
-- | Create an attribute map in which all lookups map to the same
|
||||||
|
-- attribute.
|
||||||
forceAttrMap :: Attr -> AttrMap
|
forceAttrMap :: Attr -> AttrMap
|
||||||
forceAttrMap = ForceAttr
|
forceAttrMap = ForceAttr
|
||||||
|
|
||||||
|
-- | Given an attribute and a map, merge the attribute with the map's
|
||||||
|
-- default attribute. If the map is forcing all lookups to a specific
|
||||||
|
-- attribute, the forced attribute is returned without merging it with
|
||||||
|
-- the one specified here. Otherwise the attribute given here is merged
|
||||||
|
-- with the attribute map's default attribute in that any aspect of the
|
||||||
|
-- specified attribute that is not provided falls back to the map
|
||||||
|
-- default. For example,
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- mergeWithDefault (fg blue) $ attrMap (bg red) []
|
||||||
|
-- @
|
||||||
|
--
|
||||||
|
-- returns
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- blue \`on\` red
|
||||||
|
-- @
|
||||||
mergeWithDefault :: Attr -> AttrMap -> Attr
|
mergeWithDefault :: Attr -> AttrMap -> Attr
|
||||||
mergeWithDefault _ (ForceAttr a) = a
|
mergeWithDefault _ (ForceAttr a) = a
|
||||||
mergeWithDefault a (AttrMap d _) = combineAttrs d a
|
mergeWithDefault a (AttrMap d _) = combineAttrs d a
|
||||||
|
|
||||||
|
-- | Look up the specified attribute name in the map. Map lookups
|
||||||
|
-- proceed as follows. If the attribute map is forcing all lookups to a
|
||||||
|
-- specific attribute, that attribute is returned. If the attribute name
|
||||||
|
-- is empty, the map's default attribute is returned. If the attribute
|
||||||
|
-- name is non-empty, very subsequence of names from the specified name
|
||||||
|
-- are used to perform a lookup, and the results are combined as in
|
||||||
|
-- 'mergeWithDefault', with more specific results taking precedence over
|
||||||
|
-- less specific ones.
|
||||||
|
--
|
||||||
|
-- For example:
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- attrMapLookup ("foo" <> "bar") (attrMap a []) == a
|
||||||
|
-- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red)]) == red \`on\` blue
|
||||||
|
-- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", red `on` cyan)]) == red \`on\` cyan
|
||||||
|
-- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan
|
||||||
|
-- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo", fg red)]) == red \`on\` blue
|
||||||
|
-- @
|
||||||
attrMapLookup :: AttrName -> AttrMap -> Attr
|
attrMapLookup :: AttrName -> AttrMap -> Attr
|
||||||
attrMapLookup _ (ForceAttr a) = a
|
attrMapLookup _ (ForceAttr a) = a
|
||||||
attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault
|
attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault
|
||||||
@ -61,6 +127,7 @@ attrMapLookup (AttrName ns) (AttrMap theDefault m) =
|
|||||||
let results = catMaybes $ (\n -> M.lookup n m) <$> (AttrName <$> (inits ns))
|
let results = catMaybes $ (\n -> M.lookup n m) <$> (AttrName <$> (inits ns))
|
||||||
in foldl combineAttrs theDefault results
|
in foldl combineAttrs theDefault results
|
||||||
|
|
||||||
|
-- | Set the default attribute value in an attribute map.
|
||||||
setDefault :: Attr -> AttrMap -> AttrMap
|
setDefault :: Attr -> AttrMap -> AttrMap
|
||||||
setDefault _ (ForceAttr a) = ForceAttr a
|
setDefault _ (ForceAttr a) = ForceAttr a
|
||||||
setDefault newDefault (AttrMap _ m) = AttrMap newDefault m
|
setDefault newDefault (AttrMap _ m) = AttrMap newDefault m
|
||||||
@ -76,6 +143,7 @@ combineMDs _ (SetTo v) = SetTo v
|
|||||||
combineMDs (SetTo v) _ = SetTo v
|
combineMDs (SetTo v) _ = SetTo v
|
||||||
combineMDs _ v = v
|
combineMDs _ v = v
|
||||||
|
|
||||||
|
-- | Insert a set of attribute mappings to an attribute map.
|
||||||
applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap
|
applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap
|
||||||
applyAttrMappings _ (ForceAttr a) = ForceAttr a
|
applyAttrMappings _ (ForceAttr a) = ForceAttr a
|
||||||
applyAttrMappings ms (AttrMap d m) = AttrMap d ((M.fromList ms) `M.union` m)
|
applyAttrMappings ms (AttrMap d m) = AttrMap d ((M.fromList ms) `M.union` m)
|
||||||
|
Loading…
Reference in New Issue
Block a user