travitch/taffybar — pull request #78 by bgamari (2014-05-28 14:38:02+00:00)
Title: Rework Pager formatting

This patch allows the user to mark up workspace names with access to
monadic context. This enables things like,

{{{
myMarkupWorkspaces :: Traversable f => f WorkspaceInfo -> f Markup
myMarkupWorkspaces wss = evalState (traverse f wss) ("", cycle colors)
where
colors = [ "#843c3c"
, "#60843c"
, "#3c8384"
, "#3c4d84"
, "#613c84"
, "#843c3c"
]

f :: WorkspaceInfo -> State (String, [String]) Markup
f ws@(WSInfo {wsiName=name}) = do
let group = takeWhile (/= '-') name
(lastGroup, grpColor:rest) <- get
if group /= lastGroup
then put (group, rest) >> f ws
else return $ color grpColor ws

color grpColor (WSInfo {wsiName=name}) = colorize grpColor "" $ escape name
}}}

Which colors workspace names in groups according to their prefix
(delimited by '-').