-- | This module defines the various attributes that can be used with
-- an 'ItemFieldWidget'.
module TextUI.ItemField.Attrs where


import Data.Monoid
import Brick.AttrMap (AttrName, attrName)
import Brick.Util (on)
import Graphics.Vty


-- | The 'itemAttr' is the base attribute for the entire Widget
itemAttr :: AttrName
itemAttr = attrName "item"


-- | The 'itemFieldAttr' is the attribute for the items portion of the
-- Widget.  It does not apply to the headers or the current selection
-- status.
itemFieldAttr :: AttrName
itemFieldAttr = itemAttr <> attrName "itemField"


-- | The 'itemFreeAttr' applies to showing an item state that is Free,
-- which is usually the default state for an unselected, un-evaluated
-- item.
itemFreeAttr :: AttrName
itemFreeAttr = itemFieldAttr <> attrName "itemFree"

-- | The 'itemMarkedAttr' applies to showing an item that is Marked
-- for future action.
itemMarkedAttr :: AttrName
itemMarkedAttr = itemFieldAttr <> attrName "itemMarked"

-- | The 'itemGoodAttr' indicates an item that is in the Good state.
itemGoodAttr :: AttrName
itemGoodAttr = itemFieldAttr <> attrName "itemGood"

-- | The 'itemBadAttr' indicates an item that is in the Bad state.
itemBadAttr :: AttrName
itemBadAttr = itemFieldAttr <> attrName "itemBad"

-- | The 'itemCaVaAttr' indicates an item that is in the CaVa state
-- ("ca va" is French for "OK" or "so-so").
itemCaVaAttr :: AttrName
itemCaVaAttr = itemFieldAttr <> attrName "itemModerate"

-- | The 'itemBlankAttr' is an interstitial attribute marker for
-- portions of the ItemField that are to be left blank
itemBlankAttr :: AttrName
itemBlankAttr = itemAttr <> attrName "itemBlank"

-- | The 'itemMoreMessageAttr' is used when the 'ItemField' rendering
-- would overflow the available space, so the bottom of the rendering
-- includes a message indicating there is more to display.
itemMoreMessageAttr :: AttrName
itemMoreMessageAttr = itemFieldAttr <> attrName "itemsMoreMessage"

-- | The 'itemNoneMessageAttr' is used for the message displayed when
-- the 'ItemField' contains no actual items.
itemNoneMessageAttr :: AttrName
itemNoneMessageAttr = itemFieldAttr <> attrName "itemsNoneMessage"

-- | The 'itemSelectedDetailsAttr' is used for the details info for
-- the currently selected item that is displayed at the bottom of the
-- itemfield.
itemSelectedDetailsAttr :: AttrName
itemSelectedDetailsAttr = itemAttr <> attrName "itemSelectedDetails"

-- | The 'itemHeaderAttr' is used for group headers in the ItemField.
itemHeaderAttr :: AttrName
itemHeaderAttr = itemAttr <> attrName "itemHeader"


-- | This defines the list of default attribute values for this
-- itemfield.  To apply these to the default attrbute specifications:
--
-- @
-- App { ...
--     , appAttrMap = const $ applyAttrMappings itemDefaultAttrs def
--     ... }
-- @
--
-- and to override these defaults:
--
-- @
-- App { ...
--     , appAttrMap = const
--                    $ applyAttrMappings
--                        [ (itemHeaderAddr, fg cyan), ... ]
--                    $ applyAttrMappings itemDefaultAttrs def
--     ... }
-- @
itemDefaultAttrs :: [ (AttrName, Attr) ]
itemDefaultAttrs = [ (itemGoodAttr, black `on` green `withStyle` bold)
                   , (itemBadAttr, black `on` red)
                   , (itemCaVaAttr, black `on` yellow)
                   , (itemMoreMessageAttr, currentAttr `withStyle` reverseVideo)
                   , (itemHeaderAttr, currentAttr `withStyle` underline)
                   ]