Add support for styling commands

Author: tarleb

src/HsLua/Module/DocLayout.hs

@@ -63,6 +63,14 @@ module HsLua.Module.DocLayout (
   , real_length
   , update_column
 
+  -- * Styling
+  , bold
+  , italic
+  , underlined
+  , strikeout
+  , fg
+  , bg
+
   -- * Marshaling
   , peekDoc
   , pushDoc
@@ -188,6 +196,13 @@ functions =
   , offset
   , real_length
   , update_column
+    -- styling
+  , bold
+  , italic
+  , underlined
+  , strikeout
+  , fg
+  , bg
   ]
 
 typeDoc :: LuaError e => DocumentedType e (Doc Text)
@@ -538,6 +553,54 @@ vfill = defun "vfill"
       "expands to the height of the box.  Strings cycle through the " <>
       "list provided.")
 
+--
+-- Styling
+--
+
+bold :: LuaError e => DocumentedFunction e
+bold = defun "bold"
+  ### liftPure Doc.bold
+  <#> docParam "doc"
+  =#> docResult "bolded Doc"
+  #? "Puts a [[Doc]] in boldface."
+
+italic :: LuaError e => DocumentedFunction e
+italic = defun "italic"
+  ### liftPure Doc.italic
+  <#> docParam "doc"
+  =#> docResult "styled Doc"
+  #? "Puts a [[Doc]] in italics."
+
+underlined :: LuaError e => DocumentedFunction e
+underlined = defun "underlined"
+  ### liftPure Doc.underlined
+  <#> docParam "doc"
+  =#> docResult "styled Doc"
+  #? "Underlines a [[Doc]]."
+
+strikeout :: LuaError e => DocumentedFunction e
+strikeout = defun "strikeout"
+  ### liftPure Doc.strikeout
+  <#> docParam "doc"
+  =#> docResult "styled Doc"
+  #? "Puts a line through the [[Doc]]."
+
+fg :: LuaError e => DocumentedFunction e
+fg = defun "fg"
+  ### liftPure2 (flip Doc.fg)
+  <#> docParam "doc"
+  <#> colorParam
+  =#> docResult "styled Doc"
+  #? "Set the foreground color."
+
+bg :: LuaError e => DocumentedFunction e
+bg = defun "bg"
+  ### liftPure2 (flip Doc.bg)
+  <#> docParam "doc"
+  <#> colorParam
+  =#> docResult "styled Doc"
+  #? "Set the background color."
+
 --
 -- Marshaling
 --
@@ -571,6 +634,23 @@ instance Pushable (Doc Text) where
 docParam :: LuaError e => Text -> Parameter e (Doc Text)
 docParam name = parameter peekDoc "Doc" name "document"
 
+-- | @Color@ function parameter
+colorParam :: Parameter e Doc.Color
+colorParam = parameter peekColor "string" "color"
+  ("One of 'black', 'red', 'green', 'yellow', 'blue', 'magenta' " <>
+   "'cyan', or 'white'.")
+  where
+    peekColor idx = peekByteString idx >>= \case
+      "black"   -> pure Doc.black
+      "red"     -> pure Doc.red
+      "green"   -> pure Doc.green
+      "yellow"  -> pure Doc.yellow
+      "blue"    -> pure Doc.blue
+      "magenta" -> pure Doc.magenta
+      "cyan"    -> pure Doc.cyan
+      "white"   -> pure Doc.white
+      color -> failPeek $ "Unknown color: " <> color
+
 --
 -- Results
 --

test/test-doclayout.lua

@@ -8,6 +8,10 @@ local group = tasty.test_group
 local test = tasty.test_case
 local assert = tasty.assert
 
+local function renderANSI (doc, cols)
+  return doclayout.render(doc, cols, true)
+end
+
 -- Check existence static fields
 return {
   group 'constructors' {
@@ -244,6 +248,75 @@ return {
     end)
   },
 
+  -- Styling happens per-character, so the output is quite verbose, and
+  -- includes additional commands to reset all attributes.
+  -- We just look for the right escape sequences instead of matching
+  -- the whole output.
+  group 'styling' {
+    test('bold', function ()
+      assert.is_truthy(
+        renderANSI(doclayout.bold('a')):match('\027%[1m')
+      )
+    end),
+
+    test('italics', function ()
+      assert.is_truthy(
+        renderANSI(doclayout.italic('a')):match('\027%[3m')
+      )
+    end),
+
+    test('underlined', function ()
+      assert.is_truthy(
+        renderANSI(doclayout.underlined('a')):match('\027%[4m')
+      )
+    end),
+
+    test('strikeout', function ()
+      assert.is_truthy(
+        renderANSI(doclayout.strikeout('a')):match('\027%[9m')
+      )
+    end),
+
+    test('fg', function ()
+      assert.is_truthy(
+        renderANSI(doclayout.fg('a', 'red')):match('\027%[31m')
+      )
+    end),
+
+    test('bg', function ()
+      assert.is_truthy(
+        renderANSI(doclayout.bg('a', 'red')):match('\027%[41m')
+           )
+    end),
+
+    group 'colors' {
+      test('black', function ()
+        renderANSI(doclayout.bg('a', 'black')):match('\027%[40m')
+      end),
+      test('red', function ()
+        renderANSI(doclayout.bg('a', 'red')):match('\027%[41m')
+      end),
+      test('green', function ()
+        renderANSI(doclayout.bg('a', 'green')):match('\027%[42m')
+      end),
+      test('yellow', function ()
+        renderANSI(doclayout.bg('a', 'yellow')):match('\027%[43m')
+      end),
+      test('blue', function ()
+        renderANSI(doclayout.bg('a', 'blue')):match('\027%[44m')
+      end),
+      test('magenta', function ()
+        renderANSI(doclayout.bg('a', 'magenta')):match('\027%[45m')
+      end),
+      test('cyan', function ()
+        renderANSI(doclayout.bg('a', 'cyan')):match('\027%[46m')
+      end),
+      test('white', function ()
+        renderANSI(doclayout.bg('a', 'white')):match('\027%[47m')
+      end),
+    }
+  },
+
   group 'Doc type' {
     test('empty strings equal the empty Doc', function ()
       assert.are_equal(doclayout.empty .. '', doclayout.empty)