Safe Haskell | None |
---|---|
Language | Haskell2010 |
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
specify partial attributes. Hierarchical names are created with mappend
:
let n = attrName "parent" <> attrName "child"
Attribute names are mapped to attributes, but some attributes may
be partial (specify only a foreground or background color). When
attribute name lookups occur, the attribute corresponding to a more
specific name ('parent <> child' as above) is sucessively merged with
the parent attribute (parent
as above) all the way to the "root"
of the attribute map, the map's default attribute. In this way, more
specific attributes inherit what they don't specify from more general
attributes in the same hierarchy. This allows more modularity and
less repetition in specifying how elements of your user interface
take on different attributes.
Synopsis
- data AttrMap
- data AttrName
- attrMap :: Attr -> [(AttrName, Attr)] -> AttrMap
- forceAttrMap :: Attr -> AttrMap
- attrName :: String -> AttrName
- attrNameComponents :: AttrName -> [String]
- attrMapLookup :: AttrName -> AttrMap -> Attr
- setDefaultAttr :: Attr -> AttrMap -> AttrMap
- getDefaultAttr :: AttrMap -> Attr
- applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap
- mergeWithDefault :: Attr -> AttrMap -> Attr
- mapAttrName :: AttrName -> AttrName -> AttrMap -> AttrMap
- mapAttrNames :: [(AttrName, AttrName)] -> AttrMap -> AttrMap
Documentation
Instances
Show AttrMap Source # | |
Generic AttrMap Source # | |
NFData AttrMap Source # | |
Defined in Brick.AttrMap | |
type Rep AttrMap Source # | |
Defined in Brick.AttrMap type Rep AttrMap = D1 (MetaData "AttrMap" "Brick.AttrMap" "brick-0.41.5-APj2XGFr8hFIUCnJJ8Bgpu" False) (C1 (MetaCons "AttrMap" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Attr) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Map AttrName Attr))) :+: C1 (MetaCons "ForceAttr" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Attr))) |
An attribute name. Attribute names are hierarchical; use mappend
(<>
) to assemble them. Hierarchy 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"
Instances
Eq AttrName Source # | |
Ord AttrName Source # | |
Defined in Brick.AttrMap | |
Read AttrName Source # | |
Show AttrName Source # | |
IsString AttrName Source # | |
Defined in Brick.AttrMap fromString :: String -> AttrName # | |
Generic AttrName Source # | |
Semigroup AttrName Source # | |
Monoid AttrName Source # | |
NFData AttrName Source # | |
Defined in Brick.AttrMap | |
GetAttr AttrName Source # | |
type Rep AttrName Source # | |
Defined in Brick.AttrMap |
Construction
:: 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 |
Create an attribute map.
forceAttrMap :: Attr -> AttrMap Source #
Create an attribute map in which all lookups map to the same attribute.
Inspection
attrNameComponents :: AttrName -> [String] Source #
Get the components of an attribute name.
Finding attributes from names
attrMapLookup :: AttrName -> AttrMap -> Attr Source #
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
Manipulating attribute maps
setDefaultAttr :: Attr -> AttrMap -> AttrMap Source #
Set the default attribute value in an attribute map.
getDefaultAttr :: AttrMap -> Attr Source #
Get the default attribute value in an attribute map.
applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap Source #
Insert a set of attribute mappings to an attribute map.
mergeWithDefault :: Attr -> AttrMap -> Attr Source #
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
mapAttrName :: AttrName -> AttrName -> AttrMap -> AttrMap Source #
Update an attribute map such that a lookup of ontoName
returns
the attribute value specified by fromName
. This is useful for
composite widgets with specific attribute names mapping those names
to the sub-widget's expected name when calling that sub-widget's
rendering function. See the ProgressBarDemo for an example usage,
and overrideAttr
for an alternate syntax.
mapAttrNames :: [(AttrName, AttrName)] -> AttrMap -> AttrMap Source #
Map several attributes to return the value associated with an
alternate name. Applies mapAttrName
across a list of mappings.