From 140ae84ba828b9ddeb156431dafe3804cbd2447d Mon Sep 17 00:00:00 2001 From: = Date: Thu, 6 Jun 2024 11:35:14 +0200 Subject: [PATCH] Use text-builder-linear --- src/Data/Text/Display/Core.hs | 39 +++++++++++++++++--------------- src/Data/Text/Display/Generic.hs | 13 ++++++----- test/Main.hs | 13 +++++------ text-display.cabal | 17 ++++++++++---- 4 files changed, 47 insertions(+), 35 deletions(-) diff --git a/src/Data/Text/Display/Core.hs b/src/Data/Text/Display/Core.hs index 00811d9..9093250 100644 --- a/src/Data/Text/Display/Core.hs +++ b/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 diff --git a/src/Data/Text/Display/Generic.hs b/src/Data/Text/Display/Generic.hs index 7ba09b5..5f635c4 100644 --- a/src/Data/Text/Display/Generic.hs +++ b/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 diff --git a/test/Main.hs b/test/Main.hs index 14d2bac..c9a93c3 100644 --- a/test/Main.hs +++ b/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)))" ] ] diff --git a/text-display.cabal b/text-display.cabal index 4a2fd26..34fcc60 100644 --- a/text-display.cabal +++ b/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