lipstick-brick (empty) → 0.1.0.0

raw patch · 6 files changed

+274/−0 lines, 6 filesdep +basedep +brickdep +lipstick

Dependencies added: base, brick, lipstick, lipstick-brick, microlens, tasty, tasty-hunit, text, vty

Files

CHANGELOG.md +7/−0
LICENSE +21/−0
README.md +38/−0
lipstick-brick.cabal +55/−0
src/Lipstick/Brick.hs +89/−0
test/Main.hs +64/−0

+ CHANGELOG.md view

@@ -0,0 +1,7 @@+# Revision history for lipstick-brick++## [0.1.0.0] - 2026-11-09++First version: `blockImage` and `blockWidget` show lipstick blocks in vty+and brick applications; `profileForColorMode` maps vty colour modes to+lipstick colour profiles.

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Andrea Bedini++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,38 @@+# lipstick-brick++Show [lipstick](https://hackage.haskell.org/package/lipstick) blocks in+[brick](https://hackage.haskell.org/package/brick) and+[vty](https://hackage.haskell.org/package/vty) applications, so the styles,+tables, lists and trees made with lipstick can be used in terminal user+interfaces.++```haskell+{-# LANGUAGE OverloadedStrings #-}+import Brick (Widget)+import Lipstick+import Lipstick.Brick++ui :: Widget ()+ui = blockWidget defaultRenderEnv (render (border roundedBorder <> padding 1 2) "Hello")+```++- `blockWidget` lays a block out in the width brick gives it. The widget is+  greedy horizontally when the block grows (`fillWidth`), and fixed+  otherwise.+- `blockImage` gives a vty image of a block, laid out in the width of the+  `RenderEnv`.+- `profileForColorMode` gives the lipstick colour profile matching a vty+  output's colour mode, so colours are resolved for what the terminal can+  show:++  ```haskell+  env = defaultRenderEnv {envProfile = profileForColorMode (outputColorMode (outputIface vty))}+  ```++vty measures text with its own width tables, which can disagree with+lipstick's for some emoji; layouts made of such characters may be off by a+column.++## Licence++MIT, see [LICENSE](https://github.com/andreabedini/lipstick/blob/main/lipstick-brick/LICENSE).

+ lipstick-brick.cabal view

@@ -0,0 +1,55 @@+cabal-version:   3.12+name:            lipstick-brick+version:         0.1.0.0+synopsis:        Show lipstick blocks in brick and vty applications+description:+  Turn lipstick blocks into vty images and brick widgets, so styles, tables,+  lists and trees made with lipstick can be shown in terminal user interfaces.+category:        Console, User Interfaces+license:         MIT+license-file:    LICENSE+author:          Andrea Bedini+maintainer:      andrea@bedini.au+homepage:        https://github.com/andreabedini/lipstick+bug-reports:     https://github.com/andreabedini/lipstick/issues+build-type:      Simple+tested-with:     GHC == 9.10.3 || == 9.12.2 || == 9.14.1+extra-doc-files:+    CHANGELOG.md+    README.md++source-repository head+    type:     git+    location: https://github.com/andreabedini/lipstick.git+    subdir:   lipstick-brick++common warnings+    ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates++library+    import:           warnings+    hs-source-dirs:   src+    exposed-modules:  Lipstick.Brick+    build-depends:+        base >=4.20 && <4.23,+        text ^>=2.1,+        lipstick ^>=0.1.0.0,+        vty >=6.2 && <6.7,+        brick >=2.7 && <3.1,+        microlens >=0.4 && <0.6+    default-language: GHC2024++test-suite lipstick-brick-test+    import:           warnings+    type:             exitcode-stdio-1.0+    main-is:          Main.hs+    hs-source-dirs:   test+    build-depends:+        base,+        lipstick,+        lipstick-brick,+        brick,+        vty,+        tasty ^>=1.5,+        tasty-hunit ^>=0.10+    default-language: GHC2024

+ src/Lipstick/Brick.hs view

@@ -0,0 +1,89 @@+-- | Show lipstick blocks in brick and vty applications.+--+-- > ui :: Widget ()+-- > ui = blockWidget defaultRenderEnv (render (border roundedBorder <> padding 1 2) "Hello")+--+-- Widgets lay their block out in the width brick gives them, and take all+-- of it ('Greedy') when the block grows. Colours are resolved for the+-- 'RenderEnv' (light or dark background, profile) and handed to vty, which+-- downsamples them further if its output needs it. 'profileForColorMode'+-- gives the profile matching a vty output.+--+-- vty measures text with its own width tables, which can disagree with+-- lipstick's for some emoji; layouts made of such characters may be off by+-- a column.+--+-- vty has a single underline style and no underline colour: curly, double,+-- dotted and dashed underlines become plain ones, and underline colours are+-- dropped.+module Lipstick.Brick+  ( blockWidget+  , blockImage+  , profileForColorMode+  ) where++import Brick.Types (Size (..), Widget (..), availWidthL, getContext)+import Brick.Widgets.Core (raw)+import Lens.Micro ((^.))+import Data.Maybe (fromMaybe)+import Graphics.Vty qualified as V+import Lipstick (Attrs (..), Block, ColorProfile (..), RenderEnv (..), TermColor (..), Underline (..), blockGrows, escapeUri, layout, resolveColor)+import Lipstick.Grid (Span (..), gridLines, lineSpans)++-- | A widget showing a block, laid out in the width brick makes available+-- (whatever the environment's 'envWidth'). It is 'Greedy' horizontally+-- when the block grows (see 'Lipstick.fillWidth'), and 'Fixed' otherwise.+blockWidget :: RenderEnv -> Block -> Widget n+blockWidget env b = Widget policy Fixed $ do+  ctx <- getContext+  render (raw (blockImage env {envWidth = Just (ctx ^. availWidthL)} b))+  where+    policy = if blockGrows b then Greedy else Fixed++-- | A vty image of a block laid out in the environment's 'envWidth', as+-- wide and tall as the laid-out block (but see the note on widths above).+-- vty has no zero-width images, so a block 0 columns wide gives+-- 'V.emptyImage' whatever its height.+blockImage :: RenderEnv -> Block -> V.Image+blockImage env b = V.vertCat (map line (gridLines (layout (envWidth env) b)))+  where+    line l = V.horizCat [V.text' (attr env (spanAttrs s)) (spanText s) | s <- lineSpans l]++-- | The profile to resolve colours for, given a vty output's colour mode.+profileForColorMode :: V.ColorMode -> ColorProfile+profileForColorMode = \case+  V.NoColor -> Ascii+  V.ColorMode8 -> ANSI16+  V.ColorMode16 -> ANSI16+  V.ColorMode240 _ -> ANSI256+  V.FullColor -> TrueColor++attr :: RenderEnv -> Attrs -> V.Attr+attr env a+  | profile == NoTTY = V.defAttr+  | otherwise =+      withColor V.withForeColor (attrFg a)+        . withColor V.withBackColor (attrBg a)+        . withLink (attrLink a)+        $ foldl V.withStyle V.defAttr styles+  where+    profile = envProfile env+    withColor f c x = maybe x (f x . vtyColor) (c >>= resolveColor profile (envDarkBackground env))+    withLink url x = maybe x (V.withURL x . escapeUri) url+    on f = fromMaybe False (f a)+    styles =+      [V.bold | on attrBold]+        ++ [V.dim | on attrFaint]+        ++ [V.italic | on attrItalic]+        ++ [V.blink | on attrBlink]+        ++ [V.reverseVideo | on attrReverse]+        ++ [V.strikethrough | on attrStrikethrough]+        ++ [V.underline | maybe False (/= NoUnderline) (attrUnderline a)]++vtyColor :: TermColor -> V.Color+vtyColor = \case+  TC16 n -> V.ISOColor n+  TC256 n+    | n < 16 -> V.ISOColor n+    | otherwise -> V.Color240 (n - 16)+  TCRGB r g b -> V.RGBColor r g b

+ test/Main.hs view

@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Brick.Main (renderWidget)+import Brick.Widgets.Core (raw)+import Brick.Types (Size (..), Widget, hSize)+import Graphics.Vty qualified as V+import Lipstick+import Lipstick.Brick+import Test.Tasty+import Test.Tasty.HUnit++main :: IO ()+main =+  defaultMain $+    testGroup+      "lipstick-brick"+      [ testCase "image has the block's size" $ do+          let b = render (border roundedBorder <> padding 1 2 <> width 20) "Hello, brick"+              img = blockImage defaultRenderEnv b+          (V.imageWidth img, V.imageHeight img) @?= (blockWidth b, blockHeight b)+      , testCase "tables keep their size" $ do+          let b = table (width 30) ["A", "B"] [["one", "two three four five"]]+              img = blockImage defaultRenderEnv b+          (V.imageWidth img, V.imageHeight img) @?= (blockWidth b, blockHeight b)+      , testCase "zero-width blocks are empty" $+          blockImage defaultRenderEnv (render (paddingTop 2) "") @?= V.emptyImage+      , testCase "bold, colours and links become vty attributes" $ do+          let img = blockImage defaultRenderEnv (render (bold <> fg red <> bg "#102030" <> link "https://x.y") "a")+              expected =+                V.defAttr+                  `V.withStyle` V.bold+                  `V.withForeColor` V.ISOColor 1+                  `V.withBackColor` V.RGBColor 16 32 48+                  `V.withURL` "https://x.y"+          img @?= V.text' expected "a"+      , testCase "link controls are percent-encoded" $+          blockImage defaultRenderEnv (render (link "http://x\ESC\\ y") "a")+            @?= V.text' (V.defAttr `V.withURL` "http://x%1B\\%20y") "a"+      , testCase "256 colours" $+          blockImage defaultRenderEnv (render (fg "200") "a") @?= V.text' (V.defAttr `V.withForeColor` V.Color240 184) "a"+      , testCase "light and dark backgrounds" $ do+          let b = render (fg (lightDark "1" "2")) "a"+          blockImage defaultRenderEnv {envDarkBackground = False} b @?= V.text' (V.defAttr `V.withForeColor` V.ISOColor 1) "a"+          blockImage defaultRenderEnv b @?= V.text' (V.defAttr `V.withForeColor` V.ISOColor 2) "a"+      , testCase "a block that grows is a greedy widget" $ do+          hSize (blockWidget defaultRenderEnv (render fillWidth "x") :: Widget ()) @?= Greedy+          hSize (blockWidget defaultRenderEnv (render mempty "x") :: Widget ()) @?= Fixed+      , testCase "a widget takes the width brick gives it when it grows" $+          map V.imageWidth (V.picLayers (shown (render (fillWidth <> bg red) "x") (12, 3))) @?= [12]+      , testCase "a widget wraps its text to the width brick gives it" $ do+          let b = text "the quick brown fox"+              at env = V.picLayers (renderWidget Nothing [raw (blockImage env b) :: Widget ()] (10, 5))+          V.picLayers (shown b (10, 5)) @?= at defaultRenderEnv {envWidth = Just 10}+          assertBool "laid out at its natural width it would be cut, not wrapped" $+            V.picLayers (shown b (10, 5)) /= at defaultRenderEnv+      , testCase "colour modes" $ do+          profileForColorMode V.FullColor @?= TrueColor+          profileForColorMode (V.ColorMode240 240) @?= ANSI256+          profileForColorMode V.NoColor @?= Ascii+      ]+  where+    shown b region = renderWidget Nothing [blockWidget defaultRenderEnv b :: Widget ()] region