brick 0.28 → 0.29

raw patch · 8 files changed

+587/−5 lines, 8 filesdep +config-inidep ~microlensnew-component:exe:brick-theme-demoPVP ok

version bump matches the API change (PVP)

Dependencies added: config-ini

Dependency ranges changed: microlens

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• README.md +2/−0
• brick.cabal +16/−1
• docs/guide.rst +88/−1
• programs/ThemeDemo.hs +87/−0
• src/Brick/AttrMap.hs +7/−1
• src/Brick/Themes.hs +369/−0
• src/Brick/Types/Internal.hs +2/−2

@@ -2,6 +2,22 @@ Brick changelog --------------- +0.29+----++API changes:+ * Added Ord instances for `Location` and `BrickEvent` (thanks Tom+   Sydney Kerckhove)+ * `Brick.AttrMap`: attribute name components are now exposed via the+   `attrNameComponents` function. Also added a Read instance for+   AttrName.++New features:+ * This release adds user-customizable theme support. Please see the+   "Attribute Themes" section of the User Guide for an introduction; see+   the Haddock documentation for `Brick.Themes` for full details. Also,+   see the new `programs/ThemeDemo.hs` for a working demonstration.+ 0.28 ---- 

@@ -60,6 +60,7 @@  * `tart`, a mouse-driven ASCII art drawing program: https://github.com/jtdaugherty/tart  * `silly-joy`, an interpreter for Joy in Haskell: https://github.com/rootmos/silly-joy  * `herms`, a command-line tool for managing kitchen recipes: https://github.com/jackkiefer/herms+ * `purebred`, a mail user agent: https://github.com/purebred-mua/purebred  Getting Started ---------------@@ -98,6 +99,7 @@  * Border-drawing widgets (put borders around or in between things)  * Generic scrollable viewports  * Extensible widget-building API+ * User-customizable attribute themes  * (And many more general-purpose layout control combinators)  In addition, some of `brick`'s more powerful features may not be obvious

@@ -1,5 +1,5 @@ name:                brick-version:             0.28+version:             0.29 synopsis:            A declarative terminal user interface library description:   Write terminal applications painlessly with 'brick'! You write an@@ -64,6 +64,7 @@     Brick.Focus     Brick.Main     Brick.Markup+    Brick.Themes     Brick.Types     Brick.Util     Brick.Widgets.Border@@ -89,6 +90,7 @@                        microlens >= 0.3.0.0,                        microlens-th,                        microlens-mtl,+                       config-ini,                        vector,                        contravariant,                        stm >= 2.4,@@ -229,6 +231,19 @@   ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3   default-language:    Haskell2010   main-is:             PaddingDemo.hs+  build-depends:       base <= 5,+                       brick,+                       vty >= 5.18.1,+                       text,+                       microlens++executable brick-theme-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  default-language:    Haskell2010+  main-is:             ThemeDemo.hs   build-depends:       base <= 5,                        brick,                        vty >= 5.18.1,

@@ -304,7 +304,7 @@  Since we often need to communicate application-specific events beyond Vty input events to the event handler, brick supports embedding your-application's custom events in the stream of ``BrickEvent``s that+application's custom events in the stream of ``BrickEvent``-s that your handler will receive. The type of these events is the type ``e`` mentioned in ``BrickEvent n e`` and ``App s e n``. @@ -751,6 +751,93 @@ * ``Brick.Widgets.Core.forceAttr`` * ``Brick.Widgets.Core.withDefAttr`` * ``Brick.Widgets.Core.overrideAttr``++Attribute Themes+================++Brick provides support for customizable attribute themes. This works as+follows:++* The application provides a default theme built in to the program.+* The application customizes the them by loading theme customizations+  from a user-specified customization file.+* The application can save new customizations to files for later+  re-loading.++Customizations are written in an INI-style file. Here's an example:++.. code::++   [default]+   default.fg = blue+   default.bg = black++   [other]+   someAttribute.fg = red+   someAttribute.style = underline+   otherAttribute.style = [underline, bold]+   otherAttribute.inner.fg = white++In the above example, the theme's *default attribute* -- the one that is+used when no other attributes are used -- is customized. Its foreground+and background colors are set. Then, other attributes specified by+the theme -- ``someAttribute`` and ``otherAttribute`` -- are also+customized. This example shows that styles can be customized, too, and+that a custom style can either be a single style (in this example,+``underline``) or a collection of styles to be applied simutaneously+(in this example, ``underline`` and ``bold``). Lastly, the hierarchical+attribute name ``otherAttribute.inner`` refers to an attribute name+with two components, ``otherAttribute <> inner``, similar to the+``specificAttr`` attribute described in `How Attributes Work`_. Full+documentation for the format of theme customization files can be found+in the module documentation for ``Brick.Themes``.++The above example can be used in a ``brick`` application as follows.+First, the application provides a default theme:++.. code:: haskell++   import Brick.Themes (Theme, newTheme)++   defaultTheme :: Theme+   defaultTheme =+       newTheme (white `on` blue)+                [ ("someAttribute",  fg yellow)+                , ("otherAttribute", fg magenta)+                ]++Notice that the attributes in the theme have defaults: ``someAttribute``+will default to a yellow foreground color if it is not customized. (And+its background will default to the theme's default background color,+blue, if it not customized either.) Then, the application can customize+the theme with the user's customization file:++.. code:: haskell++   import Brick.Themes (loadCustomizations)++   main :: IO ()+   main = do+       customizedTheme <- loadCustomizations "custom.ini" defaultTheme++Now we have a customized theme based on ``defaultTheme``. The next step+is to build an ``AttrMap`` from the theme:++.. code:: haskell++   import Brick.Themes (themeToAttrMap)++   main :: IO ()+   main = do+       customizedTheme <- loadCustomizations "custom.ini" defaultTheme+       let mapping = themeToAttrMap customizedTheme++The resulting ``AttrMap`` can then be returned by ``appAttrMap`` as+described in (see `How Attributes Work`_ and `appAttrMap: Managing+Attributes`_).++If the theme is further customized at runtime, any changes can be saved+with ``Brick.Themes.saveCustomizations``.  Wide Character Support and the TextWidth class ==============================================

@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad (void)+import Graphics.Vty+  ( white, blue, green, yellow, black, magenta+  , Event(EvKey)+  , Key(KChar, KEsc)+  )++import Brick.Main+import Brick.Themes+  ( Theme+  , newTheme+  , themeToAttrMap+  )+import Brick.Types+  ( Widget+  , BrickEvent(VtyEvent)+  , EventM+  , Next+  )+import Brick.Widgets.Center+  ( hCenter+  , center+  )+import Brick.Widgets.Core+  ( (<+>)+  , vBox+  , str+  , hLimit+  , withDefAttr+  )+import Brick.Util (on, fg)+import Brick.AttrMap (AttrName)++ui :: Widget n+ui =+    center $+    hLimit 40 $+    vBox $ hCenter <$>+         [ str "Press " <+> (withDefAttr keybindingAttr $ str "1") <+> str " to switch to theme 1."+         , str "Press " <+> (withDefAttr keybindingAttr $ str "2") <+> str " to switch to theme 2."+         ]++keybindingAttr :: AttrName+keybindingAttr = "keybinding"++theme1 :: Theme+theme1 =+    newTheme (white `on` blue)+             [ (keybindingAttr, fg magenta)+             ]++theme2 :: Theme+theme2 =+    newTheme (green `on` black)+             [ (keybindingAttr, fg yellow)+             ]++appEvent :: Int -> BrickEvent () e -> EventM () (Next Int)+appEvent _ (VtyEvent (EvKey (KChar '1') [])) = continue 1+appEvent _ (VtyEvent (EvKey (KChar '2') [])) = continue 2+appEvent s (VtyEvent (EvKey (KChar 'q') [])) = halt s+appEvent s (VtyEvent (EvKey KEsc [])) = halt s+appEvent s _ = continue s++app :: App Int e ()+app =+    App { appDraw = const [ui]+        , appHandleEvent = appEvent+        , appStartEvent = return+        , appAttrMap = \s ->+            -- Note that in practice this is not ideal: we don't want+            -- to build an attribute from a theme every time this is+            -- invoked, because it gets invoked once per redraw. Instead+            -- we'd build the attribute map at startup and store it in+            -- the application state. Here I just use themeToAttrMap to+            -- show the mechanics of the API.+            if s == 1+            then themeToAttrMap theme1+            else themeToAttrMap theme2+        , appChooseCursor = neverShowCursor+        }++main :: IO ()+main = void $ defaultMain app 1

@@ -29,6 +29,8 @@   , attrMap   , forceAttrMap   , attrName+  -- * Inspection+  , attrNameComponents   -- * Finding attributes from names   , attrMapLookup   -- * Manipulating attribute maps@@ -66,7 +68,7 @@ -- "header" <> "clock" <> "seconds" -- @ data AttrName = AttrName [String]-              deriving (Show, Eq, Ord)+              deriving (Show, Read, Eq, Ord)  instance Monoid AttrName where     mempty = AttrName []@@ -83,6 +85,10 @@ -- | Create an attribute name from a string. attrName :: String -> AttrName attrName = AttrName . (:[])++-- | Get the components of an attribute name.+attrNameComponents :: AttrName -> [String]+attrNameComponents (AttrName cs) = cs  -- | Create an attribute map. attrMap :: Attr

@@ -0,0 +1,369 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+{-# 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 values (no quotes)+--   "black", "red", "green", "yellow", "blue", "magenta", "cyan",+--   "white", "brightBlack", "brightRed", "brightGreen", "brightYellow",+--   "brightBlue", "brightMagenta", "brightCyan", or "brightWhite".+-- * 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.+--   * "standout"+--   * "underline"+--   * "reverseVideo"+--   * "blink"+--   * "dim"+--   * "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.Monad (forM, join)+import Control.Applicative ((<|>))+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Map as M+import Data.Tuple (swap)+import Data.List (intercalate)+import Data.Bits ((.|.), (.&.))+import Data.Maybe (fromMaybe, isNothing, catMaybes)+import Data.Monoid ((<>))+import qualified Data.Foldable as F++import Data.Ini.Config++import Brick.AttrMap (AttrMap, AttrName, attrMap, attrNameComponents)+import Brick.Types.TH (suffixLenses)++-- | An attribute customization can specify which aspects of an+-- attribute to customize.+data CustomAttr =+    CustomAttr { customFg    :: Maybe (MaybeDefault Color)+               -- ^ The customized foreground, if any.+               , customBg    :: Maybe (MaybeDefault Color)+               -- ^ The customized background, if any.+               , customStyle :: Maybe Style+               -- ^ The customized style, if any.+               }+               deriving (Eq, Read, Show, Generic)++instance Monoid CustomAttr where+    mempty = CustomAttr Nothing Nothing Nothing+    mappend a b =+        CustomAttr { customFg    = customFg a    <|> customFg b+                   , customBg    = customBg a    <|> customBg b+                   , customStyle = customStyle a <|> customStyle b+                   }++-- | Documentation for a theme's attributes.+data ThemeDocumentation =+    ThemeDocumentation { 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 (Eq, Read, Show, Generic)++-- | 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 { themeDefaultAttr :: Attr+          -- ^ The default attribute to use.+          , themeDefaultMapping :: M.Map AttrName Attr+          -- ^ The default attribute mapping to use.+          , themeCustomDefaultAttr :: Maybe CustomAttr+          -- ^ Customization for the theme's default attribute.+          , 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 (Eq, Read, Show, Generic)++suffixLenses ''CustomAttr+suffixLenses ''Theme+suffixLenses ''ThemeDocumentation++defaultSectionName :: T.Text+defaultSectionName = "default"++otherSectionName :: T.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 def mapping =+    Theme { themeDefaultAttr       = def+          , themeDefaultMapping    = M.fromList mapping+          , themeCustomDefaultAttr = Nothing+          , themeCustomMapping     = mempty+          }++-- | Build an 'AttrMap' from a 'Theme'. This applies all customizations+-- in the returned 'AttrMap'.+themeToAttrMap :: Theme -> AttrMap+themeToAttrMap t =+    attrMap (customizeAttr (themeCustomDefaultAttr t) (themeDefaultAttr t)) customMap+    where+        customMap = F.foldr f [] (M.toList $ themeDefaultMapping t)+        f (aName, attr) mapping =+            let a' = customizeAttr (M.lookup aName (themeCustomMapping t)) attr+            in (aName, a'):mapping++customizeAttr :: Maybe CustomAttr -> Attr -> Attr+customizeAttr Nothing a = a+customizeAttr (Just c) a =+    let fg = fromMaybe (attrForeColor a) (customFg c)+        bg = fromMaybe (attrBackColor a) (customBg c)+        sty = maybe (attrStyle a) SetTo (customStyle c)+    in a { attrForeColor = fg+         , attrBackColor = bg+         , attrStyle = sty+         }++isNullCustomization :: CustomAttr -> Bool+isNullCustomization c =+    isNothing (customFg c) &&+    isNothing (customBg c) &&+    isNothing (customStyle c)++parseColor :: T.Text -> Either String (MaybeDefault Color)+parseColor s =+    let stripped = T.strip $ T.toLower s+    in if stripped == "default"+       then Right Default+       else maybe (Left $ "Invalid color: " <> show s) (Right . SetTo) $+                  lookup stripped (swap <$> allColors)++allColors :: [(Color, T.Text)]+allColors =+    [ (black, "black")+    , (red, "red")+    , (green, "green")+    , (yellow, "yellow")+    , (blue, "blue")+    , (magenta, "magenta")+    , (cyan, "cyan")+    , (white, "white")+    , (brightBlack, "brightBlack")+    , (brightRed, "brightRed")+    , (brightGreen, "brightGreen")+    , (brightYellow, "brightYellow")+    , (brightBlue, "brightBlue")+    , (brightMagenta, "brightMagenta")+    , (brightCyan, "brightCyan")+    , (brightWhite, "brightWhite")+    ]++allStyles :: [(T.Text, Style)]+allStyles =+    [ ("standout", standout)+    , ("underline", underline)+    , ("reverseVideo", reverseVideo)+    , ("blink", blink)+    , ("dim", dim)+    , ("bold", bold)+    ]++parseStyle :: T.Text -> Either String Style+parseStyle s =+    let lookupStyle n = case lookup n allStyles of+            Just sty -> Right sty+            Nothing  -> Left $ T.unpack $ "Invalid style: " <> n+        stripped = T.strip $ T.toLower s+        bracketed = "[" `T.isPrefixOf` stripped &&+                    "]" `T.isSuffixOf` stripped+        unbracketed = T.tail $ T.init stripped+        parseStyleList = do+            ss <- mapM lookupStyle $ T.strip <$> T.splitOn "," unbracketed+            return $ foldr (.|.) 0 ss++    in if bracketed+       then parseStyleList+       else lookupStyle stripped++themeParser :: Theme -> IniParser (Maybe CustomAttr, M.Map AttrName CustomAttr)+themeParser t = do+    let parseCustomAttr basename = do+          c <- CustomAttr <$> fieldMbOf (basename <> ".fg")    parseColor+                          <*> fieldMbOf (basename <> ".bg")    parseColor+                          <*> fieldMbOf (basename <> ".style") parseStyle+          return $ if isNullCustomization c then Nothing else Just c++    defCustom <- sectionMb defaultSectionName $ do+        parseCustomAttr "default"++    customMap <- sectionMb otherSectionName $ do+        catMaybes <$> (forM (M.keys $ themeDefaultMapping t) $ \an ->+            (fmap (an,)) <$> parseCustomAttr (makeFieldName $ attrNameComponents an)+            )++    return (join defCustom, M.fromList $ fromMaybe [] 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 customDefAttr lookupAttr t =+    let customMap = foldr nextAttr mempty (M.keys $ themeDefaultMapping t)+        nextAttr an m = case lookupAttr an of+            Nothing     -> m+            Just custom -> M.insert an custom m+    in t { themeCustomDefaultAttr = customDefAttr+         , themeCustomMapping = 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 path t = do+    content <- T.readFile path+    case parseIniFile content (themeParser t) of+        Left e -> return $ Left e+        Right (customDef, customMap) ->+            return $ Right $ applyCustomizations customDef (flip M.lookup customMap) t++vtyColorName :: Color -> T.Text+vtyColorName (Color240 _) = error "Color240 space not supported yet"+vtyColorName c =+    fromMaybe (error $ "Invalid color: " <> show c)+              (lookup c allColors)++makeFieldName :: [String] -> T.Text+makeFieldName cs = T.pack $ intercalate "." cs++serializeCustomColor :: [String] -> MaybeDefault Color -> T.Text+serializeCustomColor cs cc =+    let cName = case cc of+          Default -> "default"+          SetTo c -> vtyColorName c+          KeepCurrent -> error "serializeCustomColor does not support KeepCurrent"+    in makeFieldName cs <> " = " <> cName++serializeCustomStyle :: [String] -> Style -> T.Text+serializeCustomStyle cs s =+    let activeStyles = filter (\(_, a) -> a .&. s == a) allStyles+        styleStr = case activeStyles of+            [(single, _)] -> single+            many -> "[" <> (T.intercalate ", " $ fst <$> many) <> "]"+    in makeFieldName cs <> " = " <> styleStr++serializeCustomAttr :: [String] -> CustomAttr -> [T.Text]+serializeCustomAttr cs c =+    catMaybes [ serializeCustomColor (cs <> ["fg"]) <$> customFg c+              , serializeCustomColor (cs <> ["bg"]) <$> customBg c+              , serializeCustomStyle (cs <> ["style"]) <$> customStyle c+              ]++emitSection :: T.Text -> [T.Text] -> [T.Text]+emitSection _ [] = []+emitSection secName ls = ("[" <> secName <> "]") : 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 path t = do+    let defSection = fromMaybe [] $+                     serializeCustomAttr ["default"] <$> themeCustomDefaultAttr t+        mapSection = concat $ flip map (M.keys $ themeDefaultMapping t) $ \an ->+            maybe [] (serializeCustomAttr (attrNameComponents an)) $+                     M.lookup an $ themeCustomMapping t+        content = T.unlines $ (emitSection defaultSectionName defSection) <>+                              (emitSection otherSectionName mapSection)+    T.writeFile path 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 path t = do+    let defSection = serializeCustomAttr ["default"] $+                     fromMaybe (attrToCustom $ themeDefaultAttr t) (themeCustomDefaultAttr t)+        mapSection = concat $ flip map (M.toList $ themeDefaultMapping t) $ \(an, def) ->+            serializeCustomAttr (attrNameComponents an) $+                fromMaybe (attrToCustom def) (M.lookup an $ themeCustomMapping t)+        content = T.unlines $ (emitSection defaultSectionName defSection) <>+                              (emitSection otherSectionName mapSection)+    T.writeFile path content++attrToCustom :: Attr -> CustomAttr+attrToCustom a =+    CustomAttr { customFg    = Just $ attrForeColor a+               , customBg    = Just $ attrForeColor a+               , customStyle = case attrStyle a of+                   SetTo s -> Just s+                   _       -> Nothing+               }

@@ -133,7 +133,7 @@ data Location = Location { loc :: (Int, Int)                          -- ^ (Column, Row)                          }-                deriving (Show, Eq)+                deriving (Show, Eq, Ord)  suffixLenses ''Location @@ -210,7 +210,7 @@                     -- ^ A mouse-up event on the specified region was                     -- received. The 'n' value is the resource name of                     -- the clicked widget (see 'clickable').-                    deriving (Show, Eq)+                    deriving (Show, Eq, Ord)  data RenderState n =     RS { viewportMap :: M.Map n Viewport