Use text-builder-linear

src/Data/Text/Display/Core.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -23,16 +24,18 @@
 module Data.Text.Display.Core where
 
 import Control.Exception hiding (TypeError)
-import Data.ByteString
-import qualified Data.ByteString.Lazy as BL
+import Data.ByteString (StrictByteString)
+import Data.ByteString.Lazy (LazyByteString)
 import Data.Int
 import Data.Kind
+import qualified Data.List as List
 import Data.List.NonEmpty
 import Data.Proxy
 import Data.Text (Text)
-import qualified Data.Text as T
+import qualified Data.Text as Text
+import Data.Text.Builder.Linear (Builder)
+import qualified Data.Text.Builder.Linear as Builder
 import qualified Data.Text.Lazy as TL
-import Data.Text.Lazy.Builder (Builder)
 import qualified Data.Text.Lazy.Builder as TB
 import qualified Data.Text.Lazy.Builder.Int as TB
 import qualified Data.Text.Lazy.Builder.RealFloat as TB
@@ -61,8 +64,8 @@ class Display a where
   -- > import qualified Data.Text.Lazy.Builder as TB
   -- >
   -- > instance Display Char where
-  -- >   displayBuilder c = TB.fromText $ T.singleton c
-  -- >   displayList cs = TB.fromText $ T.pack cs
+  -- >   displayBuilder c = Builder.fromText $ Text.pack $ Text.singleton c
+  -- >   displayList cs = Builder.fromText $ Text.pack $ Text.pack cs
   -- >
   -- > instance (Display a) => Display [a] where
   -- >   -- In this instance, 'displayBuilder' is defined in terms of 'displayList', which for most types
@@ -135,7 +138,7 @@ class Display a where
 --
 -- @since 0.0.1.0
 display :: Display a => a -> Text
-display a = TL.toStrict $ TB.toLazyText $ displayBuilder a
+display a = Builder.runBuilder $ displayBuilder a
 
 -- | 🚫 You should not try to display functions!
 --
@@ -163,7 +166,7 @@ type family CannotDisplayBareFunctions :: Constraint where
 -- Use 'Data.Text.Encoding.decodeUtf8'' or 'Data.Text.Encoding.decodeUtf8With' to convert from UTF-8
 --
 -- @since 0.0.1.0
-instance CannotDisplayByteStrings => Display ByteString where
+instance CannotDisplayByteStrings => Display StrictByteString where
   displayBuilder = undefined
 
 -- | 🚫 You should not try to display lazy ByteStrings!
@@ -172,7 +175,7 @@ instance CannotDisplayByteStrings => Display ByteString where
 -- Use 'Data.Text.Encoding.decodeUtf8'' or 'Data.Text.Encoding.decodeUtf8With' to convert from UTF-8
 --
 -- @since 0.0.1.0
-instance CannotDisplayByteStrings => Display BL.ByteString where
+instance CannotDisplayByteStrings => Display LazyByteString where
   displayBuilder = undefined
 
 type family CannotDisplayByteStrings :: Constraint where
@@ -211,7 +214,7 @@ newtype OpaqueInstance (str :: Symbol) (a :: Type) = Opaque a
 --
 -- @since 0.0.1.0
 instance KnownSymbol str => Display (OpaqueInstance str a) where
-  displayBuilder _ = TB.fromString $ symbolVal (Proxy @str)
+  displayBuilder _ = Builder.fromText $ Text.pack $ symbolVal (Proxy @str)
 
 -- | This wrapper allows you to rely on a pre-existing 'Show' instance in order to
 -- derive 'Display' from it.
@@ -237,7 +240,7 @@ newtype ShowInstance (a :: Type)
 --
 -- @since 0.0.1.0
 instance Show e => Display (ShowInstance e) where
-  displayBuilder s = TB.fromString $ show s
+  displayBuilder s = List.foldl' (\acc char -> acc <> Builder.fromChar char) "" $ show s
 
 -- @since 0.0.1.0
 newtype DisplayDecimal e
@@ -247,7 +250,7 @@ newtype DisplayDecimal e
 
 -- @since 0.0.1.0
 instance Integral e => Display (DisplayDecimal e) where
-  displayBuilder = TB.decimal
+  displayBuilder = displayBuilder . TB.toLazyText . TB.decimal
 
 -- @since 0.0.1.0
 newtype DisplayRealFloat e
@@ -257,7 +260,7 @@ newtype DisplayRealFloat e
 
 -- @since 0.0.1.0
 instance RealFloat e => Display (DisplayRealFloat e) where
-  displayBuilder = TB.realFloat
+  displayBuilder = displayBuilder . TB.toLazyText . TB.realFloat
 
 -- | @since 0.0.1.0
 deriving via (ShowInstance ()) instance Display ()
@@ -280,20 +283,20 @@ deriving via (ShowInstance Bool) instance Display Bool
 instance Display Char where
   -- This instance's implementation is used in the haddocks of the typeclass.
   -- If you change it, reflect the change in the documentation.
-  displayBuilder c = TB.fromText $ T.singleton c
-  displayList cs = TB.fromText $ T.pack cs
+  displayBuilder c = Builder.fromChar c
+  displayList cs = Builder.fromText $ Text.pack cs
 
 -- | Lazy 'TL.Text'
 --
 -- @since 0.0.1.0
 instance Display TL.Text where
-  displayBuilder = TB.fromLazyText
+  displayBuilder = Builder.fromText . TL.toStrict
 
 -- | Strict 'Data.Text.Text'
 --
 -- @since 0.0.1.0
 instance Display Text where
-  displayBuilder = TB.fromText
+  displayBuilder = Builder.fromText
 
 -- | @since 0.0.1.0
 instance Display a => Display [a] where
@@ -309,7 +312,7 @@ instance Display a => Display [a] where
 
 -- | @since 0.0.1.0
 instance Display a => Display (NonEmpty a) where
-  displayBuilder (a :| as) = displayBuilder a <> TB.fromString " :| " <> displayBuilder as
+  displayBuilder (a :| as) = displayBuilder a <> Builder.fromText " :| " <> displayBuilder as
 
 -- | @since 0.0.1.0
 instance Display a => Display (Maybe a) where

src/Data/Text/Display/Generic.hs

@@ -23,9 +23,10 @@
 module Data.Text.Display.Generic where
 
 import Data.Kind
+import qualified Data.List as List
+import Data.Text.Builder.Linear
+import qualified Data.Text.Builder.Linear as Builder
 import Data.Text.Display.Core
-import Data.Text.Lazy.Builder (Builder)
-import qualified Data.Text.Lazy.Builder as TB
 import Data.Type.Bool
 import GHC.Generics
 import GHC.TypeLits
@@ -55,9 +56,9 @@ instance Display c => GDisplay1 (K1 i c) where
 
 instance (Constructor c, GDisplay1 f) => GDisplay1 (M1 C c f) where
   gdisplayBuilder1 c@(M1 a)
-    | conIsRecord c = TB.fromString (conName c) <> "\n  { " <> gdisplayBuilder1 a <> "\n  }"
-    | conIsTuple c = TB.fromString (conName c) <> " ( " <> gdisplayBuilder1 a <> " )"
-    | otherwise = TB.fromString (conName c) <> " " <> gdisplayBuilder1 a
+    | conIsRecord c = List.foldl' (\acc char -> acc <> Builder.fromChar char) "" (conName c) <> "\n  { " <> gdisplayBuilder1 a <> "\n  }"
+    | conIsTuple c = List.foldl' (\acc char -> acc <> Builder.fromChar char) "" (conName c) <> " ( " <> gdisplayBuilder1 a <> " )"
+    | otherwise = List.foldl' (\acc char -> acc <> Builder.fromChar char) "" (conName c) <> " " <> gdisplayBuilder1 a
     where
       conIsTuple :: C1 c f p -> Bool
       conIsTuple y =
@@ -70,7 +71,7 @@ instance (Selector s, GDisplay1 f) => GDisplay1 (M1 S s f) where
   gdisplayBuilder1 s@(M1 a) =
     if selName s == ""
       then gdisplayBuilder1 a
-      else TB.fromString (selName s) <> " = " <> gdisplayBuilder1 a
+      else List.foldl' (\acc char -> acc <> Builder.fromChar char) "" (selName s) <> " = " <> gdisplayBuilder1 a
 
 instance GDisplay1 f => GDisplay1 (M1 D s f) where
   gdisplayBuilder1 (M1 a) = gdisplayBuilder1 a

test/Main.hs

@@ -13,13 +13,12 @@ import qualified Data.List.NonEmpty as NE
 import Data.Maybe
 import qualified Data.Text as T
 import Data.Text.Arbitrary
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Builder as TB
 import System.Timeout
 import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 
+import qualified Data.Text.Builder.Linear as Builder
 import Data.Text.Display
 
 main :: IO ()
@@ -81,7 +80,7 @@ spec =
             T.unpack (display list) @?= show list
         , testCase "List instance is streamed lazily" $ do
             let list = [1 ..] :: [Int]
-            TL.take 20 (TB.toLazyText $ displayBuilder list) `shouldEvaluateWithin` 100000
+            T.take 20 (Builder.runBuilder $ displayBuilder list) `shouldEvaluateWithin` 100000
         , testCase "NonEmpty instance is equivalent to Show" $ do
             let ne = NE.fromList [1 .. 5] :: NonEmpty Int
             T.unpack (display ne) @?= show ne
@@ -113,12 +112,12 @@ spec =
     , testGroup
         "`displayParen` tests"
         [ testCase "Surrounds with parens when True" $
-            displayParen True "foo" @?= "(foo)"
+            Builder.runBuilder (displayParen True "foo") @?= "(foo)"
         , testCase "Doesn't surround with parens when False" $
-            displayParen False "foo" @?= "foo"
+            Builder.runBuilder (displayParen False "foo") @?= "foo"
         , testCase "Surrounds deeply-nested Maybes with a prec of 10" $
-            displayPrec 10 (Just (Just (Just (3 :: Int)))) @?= "Just (Just (Just 3))"
+            Builder.runBuilder (displayPrec 10 (Just (Just (Just (3 :: Int))))) @?= "Just (Just (Just 3))"
         , testCase "Surrounds deeply-nested Maybes with a prec of 11" $
-            displayPrec 11 (Just (Just (Just (3 :: Int)))) @?= "(Just (Just (Just 3)))"
+            Builder.runBuilder (displayPrec 11 (Just (Just (Just (3 :: Int))))) @?= "(Just (Just (Just 3)))"
         ]
     ]

text-display.cabal

@@ -15,7 +15,13 @@ maintainer:         Hécate Moonlight
 license:            MIT
 build-type:         Simple
 tested-with:
-  GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.2 || ==9.10.1
+  GHC ==8.10.7
+   || ==9.0.2
+   || ==9.2.8
+   || ==9.4.8
+   || ==9.6.6
+   || ==9.8.2
+   || ==9.10.1
 
 extra-source-files:
   LICENSE
@@ -65,10 +71,12 @@ library
     Data.Text.Display
     Data.Text.Display.Core
     Data.Text.Display.Generic
+
   build-depends:
-    , base        >=4.12 && <5.0
-    , bytestring  >=0.10 && <0.13
-    , text        >=2.0
+    , base                 >=4.12 && <5.0
+    , bytestring           >=0.10 && <0.13
+    , text                 >=2.0
+    , text-builder-linear
 
 executable book
   import:         common-extensions
@@ -101,4 +109,5 @@ test-suite text-display-test
     , tasty-hunit
     , tasty-quickcheck
     , text
+    , text-builder-linear
     , text-display