Make displayList lazier

CHANGELOG.md

@@ -1,5 +1,9 @@
 # CHANGELOG
 
+## [Unreleased]
+
+* Fix `displayList` by making it lazier (https://github.com/haskell-text/text-display/pull/27)
+
 ## [v0.0.3.0] - 21/08/2022
 
 This is an experimental release.

src/Data/Text/Display.hs

@@ -94,11 +94,10 @@ class Display a where
   -- > → Custom `displayList`
   displayList :: [a] -> Builder
   displayList [] = "[]"
-  displayList (x : xs) = displayList' xs ("[" <> displayBuilder x)
+  displayList (x : xs) = "[" <> displayBuilder x <> foldMap go xs <> "]"
     where
-      displayList' :: [a] -> Builder -> Builder
-      displayList' [] acc = acc <> "]"
-      displayList' (y : ys) acc = displayList' ys (acc <> "," <> displayBuilder y)
+      go :: a -> Builder
+      go y = "," <> displayBuilder y
 
   -- | The method 'displayPrec' allows you to write instances that
   -- require nesting. The precedence parameter can be thought of as a

test/Main.hs

@@ -6,11 +6,18 @@
 
 module Main where
 
+import Control.DeepSeq
+import Control.Exception
+import Control.Monad
 import Data.ByteString
 import Data.List.NonEmpty
 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.Hspec
 import Test.Hspec.QuickCheck
 import Test.ShouldNotTypecheck (shouldNotTypecheck)
@@ -34,6 +41,14 @@ data OpaqueType = OpaqueType Int
     (Display)
     via (OpaqueInstance "<opaque>" OpaqueType)
 
+-- | @v \`shouldEvaluateWithin\` n@ sets the expectation that evaluating @v@
+-- should take no longer than @n@ microseconds.
+shouldEvaluateWithin :: (HasCallStack, NFData a) => a -> Int -> Expectation
+shouldEvaluateWithin a n = do
+  res <- timeout n (evaluate $ force a)
+  when (isNothing res) $ do
+    expectationFailure ("evaluation timed out in " <> show n <> " microseconds")
+
 spec :: Spec
 spec = do
   describe "Display Tests:" $ do
@@ -51,6 +66,9 @@ spec = do
     it "Single-element List instance is equivalent to Show" $ do
       let list = [1] :: [Int]
       T.unpack (display list) `shouldBe` show list
+    it "List instance is streamed lazily" $ do
+      let list = [1 ..] :: [Int]
+      TL.take 20 (TB.toLazyText $ displayBuilder list) `shouldEvaluateWithin` 100000
     it "NonEmpty instance is equivalent to Show" $ do
       let ne = NE.fromList [1 .. 5] :: NonEmpty Int
       T.unpack (display ne) `shouldBe` show ne

text-display.cabal

@@ -55,6 +55,7 @@ test-suite text-display-test
   build-depends:
     , base
     , bytestring
+    , deepseq
     , hspec
     , quickcheck-text
     , should-not-typecheck