diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,19 @@ Brick changelog --------------- +0.68 +---- + +API changes: + * Removed the "markup" feature, which included `Data.Text.Markup`, + `Brick.Markup`, and `brick-markup-demo`. This feature never performed + well and was awkward to use. I considered it experimental from the + initial release of this library. Some recent incompatibilities with + Vty changes made me realize that it was time to finally get rid of + this. If this affects you, please let me know and I am happy to work + with you to figure out an alternative. Granted, anyone is welcome to + dig up the previous code and re-use it in their own projects! + 0.67 ---- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -81,6 +81,7 @@ | [`swarm`](https://github.com/byorgey/swarm/) | A 2D programming and resource gathering game | | [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. | | [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries | +| [`wordle`](https://github.com/ivanjermakov/wordle) | An implementation of the Wordle game | These third-party packages also extend `brick`: diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 0.67 +version: 0.68 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You @@ -60,7 +60,6 @@ docs/programs-screenshots/brick-layer-demo.png, docs/programs-screenshots/brick-list-demo.png, docs/programs-screenshots/brick-list-vi-demo.png, - docs/programs-screenshots/brick-markup-demo.png, docs/programs-screenshots/brick-mouse-demo.png, docs/programs-screenshots/brick-padding-demo.png, docs/programs-screenshots/brick-progressbar-demo.png, @@ -92,7 +91,6 @@ Brick.Focus Brick.Forms Brick.Main - Brick.Markup Brick.Themes Brick.Types Brick.Util @@ -107,7 +105,6 @@ Brick.Widgets.ProgressBar Brick.Widgets.Table Data.IMap - Data.Text.Markup other-modules: Brick.Types.Common Brick.Types.TH @@ -377,19 +374,6 @@ ghc-options: -threaded -Wall -Wcompat -O2 default-language: Haskell2010 main-is: AttrDemo.hs - build-depends: base, - brick, - vty, - text, - microlens - -executable brick-markup-demo - if !flag(demos) - Buildable: False - hs-source-dirs: programs - ghc-options: -threaded -Wall -Wcompat -O2 - default-language: Haskell2010 - main-is: MarkupDemo.hs build-depends: base, brick, vty, diff --git a/docs/guide.rst b/docs/guide.rst --- a/docs/guide.rst +++ b/docs/guide.rst @@ -763,26 +763,70 @@ , (specificAttr, fg white) ] -Functions ``Brick.Util.fg`` and ``Brick.Util.bg`` specify -partial attributes, and map lookups start with the desired name -(``general/specific`` in this case) and walk up the name hierarchy (to -``general``), merging partial attribute settings as they go, letting -already-specified attribute settings take precedence. Finally, any -attribute settings not specified by map lookups fall back to the map's -*default attribute*, specified above as ``Graphics.Vty.defAttr``. In -this way, if you want everything in your application to have a ``blue`` -background color, you only need to specify it *once*: in the attribute -map's default attribute. Any other attribute names can merely customize -the foreground color. +When drawing a widget, Brick keeps track of the current attribute it +is using to draw to the screen. The attribute it tracks is specified +by its *attribute name*, which is a hierarchical name referring to the +attribute in the attribute map. In the example above, the map contains +two attribute names: ``generalAttr`` and ``specificAttr``. Both names +are made up of segments: ``general`` is the first segment for both +names, and ``specific`` is the second segment for ``specificAttr``. +This tells Brick that ``specificAttr`` is a more specialized version +of ``generalAttr``. We'll see below how that affects the resulting +attributes that Brick uses. -In addition to using the attribute map provided by ``appAttrMap``, -the map can be customized on a per-widget basis by using the attribute -map combinators: +When it comes to drawing something on the screen with either of these +attributes, Brick looks up the desired attribute name in the map +and uses the result to draw to the screen. In the example above, +``withAttr`` is used to tell Brick that when drawing ``str "foobar"``, +the attribute ``specificAttr`` should be used. Brick looks that name +up in the attribute map and finds a match: an attribute with a white +foreground color. However, what happens next is important: Brick then +looks up the more general attribute name derived from ``specificAttr``, +which it gets by removing the last segment in the name, ``specific``. +The resulting name, ``general``, is then looked up. The new result is +then *merged* with the initial lookup, yielding an attribute with a +white foreground color and a blue background color. This happens because +the ``specificAttr`` entry did not specify a background color. If it +had, that would have been used instead. In this way, we can create +inheritance relationships between attributes, much the same way CSS +supports inheritance of styles based on rule specificity. -* ``Brick.Widgets.Core.updateAttrMap`` -* ``Brick.Widgets.Core.forceAttr`` -* ``Brick.Widgets.Core.withDefAttr`` -* ``Brick.Widgets.Core.overrideAttr`` +Brick uses Vty's attribute type, ``Attr``, which has three components: +foreground color, background color, and style. These three components +can be independently specified to have an explicit value, and any +component not explicitly specified can default to whatever the terminal +is currently using. Vty styles can be combined together, e.g. underline +and bold, so styles are cummulative. + +What if a widget attempts to draw with an attribute name that is not +specified in the map at all? In that case, the attribute map's "default +attribute" is used. In the example above, the default attribute for the +map is Vty's ``defAttr`` value, which means that the terminal's default +colors and style should be used. But that attribute can be customized +as well, and any attribute map lookup results will get merged with the +default attribute for the map. So, for example, if you'd like your +entire application background to be blue unless otherwise specified, you +could create an attribute map as follows: + +.. code:: haskell + + let myMap = attrMap (bg blue) [ ... ] + +This way, we can avoid repeating the desired background color and all of +the other map entries can just set foreground colors and styles where +needed. + +In addition to using the attribute map provided by ``appAttrMap``, the +map and attribute lookup behavior can be customized on a per-widget +basis by using various functions from ``Brick.Widgets.Core``: + +* ``updateAttrMap`` -- allows transformations of the attribute map, +* ``forceAttr`` -- forces all attribute lookups to map to the value of + the specified attribute name, +* ``withDefAttr`` -- changes the default attribute for the attribute map + to the one with the specified name, and +* ``overrideAttr`` -- creates attribute map lookup synonyms between + attribute names. Attribute Themes ================ diff --git a/docs/programs-screenshots.md b/docs/programs-screenshots.md --- a/docs/programs-screenshots.md +++ b/docs/programs-screenshots.md @@ -42,9 +42,6 @@ ## [ListViDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ListViDemo.hs) ![list-vi demo](./programs-screenshots/brick-list-vi-demo.png) -## [MarkupDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/MarkupDemo.hs) -![markup demo](./programs-screenshots/brick-markup-demo.png) - ## [MouseDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/MouseDemo.hs) ![mouse demo](./programs-screenshots/brick-mouse-demo.png) diff --git a/docs/programs-screenshots/brick-markup-demo.png b/docs/programs-screenshots/brick-markup-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-markup-demo.png and /dev/null differ diff --git a/programs/MarkupDemo.hs b/programs/MarkupDemo.hs deleted file mode 100644 --- a/programs/MarkupDemo.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Main where - -#if !(MIN_VERSION_base(4,11,0)) -import Data.Monoid ((<>)) -#endif -import qualified Graphics.Vty as V - -import Brick.Main (App(..), defaultMain, resizeOrQuit, neverShowCursor) -import Brick.Types - ( Widget - , Padding(..) - ) -import Brick.Widgets.Core - ( (<=>) - , (<+>) - , padLeft - ) -import Brick.Util (on, fg) -import Brick.Markup (markup, (@?)) -import Brick.AttrMap (attrMap, AttrMap) -import Data.Text.Markup ((@@)) - -ui :: Widget () -ui = (m1 <=> m2) <+> (padLeft (Pad 1) m3) - where - m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red) - m2 = markup $ ("Hello" @? "keyword1") <> ", " <> ("world!" @? "keyword2") - m3 = markup $ ("Hello," @? "keyword1") <> "\n" <> ("world!" @? "keyword2") - -theMap :: AttrMap -theMap = attrMap V.defAttr - [ ("keyword1", fg V.magenta) - , ("keyword2", V.white `on` V.blue) - ] - -app :: App () e () -app = - App { appDraw = const [ui] - , appHandleEvent = resizeOrQuit - , appAttrMap = const theMap - , appStartEvent = return - , appChooseCursor = neverShowCursor - } - -main :: IO () -main = defaultMain app () diff --git a/src/Brick/AttrMap.hs b/src/Brick/AttrMap.hs --- a/src/Brick/AttrMap.hs +++ b/src/Brick/AttrMap.hs @@ -106,7 +106,7 @@ attrMap theDefault pairs = AttrMap theDefault (M.fromList pairs) -- | Create an attribute map in which all lookups map to the same --- attribute. +-- attribute. This is functionally equivalent to @AttrMap attr []@. forceAttrMap :: Attr -> AttrMap forceAttrMap = ForceAttr diff --git a/src/Brick/Markup.hs b/src/Brick/Markup.hs deleted file mode 100644 --- a/src/Brick/Markup.hs +++ /dev/null @@ -1,60 +0,0 @@ --- | This module provides an API for turning "markup" values into --- widgets. This module uses the "Data.Text.Markup" interface in this --- package to assign attributes to substrings in a text string; to --- manipulate markup using (for example) syntax highlighters, see that --- module. -module Brick.Markup - ( Markup - , markup - , (@?) - , GetAttr(..) - ) -where - -import Lens.Micro ((.~), (&), (^.)) -import Control.Monad (forM) -import qualified Data.Text as T -import Data.Text.Markup - -import Graphics.Vty (Attr, vertCat, horizCat, text', defAttr) - -import Brick.AttrMap -import Brick.Types - --- | A type class for types that provide access to an attribute in the --- rendering monad. You probably won't need to instance this. -class GetAttr a where - -- | Where to get the attribute for this attribute metadata. - getAttr :: a -> RenderM n Attr - -instance GetAttr Attr where - getAttr a = do - c <- getContext - return $ mergeWithDefault a (c^.ctxAttrMapL) - -instance GetAttr AttrName where - getAttr = lookupAttrName - --- | Build a piece of markup from text with an assigned attribute name. --- When the markup is rendered, the attribute name will be looked up in --- the rendering context's 'AttrMap' to determine the attribute to use --- for this piece of text. -(@?) :: T.Text -> AttrName -> Markup AttrName -(@?) = (@@) - --- | Build a widget from markup. -markup :: (Eq a, GetAttr a) => Markup a -> Widget n -markup m = - Widget Fixed Fixed $ do - let markupLines = markupToList m - mkLine pairs = do - is <- forM pairs $ \(t, aSrc) -> do - a <- getAttr aSrc - return $ text' a t - if null is - then do - def <- getAttr defAttr - return $ text' def $ T.singleton ' ' - else return $ horizCat is - lineImgs <- mapM mkLine markupLines - return $ emptyResult & imageL .~ vertCat lineImgs diff --git a/src/Brick/Types/TH.hs b/src/Brick/Types/TH.hs --- a/src/Brick/Types/TH.hs +++ b/src/Brick/Types/TH.hs @@ -11,7 +11,7 @@ import Lens.Micro.TH (DefName(..), LensRules, makeLensesWith, lensRules, lensField) -- | A template haskell function to build lenses for a record type. This --- function differs from the 'Control.Lens.makeLenses' function in that +-- function differs from the 'Lens.Micro.TH.makeLenses' function in that -- it does not require the record fields to be prefixed with underscores -- and it adds an "L" suffix to lens names to make it clear that they -- are lenses. diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -373,7 +373,7 @@ hyperlink url p = Widget (hSize p) (vSize p) $ do c <- getContext - let attr = attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL) `V.withURL` url + let attr = (c^.attrL) `V.withURL` url withReaderT (ctxAttrMapL %~ setDefaultAttr attr) (render p) -- | Pad the specified widget on the left. If max padding is used, this @@ -861,38 +861,93 @@ withReaderT (\c -> c & availHeightL .~ h & availWidthL .~ w) $ render $ cropToContext p --- | When drawing the specified widget, set the current attribute used --- for drawing to the one with the specified name. Note that the widget --- may use further calls to 'withAttr' to override this; if you really --- want to prevent that, use 'forceAttr'. Attributes used this way still --- get merged hierarchically and still fall back to the attribute map's --- default attribute. If you want to change the default attribute, use --- 'withDefAttr'. +-- | When drawing the specified widget, set the attribute used for +-- drawing to the one with the specified name. Note that the widget +-- may use further calls to 'withAttr' to change the active drawing +-- attribute, so this only takes effect if nothing in the specified +-- widget invokes 'withAttr'. If you want to prevent that, use +-- 'forceAttr'. Attributes used this way still get merged hierarchically +-- and still fall back to the attribute map's default attribute. If you +-- want to change the default attribute, use 'withDefAttr'. +-- +-- For example: +-- +-- @ +-- appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow) +-- , ("warning", bg magenta) +-- ] +-- +-- renderA :: (String, String) -> [Widget n] +-- renderA (a,b) = hBox [ str a +-- , str " is " +-- , withAttr "highlight" (str b) +-- ] +-- +-- render1 = renderA ("Brick", "fun") +-- render2 = withAttr "warning" render1 +-- @ +-- +-- In the example above, @render1@ will show @Brick is fun@ where the +-- first two words are white on a blue background and the last word +-- is yellow on a blue background. However, @render2@ will show the +-- first two words in white on magenta although the last word is still +-- rendered in yellow on blue. withAttr :: AttrName -> Widget n -> Widget n withAttr an p = Widget (hSize p) (vSize p) $ withReaderT (ctxAttrNameL .~ an) (render p) -- | Update the attribute map while rendering the specified widget: set --- its new default attribute to the one that we get by applying specified --- function to the current default attribute. +-- the map's default attribute to the one that we get by applying the +-- specified function to the current map's default attribute. This is a +-- variant of 'withDefAttr'; see the latter for more information. modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n modifyDefAttr f p = Widget (hSize p) (vSize p) $ do c <- getContext withReaderT (ctxAttrMapL %~ (setDefaultAttr (f $ getDefaultAttr (c^.ctxAttrMapL)))) (render p) --- | Update the attribute map while rendering the specified widget: set --- its new default attribute to the one that we get by looking up the --- specified attribute name in the map. +-- | Update the attribute map used while rendering the specified +-- widget (and any sub-widgets): set its new *default* attribute +-- (i.e. the attribute components that will be applied if not +-- overridden by any more specific attributes) to the one that we get +-- by looking up the specified attribute name in the map. +-- +-- For example: +-- +-- @ +-- ... +-- appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow) +-- , ("warning", bg magenta) +-- , ("good", white `on` green) ] +-- ... +-- +-- renderA :: (String, String) -> [Widget n] +-- renderA (a,b) = hBox [ withAttr "good" (str a) +-- , str " is " +-- , withAttr "highlight" (str b) ] +-- +-- render1 = renderA ("Brick", "fun") +-- render2 = withDefAttr "warning" render1 +-- @ +-- +-- In the above, render1 will show "Brick is fun" where the first word +-- is white on a green background, the middle word is white on a blue +-- background, and the last word is yellow on a blue background. +-- However, render2 will show the first word in the same colors but +-- the middle word will be shown in whatever the terminal's normal +-- foreground is on a magenta background, and the third word will be +-- yellow on a magenta background. withDefAttr :: AttrName -> Widget n -> Widget n withDefAttr an p = Widget (hSize p) (vSize p) $ do c <- getContext withReaderT (ctxAttrMapL %~ (setDefaultAttr (attrMapLookup an (c^.ctxAttrMapL)))) (render p) --- | When rendering the specified widget, update the attribute map with --- the specified transformation. +-- | While rendering the specified widget, use a transformed version +-- of the current attribute map. This is a very general function with +-- broad capabilities: you probably want a more specific function such +-- as 'withDefAttr' or 'withAttr'. updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n updateAttrMap f p = Widget (hSize p) (vSize p) $ @@ -906,15 +961,58 @@ -- entry in the attribute map as would normally be the case. If you -- want to have more control over the resulting attribute, consider -- 'modifyDefAttr'. +-- +-- For example: +-- +-- @ +-- ... +-- appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow) +-- , ("notice", fg red) ] +-- ... +-- +-- renderA :: (String, String) -> [Widget n] +-- renderA (a,b) = hBox [ withAttr "highlight" (str a) +-- , str " is " +-- , withAttr "highlight" (str b) +-- ] +-- +-- render1 = renderA ("Brick", "fun") +-- render2 = forceAttr "notice" render1 +-- @ +-- +-- In the above, render1 will show "Brick is fun" where the first and +-- last words are yellow on a blue background and the middle word is +-- white on a blue background. However, render2 will show all words +-- in red on a blue background. In both versions, the middle word +-- will be in white on a blue background. forceAttr :: AttrName -> Widget n -> Widget n forceAttr an p = Widget (hSize p) (vSize p) $ do c <- getContext withReaderT (ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p) --- | Override the lookup of 'targetName' to return the attribute value --- associated with 'fromName' when rendering the specified widget. --- See also 'mapAttrName'. +-- | Override the lookup of the attribute name 'targetName' to return +-- the attribute value associated with 'fromName' when rendering the +-- specified widget. +-- +-- For example: +-- +-- @ +-- appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow) +-- , ("notice", fg red) +-- ] +-- +-- renderA :: (String, String) -> [Widget n] +-- renderA (a, b) = str a <+> str " is " <+> withAttr "highlight" (str b) +-- +-- render1 = withAttr "notice" $ renderA ("Brick", "fun") +-- render2 = overrideAttr "highlight" "notice" render1 +-- @ +-- +-- In the example above, @render1@ will show @Brick is fun@ where the +-- first two words are red on a blue background, but @fun@ is yellow on +-- a blue background. However, @render2@ will show all three words in +-- red on a blue background. overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n overrideAttr targetName fromName = updateAttrMap (mapAttrName fromName targetName) @@ -1097,8 +1195,13 @@ withReaderT (ctxVScrollBarOrientationL .~ Just orientation) (render w) -- | Enable scroll bar handles on all vertical scroll bars in the --- specified widget. This will only have an effect if 'withVScrollBars' --- is also called. +-- specified widget. Handles appear at the ends of the scroll bar, +-- representing the "handles" that are typically clickable in +-- graphical UIs to move the scroll bar incrementally. Vertical +-- scroll bars are also clickable if mouse mode is enabled and if +-- 'withClickableVScrollBars' is used. +-- +-- This will only have an effect if 'withVScrollBars' is also called. withVScrollBarHandles :: Widget n -> Widget n withVScrollBarHandles w = Widget (hSize w) (vSize w) $ @@ -1149,9 +1252,14 @@ Widget (hSize w) (vSize w) $ withReaderT (ctxVScrollBarClickableConstrL .~ Just f) (render w) --- | Enable scroll bar handles on all horizontal scroll bars in the --- specified widget. This will only have an effect if 'withHScrollBars' --- is also called. +-- | Enable scroll bar handles on all horizontal scroll bars in +-- the specified widget. Handles appear at the ends of the scroll +-- bar, representing the "handles" that are typically clickable in +-- graphical UIs to move the scroll bar incrementally. Horizontal +-- scroll bars are also clickable if mouse mode is enabled and if +-- 'withClickableHScrollBars' is used. +-- +-- This will only have an effect if 'withHScrollBars' is also called. withHScrollBarHandles :: Widget n -> Widget n withHScrollBarHandles w = Widget (hSize w) (vSize w) $ diff --git a/src/Data/Text/Markup.hs b/src/Data/Text/Markup.hs deleted file mode 100644 --- a/src/Data/Text/Markup.hs +++ /dev/null @@ -1,85 +0,0 @@ --- | This module provides an API for "marking up" text with arbitrary --- values. A piece of markup can then be converted to a list of pairs --- representing the sequences of characters assigned the same markup --- value. --- --- This interface is experimental. Don't use this for your full-file --- syntax highlighter just yet! -module Data.Text.Markup - ( Markup - , markupToList - , markupSet - , fromList - , fromText - , toText - , isEmpty - , (@@) - ) -where - -import qualified Data.Semigroup as Sem -import Data.String (IsString(..)) -import qualified Data.Text as T - --- | Markup with metadata type 'a' assigned to each character. -data Markup a = Markup [(Char, a)] - deriving Show - -instance Sem.Semigroup (Markup a) where - (Markup t1) <> (Markup t2) = Markup (t1 `mappend` t2) - -instance Monoid (Markup a) where - mempty = Markup mempty - mappend = (Sem.<>) - -instance (Monoid a) => IsString (Markup a) where - fromString = fromText . T.pack - --- | Build a piece of markup; assign the specified metadata to every --- character in the specified text. -(@@) :: T.Text -> a -> Markup a -t @@ val = Markup [(c, val) | c <- T.unpack t] - --- | Build markup from text with the default metadata. -fromText :: (Monoid a) => T.Text -> Markup a -fromText = (@@ mempty) - --- | Extract the text from markup, discarding the markup metadata. -toText :: (Eq a) => Markup a -> T.Text -toText = T.concat . (fst <$>) . concat . markupToList - --- | Test whether the markup is empty. -isEmpty :: Markup a -> Bool -isEmpty (Markup ls) = null ls - --- | Set the metadata for a range of character positions in a piece of --- markup. This is useful for, e.g., syntax highlighting. -markupSet :: (Eq a) => (Int, Int) -> a -> Markup a -> Markup a -markupSet (start, len) val m@(Markup l) = if start < 0 || start + len > length l - then m - else newM - where - newM = Markup $ theHead ++ theNewEntries ++ theTail - (theHead, theLongTail) = splitAt start l - (theOldEntries, theTail) = splitAt len theLongTail - theNewEntries = zip (fst <$> theOldEntries) (repeat val) - --- | Convert markup to a list of lines. Each line is represented by a --- list of pairs in which each pair contains the longest subsequence of --- characters having the same metadata. -markupToList :: (Eq a) => Markup a -> [[(T.Text, a)]] -markupToList (Markup thePairs) = toList <$> toLines [] [] thePairs - where - toLines ls cur [] = ls ++ [cur] - toLines ls cur ((ch, val):rest) - | ch == '\n' = toLines (ls ++ [cur]) [] rest - | otherwise = toLines ls (cur ++ [(ch, val)]) rest - - toList [] = [] - toList ((ch, val):rest) = (T.pack $ ch : (fst <$> matching), val) : toList remaining - where - (matching, remaining) = break (\(_, v) -> v /= val) rest - --- | Convert a list of text and metadata pairs into markup. -fromList :: [(T.Text, a)] -> Markup a -fromList pairs = Markup $ concatMap (\(t, val) -> [(c, val) | c <- T.unpack t]) pairs