    {-# LANGUAGE DeriveAnyClass #-}
    {-# 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
    -- 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.
    module Brick.AttrMap
      ( AttrMap
      , AttrName
      -- * Construction
      , attrMap
      , forceAttrMap
      , attrName
      -- * Inspection
      , attrNameComponents
      -- * Finding attributes from names
      , attrMapLookup
      -- * Manipulating attribute maps
      , setDefaultAttr
      , getDefaultAttr
      , applyAttrMappings
      , mergeWithDefault
      , mapAttrName
      , mapAttrNames
      )
    where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>))
    import Data.Monoid
    #endif

    import qualified Data.Semigroup as Sem

    import Control.DeepSeq
    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)

    -- | 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"
    -- @
    data AttrName = AttrName [String]
                  deriving (Int -> AttrName -> ShowS
    [AttrName] -> ShowS
    AttrName -> String
    (Int -> AttrName -> ShowS)
    -> (AttrName -> String) -> ([AttrName] -> ShowS) -> Show AttrName
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [AttrName] -> ShowS
    $cshowList :: [AttrName] -> ShowS
    show :: AttrName -> String
    $cshow :: AttrName -> String
    showsPrec :: Int -> AttrName -> ShowS
    $cshowsPrec :: Int -> AttrName -> ShowS
    Show, ReadPrec [AttrName]
    ReadPrec AttrName
    Int -> ReadS AttrName
    ReadS [AttrName]
    (Int -> ReadS AttrName)
    -> ReadS [AttrName]
    -> ReadPrec AttrName
    -> ReadPrec [AttrName]
    -> Read AttrName
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [AttrName]
    $creadListPrec :: ReadPrec [AttrName]
    readPrec :: ReadPrec AttrName
    $creadPrec :: ReadPrec AttrName
    readList :: ReadS [AttrName]
    $creadList :: ReadS [AttrName]
    readsPrec :: Int -> ReadS AttrName
    $creadsPrec :: Int -> ReadS AttrName
    Read, AttrName -> AttrName -> Bool
    (AttrName -> AttrName -> Bool)
    -> (AttrName -> AttrName -> Bool) -> Eq AttrName
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: AttrName -> AttrName -> Bool
    $c/= :: AttrName -> AttrName -> Bool
    == :: AttrName -> AttrName -> Bool
    $c== :: AttrName -> AttrName -> Bool
    Eq, Eq AttrName
    Eq AttrName =>
    (AttrName -> AttrName -> Ordering)
    -> (AttrName -> AttrName -> Bool)
    -> (AttrName -> AttrName -> Bool)
    -> (AttrName -> AttrName -> Bool)
    -> (AttrName -> AttrName -> Bool)
    -> (AttrName -> AttrName -> AttrName)
    -> (AttrName -> AttrName -> AttrName)
    -> Ord AttrName
    AttrName -> AttrName -> Bool
    AttrName -> AttrName -> Ordering
    AttrName -> AttrName -> AttrName
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: AttrName -> AttrName -> AttrName
    $cmin :: AttrName -> AttrName -> AttrName
    max :: AttrName -> AttrName -> AttrName
    $cmax :: AttrName -> AttrName -> AttrName
    >= :: AttrName -> AttrName -> Bool
    $c>= :: AttrName -> AttrName -> Bool
    > :: AttrName -> AttrName -> Bool
    $c> :: AttrName -> AttrName -> Bool
    <= :: AttrName -> AttrName -> Bool
    $c<= :: AttrName -> AttrName -> Bool
    < :: AttrName -> AttrName -> Bool
    $c< :: AttrName -> AttrName -> Bool
    compare :: AttrName -> AttrName -> Ordering
    $ccompare :: AttrName -> AttrName -> Ordering
    $cp1Ord :: Eq AttrName
    Ord, (forall x. AttrName -> Rep AttrName x)
    -> (forall x. Rep AttrName x -> AttrName) -> Generic AttrName
    forall x. Rep AttrName x -> AttrName
    forall x. AttrName -> Rep AttrName x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep AttrName x -> AttrName
    $cfrom :: forall x. AttrName -> Rep AttrName x
    Generic, AttrName -> ()
    (AttrName -> ()) -> NFData AttrName
    forall a. (a -> ()) -> NFData a
    rnf :: AttrName -> ()
    $crnf :: AttrName -> ()
    NFData)

    instance Sem.Semigroup AttrName where
        (AttrName as :: [String]
    as) <> :: AttrName -> AttrName -> AttrName
    <> (AttrName bs :: [String]
    bs) = [String] -> AttrName
    AttrName ([String] -> AttrName) -> [String] -> AttrName
    forall a b. (a -> b) -> a -> b
    $ [String]
    as [String] -> [String] -> [String]
    forall a. Monoid a => a -> a -> a
    `mappend` [String]
    bs

    instance Monoid AttrName where
        mempty :: AttrName
    mempty = [String] -> AttrName
    AttrName []
        mappend :: AttrName -> AttrName -> AttrName
    mappend = AttrName -> AttrName -> AttrName
    forall a. Semigroup a => a -> a -> a
    (Sem.<>)

    instance IsString AttrName where
        fromString :: String -> AttrName
    fromString = [String] -> AttrName
    AttrName ([String] -> AttrName)
    -> (String -> [String]) -> String -> AttrName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[])

    -- | An attribute map which maps 'AttrName' values to 'Attr' values.
    data AttrMap = AttrMap Attr (M.Map AttrName Attr)
                 | ForceAttr Attr
                 deriving (Int -> AttrMap -> ShowS
    [AttrMap] -> ShowS
    AttrMap -> String
    (Int -> AttrMap -> ShowS)
    -> (AttrMap -> String) -> ([AttrMap] -> ShowS) -> Show AttrMap
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [AttrMap] -> ShowS
    $cshowList :: [AttrMap] -> ShowS
    show :: AttrMap -> String
    $cshow :: AttrMap -> String
    showsPrec :: Int -> AttrMap -> ShowS
    $cshowsPrec :: Int -> AttrMap -> ShowS
    Show, (forall x. AttrMap -> Rep AttrMap x)
    -> (forall x. Rep AttrMap x -> AttrMap) -> Generic AttrMap
    forall x. Rep AttrMap x -> AttrMap
    forall x. AttrMap -> Rep AttrMap x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep AttrMap x -> AttrMap
    $cfrom :: forall x. AttrMap -> Rep AttrMap x
    Generic, AttrMap -> ()
    (AttrMap -> ()) -> NFData AttrMap
    forall a. (a -> ()) -> NFData a
    rnf :: AttrMap -> ()
    $crnf :: AttrMap -> ()
    NFData)

    -- | Create an attribute name from a string.
    attrName :: String -> AttrName
    attrName :: String -> AttrName
    attrName = [String] -> AttrName
    AttrName ([String] -> AttrName)
    -> (String -> [String]) -> String -> AttrName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[])

    -- | Get the components of an attribute name.
    attrNameComponents :: AttrName -> [String]
    attrNameComponents :: AttrName -> [String]
    attrNameComponents (AttrName cs :: [String]
    cs) = [String]
    cs

    -- | 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 :: Attr -> [(AttrName, Attr)] -> AttrMap
    attrMap theDefault :: Attr
    theDefault pairs :: [(AttrName, Attr)]
    pairs = Attr -> Map AttrName Attr -> AttrMap
    AttrMap Attr
    theDefault ([(AttrName, Attr)] -> Map AttrName Attr
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(AttrName, Attr)]
    pairs)

    -- | Create an attribute map in which all lookups map to the same
    -- attribute.
    forceAttrMap :: Attr -> AttrMap
    forceAttrMap :: Attr -> AttrMap
    forceAttrMap = Attr -> AttrMap
    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 :: Attr
    a) = Attr
    a
    mergeWithDefault a :: Attr
    a (AttrMap d :: Attr
    d _) = Attr -> Attr -> Attr
    combineAttrs Attr
    d Attr
    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 along with its style
    -- settings. If the attribute name is empty, the map's default attribute
    -- is returned. If the attribute name is non-empty, every 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. As attributes are
    -- merged, styles are also merged. If a more specific attribute name
    -- introduces a style (underline, say) and a less specific attribute
    -- name introduces an additional style (bold, say) then the final result
    -- will include both styles.
    --
    -- 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 :: Attr
    a) = Attr
    a
    attrMapLookup (AttrName []) (AttrMap theDefault :: Attr
    theDefault _) = Attr
    theDefault
    attrMapLookup (AttrName ns :: [String]
    ns) (AttrMap theDefault :: Attr
    theDefault m :: Map AttrName Attr
    m) =
        let results :: [Attr]
    results = [Maybe Attr] -> [Attr]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Attr] -> [Attr]) -> [Maybe Attr] -> [Attr]
    forall a b. (a -> b) -> a -> b
    $ (\n :: AttrName
    n -> AttrName -> Map AttrName Attr -> Maybe Attr
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup AttrName
    n Map AttrName Attr
    m) (AttrName -> Maybe Attr) -> [AttrName] -> [Maybe Attr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([String] -> AttrName
    AttrName ([String] -> AttrName) -> [[String]] -> [AttrName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([String] -> [[String]]
    forall a. [a] -> [[a]]
    inits [String]
    ns))
        in (Attr -> Attr -> Attr) -> Attr -> [Attr] -> Attr
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Attr -> Attr -> Attr
    combineAttrs Attr
    theDefault [Attr]
    results

    -- | Set the default attribute value in an attribute map.
    setDefaultAttr :: Attr -> AttrMap -> AttrMap
    setDefaultAttr :: Attr -> AttrMap -> AttrMap
    setDefaultAttr _ (ForceAttr a :: Attr
    a) = Attr -> AttrMap
    ForceAttr Attr
    a
    setDefaultAttr newDefault :: Attr
    newDefault (AttrMap _ m :: Map AttrName Attr
    m) = Attr -> Map AttrName Attr -> AttrMap
    AttrMap Attr
    newDefault Map AttrName Attr
    m

    -- | Get the default attribute value in an attribute map.
    getDefaultAttr :: AttrMap -> Attr
    getDefaultAttr :: AttrMap -> Attr
    getDefaultAttr (ForceAttr a :: Attr
    a) = Attr
    a
    getDefaultAttr (AttrMap d :: Attr
    d _) = Attr
    d

    combineAttrs :: Attr -> Attr -> Attr
    combineAttrs :: Attr -> Attr -> Attr
    combineAttrs (Attr s1 :: MaybeDefault Style
    s1 f1 :: MaybeDefault Color
    f1 b1 :: MaybeDefault Color
    b1 u1 :: MaybeDefault Text
    u1) (Attr s2 :: MaybeDefault Style
    s2 f2 :: MaybeDefault Color
    f2 b2 :: MaybeDefault Color
    b2 u2 :: MaybeDefault Text
    u2) =
        MaybeDefault Style
    -> MaybeDefault Color
    -> MaybeDefault Color
    -> MaybeDefault Text
    -> Attr
    Attr (MaybeDefault Style
    s1 MaybeDefault Style -> MaybeDefault Style -> MaybeDefault Style
    `combineStyles` MaybeDefault Style
    s2)
             (MaybeDefault Color
    f1 MaybeDefault Color -> MaybeDefault Color -> MaybeDefault Color
    forall a. MaybeDefault a -> MaybeDefault a -> MaybeDefault a
    `combineMDs` MaybeDefault Color
    f2)
             (MaybeDefault Color
    b1 MaybeDefault Color -> MaybeDefault Color -> MaybeDefault Color
    forall a. MaybeDefault a -> MaybeDefault a -> MaybeDefault a
    `combineMDs` MaybeDefault Color
    b2)
             (MaybeDefault Text
    u1 MaybeDefault Text -> MaybeDefault Text -> MaybeDefault Text
    forall a. MaybeDefault a -> MaybeDefault a -> MaybeDefault a
    `combineMDs` MaybeDefault Text
    u2)

    combineMDs :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a
    combineMDs :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a
    combineMDs _ (SetTo v :: a
    v) = a -> MaybeDefault a
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo a
    v
    combineMDs (SetTo v :: a
    v) _ = a -> MaybeDefault a
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo a
    v
    combineMDs _ v :: MaybeDefault a
    v = MaybeDefault a
    v

    combineStyles :: MaybeDefault Style -> MaybeDefault Style -> MaybeDefault Style
    combineStyles :: MaybeDefault Style -> MaybeDefault Style -> MaybeDefault Style
    combineStyles (SetTo a :: Style
    a) (SetTo b :: Style
    b) = Style -> MaybeDefault Style
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo (Style -> MaybeDefault Style) -> Style -> MaybeDefault Style
    forall a b. (a -> b) -> a -> b
    $ Style
    a Style -> Style -> Style
    forall a. Bits a => a -> a -> a
    .|. Style
    b
    combineStyles _ (SetTo v :: Style
    v) = Style -> MaybeDefault Style
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo Style
    v
    combineStyles (SetTo v :: Style
    v) _ = Style -> MaybeDefault Style
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo Style
    v
    combineStyles _ v :: MaybeDefault Style
    v = MaybeDefault Style
    v

    -- | Insert a set of attribute mappings to an attribute map.
    applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap
    applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap
    applyAttrMappings _ (ForceAttr a :: Attr
    a) = Attr -> AttrMap
    ForceAttr Attr
    a
    applyAttrMappings ms :: [(AttrName, Attr)]
    ms (AttrMap d :: Attr
    d m :: Map AttrName Attr
    m) = Attr -> Map AttrName Attr -> AttrMap
    AttrMap Attr
    d (([(AttrName, Attr)] -> Map AttrName Attr
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(AttrName, Attr)]
    ms) Map AttrName Attr -> Map AttrName Attr -> Map AttrName Attr
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `M.union` Map AttrName Attr
    m)

    -- | 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.
    mapAttrName :: AttrName -> AttrName -> AttrMap -> AttrMap
    mapAttrName :: AttrName -> AttrName -> AttrMap -> AttrMap
    mapAttrName fromName :: AttrName
    fromName ontoName :: AttrName
    ontoName inMap :: AttrMap
    inMap =
        [(AttrName, Attr)] -> AttrMap -> AttrMap
    applyAttrMappings [(AttrName
    ontoName, AttrName -> AttrMap -> Attr
    attrMapLookup AttrName
    fromName AttrMap
    inMap)] AttrMap
    inMap

    -- | Map several attributes to return the value associated with an
    -- alternate name.  Applies 'mapAttrName' across a list of mappings.
    mapAttrNames :: [(AttrName, AttrName)] -> AttrMap -> AttrMap
    mapAttrNames :: [(AttrName, AttrName)] -> AttrMap -> AttrMap
    mapAttrNames names :: [(AttrName, AttrName)]
    names inMap :: AttrMap
    inMap = ((AttrName, AttrName) -> AttrMap -> AttrMap)
    -> AttrMap -> [(AttrName, AttrName)] -> AttrMap
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((AttrName -> AttrName -> AttrMap -> AttrMap)
    -> (AttrName, AttrName) -> AttrMap -> AttrMap
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry AttrName -> AttrName -> AttrMap -> AttrMap
    mapAttrName) AttrMap
    inMap [(AttrName, AttrName)]
    names