Use Data.Text.Lazy.Builder in ANSI rendering

src/Text/DocLayout.hs

@@ -109,6 +109,8 @@ import Data.Foldable (toList)
 import Data.String
 import qualified Data.Text as T
 import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as B
 import Text.DocLayout.HasChars
 import Text.DocLayout.ANSIFont
 import Text.DocLayout.Attributed
@@ -288,9 +290,9 @@ outp off s = do           -- offset >= 0 (0 might be combining char)
 render :: HasChars a => Maybe Int -> Doc a -> a
 render = renderPlain
 
-renderANSI :: HasChars a => Maybe Int -> Doc a -> a
-renderANSI n d = snd $ go $ prerender n d where
-  go (Attributed s) = foldl attrRender (baseFont, "") s
+renderANSI :: HasChars a => Maybe Int -> Doc a -> TL.Text
+renderANSI n d = B.toLazyText $ snd $ go $ prerender n d where
+  go (Attributed s) = foldl attrRender (baseFont, B.fromText "") s
 
 renderPlain :: HasChars a => Maybe Int -> Doc a -> a
 renderPlain n d = go $ prerender n d where
@@ -300,11 +302,12 @@ attrStrip :: HasChars a => Attr a -> a
 attrStrip (Attr _ y) | isNull y = ""
                      | otherwise = y
 
-attrRender :: HasChars a => (Font, a) -> Attr a -> (Font, a)
+attrRender :: HasChars a => (Font, B.Builder) -> Attr a -> (Font, B.Builder)
 attrRender (f, acc) (Attr g y)
-  | isNull y = (f, acc)
-  | f == g = (f, acc <> y)
-  | otherwise = (g, acc <> renderFont g <> y)
+    | isNull y = (f, acc)
+    | otherwise = (g, acc <> B.fromText newFont <> build y)
+  where
+    newFont = if f == g then mempty else renderFont g
 
 prerender :: HasChars a => Maybe Int -> Doc a -> Attributed a
 prerender linelen doc = fromList . reverse . output $

src/Text/DocLayout/HasChars.hs

@@ -8,6 +8,7 @@ import Data.String
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import Data.Text (Text)
+import qualified Data.Text.Lazy.Builder as B
 import Data.List (foldl', uncons)
 import Data.Maybe (fromMaybe)
 import Text.DocLayout.Attributed
@@ -31,32 +32,38 @@ class (IsString a, Semigroup a, Monoid a, Show a) => HasChars a where
     (firstline, otherlines) = foldrChar go ([],[]) s
     go '\n' (cur,lns) = ([], fromString cur : lns)
     go c    (cur,lns) = (c:cur, lns)
+  build         :: a -> B.Builder
+  build = foldrChar (mappend . B.singleton) (B.fromString "")
 
 instance HasChars Text where
   foldrChar         = T.foldr
   foldlChar         = T.foldl'
   splitLines        = T.splitOn "\n"
   replicateChar n c = T.replicate n (T.singleton c)
   isNull            = T.null
+  build             = B.fromText
 
 instance HasChars String where
   foldrChar     = foldr
   foldlChar     = foldl'
   splitLines    = lines . (++"\n")
   replicateChar = replicate
   isNull        = null
+  build         = B.fromString
 
 instance HasChars TL.Text where
   foldrChar         = TL.foldr
   foldlChar         = TL.foldl'
   splitLines        = TL.splitOn "\n"
   replicateChar n c = TL.replicate (fromIntegral n) (TL.singleton c)
   isNull            = TL.null
+  build             = B.fromLazyText
 
 instance HasChars a => HasChars (Attr a) where
   foldrChar f a (Attr _ x) = foldrChar f a x
   foldlChar f a (Attr _ x) = foldlChar f a x
   splitLines (Attr f x) = Attr f <$> splitLines x
+  build (Attr _ x) = build x
 
 instance (HasChars a) => HasChars (Attributed a) where
   foldrChar _ acc (Attributed S.Empty) = acc
@@ -79,3 +86,4 @@ instance (HasChars a) => HasChars (Attributed a) where
           k1 : ks ->
             let (end, most) = fromMaybe (S.empty, []) $ uncons $ reverse $ S.singleton <$> ks
              in go (most ++ (cur |> k1) : lns, end) xs
+  build = foldMap build