    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE TemplateHaskell #-}
    -- | Support for representing attribute themes and loading and saving
    -- theme customizations in INI-style files.
    --
    -- The file format is as follows:
    --
    -- Customization files are INI-style files with two sections, both
    -- optional: @"default"@ and @"other"@.
    --
    -- The @"default"@ section specifies three optional fields:
    --
    --  * @"default.fg"@ - a color specification
    --  * @"default.bg"@ - a color specification
    --  * @"default.style"@ - a style specification
    --
    -- A color specification can be any of the strings @black@, @red@,
    -- @green@, @yellow@, @blue@, @magenta@, @cyan@, @white@, @brightBlack@,
    -- @brightRed@, @brightGreen@, @brightYellow@, @brightBlue@,
    -- @brightMagenta@, @brightCyan@, @brightWhite@, or @default@.
    --
    -- We also support color specifications in the common hex format @#RRGGBB@, but
    -- note that this specification is lossy: terminals can only display 256 colors,
    -- but hex codes can specify @256^3 = 16777216@ colors.
    --
    -- A style specification can be either one of the following values
    -- (without quotes) or a comma-delimited list of one or more of the
    -- following values (e.g. @"[bold,underline]"@) indicating that all
    -- of the specified styles be used. Valid styles are @standout@,
    -- @underline@, @reverseVideo@, @blink@, @dim@, @italic@, and @bold@.
    --
    -- The @other@ section specifies for each attribute name in the theme
    -- the same @fg@, @bg@, and @style@ settings as for the default
    -- attribute. Furthermore, if an attribute name has multiple components,
    -- the fields in the INI file should use periods as delimiters. For
    -- example, if a theme has an attribute name (@"foo" <> "bar"@), then
    -- the file may specify three fields:
    --
    --  * @foo.bar.fg@ - a color specification
    --  * @foo.bar.bg@ - a color specification
    --  * @foo.bar.style@ - a style specification
    --
    -- Any color or style specifications omitted from the file mean that
    -- those attribute or style settings will use the theme's default value
    -- instead.
    --
    -- Attribute names with multiple components (e.g. @attr1 <> attr2@) can
    -- be referenced in customization files by separating the names with
    -- a dot. For example, the attribute name @"list" <> "selected"@ can be
    -- referenced by using the string "list.selected".
    module Brick.Themes
      ( CustomAttr(..)
      , customFgL
      , customBgL
      , customStyleL

      , Theme(..)
      , newTheme
      , themeDefaultAttrL
      , themeDefaultMappingL
      , themeCustomMappingL
      , themeCustomDefaultAttrL

      , ThemeDocumentation(..)
      , themeDescriptionsL

      , themeToAttrMap
      , applyCustomizations
      , loadCustomizations
      , saveCustomizations
      , saveTheme
      )
    where

    import GHC.Generics (Generic)
    import Graphics.Vty hiding ((<|>))
    import Control.DeepSeq
    import Control.Monad (forM, join)
    import Control.Applicative ((<|>))
    import qualified Data.Text as T
    import qualified Data.Text.Read as T
    import qualified Data.Text.IO as T
    import qualified Data.Map as M
    import qualified Data.Semigroup as Sem
    import Data.Tuple (swap)
    import Data.List (intercalate)
    import Data.Bits ((.|.), (.&.))
    import Data.Maybe (fromMaybe, isNothing, catMaybes, mapMaybe)
    #if !(MIN_VERSION_base(4,11,0))
    import Data.Monoid ((<>))
    #endif
    import qualified Data.Foldable as F

    import Data.Ini.Config

    import Brick.AttrMap (AttrMap, AttrName, attrMap, attrNameComponents)
    import Brick.Types.TH (suffixLenses)

    import Text.Printf

    -- | An attribute customization can specify which aspects of an
    -- attribute to customize.
    data CustomAttr =
        CustomAttr { CustomAttr -> Maybe (MaybeDefault Color)
    customFg    :: Maybe (MaybeDefault Color)
                   -- ^ The customized foreground, if any.
                   , CustomAttr -> Maybe (MaybeDefault Color)
    customBg    :: Maybe (MaybeDefault Color)
                   -- ^ The customized background, if any.
                   , CustomAttr -> Maybe Style
    customStyle :: Maybe Style
                   -- ^ The customized style, if any.
                   }
                   deriving (CustomAttr -> CustomAttr -> Bool
    (CustomAttr -> CustomAttr -> Bool)
    -> (CustomAttr -> CustomAttr -> Bool) -> Eq CustomAttr
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: CustomAttr -> CustomAttr -> Bool
    $c/= :: CustomAttr -> CustomAttr -> Bool
    == :: CustomAttr -> CustomAttr -> Bool
    $c== :: CustomAttr -> CustomAttr -> Bool
    Eq, ReadPrec [CustomAttr]
    ReadPrec CustomAttr
    Int -> ReadS CustomAttr
    ReadS [CustomAttr]
    (Int -> ReadS CustomAttr)
    -> ReadS [CustomAttr]
    -> ReadPrec CustomAttr
    -> ReadPrec [CustomAttr]
    -> Read CustomAttr
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [CustomAttr]
    $creadListPrec :: ReadPrec [CustomAttr]
    readPrec :: ReadPrec CustomAttr
    $creadPrec :: ReadPrec CustomAttr
    readList :: ReadS [CustomAttr]
    $creadList :: ReadS [CustomAttr]
    readsPrec :: Int -> ReadS CustomAttr
    $creadsPrec :: Int -> ReadS CustomAttr
    Read, Int -> CustomAttr -> ShowS
    [CustomAttr] -> ShowS
    CustomAttr -> String
    (Int -> CustomAttr -> ShowS)
    -> (CustomAttr -> String)
    -> ([CustomAttr] -> ShowS)
    -> Show CustomAttr
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [CustomAttr] -> ShowS
    $cshowList :: [CustomAttr] -> ShowS
    show :: CustomAttr -> String
    $cshow :: CustomAttr -> String
    showsPrec :: Int -> CustomAttr -> ShowS
    $cshowsPrec :: Int -> CustomAttr -> ShowS
    Show, (forall x. CustomAttr -> Rep CustomAttr x)
    -> (forall x. Rep CustomAttr x -> CustomAttr) -> Generic CustomAttr
    forall x. Rep CustomAttr x -> CustomAttr
    forall x. CustomAttr -> Rep CustomAttr x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep CustomAttr x -> CustomAttr
    $cfrom :: forall x. CustomAttr -> Rep CustomAttr x
    Generic, CustomAttr -> ()
    (CustomAttr -> ()) -> NFData CustomAttr
    forall a. (a -> ()) -> NFData a
    rnf :: CustomAttr -> ()
    $crnf :: CustomAttr -> ()
    NFData)

    instance Sem.Semigroup CustomAttr where
        a :: CustomAttr
    a <> :: CustomAttr -> CustomAttr -> CustomAttr
    <> b :: CustomAttr
    b =
            CustomAttr :: Maybe (MaybeDefault Color)
    -> Maybe (MaybeDefault Color) -> Maybe Style -> CustomAttr
    CustomAttr { customFg :: Maybe (MaybeDefault Color)
    customFg    = CustomAttr -> Maybe (MaybeDefault Color)
    customFg CustomAttr
    a    Maybe (MaybeDefault Color)
    -> Maybe (MaybeDefault Color) -> Maybe (MaybeDefault Color)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> CustomAttr -> Maybe (MaybeDefault Color)
    customFg CustomAttr
    b
                       , customBg :: Maybe (MaybeDefault Color)
    customBg    = CustomAttr -> Maybe (MaybeDefault Color)
    customBg CustomAttr
    a    Maybe (MaybeDefault Color)
    -> Maybe (MaybeDefault Color) -> Maybe (MaybeDefault Color)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> CustomAttr -> Maybe (MaybeDefault Color)
    customBg CustomAttr
    b
                       , customStyle :: Maybe Style
    customStyle = CustomAttr -> Maybe Style
    customStyle CustomAttr
    a Maybe Style -> Maybe Style -> Maybe Style
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> CustomAttr -> Maybe Style
    customStyle CustomAttr
    b
                       }

    instance Monoid CustomAttr where
        mempty :: CustomAttr
    mempty = Maybe (MaybeDefault Color)
    -> Maybe (MaybeDefault Color) -> Maybe Style -> CustomAttr
    CustomAttr Maybe (MaybeDefault Color)
    forall a. Maybe a
    Nothing Maybe (MaybeDefault Color)
    forall a. Maybe a
    Nothing Maybe Style
    forall a. Maybe a
    Nothing
        mappend :: CustomAttr -> CustomAttr -> CustomAttr
    mappend = CustomAttr -> CustomAttr -> CustomAttr
    forall a. Semigroup a => a -> a -> a
    (Sem.<>)

    -- | Documentation for a theme's attributes.
    data ThemeDocumentation =
        ThemeDocumentation { ThemeDocumentation -> Map AttrName Text
    themeDescriptions :: M.Map AttrName T.Text
                           -- ^ The per-attribute documentation for a theme
                           -- so e.g. documentation for theme customization
                           -- can be generated mechanically.
                           }
                           deriving (ThemeDocumentation -> ThemeDocumentation -> Bool
    (ThemeDocumentation -> ThemeDocumentation -> Bool)
    -> (ThemeDocumentation -> ThemeDocumentation -> Bool)
    -> Eq ThemeDocumentation
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ThemeDocumentation -> ThemeDocumentation -> Bool
    $c/= :: ThemeDocumentation -> ThemeDocumentation -> Bool
    == :: ThemeDocumentation -> ThemeDocumentation -> Bool
    $c== :: ThemeDocumentation -> ThemeDocumentation -> Bool
    Eq, ReadPrec [ThemeDocumentation]
    ReadPrec ThemeDocumentation
    Int -> ReadS ThemeDocumentation
    ReadS [ThemeDocumentation]
    (Int -> ReadS ThemeDocumentation)
    -> ReadS [ThemeDocumentation]
    -> ReadPrec ThemeDocumentation
    -> ReadPrec [ThemeDocumentation]
    -> Read ThemeDocumentation
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [ThemeDocumentation]
    $creadListPrec :: ReadPrec [ThemeDocumentation]
    readPrec :: ReadPrec ThemeDocumentation
    $creadPrec :: ReadPrec ThemeDocumentation
    readList :: ReadS [ThemeDocumentation]
    $creadList :: ReadS [ThemeDocumentation]
    readsPrec :: Int -> ReadS ThemeDocumentation
    $creadsPrec :: Int -> ReadS ThemeDocumentation
    Read, Int -> ThemeDocumentation -> ShowS
    [ThemeDocumentation] -> ShowS
    ThemeDocumentation -> String
    (Int -> ThemeDocumentation -> ShowS)
    -> (ThemeDocumentation -> String)
    -> ([ThemeDocumentation] -> ShowS)
    -> Show ThemeDocumentation
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ThemeDocumentation] -> ShowS
    $cshowList :: [ThemeDocumentation] -> ShowS
    show :: ThemeDocumentation -> String
    $cshow :: ThemeDocumentation -> String
    showsPrec :: Int -> ThemeDocumentation -> ShowS
    $cshowsPrec :: Int -> ThemeDocumentation -> ShowS
    Show, (forall x. ThemeDocumentation -> Rep ThemeDocumentation x)
    -> (forall x. Rep ThemeDocumentation x -> ThemeDocumentation)
    -> Generic ThemeDocumentation
    forall x. Rep ThemeDocumentation x -> ThemeDocumentation
    forall x. ThemeDocumentation -> Rep ThemeDocumentation x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep ThemeDocumentation x -> ThemeDocumentation
    $cfrom :: forall x. ThemeDocumentation -> Rep ThemeDocumentation x
    Generic, ThemeDocumentation -> ()
    (ThemeDocumentation -> ()) -> NFData ThemeDocumentation
    forall a. (a -> ()) -> NFData a
    rnf :: ThemeDocumentation -> ()
    $crnf :: ThemeDocumentation -> ()
    NFData)

    -- | A theme provides a set of default attribute mappings, a default
    -- attribute, and a set of customizations for the default mapping
    -- and default attribute. The idea here is that the application will
    -- always need to provide a complete specification of its attribute
    -- mapping, but if the user wants to customize any aspect of that
    -- default mapping, it can be contained here and then built into an
    -- 'AttrMap' (see 'themeToAttrMap'). We keep the defaults separate
    -- from customizations to permit users to serialize themes and their
    -- customizations to, say, disk files.
    data Theme =
        Theme { Theme -> Attr
    themeDefaultAttr :: Attr
              -- ^ The default attribute to use.
              , Theme -> Map AttrName Attr
    themeDefaultMapping :: M.Map AttrName Attr
              -- ^ The default attribute mapping to use.
              , Theme -> Maybe CustomAttr
    themeCustomDefaultAttr :: Maybe CustomAttr
              -- ^ Customization for the theme's default attribute.
              , Theme -> Map AttrName CustomAttr
    themeCustomMapping :: M.Map AttrName CustomAttr
              -- ^ Customizations for individual entries of the default
              -- mapping. Note that this will only affect entries in the
              -- default mapping; any attributes named here that are not
              -- present in the default mapping will not be considered.
              }
              deriving (Theme -> Theme -> Bool
    (Theme -> Theme -> Bool) -> (Theme -> Theme -> Bool) -> Eq Theme
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Theme -> Theme -> Bool
    $c/= :: Theme -> Theme -> Bool
    == :: Theme -> Theme -> Bool
    $c== :: Theme -> Theme -> Bool
    Eq, ReadPrec [Theme]
    ReadPrec Theme
    Int -> ReadS Theme
    ReadS [Theme]
    (Int -> ReadS Theme)
    -> ReadS [Theme]
    -> ReadPrec Theme
    -> ReadPrec [Theme]
    -> Read Theme
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [Theme]
    $creadListPrec :: ReadPrec [Theme]
    readPrec :: ReadPrec Theme
    $creadPrec :: ReadPrec Theme
    readList :: ReadS [Theme]
    $creadList :: ReadS [Theme]
    readsPrec :: Int -> ReadS Theme
    $creadsPrec :: Int -> ReadS Theme
    Read, Int -> Theme -> ShowS
    [Theme] -> ShowS
    Theme -> String
    (Int -> Theme -> ShowS)
    -> (Theme -> String) -> ([Theme] -> ShowS) -> Show Theme
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Theme] -> ShowS
    $cshowList :: [Theme] -> ShowS
    show :: Theme -> String
    $cshow :: Theme -> String
    showsPrec :: Int -> Theme -> ShowS
    $cshowsPrec :: Int -> Theme -> ShowS
    Show, (forall x. Theme -> Rep Theme x)
    -> (forall x. Rep Theme x -> Theme) -> Generic Theme
    forall x. Rep Theme x -> Theme
    forall x. Theme -> Rep Theme x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep Theme x -> Theme
    $cfrom :: forall x. Theme -> Rep Theme x
    Generic, Theme -> ()
    (Theme -> ()) -> NFData Theme
    forall a. (a -> ()) -> NFData a
    rnf :: Theme -> ()
    $crnf :: Theme -> ()
    NFData)

    suffixLenses ''CustomAttr
    suffixLenses ''Theme
    suffixLenses ''ThemeDocumentation

    defaultSectionName :: T.Text
    defaultSectionName :: Text
    defaultSectionName = "default"

    otherSectionName :: T.Text
    otherSectionName :: Text
    otherSectionName = "other"

    -- | Create a new theme with the specified default attribute and
    -- attribute mapping. The theme will have no customizations.
    newTheme :: Attr -> [(AttrName, Attr)] -> Theme
    newTheme :: Attr -> [(AttrName, Attr)] -> Theme
    newTheme def :: Attr
    def mapping :: [(AttrName, Attr)]
    mapping =
        Theme :: Attr
    -> Map AttrName Attr
    -> Maybe CustomAttr
    -> Map AttrName CustomAttr
    -> Theme
    Theme { themeDefaultAttr :: Attr
    themeDefaultAttr       = Attr
    def
              , themeDefaultMapping :: Map AttrName Attr
    themeDefaultMapping    = [(AttrName, Attr)] -> Map AttrName Attr
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(AttrName, Attr)]
    mapping
              , themeCustomDefaultAttr :: Maybe CustomAttr
    themeCustomDefaultAttr = Maybe CustomAttr
    forall a. Maybe a
    Nothing
              , themeCustomMapping :: Map AttrName CustomAttr
    themeCustomMapping     = Map AttrName CustomAttr
    forall a. Monoid a => a
    mempty
              }

    -- | Build an 'AttrMap' from a 'Theme'. This applies all customizations
    -- in the returned 'AttrMap'.
    themeToAttrMap :: Theme -> AttrMap
    themeToAttrMap :: Theme -> AttrMap
    themeToAttrMap t :: Theme
    t =
        Attr -> [(AttrName, Attr)] -> AttrMap
    attrMap (Maybe CustomAttr -> Attr -> Attr
    customizeAttr (Theme -> Maybe CustomAttr
    themeCustomDefaultAttr Theme
    t) (Theme -> Attr
    themeDefaultAttr Theme
    t)) [(AttrName, Attr)]
    customMap
        where
            customMap :: [(AttrName, Attr)]
    customMap = ((AttrName, Attr) -> [(AttrName, Attr)] -> [(AttrName, Attr)])
    -> [(AttrName, Attr)] -> [(AttrName, Attr)] -> [(AttrName, Attr)]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    F.foldr (AttrName, Attr) -> [(AttrName, Attr)] -> [(AttrName, Attr)]
    f [] (Map AttrName Attr -> [(AttrName, Attr)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map AttrName Attr -> [(AttrName, Attr)])
    -> Map AttrName Attr -> [(AttrName, Attr)]
    forall a b. (a -> b) -> a -> b
    $ Theme -> Map AttrName Attr
    themeDefaultMapping Theme
    t)
            f :: (AttrName, Attr) -> [(AttrName, Attr)] -> [(AttrName, Attr)]
    f (aName :: AttrName
    aName, attr :: Attr
    attr) mapping :: [(AttrName, Attr)]
    mapping =
                let a' :: Attr
    a' = Maybe CustomAttr -> Attr -> Attr
    customizeAttr (AttrName -> Map AttrName CustomAttr -> Maybe CustomAttr
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup AttrName
    aName (Theme -> Map AttrName CustomAttr
    themeCustomMapping Theme
    t)) Attr
    attr
                in (AttrName
    aName, Attr
    a')(AttrName, Attr) -> [(AttrName, Attr)] -> [(AttrName, Attr)]
    forall a. a -> [a] -> [a]
    :[(AttrName, Attr)]
    mapping

    customizeAttr :: Maybe CustomAttr -> Attr -> Attr
    customizeAttr :: Maybe CustomAttr -> Attr -> Attr
    customizeAttr Nothing a :: Attr
    a = Attr
    a
    customizeAttr (Just c :: CustomAttr
    c) a :: Attr
    a =
        let fg :: MaybeDefault Color
    fg = MaybeDefault Color
    -> Maybe (MaybeDefault Color) -> MaybeDefault Color
    forall a. a -> Maybe a -> a
    fromMaybe (Attr -> MaybeDefault Color
    attrForeColor Attr
    a) (CustomAttr -> Maybe (MaybeDefault Color)
    customFg CustomAttr
    c)
            bg :: MaybeDefault Color
    bg = MaybeDefault Color
    -> Maybe (MaybeDefault Color) -> MaybeDefault Color
    forall a. a -> Maybe a -> a
    fromMaybe (Attr -> MaybeDefault Color
    attrBackColor Attr
    a) (CustomAttr -> Maybe (MaybeDefault Color)
    customBg CustomAttr
    c)
            sty :: MaybeDefault Style
    sty = MaybeDefault Style
    -> (Style -> MaybeDefault Style)
    -> Maybe Style
    -> MaybeDefault Style
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Attr -> MaybeDefault Style
    attrStyle Attr
    a) Style -> MaybeDefault Style
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo (CustomAttr -> Maybe Style
    customStyle CustomAttr
    c)
        in Attr
    a { attrForeColor :: MaybeDefault Color
    attrForeColor = MaybeDefault Color
    fg
             , attrBackColor :: MaybeDefault Color
    attrBackColor = MaybeDefault Color
    bg
             , attrStyle :: MaybeDefault Style
    attrStyle = MaybeDefault Style
    sty
             }

    isNullCustomization :: CustomAttr -> Bool
    isNullCustomization :: CustomAttr -> Bool
    isNullCustomization c :: CustomAttr
    c =
        Maybe (MaybeDefault Color) -> Bool
    forall a. Maybe a -> Bool
    isNothing (CustomAttr -> Maybe (MaybeDefault Color)
    customFg CustomAttr
    c) Bool -> Bool -> Bool
    &&
        Maybe (MaybeDefault Color) -> Bool
    forall a. Maybe a -> Bool
    isNothing (CustomAttr -> Maybe (MaybeDefault Color)
    customBg CustomAttr
    c) Bool -> Bool -> Bool
    &&
        Maybe Style -> Bool
    forall a. Maybe a -> Bool
    isNothing (CustomAttr -> Maybe Style
    customStyle CustomAttr
    c)

    -- |  This function is lossy in the sense that we only internally support 240 colors but
    -- the #RRGGBB format supports 16^3 colors.
    parseColor :: T.Text -> Either String (MaybeDefault Color)
    parseColor :: Text -> Either String (MaybeDefault Color)
    parseColor s :: Text
    s =
        let stripped :: Text
    stripped = Text -> Text
    T.strip (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.toLower Text
    s
            normalize :: (Text, b) -> (Text, b)
    normalize (t :: Text
    t, c :: b
    c) = (Text -> Text
    T.toLower Text
    t, b
    c)
        in if Text
    stripped Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == "default"
              then MaybeDefault Color -> Either String (MaybeDefault Color)
    forall a b. b -> Either a b
    Right MaybeDefault Color
    forall v. MaybeDefault v
    Default
              else case Text -> Maybe Color
    parseRGB Text
    stripped of
                  Just c :: Color
    c  -> MaybeDefault Color -> Either String (MaybeDefault Color)
    forall a b. b -> Either a b
    Right (Color -> MaybeDefault Color
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo Color
    c)
                  Nothing -> Either String (MaybeDefault Color)
    -> (Color -> Either String (MaybeDefault Color))
    -> Maybe Color
    -> Either String (MaybeDefault Color)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> Either String (MaybeDefault Color)
    forall a b. a -> Either a b
    Left (String -> Either String (MaybeDefault Color))
    -> String -> Either String (MaybeDefault Color)
    forall a b. (a -> b) -> a -> b
    $ "Invalid color: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    forall a. Show a => a -> String
    show Text
    stripped) (MaybeDefault Color -> Either String (MaybeDefault Color)
    forall a b. b -> Either a b
    Right (MaybeDefault Color -> Either String (MaybeDefault Color))
    -> (Color -> MaybeDefault Color)
    -> Color
    -> Either String (MaybeDefault Color)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> MaybeDefault Color
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo) (Maybe Color -> Either String (MaybeDefault Color))
    -> Maybe Color -> Either String (MaybeDefault Color)
    forall a b. (a -> b) -> a -> b
    $
                                 Text -> [(Text, Color)] -> Maybe Color
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    stripped ((Text, Color) -> (Text, Color)
    forall b. (Text, b) -> (Text, b)
    normalize ((Text, Color) -> (Text, Color))
    -> ((Color, Text) -> (Text, Color))
    -> (Color, Text)
    -> (Text, Color)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Color, Text) -> (Text, Color)
    forall a b. (a, b) -> (b, a)
    swap ((Color, Text) -> (Text, Color))
    -> [(Color, Text)] -> [(Text, Color)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Color, Text)]
    allColors)
      where
        parseRGB :: Text -> Maybe Color
    parseRGB t :: Text
    t = if Text -> Char
    T.head Text
    t Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '#'
                        then Maybe Color
    forall a. Maybe a
    Nothing
                        else case (Text -> Maybe Int) -> [Text] -> [Int]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Text -> Maybe Int
    readHex (Int -> Text -> [Text]
    T.chunksOf 2 (Text -> Text
    T.tail Text
    t)) of
                                [r :: Int
    r,g :: Int
    g,b :: Int
    b] -> Color -> Maybe Color
    forall a. a -> Maybe a
    Just (Int -> Int -> Int -> Color
    forall i. Integral i => i -> i -> i -> Color
    rgbColor Int
    r Int
    g Int
    b)
                                _ -> Maybe Color
    forall a. Maybe a
    Nothing

        readHex :: T.Text -> Maybe Int
        readHex :: Text -> Maybe Int
    readHex t :: Text
    t = (String -> Maybe Int)
    -> ((Int, Text) -> Maybe Int)
    -> Either String (Int, Text)
    -> Maybe Int
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe Int -> String -> Maybe Int
    forall a b. a -> b -> a
    const Maybe Int
    forall a. Maybe a
    Nothing) (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int)
    -> ((Int, Text) -> Int) -> (Int, Text) -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Text) -> Int
    forall a b. (a, b) -> a
    fst) (Reader Int
    forall a. Integral a => Reader a
    T.hexadecimal Text
    t)

    allColors :: [(Color, T.Text)]
    allColors :: [(Color, Text)]
    allColors =
        [ (Color
    black, "black")
        , (Color
    red, "red")
        , (Color
    green, "green")
        , (Color
    yellow, "yellow")
        , (Color
    blue, "blue")
        , (Color
    magenta, "magenta")
        , (Color
    cyan, "cyan")
        , (Color
    white, "white")
        , (Color
    brightBlack, "brightBlack")
        , (Color
    brightRed, "brightRed")
        , (Color
    brightGreen, "brightGreen")
        , (Color
    brightYellow, "brightYellow")
        , (Color
    brightBlue, "brightBlue")
        , (Color
    brightMagenta, "brightMagenta")
        , (Color
    brightCyan, "brightCyan")
        , (Color
    brightWhite, "brightWhite")
        ]

    allStyles :: [(T.Text, Style)]
    allStyles :: [(Text, Style)]
    allStyles =
        [ ("standout", Style
    standout)
        , ("underline", Style
    underline)
        , ("reversevideo", Style
    reverseVideo)
        , ("blink", Style
    blink)
        , ("dim", Style
    dim)
        , ("bold", Style
    bold)
        , ("italic", Style
    italic)
        ]

    parseStyle :: T.Text -> Either String Style
    parseStyle :: Text -> Either String Style
    parseStyle s :: Text
    s =
        let lookupStyle :: Text -> Either String (Maybe Style)
    lookupStyle "" = Maybe Style -> Either String (Maybe Style)
    forall a b. b -> Either a b
    Right Maybe Style
    forall a. Maybe a
    Nothing
            lookupStyle n :: Text
    n = case Text -> [(Text, Style)] -> Maybe Style
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    n [(Text, Style)]
    normalizedStyles of
                Just sty :: Style
    sty -> Maybe Style -> Either String (Maybe Style)
    forall a b. b -> Either a b
    Right (Maybe Style -> Either String (Maybe Style))
    -> Maybe Style -> Either String (Maybe Style)
    forall a b. (a -> b) -> a -> b
    $ Style -> Maybe Style
    forall a. a -> Maybe a
    Just Style
    sty
                Nothing  -> String -> Either String (Maybe Style)
    forall a b. a -> Either a b
    Left (String -> Either String (Maybe Style))
    -> String -> Either String (Maybe Style)
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ "Invalid style: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    n
            stripped :: Text
    stripped = Text -> Text
    T.strip (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.toLower Text
    s
            normalize :: (Text, b) -> (Text, b)
    normalize (n :: Text
    n, a :: b
    a) = (Text -> Text
    T.toLower Text
    n, b
    a)
            normalizedStyles :: [(Text, Style)]
    normalizedStyles = (Text, Style) -> (Text, Style)
    forall b. (Text, b) -> (Text, b)
    normalize ((Text, Style) -> (Text, Style))
    -> [(Text, Style)] -> [(Text, Style)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, Style)]
    allStyles
            bracketed :: Bool
    bracketed = "[" Text -> Text -> Bool
    `T.isPrefixOf` Text
    stripped Bool -> Bool -> Bool
    &&
                        "]" Text -> Text -> Bool
    `T.isSuffixOf` Text
    stripped
            unbracketed :: Text
    unbracketed = Text -> Text
    T.tail (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.init Text
    stripped
            parseStyleList :: Either String Style
    parseStyleList = do
                [Maybe Style]
    ss <- (Text -> Either String (Maybe Style))
    -> [Text] -> Either String [Maybe Style]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Text -> Either String (Maybe Style)
    lookupStyle ([Text] -> Either String [Maybe Style])
    -> [Text] -> Either String [Maybe Style]
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.strip (Text -> Text) -> [Text] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> Text -> [Text]
    T.splitOn "," Text
    unbracketed
                Style -> Either String Style
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Style -> Either String Style) -> Style -> Either String Style
    forall a b. (a -> b) -> a -> b
    $ (Style -> Style -> Style) -> Style -> [Style] -> Style
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Style -> Style -> Style
    forall a. Bits a => a -> a -> a
    (.|.) 0 ([Style] -> Style) -> [Style] -> Style
    forall a b. (a -> b) -> a -> b
    $ [Maybe Style] -> [Style]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Style]
    ss

        in if Bool
    bracketed
           then Either String Style
    parseStyleList
           else do
               Maybe Style
    result <- Text -> Either String (Maybe Style)
    lookupStyle Text
    stripped
               case Maybe Style
    result of
                   Nothing -> String -> Either String Style
    forall a b. a -> Either a b
    Left (String -> Either String Style) -> String -> Either String Style
    forall a b. (a -> b) -> a -> b
    $ "Invalid style: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    forall a. Show a => a -> String
    show Text
    stripped
                   Just sty :: Style
    sty -> Style -> Either String Style
    forall a b. b -> Either a b
    Right Style
    sty

    themeParser :: Theme -> IniParser (Maybe CustomAttr, M.Map AttrName CustomAttr)
    themeParser :: Theme -> IniParser (Maybe CustomAttr, Map AttrName CustomAttr)
    themeParser t :: Theme
    t = do
        let parseCustomAttr :: Text -> SectionParser (Maybe CustomAttr)
    parseCustomAttr basename :: Text
    basename = do
              CustomAttr
    c <- Maybe (MaybeDefault Color)
    -> Maybe (MaybeDefault Color) -> Maybe Style -> CustomAttr
    CustomAttr (Maybe (MaybeDefault Color)
     -> Maybe (MaybeDefault Color) -> Maybe Style -> CustomAttr)
    -> SectionParser (Maybe (MaybeDefault Color))
    -> SectionParser
         (Maybe (MaybeDefault Color) -> Maybe Style -> CustomAttr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text
    -> (Text -> Either String (MaybeDefault Color))
    -> SectionParser (Maybe (MaybeDefault Color))
    forall a.
    Text -> (Text -> Either String a) -> SectionParser (Maybe a)
    fieldMbOf (Text
    basename Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ".fg")    Text -> Either String (MaybeDefault Color)
    parseColor
                              SectionParser
      (Maybe (MaybeDefault Color) -> Maybe Style -> CustomAttr)
    -> SectionParser (Maybe (MaybeDefault Color))
    -> SectionParser (Maybe Style -> CustomAttr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Text
    -> (Text -> Either String (MaybeDefault Color))
    -> SectionParser (Maybe (MaybeDefault Color))
    forall a.
    Text -> (Text -> Either String a) -> SectionParser (Maybe a)
    fieldMbOf (Text
    basename Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ".bg")    Text -> Either String (MaybeDefault Color)
    parseColor
                              SectionParser (Maybe Style -> CustomAttr)
    -> SectionParser (Maybe Style) -> SectionParser CustomAttr
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Text
    -> (Text -> Either String Style) -> SectionParser (Maybe Style)
    forall a.
    Text -> (Text -> Either String a) -> SectionParser (Maybe a)
    fieldMbOf (Text
    basename Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ".style") Text -> Either String Style
    parseStyle
              Maybe CustomAttr -> SectionParser (Maybe CustomAttr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CustomAttr -> SectionParser (Maybe CustomAttr))
    -> Maybe CustomAttr -> SectionParser (Maybe CustomAttr)
    forall a b. (a -> b) -> a -> b
    $ if CustomAttr -> Bool
    isNullCustomization CustomAttr
    c then Maybe CustomAttr
    forall a. Maybe a
    Nothing else CustomAttr -> Maybe CustomAttr
    forall a. a -> Maybe a
    Just CustomAttr
    c

        Maybe (Maybe CustomAttr)
    defCustom <- Text
    -> SectionParser (Maybe CustomAttr)
    -> IniParser (Maybe (Maybe CustomAttr))
    forall a. Text -> SectionParser a -> IniParser (Maybe a)
    sectionMb Text
    defaultSectionName (SectionParser (Maybe CustomAttr)
     -> IniParser (Maybe (Maybe CustomAttr)))
    -> SectionParser (Maybe CustomAttr)
    -> IniParser (Maybe (Maybe CustomAttr))
    forall a b. (a -> b) -> a -> b
    $ do
            Text -> SectionParser (Maybe CustomAttr)
    parseCustomAttr "default"

        Maybe [(AttrName, CustomAttr)]
    customMap <- Text
    -> SectionParser [(AttrName, CustomAttr)]
    -> IniParser (Maybe [(AttrName, CustomAttr)])
    forall a. Text -> SectionParser a -> IniParser (Maybe a)
    sectionMb Text
    otherSectionName (SectionParser [(AttrName, CustomAttr)]
     -> IniParser (Maybe [(AttrName, CustomAttr)]))
    -> SectionParser [(AttrName, CustomAttr)]
    -> IniParser (Maybe [(AttrName, CustomAttr)])
    forall a b. (a -> b) -> a -> b
    $ do
            [Maybe (AttrName, CustomAttr)] -> [(AttrName, CustomAttr)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (AttrName, CustomAttr)] -> [(AttrName, CustomAttr)])
    -> SectionParser [Maybe (AttrName, CustomAttr)]
    -> SectionParser [(AttrName, CustomAttr)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([AttrName]
    -> (AttrName -> SectionParser (Maybe (AttrName, CustomAttr)))
    -> SectionParser [Maybe (AttrName, CustomAttr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (Map AttrName Attr -> [AttrName]
    forall k a. Map k a -> [k]
    M.keys (Map AttrName Attr -> [AttrName])
    -> Map AttrName Attr -> [AttrName]
    forall a b. (a -> b) -> a -> b
    $ Theme -> Map AttrName Attr
    themeDefaultMapping Theme
    t) ((AttrName -> SectionParser (Maybe (AttrName, CustomAttr)))
     -> SectionParser [Maybe (AttrName, CustomAttr)])
    -> (AttrName -> SectionParser (Maybe (AttrName, CustomAttr)))
    -> SectionParser [Maybe (AttrName, CustomAttr)]
    forall a b. (a -> b) -> a -> b
    $ \an :: AttrName
    an ->
                ((CustomAttr -> (AttrName, CustomAttr))
    -> Maybe CustomAttr -> Maybe (AttrName, CustomAttr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (AttrName
    an,)) (Maybe CustomAttr -> Maybe (AttrName, CustomAttr))
    -> SectionParser (Maybe CustomAttr)
    -> SectionParser (Maybe (AttrName, CustomAttr))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> SectionParser (Maybe CustomAttr)
    parseCustomAttr ([String] -> Text
    makeFieldName ([String] -> Text) -> [String] -> Text
    forall a b. (a -> b) -> a -> b
    $ AttrName -> [String]
    attrNameComponents AttrName
    an)
                )

        (Maybe CustomAttr, Map AttrName CustomAttr)
    -> IniParser (Maybe CustomAttr, Map AttrName CustomAttr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Maybe CustomAttr) -> Maybe CustomAttr
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join Maybe (Maybe CustomAttr)
    defCustom, [(AttrName, CustomAttr)] -> Map AttrName CustomAttr
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(AttrName, CustomAttr)] -> Map AttrName CustomAttr)
    -> [(AttrName, CustomAttr)] -> Map AttrName CustomAttr
    forall a b. (a -> b) -> a -> b
    $ [(AttrName, CustomAttr)]
    -> Maybe [(AttrName, CustomAttr)] -> [(AttrName, CustomAttr)]
    forall a. a -> Maybe a -> a
    fromMaybe [] Maybe [(AttrName, CustomAttr)]
    customMap)

    -- | Apply customizations using a custom lookup function. Customizations
    -- are obtained for each attribute name in the theme. Any customizations
    -- already set are lost.
    applyCustomizations :: Maybe CustomAttr
                        -- ^ An optional customization for the theme's
                        -- default attribute.
                        -> (AttrName -> Maybe CustomAttr)
                        -- ^ A function to obtain a customization for the
                        -- specified attribute.
                        -> Theme
                        -- ^ The theme to customize.
                        -> Theme
    applyCustomizations :: Maybe CustomAttr
    -> (AttrName -> Maybe CustomAttr) -> Theme -> Theme
    applyCustomizations customDefAttr :: Maybe CustomAttr
    customDefAttr lookupAttr :: AttrName -> Maybe CustomAttr
    lookupAttr t :: Theme
    t =
        let customMap :: Map AttrName CustomAttr
    customMap = (AttrName -> Map AttrName CustomAttr -> Map AttrName CustomAttr)
    -> Map AttrName CustomAttr -> [AttrName] -> Map AttrName CustomAttr
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr AttrName -> Map AttrName CustomAttr -> Map AttrName CustomAttr
    nextAttr Map AttrName CustomAttr
    forall a. Monoid a => a
    mempty (Map AttrName Attr -> [AttrName]
    forall k a. Map k a -> [k]
    M.keys (Map AttrName Attr -> [AttrName])
    -> Map AttrName Attr -> [AttrName]
    forall a b. (a -> b) -> a -> b
    $ Theme -> Map AttrName Attr
    themeDefaultMapping Theme
    t)
            nextAttr :: AttrName -> Map AttrName CustomAttr -> Map AttrName CustomAttr
    nextAttr an :: AttrName
    an m :: Map AttrName CustomAttr
    m = case AttrName -> Maybe CustomAttr
    lookupAttr AttrName
    an of
                Nothing     -> Map AttrName CustomAttr
    m
                Just custom :: CustomAttr
    custom -> AttrName
    -> CustomAttr -> Map AttrName CustomAttr -> Map AttrName CustomAttr
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert AttrName
    an CustomAttr
    custom Map AttrName CustomAttr
    m
        in Theme
    t { themeCustomDefaultAttr :: Maybe CustomAttr
    themeCustomDefaultAttr = Maybe CustomAttr
    customDefAttr
             , themeCustomMapping :: Map AttrName CustomAttr
    themeCustomMapping = Map AttrName CustomAttr
    customMap
             }

    -- | Load an INI file containing theme customizations. Use the specified
    -- theme to determine which customizations to load. Return the specified
    -- theme with customizations set. See the module documentation for the
    -- theme file format.
    loadCustomizations :: FilePath -> Theme -> IO (Either String Theme)
    loadCustomizations :: String -> Theme -> IO (Either String Theme)
    loadCustomizations path :: String
    path t :: Theme
    t = do
        Text
    content <- String -> IO Text
    T.readFile String
    path
        case Text
    -> IniParser (Maybe CustomAttr, Map AttrName CustomAttr)
    -> Either String (Maybe CustomAttr, Map AttrName CustomAttr)
    forall a. Text -> IniParser a -> Either String a
    parseIniFile Text
    content (Theme -> IniParser (Maybe CustomAttr, Map AttrName CustomAttr)
    themeParser Theme
    t) of
            Left e :: String
    e -> Either String Theme -> IO (Either String Theme)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String Theme -> IO (Either String Theme))
    -> Either String Theme -> IO (Either String Theme)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String Theme
    forall a b. a -> Either a b
    Left String
    e
            Right (customDef :: Maybe CustomAttr
    customDef, customMap :: Map AttrName CustomAttr
    customMap) ->
                Either String Theme -> IO (Either String Theme)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String Theme -> IO (Either String Theme))
    -> Either String Theme -> IO (Either String Theme)
    forall a b. (a -> b) -> a -> b
    $ Theme -> Either String Theme
    forall a b. b -> Either a b
    Right (Theme -> Either String Theme) -> Theme -> Either String Theme
    forall a b. (a -> b) -> a -> b
    $ Maybe CustomAttr
    -> (AttrName -> Maybe CustomAttr) -> Theme -> Theme
    applyCustomizations Maybe CustomAttr
    customDef ((AttrName -> Map AttrName CustomAttr -> Maybe CustomAttr)
    -> Map AttrName CustomAttr -> AttrName -> Maybe CustomAttr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip AttrName -> Map AttrName CustomAttr -> Maybe CustomAttr
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Map AttrName CustomAttr
    customMap) Theme
    t

    vtyColorName :: Color -> T.Text
    vtyColorName :: Color -> Text
    vtyColorName c :: Color
    c@(Color240 n :: Style
    n) = case Style -> Maybe (Int, Int, Int)
    color240CodeToRGB (Style -> Style
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Style
    n) of
        Just (r :: Int
    r,g :: Int
    g,b :: Int
    b) -> String -> Text
    T.pack (String -> Int -> Int -> Int -> String
    forall r. PrintfType r => String -> r
    printf "#%02x%02x%02x" Int
    r Int
    g Int
    b)
        Nothing -> (String -> Text
    forall a. HasCallStack => String -> a
    error (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ "Invalid color: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Color -> String
    forall a. Show a => a -> String
    show Color
    c)
    vtyColorName c :: Color
    c =
        Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Text
    forall a. HasCallStack => String -> a
    error (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ "Invalid color: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Color -> String
    forall a. Show a => a -> String
    show Color
    c)
                  (Color -> [(Color, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Color
    c [(Color, Text)]
    allColors)

    makeFieldName :: [String] -> T.Text
    makeFieldName :: [String] -> Text
    makeFieldName cs :: [String]
    cs = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "." [String]
    cs

    serializeCustomColor :: [String] -> MaybeDefault Color -> T.Text
    serializeCustomColor :: [String] -> MaybeDefault Color -> Text
    serializeCustomColor cs :: [String]
    cs cc :: MaybeDefault Color
    cc =
        let cName :: Text
    cName = case MaybeDefault Color
    cc of
              Default -> "default"
              SetTo c :: Color
    c -> Color -> Text
    vtyColorName Color
    c
              KeepCurrent -> String -> Text
    forall a. HasCallStack => String -> a
    error "serializeCustomColor does not support KeepCurrent"
        in [String] -> Text
    makeFieldName [String]
    cs Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> " = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    cName

    serializeCustomStyle :: [String] -> Style -> T.Text
    serializeCustomStyle :: [String] -> Style -> Text
    serializeCustomStyle cs :: [String]
    cs s :: Style
    s =
        let activeStyles :: [(Text, Style)]
    activeStyles = ((Text, Style) -> Bool) -> [(Text, Style)] -> [(Text, Style)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(_, a :: Style
    a) -> Style
    a Style -> Style -> Style
    forall a. Bits a => a -> a -> a
    .&. Style
    s Style -> Style -> Bool
    forall a. Eq a => a -> a -> Bool
    == Style
    a) [(Text, Style)]
    allStyles
            styleStr :: Text
    styleStr = case [(Text, Style)]
    activeStyles of
                [(single :: Text
    single, _)] -> Text
    single
                many :: [(Text, Style)]
    many -> "[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (Text -> [Text] -> Text
    T.intercalate ", " ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Text, Style) -> Text
    forall a b. (a, b) -> a
    fst ((Text, Style) -> Text) -> [(Text, Style)] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, Style)]
    many) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "]"
        in [String] -> Text
    makeFieldName [String]
    cs Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> " = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    styleStr

    serializeCustomAttr :: [String] -> CustomAttr -> [T.Text]
    serializeCustomAttr :: [String] -> CustomAttr -> [Text]
    serializeCustomAttr cs :: [String]
    cs c :: CustomAttr
    c =
        [Maybe Text] -> [Text]
    forall a. [Maybe a] -> [a]
    catMaybes [ [String] -> MaybeDefault Color -> Text
    serializeCustomColor ([String]
    cs [String] -> [String] -> [String]
    forall a. Semigroup a => a -> a -> a
    <> ["fg"]) (MaybeDefault Color -> Text)
    -> Maybe (MaybeDefault Color) -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CustomAttr -> Maybe (MaybeDefault Color)
    customFg CustomAttr
    c
                  , [String] -> MaybeDefault Color -> Text
    serializeCustomColor ([String]
    cs [String] -> [String] -> [String]
    forall a. Semigroup a => a -> a -> a
    <> ["bg"]) (MaybeDefault Color -> Text)
    -> Maybe (MaybeDefault Color) -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CustomAttr -> Maybe (MaybeDefault Color)
    customBg CustomAttr
    c
                  , [String] -> Style -> Text
    serializeCustomStyle ([String]
    cs [String] -> [String] -> [String]
    forall a. Semigroup a => a -> a -> a
    <> ["style"]) (Style -> Text) -> Maybe Style -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CustomAttr -> Maybe Style
    customStyle CustomAttr
    c
                  ]

    emitSection :: T.Text -> [T.Text] -> [T.Text]
    emitSection :: Text -> [Text] -> [Text]
    emitSection _ [] = []
    emitSection secName :: Text
    secName ls :: [Text]
    ls = ("[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    secName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "]") Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    ls

    -- | Save an INI file containing theme customizations. Use the specified
    -- theme to determine which customizations to save. See the module
    -- documentation for the theme file format.
    saveCustomizations :: FilePath -> Theme -> IO ()
    saveCustomizations :: String -> Theme -> IO ()
    saveCustomizations path :: String
    path t :: Theme
    t = do
        let defSection :: [Text]
    defSection = [Text] -> Maybe [Text] -> [Text]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $
                         [String] -> CustomAttr -> [Text]
    serializeCustomAttr ["default"] (CustomAttr -> [Text]) -> Maybe CustomAttr -> Maybe [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Theme -> Maybe CustomAttr
    themeCustomDefaultAttr Theme
    t
            mapSection :: [Text]
    mapSection = [[Text]] -> [Text]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ ((AttrName -> [Text]) -> [AttrName] -> [[Text]])
    -> [AttrName] -> (AttrName -> [Text]) -> [[Text]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (AttrName -> [Text]) -> [AttrName] -> [[Text]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map AttrName Attr -> [AttrName]
    forall k a. Map k a -> [k]
    M.keys (Map AttrName Attr -> [AttrName])
    -> Map AttrName Attr -> [AttrName]
    forall a b. (a -> b) -> a -> b
    $ Theme -> Map AttrName Attr
    themeDefaultMapping Theme
    t) ((AttrName -> [Text]) -> [[Text]])
    -> (AttrName -> [Text]) -> [[Text]]
    forall a b. (a -> b) -> a -> b
    $ \an :: AttrName
    an ->
                [Text] -> (CustomAttr -> [Text]) -> Maybe CustomAttr -> [Text]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] ([String] -> CustomAttr -> [Text]
    serializeCustomAttr (AttrName -> [String]
    attrNameComponents AttrName
    an)) (Maybe CustomAttr -> [Text]) -> Maybe CustomAttr -> [Text]
    forall a b. (a -> b) -> a -> b
    $
                         AttrName -> Map AttrName CustomAttr -> Maybe CustomAttr
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup AttrName
    an (Map AttrName CustomAttr -> Maybe CustomAttr)
    -> Map AttrName CustomAttr -> Maybe CustomAttr
    forall a b. (a -> b) -> a -> b
    $ Theme -> Map AttrName CustomAttr
    themeCustomMapping Theme
    t
            content :: Text
    content = [Text] -> Text
    T.unlines ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Text -> [Text] -> [Text]
    emitSection Text
    defaultSectionName [Text]
    defSection) [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <>
                                  (Text -> [Text] -> [Text]
    emitSection Text
    otherSectionName [Text]
    mapSection)
        String -> Text -> IO ()
    T.writeFile String
    path Text
    content

    -- | Save an INI file containing all attributes from the specified
    -- theme. Customized attributes are saved, but if an attribute is not
    -- customized, its default is saved instead. The file can later be
    -- re-loaded as a customization file.
    saveTheme :: FilePath -> Theme -> IO ()
    saveTheme :: String -> Theme -> IO ()
    saveTheme path :: String
    path t :: Theme
    t = do
        let defSection :: [Text]
    defSection = [String] -> CustomAttr -> [Text]
    serializeCustomAttr ["default"] (CustomAttr -> [Text]) -> CustomAttr -> [Text]
    forall a b. (a -> b) -> a -> b
    $
                         CustomAttr -> Maybe CustomAttr -> CustomAttr
    forall a. a -> Maybe a -> a
    fromMaybe (Attr -> CustomAttr
    attrToCustom (Attr -> CustomAttr) -> Attr -> CustomAttr
    forall a b. (a -> b) -> a -> b
    $ Theme -> Attr
    themeDefaultAttr Theme
    t) (Theme -> Maybe CustomAttr
    themeCustomDefaultAttr Theme
    t)
            mapSection :: [Text]
    mapSection = [[Text]] -> [Text]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ (((AttrName, Attr) -> [Text]) -> [(AttrName, Attr)] -> [[Text]])
    -> [(AttrName, Attr)] -> ((AttrName, Attr) -> [Text]) -> [[Text]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((AttrName, Attr) -> [Text]) -> [(AttrName, Attr)] -> [[Text]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map AttrName Attr -> [(AttrName, Attr)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map AttrName Attr -> [(AttrName, Attr)])
    -> Map AttrName Attr -> [(AttrName, Attr)]
    forall a b. (a -> b) -> a -> b
    $ Theme -> Map AttrName Attr
    themeDefaultMapping Theme
    t) (((AttrName, Attr) -> [Text]) -> [[Text]])
    -> ((AttrName, Attr) -> [Text]) -> [[Text]]
    forall a b. (a -> b) -> a -> b
    $ \(an :: AttrName
    an, def :: Attr
    def) ->
                [String] -> CustomAttr -> [Text]
    serializeCustomAttr (AttrName -> [String]
    attrNameComponents AttrName
    an) (CustomAttr -> [Text]) -> CustomAttr -> [Text]
    forall a b. (a -> b) -> a -> b
    $
                    CustomAttr -> Maybe CustomAttr -> CustomAttr
    forall a. a -> Maybe a -> a
    fromMaybe (Attr -> CustomAttr
    attrToCustom Attr
    def) (AttrName -> Map AttrName CustomAttr -> Maybe CustomAttr
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup AttrName
    an (Map AttrName CustomAttr -> Maybe CustomAttr)
    -> Map AttrName CustomAttr -> Maybe CustomAttr
    forall a b. (a -> b) -> a -> b
    $ Theme -> Map AttrName CustomAttr
    themeCustomMapping Theme
    t)
            content :: Text
    content = [Text] -> Text
    T.unlines ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Text -> [Text] -> [Text]
    emitSection Text
    defaultSectionName [Text]
    defSection) [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <>
                                  (Text -> [Text] -> [Text]
    emitSection Text
    otherSectionName [Text]
    mapSection)
        String -> Text -> IO ()
    T.writeFile String
    path Text
    content

    attrToCustom :: Attr -> CustomAttr
    attrToCustom :: Attr -> CustomAttr
    attrToCustom a :: Attr
    a =
        CustomAttr :: Maybe (MaybeDefault Color)
    -> Maybe (MaybeDefault Color) -> Maybe Style -> CustomAttr
    CustomAttr { customFg :: Maybe (MaybeDefault Color)
    customFg    = MaybeDefault Color -> Maybe (MaybeDefault Color)
    forall a. a -> Maybe a
    Just (MaybeDefault Color -> Maybe (MaybeDefault Color))
    -> MaybeDefault Color -> Maybe (MaybeDefault Color)
    forall a b. (a -> b) -> a -> b
    $ Attr -> MaybeDefault Color
    attrForeColor Attr
    a
                   , customBg :: Maybe (MaybeDefault Color)
    customBg    = MaybeDefault Color -> Maybe (MaybeDefault Color)
    forall a. a -> Maybe a
    Just (MaybeDefault Color -> Maybe (MaybeDefault Color))
    -> MaybeDefault Color -> Maybe (MaybeDefault Color)
    forall a b. (a -> b) -> a -> b
    $ Attr -> MaybeDefault Color
    attrForeColor Attr
    a
                   , customStyle :: Maybe Style
    customStyle = case Attr -> MaybeDefault Style
    attrStyle Attr
    a of
                       SetTo s :: Style
    s -> Style -> Maybe Style
    forall a. a -> Maybe a
    Just Style
    s
                       _       -> Maybe Style
    forall a. Maybe a
    Nothing
                   }