packages feed

text-builder-linear (empty) → 0.1

raw patch · 18 files changed

+1564/−0 lines, 18 filesdep +basedep +bytestringdep +quote-quot

Dependencies added: base, bytestring, quote-quot, tasty, tasty-bench, tasty-quickcheck, text, text-builder-linear

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Andrew Lelechenko (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Lelechenko nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,119 @@+# linear-builder [![Hackage](http://img.shields.io/hackage/v/linear-builder.svg)](https://hackage.haskell.org/package/linear-builder) [![Stackage LTS](http://stackage.org/package/linear-builder/badge/lts)](http://stackage.org/lts/package/linear-builder) [![Stackage Nightly](http://stackage.org/package/linear-builder/badge/nightly)](http://stackage.org/nightly/package/linear-builder)++_Linear types for linear times!_++Builder for strict `Text`, based on linear types. It's consistently+outperforms lazy `Builder` from `text` as well as a strict builder from `text-builder`,+and scales better.++## Example++```haskell+> :set -XOverloadedStrings+> import Data.Text.Builder.Linear+> fromText "foo" <> fromChar '_' <> fromDec (42 :: Int)+"foo_42"+```++## Design++String builders in Haskell serve the same purpose as `StringBuilder` in Java to prevent+quadratic slow down in concatenation.++Classic builders such as `Data.Text.Lazy.Builder` are lazy and fundamentally are+[`dlist`](https://hackage.haskell.org/package/dlist) with bells and whistles:+instead of actually concatenating substrings we compose actions, which implement+concatenation, building a tree of thunks. The tree can be forced partially, left-to-right,+producing chunks of strict `Text`, combined into a lazy one. Neither input, nor output need to be materialized in full, which potentially allows for fusion. Such builders allow+linear time complexity, but constant factors are relatively high, because thunks are+expensive. To a certain degree this is mitigated by inlining, which massively reduces+number of nodes.++Strict builders such as [`text-builder`](https://hackage.haskell.org/package/text-builder)+offer another design: they first inspect their input in full to determine output length,+then allocate a buffer of required size and fill it in one go. If everything inlines nicely,+the length may be known in compile time, which gives blazingly fast runtime. In more+complex cases it still builds a tree of thunks and forces all inputs to be materialized.++This package offers two interfaces. One is a mutable `Buffer` with linear API,+which operates very similar to `StringBuilder` in Java. It allocates a buffer+with extra space at the ends to append new strings. If there is not enough free space+to insert new data, it allocates a twice larger buffer and copies itself there.+The dispatch happens in runtime, so we do not need to inspect and materialize all inputs+beforehand; and inlining is mostly irrelevant.+Exponential growth provides for amortized linear time.+Such structure can be implemented without linear types, but that would+greatly affect user experience by polluting everything with `ST` monad.+Users are encouraged to use `Buffer` API, and built-in benchmarks refer to it.++The second interface is more traditional `newtype Builder = Builder (Buffer ⊸ Buffer)`+with `Monoid` instance. This type provides easy migration from other builders,+but may suffer from insufficient inlining, allocating a tree of thunks. It is still+significantly faster than `Data.Text.Lazy.Builder`, as witnessed by benchmarks+for `blaze-builder` below.++## Benchmarks++|Group / size|`text`|`text-builder`|Ratio|This package|Ratio|+|------------|-----:|-------------:|-:|-----------:|-:|+| **Text** ||||||+|1|69.2 ns|37.0 ns|0.53x|36.8 ns|0.53x|+|10|736 ns|344 ns|0.47x|190 ns|0.26x|+|100|7.07 μs|3.42 μs|0.48x|1.81 μs|0.26x|+|1000|74.2 μs|38.5 μs|0.52x|14.4 μs|0.19x|+|10000|1.10 ms|477 μs|0.43x|163 μs|0.15x|+|100000|23.1 ms|11.6 ms|0.50x|4.17 ms|0.18x|+|1000000|282 ms|166 ms|0.59x|40.4 ms|0.14x|+| **Char** ||||||+|1|83.2 ns|34.8 ns|0.42x|34.8 ns|0.42x|+|10|378 ns|302 ns|0.80x|123 ns|0.33x|+|100|3.14 μs|2.46 μs|0.78x|922 ns|0.29x|+|1000|34.9 μs|31.3 μs|0.90x|9.37 μs|0.27x|+|10000|494 μs|454 μs|0.92x|101 μs|0.20x|+|100000|15.9 ms|13.8 ms|0.87x|1.64 ms|0.10x|+|1000000|212 ms|227 ms|1.07x|14.5 ms|0.07x|+| **Decimal** ||||||+|1|147 ns|993 ns|6.76x|106 ns|0.72x|+|10|1.36 μs|10.1 μs|7.43x|845 ns|0.62x|+|100|13.5 μs|108 μs|7.97x|8.44 μs|0.62x|+|1000|136 μs|1.34 ms|9.84x|83.0 μs|0.61x|+|10000|1.85 ms|22.0 ms|11.86x|822 μs|0.44x|+|100000|33.9 ms|237 ms|7.00x|10.4 ms|0.31x|+|1000000|399 ms|2.504 s|6.28x|89.8 ms|0.23x|+| **Hexadecimal** ||||||+|1|599 ns|940 ns|1.57x|98.9 ns|0.17x|+|10|6.05 μs|9.89 μs|1.64x|916 ns|0.15x|+|100|66.4 μs|121 μs|1.82x|9.61 μs|0.14x|+|1000|807 μs|1.47 ms|1.82x|96.7 μs|0.12x|+|10000|13.0 ms|20.8 ms|1.60x|980 μs|0.08x|+|100000|152 ms|223 ms|1.47x|11.7 ms|0.08x|+|1000000|1.657 s|2.228 s|1.34x|104 ms|0.06x|+| **Double** ||||||+|1|11.9 μs|26.6 μs|2.23x|632 ns|0.05x|+|10|117 μs|270 μs|2.30x|6.32 μs|0.05x|+|100|1.20 ms|3.68 ms|3.06x|64.5 μs|0.05x|+|1000|12.8 ms|43.9 ms|3.44x|638 μs|0.05x|+|10000|126 ms|457 ms|3.63x|7.38 ms|0.06x|+|100000|1.266 s|4.717 s|3.73x|65.9 ms|0.05x|+|1000000|12.599 s|65.467 s|5.20x|653 ms|0.05x|++If you are not convinced by synthetic data,+here are benchmarks for+[`blaze-markup` after migration to `Data.Text.Builder.Linear`](https://github.com/Bodigrim/blaze-markup):++```+bigTable+  992  μs ±  80 μs, 49% less than baseline+basic+  4.35 μs ± 376 ns, 47% less than baseline+wideTree+  1.26 ms ±  85 μs, 53% less than baseline+wideTreeEscaping+  217  μs ± 7.8 μs, 58% less than baseline+deepTree+  242  μs ±  23 μs, 48% less than baseline+manyAttributes+  811  μs ±  79 μs, 58% less than baseline+customAttribute+  1.68 ms ± 135 μs, 56% less than baseline+```
+ bench/BenchChar.hs view
@@ -0,0 +1,50 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module BenchChar (benchChar) where++import Data.Char+import qualified Data.Text as T+import Data.Text.Builder.Linear.Buffer+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText, singleton)+import Test.Tasty.Bench++#ifdef MIN_VERSION_text_builder+import qualified Text.Builder+#endif++benchLazyBuilder ∷ Int → T.Text+benchLazyBuilder = toStrict . toLazyText . go mempty+  where+    go !acc 0 = acc+    go !acc n = let ch = chr n in go (singleton ch <> (acc <> singleton ch)) (n - 1)++#ifdef MIN_VERSION_text_builder+benchStrictBuilder ∷ Int → T.Text+benchStrictBuilder = Text.Builder.run . go mempty+  where+    go !acc 0 = acc+    go !acc n = let ch = chr n in go (Text.Builder.char ch <> (acc <> Text.Builder.char ch)) (n - 1)+#endif++benchLinearBuilder ∷ Int → T.Text+benchLinearBuilder m = runBuffer (\b → go b m)+  where+    go ∷ Buffer ⊸ Int → Buffer+    go !acc 0 = acc+    go !acc n = let ch = chr n in go (ch .<| (acc |>. ch)) (n - 1)++benchChar ∷ Benchmark+benchChar = bgroup "Char" $ map mkGroup [1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6]++mkGroup :: Int → Benchmark+mkGroup n = bgroup (show n)+  [ bench "Data.Text.Lazy.Builder" $ nf benchLazyBuilder n+#ifdef MIN_VERSION_text_builder+  , bench "Text.Builder" $ nf benchStrictBuilder n+#endif+  , bench "Data.Text.Builder.Linear" $ nf benchLinearBuilder n+  ]
+ bench/BenchDecimal.hs view
@@ -0,0 +1,53 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module BenchDecimal (benchDecimal) where++import qualified Data.Text as T+import Data.Text.Builder.Linear.Buffer+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Lazy.Builder.Int (decimal)+import Test.Tasty.Bench++#ifdef MIN_VERSION_text_builder+import qualified Text.Builder+#endif++int :: Int+int = 123456789123456789++benchLazyBuilder ∷ Int → T.Text+benchLazyBuilder = toStrict . toLazyText . go mempty+  where+    go !acc 0 = acc+    go !acc n = let i = n * int in go (decimal i <> (acc <> decimal i)) (n - 1)++#ifdef MIN_VERSION_text_builder+benchStrictBuilder ∷ Int → T.Text+benchStrictBuilder = Text.Builder.run . go mempty+  where+    go !acc 0 = acc+    go !acc n = let i = n * int in go (Text.Builder.decimal i <> (acc <> Text.Builder.decimal i)) (n - 1)+#endif++benchLinearBuilder ∷ Int → T.Text+benchLinearBuilder m = runBuffer (\b → go b m)+  where+    go ∷ Buffer ⊸ Int → Buffer+    go !acc 0 = acc+    go !acc n = let i = n * int in go (i $<| (acc |>$ i)) (n - 1)++benchDecimal ∷ Benchmark+benchDecimal = bgroup "Decimal" $ map mkGroup [1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6]++mkGroup :: Int → Benchmark+mkGroup n = bgroup (show n)+  [ bench "Data.Text.Lazy.Builder" $ nf benchLazyBuilder n+#ifdef MIN_VERSION_text_builder+  , bench "Text.Builder" $ nf benchStrictBuilder n+#endif+  , bench "Data.Text.Builder.Linear" $ nf benchLinearBuilder n+  ]
+ bench/BenchDouble.hs view
@@ -0,0 +1,53 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module BenchDouble (benchDouble) where++import qualified Data.Text as T+import Data.Text.Builder.Linear.Buffer+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Lazy.Builder.RealFloat (realFloat)+import Test.Tasty.Bench++#ifdef MIN_VERSION_text_builder+import qualified Text.Builder+#endif++dbl :: Double+dbl = - pi * 1e300++benchLazyBuilder ∷ Int → T.Text+benchLazyBuilder = toStrict . toLazyText . go mempty+  where+    go !acc 0 = acc+    go !acc n = let d = fromIntegral n * dbl in go (realFloat d <> (acc <> realFloat d)) (n - 1)++#ifdef MIN_VERSION_text_builder+benchStrictBuilder ∷ Int → T.Text+benchStrictBuilder = Text.Builder.run . go mempty+  where+    go !acc 0 = acc+    go !acc n = let d = fromIntegral n * dbl in go (Text.Builder.fixedDouble 17 d <> (acc <> Text.Builder.fixedDouble 17 d)) (n - 1)+#endif++benchLinearBuilder ∷ Int → T.Text+benchLinearBuilder m = runBuffer (\b → go b m)+  where+    go ∷ Buffer ⊸ Int → Buffer+    go !acc 0 = acc+    go !acc n = let d = fromIntegral n * dbl in go (d %<| (acc |>% d)) (n - 1)++benchDouble ∷ Benchmark+benchDouble = bgroup "Double" $ map mkGroup [1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6]++mkGroup :: Int → Benchmark+mkGroup n = bgroup (show n)+  [ bench "Data.Text.Lazy.Builder" $ nf benchLazyBuilder n+#ifdef MIN_VERSION_text_builder+  , bench "Text.Builder" $ nf benchStrictBuilder n+#endif+  , bench "Data.Text.Builder.Linear" $ nf benchLinearBuilder n+  ]
+ bench/BenchHexadecimal.hs view
@@ -0,0 +1,53 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module BenchHexadecimal (benchHexadecimal) where++import qualified Data.Text as T+import Data.Text.Builder.Linear.Buffer+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Lazy.Builder.Int (hexadecimal)+import Test.Tasty.Bench++#ifdef MIN_VERSION_text_builder+import qualified Text.Builder+#endif++word :: Word+word = 123456789123456789++benchLazyBuilder ∷ Int → T.Text+benchLazyBuilder = toStrict . toLazyText . go mempty+  where+    go !acc 0 = acc+    go !acc n = let i = fromIntegral n * word in go (hexadecimal i <> (acc <> hexadecimal i)) (n - 1)++#ifdef MIN_VERSION_text_builder+benchStrictBuilder ∷ Int → T.Text+benchStrictBuilder = Text.Builder.run . go mempty+  where+    go !acc 0 = acc+    go !acc n = let i = fromIntegral n * word in go (Text.Builder.hexadecimal i <> (acc <> Text.Builder.hexadecimal i)) (n - 1)+#endif++benchLinearBuilder ∷ Int → T.Text+benchLinearBuilder m = runBuffer (\b → go b m)+  where+    go ∷ Buffer ⊸ Int → Buffer+    go !acc 0 = acc+    go !acc n = let i = fromIntegral n * word in go (i &<| (acc |>& i)) (n - 1)++benchHexadecimal ∷ Benchmark+benchHexadecimal = bgroup "Hexadecimal" $ map mkGroup [1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6]++mkGroup :: Int → Benchmark+mkGroup n = bgroup (show n)+  [ bench "Data.Text.Lazy.Builder" $ nf benchLazyBuilder n+#ifdef MIN_VERSION_text_builder+  , bench "Text.Builder" $ nf benchStrictBuilder n+#endif+  , bench "Data.Text.Builder.Linear" $ nf benchLinearBuilder n+  ]
+ bench/BenchText.hs view
@@ -0,0 +1,54 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module BenchText (benchText) where++import qualified Data.Text as T+import Data.Text.Builder.Linear.Buffer+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText, fromText)+import Test.Tasty.Bench++#ifdef MIN_VERSION_text_builder+import qualified Text.Builder+#endif++txt ∷ T.Text+txt = T.pack "Haskell + Linear Types = ♡"++benchLazyBuilder ∷ Int → T.Text+benchLazyBuilder = toStrict . toLazyText . go mempty+  where+    txtB = fromText txt+    go !acc 0 = acc+    go !acc n = go (txtB <> (acc <> txtB)) (n - 1)++#ifdef MIN_VERSION_text_builder+benchStrictBuilder ∷ Int → T.Text+benchStrictBuilder = Text.Builder.run . go mempty+  where+    txtB = Text.Builder.text txt+    go !acc 0 = acc+    go !acc n = go (txtB <> (acc <> txtB)) (n - 1)+#endif++benchLinearBuilder ∷ Int → T.Text+benchLinearBuilder m = runBuffer (\b → go b m)+  where+    go ∷ Buffer ⊸ Int → Buffer+    go !acc 0 = acc+    go !acc n = go (txt <| (acc |> txt)) (n - 1)++benchText ∷ Benchmark+benchText = bgroup "Text" $ map mkGroup [1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6]++mkGroup :: Int → Benchmark+mkGroup n = bgroup (show n)+  [ bench "Data.Text.Lazy.Builder" $ nf benchLazyBuilder n+#ifdef MIN_VERSION_text_builder+  , bench "Text.Builder" $ nf benchStrictBuilder n+#endif+  , bench "Data.Text.Builder.Linear" $ nf benchLinearBuilder n+  ]
+ bench/Main.hs view
@@ -0,0 +1,52 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module Main where++import Data.Foldable (foldl')+import Test.Tasty.Bench+import Test.Tasty.Runners (TestTree(..))+import Test.Tasty.Patterns.Printer+import Test.Tasty.Patterns.Types as Pat++import BenchChar+import BenchDecimal+import BenchDouble+import BenchHexadecimal+import BenchText++main ∷ IO ()+main = defaultMain $ map (mapLeafs addCompare) $+  [ benchText+  , benchChar+  , benchDecimal+  , benchHexadecimal+  , benchDouble+  ]++textBenchName :: String+textBenchName = "Data.Text.Lazy.Builder"++addCompare :: ([String] -> Benchmark -> Benchmark)+addCompare (name : path)+  | name /= textBenchName = bcompare (printAwkExpr (locateLeaf (textBenchName : path)))+addCompare _ = id++mapLeafs :: ([String] -> Benchmark -> Benchmark) -> Benchmark -> Benchmark+mapLeafs processLeaf = go mempty+  where+    go :: [String] -> Benchmark -> Benchmark+    go path = \case+      SingleTest name t    -> processLeaf (name : path) (SingleTest name t)+      TestGroup name tts   -> TestGroup name (map (go (name : path)) tts)+      PlusTestOptions g tt -> PlusTestOptions g (go path tt)+      WithResource res f   -> WithResource res (go path . f)+      AskOptions f         -> AskOptions (go path . f)+      After dep expr tt    -> After dep expr (go path tt)++locateLeaf :: [String] -> Expr+locateLeaf path+  = foldl' And (IntLit 1)+  $ zipWith (\i name -> Pat.EQ (Field (Sub NF (IntLit i))) (StringLit name)) [0..] path
+ changelog.md view
@@ -0,0 +1,3 @@+## 0.1++* Initial release.
+ src/Data/Text/Builder/Linear.hs view
@@ -0,0 +1,127 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Builder for strict 'Text', based on linear types. It's consistently+-- outperforms "Data.Text.Lazy.Builder"+-- from @text@ as well as a strict builder from @text-builder@,+-- and scales better.++module Data.Text.Builder.Linear+  ( Builder(..)+  , runBuilder+  , fromText+  , fromChar+  , fromAddr+  , fromDec+  , fromHex+  , fromDouble+  ) where++import Data.Bits (FiniteBits)+import Data.Text.Internal (Text(..))+import GHC.Exts (IsString(..), Addr#)++import Data.Text.Builder.Linear.Buffer++-- | Thin wrapper over 'Buffer' with a handy 'Semigroup' instance.+--+-- >>> :set -XOverloadedStrings -XMagicHash+-- >>> fromText "foo" <> fromChar '_' <> fromAddr "bar"#+-- "foo_bar"+--+-- Remember: this is a strict builder, so on contrary to "Data.Text.Lazy.Builder"+-- for optimal performance you should use strict left folds instead of lazy right ones.+--+-- Note that (similar to other builders) concatenation of 'Builder's allocates+-- thunks. This is to a certain extent mitigated by aggressive inlining,+-- but it is faster to use 'Buffer' directly.+--+newtype Builder = Builder { unBuilder :: Buffer ⊸ Buffer }++-- | Run 'Builder' computation on an empty 'Buffer', returning 'Text'.+--+-- >>> :set -XOverloadedStrings -XMagicHash+-- >>> runBuilder (fromText "foo" <> fromChar '_' <> fromAddr "bar"#)+-- "foo_bar"+--+-- This function has a polymorphic arrow and thus can be used both in+-- usual and linear contexts.+--+runBuilder :: forall m. Builder %m → Text+runBuilder (Builder f) = runBuffer f+{-# INLINE runBuilder #-}++instance Show Builder where+  show (Builder f) = show (runBuffer f)++instance Semigroup Builder where+  Builder f <> Builder g = Builder $ \b → g (f b)+  {-# INLINE (<>) #-}++instance Monoid Builder where+  mempty = Builder (\b → b)+  {-# INLINE mempty #-}++instance IsString Builder where+  fromString = fromText . fromString+  {-# INLINE fromString #-}++-- | Create 'Builder', containing a given 'Text'.+--+-- >>> :set -XOverloadedStrings+-- >>> fromText "foo" <> fromText "bar"+-- "foobar"+--+fromText :: Text → Builder+fromText x = Builder $ \b → b |> x+{-# INLINE fromText #-}++-- | Create 'Builder', containing a given 'Char'.+--+-- >>> fromChar 'x' <> fromChar 'y'+-- "xy"+--+fromChar :: Char → Builder+fromChar x = Builder $ \b → b |>. x+{-# INLINE fromChar #-}++-- | Create 'Builder', containing a null-terminated UTF-8 string, specified by 'Addr#'.+--+-- >>> :set -XMagicHash+-- >>> fromAddr "foo"# <> fromAddr "bar"#+-- "foobar"+--+fromAddr :: Addr# → Builder+fromAddr x = Builder $ \b → b |># x+{-# INLINE fromAddr #-}++-- | Create 'Builder', containing decimal representation of a given number.+--+-- >>> fromChar 'x' <> fromDec (123 :: Int)+-- "x123"+--+fromDec :: (Integral a, FiniteBits a) => a → Builder+fromDec x = Builder $ \b → b |>$ x+{-# INLINE fromDec #-}++-- | Create 'Builder', containing hexadecimal representation of a given number.+--+-- >>> :set -XMagicHash+-- >>> fromAddr "0x"# <> fromHex (0x123def :: Int)+-- "0x123def"+--+fromHex :: (Integral a, FiniteBits a) => a → Builder+fromHex x = Builder $ \b → b |>& x+{-# INLINE fromHex #-}++-- | Create 'Builder', containing a given 'Double'.+--+-- >>> :set -XMagicHash+-- >>> fromAddr "pi="# <> fromDouble pi+-- "pi=3.141592653589793"+--+fromDouble :: Double → Builder+fromDouble x = Builder $ \b → b |>% x+{-# INLINE fromDouble #-}
+ src/Data/Text/Builder/Linear/Buffer.hs view
@@ -0,0 +1,134 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- 'Buffer' for strict 'Text', based on linear types.++module Data.Text.Builder.Linear.Buffer+  ( Buffer+  , runBuffer+  , dupBuffer+  , consumeBuffer+  , eraseBuffer+  , foldlIntoBuffer+  , (|>)+  , (|>.)+  , (|>#)+  , (<|)+  , (.<|)+  , (<|#)+  , (><)+  , (|>$)+  , ($<|)+  , (|>%)+  , (%<|)+  , (|>&)+  , (&<|)+  , (|>…)+  , (…<|)+  ) where++import qualified Data.Text.Array as A+import Data.Text.Internal (Text(..))+import GHC.Exts (cstringLength#, Addr#, Int(..), Ptr(..), setByteArray#)+import GHC.ST (ST(..))++import Data.Text.Builder.Linear.Char+import Data.Text.Builder.Linear.Core+import Data.Text.Builder.Linear.Dec+import Data.Text.Builder.Linear.Double+import Data.Text.Builder.Linear.Hex++-- | Append 'Text' suffix to a 'Buffer' by mutating it.+-- If a suffix is statically known, consider using '(|>#)' for optimal performance.+--+-- >>> :set -XOverloadedStrings -XLinearTypes+-- >>> runBuffer (\b -> b |> "foo" |> "bar")+-- "foobar"+--+(|>) ∷ Buffer ⊸ Text → Buffer+infixl 6 |>+buffer |> (Text src srcOff srcLen) = appendExact+  srcLen+  (\dst dstOff → A.copyI srcLen dst dstOff src srcOff)+  buffer++-- | Prepend 'Text' prefix to a 'Buffer' by mutating it.+-- If a prefix is statically known, consider using '(<|#)' for optimal performance.+--+-- >>> :set -XOverloadedStrings -XLinearTypes+-- >>> runBuffer (\b -> "foo" <| "bar" <| b)+-- "foobar"+--+(<|) ∷ Text → Buffer ⊸ Buffer+infixr 6 <|+Text src srcOff srcLen <| buffer = prependExact+  srcLen+  (\dst dstOff → A.copyI srcLen dst dstOff src srcOff)+  buffer++-- | Append a null-terminated UTF-8 string+-- to a 'Buffer' by mutating it. E. g.,+--+-- >>> :set -XOverloadedStrings -XLinearTypes -XMagicHash+-- >>> runBuffer (\b -> b |># "foo"# |># "bar"#)+-- "foobar"+--+-- The literal string must not contain zero bytes @\\0@, this condition is not checked.+--+-- Note the inconsistency in naming: unfortunately, GHC parser does not allow for @#<|@.+--+(|>#) ∷ Buffer ⊸ Addr# → Buffer+infixl 6 |>#+buffer |># addr# = appendExact+  srcLen+  (\dst dstOff → A.copyFromPointer dst dstOff (Ptr addr#) srcLen)+  buffer+  where+    srcLen = I# (cstringLength# addr#)++-- | Prepend a null-terminated UTF-8 string+-- to a 'Buffer' by mutating it. E. g.,+--+-- >>> :set -XOverloadedStrings -XLinearTypes -XMagicHash+-- >>> runBuffer (\b -> "foo"# <|# "bar"# <|# b)+-- "foobar"+--+-- The literal string must not contain zero bytes @\\0@, this condition is not checked.+(<|#) ∷ Addr# → Buffer ⊸ Buffer+infixr 6 <|#+addr# <|# buffer = prependExact+  srcLen+  (\dst dstOff → A.copyFromPointer dst dstOff (Ptr addr#) srcLen)+  buffer+  where+    srcLen = I# (cstringLength# addr#)++-- | Append given number of spaces.+(|>…) ∷ Buffer ⊸ Word → Buffer+infixr 6 |>…+buf |>… 0 = buf+buffer |>… (fromIntegral -> spaces@(I# spaces#)) = appendExact+  spaces+  (\(A.MutableByteArray dst#) (I# dstOff#) -> ST (\s# ->+    (# setByteArray# dst# dstOff# spaces# 32# s#, () #)))+  buffer++-- | Prepend given number of spaces.+(…<|) ∷ Word → Buffer ⊸ Buffer+infixr 6 …<|+0 …<| buf = buf+(fromIntegral -> spaces@(I# spaces#)) …<| buffer = prependExact+  spaces+  (\(A.MutableByteArray dst#) (I# dstOff#) -> ST (\s# ->+    (# setByteArray# dst# dstOff# spaces# 32# s#, () #)))+  buffer++-- | This is just a normal 'Data.List.foldl'', but with a linear arrow+-- and potentially unlifted accumulator.+foldlIntoBuffer ∷ (Buffer ⊸ a → Buffer) → Buffer ⊸ [a] → Buffer+foldlIntoBuffer f = go+  where+    go !acc [] = acc+    go !acc (x : xs) = go (f acc x) xs
+ src/Data/Text/Builder/Linear/Char.hs view
@@ -0,0 +1,68 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module Data.Text.Builder.Linear.Char+  ( -- * Buffer+    (|>.)+  , (.<|)+  ) where++import qualified Data.Text.Array as A+import Data.Text.Internal.Encoding.Utf8 (utf8Length, ord2, ord3, ord4)+import Data.Text.Internal.Unsafe.Char (unsafeWrite, ord)+import GHC.ST (ST)++import Data.Text.Builder.Linear.Core++-- | Append 'Char' to a 'Buffer' by mutating it.+--+-- >>> :set -XLinearTypes+-- >>> runBuffer (\b -> b |>. 'q' |>. 'w')+-- "qw"+--+(|>.) ∷ Buffer ⊸ Char → Buffer+infixl 6 |>.+buffer |>. ch = appendBounded 4 (\dst dstOff → unsafeWrite dst dstOff ch) buffer++-- | Prepend 'Char' to a 'Buffer' by mutating it.+--+-- >>> :set -XLinearTypes+-- >>> runBuffer (\b -> 'q' .<| 'w' .<| b)+-- "qw"+--+(.<|) ∷ Char → Buffer ⊸ Buffer+infixr 6 .<|+ch .<| buffer = prependBounded+  4+  (\dst dstOff → unsafePrependCharM dst dstOff ch)+  (\dst dstOff → unsafeWrite dst dstOff ch)+  buffer++-- | Similar to 'Data.Text.Internal.Unsafe.Char.unsafeWrite',+-- but writes _before_ a given offset.+unsafePrependCharM :: A.MArray s → Int → Char → ST s Int+unsafePrependCharM marr off c = case utf8Length c of+  1 → do+    let n0 = fromIntegral (ord c)+    A.unsafeWrite marr (off - 1) n0+    pure 1+  2 → do+    let (n0, n1) = ord2 c+    A.unsafeWrite marr (off - 2) n0+    A.unsafeWrite marr (off - 1) n1+    pure 2+  3 → do+    let (n0, n1, n2) = ord3 c+    A.unsafeWrite marr (off - 3) n0+    A.unsafeWrite marr (off - 2) n1+    A.unsafeWrite marr (off - 1) n2+    pure 3+  _ → do+    let (n0, n1, n2, n3) = ord4 c+    A.unsafeWrite marr (off - 4) n0+    A.unsafeWrite marr (off - 3) n1+    A.unsafeWrite marr (off - 2) n2+    A.unsafeWrite marr (off - 1) n3+    pure 4
+ src/Data/Text/Builder/Linear/Core.hs view
@@ -0,0 +1,271 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Low-level routines for 'Buffer' manipulations.++module Data.Text.Builder.Linear.Core+  ( Buffer+  , runBuffer+  , dupBuffer+  , consumeBuffer+  , eraseBuffer+  , byteSizeOfBuffer+  , lengthOfBuffer+  , dropBuffer+  , takeBuffer+  , appendBounded+  , appendExact+  , prependBounded+  , prependExact+  , (><)+  ) where++import qualified Data.Text as T+import Data.Text.Array (Array(..), MArray(..))+import qualified Data.Text.Array as A+import Data.Text.Internal (Text(..))+import GHC.Exts (unsafeCoerce#, Int(..), sizeofByteArray#)+#if MIN_VERSION_base(4,16,0)+import GHC.Exts (TYPE, Levity(..), RuntimeRep(..))+#endif+import GHC.ST (ST(..), runST)++-- | Internally 'Buffer' is a mutable buffer.+-- If a client gets hold of a variable of type 'Buffer',+-- they'd be able to pass a mutable buffer to concurrent threads.+-- That's why API below is carefully designed to prevent such possibility:+-- clients always work with linear functions 'Buffer' ⊸ 'Buffer' instead+-- and run them on an empty 'Buffer' to extract results.+--+-- In terms of @linear-base@ 'Buffer' is @Consumable@ (see 'consumeBuffer')+-- and @Dupable@ (see 'dupBuffer'), but not @Movable@.+--+-- >>> :set -XOverloadedStrings -XLinearTypes+-- >>> import Data.Text.Builder.Linear.Buffer+-- >>> runBuffer (\b -> '!' .<| "foo" <| (b |> "bar" |>. '.'))+-- "!foobar."+--+-- Remember: this is a strict builder, so on contrary to "Data.Text.Lazy.Builder"+-- for optimal performance you should use strict left folds instead of lazy right ones.+--+-- Starting from GHC 9.2, 'Buffer' is an unlifted datatype,+-- so you can put it into an unboxed tuple @(# ..., ... #)@,+-- but not into @(..., ...)@.+--+#if MIN_VERSION_base(4,16,0)+data Buffer ∷ TYPE ('BoxedRep 'Unlifted) where+#else+data Buffer where+#endif+  Buffer ∷ {-# UNPACK #-} !Text → Buffer++-- | Unwrap 'Buffer', no-op.+-- Most likely, this is not the function you're looking for+-- and you need 'runBuffer' instead.+unBuffer ∷ Buffer ⊸ Text+unBuffer (Buffer x) = x++-- | Run a linear function on an empty 'Buffer', producing 'Text'.+--+-- Be careful to write @runBuffer (\b -> ...)@ instead of @runBuffer $ \b -> ...@,+-- because current implementation of linear types lacks special support for '($)'.+-- Another option is to enable @{-# LANGUAGE BlockArguments #-}@+-- and write @runBuffer \b -> ...@.+-- Alternatively, you can import @Prelude.Linear.($)@ from @linear-base@.+--+-- 'runBuffer' is similar in spirit to mutable arrays API in @Data.Array.Mutable.Linear@,+-- which provides functions like @fromList@ ∷ [@a@] → (@Vector@ @a@ ⊸ @Ur@ b) ⊸ @Ur@ @b@.+-- Here the initial buffer is always empty and @b@ is 'Text'. Since 'Text' is @Movable@,+-- 'Text' and @Ur@ 'Text' are equivalent.+--+runBuffer ∷ (Buffer ⊸ Buffer) ⊸ Text+runBuffer f = unBuffer (f (Buffer mempty))++-- | Duplicate builder. Feel free to process results in parallel threads.+-- Similar to @Data.Unrestricted.Linear.Dupable@ from @linear-base@.+--+-- It is a bit tricky to use because of+-- <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/linear_types.html#limitations current limitations>+-- of linear types with regards to @let@ and @where@. E. g., one cannot write+--+-- > let (# b1, b2 #) = dupBuffer b in ("foo" <| b1) >< (b2 |> "bar")+--+-- Instead write:+--+-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples+-- >>> import Data.Text.Builder.Linear.Buffer+-- >>> runBuffer (\b -> (\(# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar")) (dupBuffer b))+-- "foobar"+--+-- Note the unboxed tuple: starting from GHC 9.2, 'Buffer' is an unlifted datatype,+-- so it cannot be put into @(..., ...)@.+--+dupBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)+dupBuffer (Buffer x) = (# Buffer x, Buffer (T.copy x) #)++-- | Consume buffer linearly,+-- similar to @Data.Unrestricted.Linear.Consumable@ from @linear-base@.+consumeBuffer ∷ Buffer ⊸ ()+consumeBuffer Buffer{} = ()++-- | Erase buffer's content, replacing it with an empty 'Text'.+eraseBuffer ∷ Buffer ⊸ Buffer+eraseBuffer Buffer{} = Buffer mempty++-- | Return buffer's size in __bytes__ (not in 'Char's).+-- This could be useful to implement a lazy builder atop of a strict one.+byteSizeOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)+byteSizeOfBuffer (Buffer t@(Text _ _ len)) = (# Buffer t, fromIntegral len #)++-- | Return buffer's length in 'Char's (not in bytes).+-- This could be useful to implement @dropEndBuffer@ and @takeEndBuffer@, e. g.,+--+-- @+-- import Data.Unrestricted.Linear+--+-- dropEndBuffer :: Word -> Buffer %1 -> Buffer+-- dropEndBuffer n buf =+--   (\(# buf', len #) -> case move len of Ur len' -> takeBuffer (len' - n) buf')+--     (lengthOfBuffer buf)+-- @+lengthOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)+lengthOfBuffer (Buffer t) = (# Buffer t, fromIntegral (T.length t) #)++-- | Slice 'Buffer' by dropping given number of 'Char's.+dropBuffer ∷ Word → Buffer ⊸ Buffer+dropBuffer nChar (Buffer t@(Text arr off len))+  | nByte <= 0 = Buffer (Text arr (off + len) 0)+  | otherwise = Buffer (Text arr (off + nByte) (len - nByte))+  where+    nByte = T.measureOff (fromIntegral nChar) t++-- | Slice 'Buffer' by taking given number of 'Char's.+takeBuffer ∷ Word → Buffer ⊸ Buffer+takeBuffer nChar (Buffer t@(Text arr off _))+  | nByte <= 0 = Buffer t+  | otherwise = Buffer (Text arr off nByte)+  where+    nByte = T.measureOff (fromIntegral nChar) t++-- | Low-level routine to append data of unknown size to a 'Buffer'.+appendBounded+  ∷ Int+  -- ^ Upper bound for the number of bytes, written by an action+  → (forall s. MArray s → Int → ST s Int)+  -- ^ Action, which writes bytes __starting__ from the given offset+  -- and returns an actual number of bytes written.+  → Buffer+  ⊸ Buffer+appendBounded maxSrcLen appender (Buffer (Text dst dstOff dstLen)) = Buffer $ runST $ do+  let dstFullLen = sizeofByteArray dst+      newFullLen = dstOff + 2 * (dstLen + maxSrcLen)+  newM ← if dstOff + dstLen + maxSrcLen <= dstFullLen+    then unsafeThaw dst+    else do+      tmpM ← A.new newFullLen+      A.copyI dstLen tmpM dstOff dst dstOff+      pure tmpM+  srcLen ← appender newM (dstOff + dstLen)+  new ← A.unsafeFreeze newM+  pure $ Text new dstOff (dstLen + srcLen)+{-# INLINE appendBounded #-}++-- | Low-level routine to append data of known size to a 'Buffer'.+appendExact+  ∷ Int+  -- ^ Exact number of bytes, written by an action+  → (forall s. MArray s → Int → ST s ())+  -- ^ Action, which writes bytes __starting__ from the given offset+  → Buffer+  ⊸ Buffer+appendExact srcLen appender = appendBounded+  srcLen+  (\dst dstOff → appender dst dstOff >> pure srcLen)+{-# INLINE appendExact #-}++-- | Low-level routine to prepend data of unknown size to a 'Buffer'.+prependBounded+  ∷ Int+  -- ^ Upper bound for the number of bytes, written by an action+  → (forall s. MArray s → Int → ST s Int)+  -- ^ Action, which writes bytes __finishing__ before the given offset+  -- and returns an actual number of bytes written.+  → (forall s. MArray s → Int → ST s Int)+  -- ^ Action, which writes bytes __starting__ from the given offset+  -- and returns an actual number of bytes written.+  → Buffer+  ⊸ Buffer+prependBounded maxSrcLen prepender appender (Buffer (Text dst dstOff dstLen))+  | maxSrcLen <= dstOff = Buffer $ runST $ do+    newM ← unsafeThaw dst+    srcLen ← prepender newM dstOff+    new ← A.unsafeFreeze newM+    pure $ Text new (dstOff - srcLen) (srcLen + dstLen)+  | otherwise = Buffer $ runST $ do+    let dstFullLen = sizeofByteArray dst+        newOff = dstLen + maxSrcLen+        newFullLen = 2 * newOff + (dstFullLen - dstOff - dstLen)+    newM ← A.new newFullLen+    srcLen ← appender newM newOff+    A.copyI dstLen newM (newOff + srcLen) dst dstOff+    new ← A.unsafeFreeze newM+    pure $ Text new newOff (dstLen + srcLen)+{-# INLINE prependBounded #-}++-- | Low-level routine to append data of unknown size to a 'Buffer'.+prependExact+  ∷ Int+  -- ^ Exact number of bytes, written by an action+  → (forall s. MArray s → Int → ST s ())+  -- ^ Action, which writes bytes __starting__ from the given offset+  → Buffer+  ⊸ Buffer+prependExact srcLen appender = prependBounded+  srcLen+  (\dst dstOff → appender dst (dstOff - srcLen) >> pure srcLen)+  (\dst dstOff → appender dst dstOff >> pure srcLen)+{-# INLINE prependExact #-}++unsafeThaw ∷ Array → ST s (MArray s)+unsafeThaw (ByteArray a) = ST $ \s# →+  (# s#, MutableByteArray (unsafeCoerce# a) #)++sizeofByteArray ∷ Array → Int+sizeofByteArray (ByteArray a) = I# (sizeofByteArray# a)++-- | Concatenate two 'Buffer's, potentially mutating both of them.+--+-- You likely need to use 'dupBuffer' to get hold on two builders at once:+--+-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples+-- >>> import Data.Text.Builder.Linear.Buffer+-- >>> runBuffer (\b -> (\(# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar")) (dupBuffer b))+-- "foobar"+--+(><) ∷ Buffer ⊸ Buffer ⊸ Buffer+infix 6 ><+Buffer (Text left leftOff leftLen) >< Buffer (Text right rightOff rightLen) = Buffer $ runST $ do+  let leftFullLen = sizeofByteArray left+      rightFullLen = sizeofByteArray right+      canCopyToLeft = leftOff + leftLen + rightLen <= leftFullLen+      canCopyToRight = leftLen <= rightOff+      shouldCopyToLeft = canCopyToLeft && (not canCopyToRight || leftLen >= rightLen)+  if shouldCopyToLeft then do+    newM ← unsafeThaw left+    A.copyI rightLen newM (leftOff + leftLen) right rightOff+    new ← A.unsafeFreeze newM+    pure $ Text new leftOff (leftLen + rightLen)+  else if canCopyToRight then do+    newM ← unsafeThaw right+    A.copyI leftLen newM (rightOff - leftLen) left leftOff+    new ← A.unsafeFreeze newM+    pure $ Text new (rightOff - leftLen) (leftLen + rightLen)+  else do+    let fullLen = leftOff + leftLen + rightLen + (rightFullLen - rightOff - rightLen)+    newM ← A.new fullLen+    A.copyI leftLen newM leftOff left leftOff+    A.copyI rightLen newM (leftOff + leftLen) right rightOff+    new ← A.unsafeFreeze newM+    pure $ Text new leftOff (leftLen + rightLen)
+ src/Data/Text/Builder/Linear/Dec.hs view
@@ -0,0 +1,134 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++{-# LANGUAGE TemplateHaskell #-}++module Data.Text.Builder.Linear.Dec+  ( (|>$)+  , ($<|)+  ) where++import Data.Bits (FiniteBits(..), Bits(..))+import Data.Int (Int8, Int16, Int32, Int64)+import qualified Data.Text.Array as A+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Exts (Addr#, Int(..), Ptr(..), (>=#), dataToTag#)+import GHC.Ptr (plusPtr)+import GHC.ST (ST)+import Numeric.QuoteQuot (assumeNonNegArg, astQuot, quoteAST, quoteQuot)++import Data.Text.Builder.Linear.Core++-- | Append decimal number.+(|>$) :: (Integral a, FiniteBits a) => Buffer ⊸ a → Buffer+infixl 6 |>$+buffer |>$ n = appendBounded+  (maxDecLen n)+  (\dst dstOff → unsafeAppendDec dst dstOff n)+  buffer+{-# INLINABLE (|>$) #-}++-- | Prepend decimal number.+($<|) :: (Integral a, FiniteBits a) => a → Buffer ⊸ Buffer+infixr 6 $<|+n $<| buffer = prependBounded+  (maxDecLen n)+  (\dst dstOff → unsafePrependDec dst dstOff n)+  (\dst dstOff → unsafeAppendDec dst dstOff n)+  buffer+{-# INLINABLE ($<|) #-}++-- | ceiling (fbs a * logBase 10 2) < ceiling (fbs a * 5 / 16) < 1 + floor (fbs a * 5 / 16)+maxDecLen :: FiniteBits a => a → Int+maxDecLen a+  | isSigned a = 2 + (finiteBitSize a * 5) `shiftR` 4+  | otherwise  = 1 + (finiteBitSize a * 5) `shiftR` 4+{-# INLINABLE maxDecLen #-}++exactDecLen :: (Integral a, FiniteBits a) => a → Int+exactDecLen n+  | n < 0+  = go 2 (complement n + fromIntegral (I# (dataToTag# (n > bit (finiteBitSize n - 1)))))+  | otherwise+  = go 1 n+  where+    go :: (Integral a, FiniteBits a) => Int → a → Int+    go acc k+      | finiteBitSize k >= 32, k >= 1000000000 = go (acc + 9) (quotBillion k)+      | otherwise = acc + goInt (fromIntegral k)++    goInt l@(I# l#)+      | l >= 1e5  = 5 + I# (l# >=# 100000000#) + I# (l# >=# 10000000#) + I# (l# >=# 1000000#)+      | otherwise = I# (l# >=# 10000#) + I# (l# >=# 1000#) + I# (l# >=# 100#) + I# (l# >=# 10#)+{-# INLINABLE exactDecLen #-}++unsafeAppendDec :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int+unsafeAppendDec marr off n = unsafePrependDec marr (off + exactDecLen n) n+{-# INLINABLE unsafeAppendDec #-}++unsafePrependDec :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int+unsafePrependDec marr off n+  | n < 0, n == bit (finiteBitSize n - 1) = do+    A.unsafeWrite marr (off - 1) (fromIntegral (48 + minBoundLastDigit n))+    go (off - 2) (abs (bit (finiteBitSize n - 1) `quot` 10)) >>= sign+  | n == 0 = do+    A.unsafeWrite marr (off - 1) 0x30 >> pure 1+  | otherwise = go (off - 1) (abs n) >>= sign+  where+    sign o+      | n > 0 = pure (off - o)+      | otherwise = do+        A.unsafeWrite marr (o - 1) 0x2d -- '-'+        pure (off - o + 1)++    go o k+      | k >= 10 = do+        let q = quot100 k+            r = k - 100 * q+        A.copyFromPointer marr (o - 1) (Ptr digits `plusPtr` (fromIntegral r `shiftL` 1)) 2+        if k < 100 then pure (o - 1) else go (o - 2) q+      | otherwise = do+        A.unsafeWrite marr o (fromIntegral (48 + k))+        pure o++    digits :: Addr#+    digits = "00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899"#+{-# INLINABLE unsafePrependDec #-}++minBoundLastDigit :: FiniteBits a => a → Int+minBoundLastDigit a = case finiteBitSize a .&. 4 of+  0 → 8+  1 → 6+  2 → 2+  _ → 4+{-# INLINABLE minBoundLastDigit #-}++quot100 :: (Integral a, FiniteBits a) => a → a+quot100 a = case (finiteBitSize a, isSigned a) of+  (64, True)  → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int64))+  (64, False) → cast $$(quoteQuot (100 :: Word64))+  (32, True)  → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int32))+  (32, False) → cast $$(quoteQuot (100 :: Word32))+  (16, True)  → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int16))+  (16, False) → cast $$(quoteQuot (100 :: Word16))+  ( 8, True)  → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int8))+  ( 8, False) → cast $$(quoteQuot (100 :: Word8))+  _ → a `quot` 100+  where+    cast :: (Integral a, Integral b) => (b → b) → a+    cast f = fromIntegral (f (fromIntegral a))+{-# INLINABLE quot100 #-}++quotBillion :: (Integral a, FiniteBits a) => a → a+quotBillion a = case (finiteBitSize a, isSigned a) of+  (64, True)  → cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int64))+  (64, False) → cast $$(quoteQuot (1e9 :: Word64))+  (32, True)  → cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int32))+  (32, False) → cast $$(quoteQuot (1e9 :: Word32))+  _ → a `quot` 1e9+  where+    cast :: (Integral a, Integral b) => (b → b) → a+    cast f = fromIntegral (f (fromIntegral a))+{-# INLINABLE quotBillion #-}
+ src/Data/Text/Builder/Linear/Double.hs view
@@ -0,0 +1,70 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module Data.Text.Builder.Linear.Double+  ( (|>%)+  , (%<|)+  ) where++import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Builder.Internal as BBI+import qualified Data.Text.Array as A+import Data.Word (Word8)+import GHC.Exts (Ptr(..))+import GHC.ForeignPtr (touchForeignPtr, unsafeForeignPtrToPtr, unsafeWithForeignPtr, ForeignPtr)+import GHC.IO (unsafeIOToST, unsafeSTToIO, unsafeDupablePerformIO)+import GHC.Ptr (minusPtr)+import GHC.ST (ST)++import Data.Text.Builder.Linear.Core++-- | Append double.+(|>%) :: Buffer ⊸ Double → Buffer+infixl 6 |>%+buffer |>% x = appendBounded+  maxDblLen+  (\dst dstOff → unsafeAppendDouble dst dstOff x)+  buffer++-- | Prepend double+(%<|) :: Double → Buffer ⊸ Buffer+infixr 6 %<|+x %<| buffer = prependBounded+  maxDblLen+  (\dst dstOff → unsafePrependDouble dst dstOff x)+  (\dst dstOff → unsafeAppendDouble dst dstOff x)+  buffer++unsafeAppendDouble :: A.MArray s → Int → Double → ST s Int+unsafeAppendDouble dst !dstOff !x = do+  let (fp, !srcLen) = runDoubleBuilder x+  unsafeIOToST $ unsafeWithForeignPtr fp $ \(Ptr addr#) →+    unsafeSTToIO $ A.copyFromPointer dst dstOff (Ptr addr#) srcLen+  pure srcLen++unsafePrependDouble :: A.MArray s → Int → Double → ST s Int+unsafePrependDouble dst !dstOff !x = do+  let (fp, !srcLen) = runDoubleBuilder x+  unsafeIOToST $ unsafeWithForeignPtr fp $ \(Ptr addr#) →+    unsafeSTToIO $ A.copyFromPointer dst (dstOff - srcLen) (Ptr addr#) srcLen+  pure srcLen++runDoubleBuilder :: Double → (ForeignPtr Word8, Int)+runDoubleBuilder =+  unsafeDupablePerformIO . buildStepToFirstChunk . BBI.runBuilder . BB.doubleDec+{-# INLINE runDoubleBuilder #-}++buildStepToFirstChunk :: BBI.BuildStep a → IO (ForeignPtr Word8, Int)+buildStepToFirstChunk = \step → BBI.newBuffer maxDblLen >>= fill step+  where+    fill !step (BBI.Buffer fpbuf br) = do+      let doneH op' _ = pure (fpbuf, op' `minusPtr` unsafeForeignPtrToPtr fpbuf)+          fullH _ _ nextStep = BBI.newBuffer maxDblLen >>= fill nextStep+      res ← BBI.fillWithBuildStep step doneH fullH undefined br+      touchForeignPtr fpbuf+      return res++maxDblLen :: Int+maxDblLen = 24 -- length (show (-1.0000000000000004e-308 :: Double))
+ src/Data/Text/Builder/Linear/Hex.hs view
@@ -0,0 +1,67 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module Data.Text.Builder.Linear.Hex+  ( (|>&)+  , (&<|)+  ) where++import Data.Bits (FiniteBits(..), Bits(..))+import Data.Foldable (forM_)+import qualified Data.Text.Array as A+import GHC.Exts (Int(..), (>#), (<=#))+import GHC.ST (ST)++import Data.Text.Builder.Linear.Core++-- | Append hexadecimal number.+(|>&) :: (Integral a, FiniteBits a) => Buffer ⊸ a → Buffer+infixl 6 |>&+buffer |>& n = appendBounded+  (finiteBitSize n `shiftR` 2)+  (\dst dstOff → unsafeAppendHex dst dstOff n)+  buffer+{-# INLINABLE (|>&) #-}++-- | Prepend hexadecimal number.+(&<|) :: (Integral a, FiniteBits a) => a → Buffer ⊸ Buffer+infixr 6 &<|+n &<| buffer = prependBounded+  (finiteBitSize n `shiftR` 2)+  (\dst dstOff → unsafePrependHex dst dstOff n)+  (\dst dstOff → unsafeAppendHex dst dstOff n)+  buffer+{-# INLINABLE (&<|) #-}++unsafeAppendHex :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int+unsafeAppendHex marr off n = do+  let len = lengthAsHex n+  forM_ [0 .. len - 1] $ \i →+    let nibble = (n `shiftR` ((len - 1 - i) `shiftL` 2)) .&. 0xf in+      writeNibbleAsHex marr (off + i) (fromIntegral nibble)+  pure len+{-# INLINABLE unsafeAppendHex #-}++unsafePrependHex :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int+unsafePrependHex marr off n = do+  let len = lengthAsHex n+  forM_ [0 .. len - 1] $ \i →+    let nibble = (n `shiftR` (i `shiftL` 2)) .&. 0xf in+      writeNibbleAsHex marr (off - 1 - i) (fromIntegral nibble)+  pure len+{-# INLINABLE unsafePrependHex #-}++lengthAsHex :: FiniteBits a => a → Int+lengthAsHex n = max1 $ (finiteBitSize n `shiftR` 2) - (countLeadingZeros n `shiftR` 2)+{-# INLINABLE lengthAsHex #-}++-- Branchless equivalent for max 1 n.+max1 :: Int → Int+max1 n@(I# n#) = n `xor` I# (n# <=# 0#)++writeNibbleAsHex :: A.MArray s → Int → Int → ST s ()+writeNibbleAsHex marr off n@(I# n#) = A.unsafeWrite marr off (fromIntegral hex)+  where+    hex = 48 + n + I# (n# ># 9#) * 39
+ test/Main.hs view
@@ -0,0 +1,137 @@+-- |+-- Copyright:   (c) 2022 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>++module Main where++import Data.Foldable+import qualified Data.Text as T+import Data.Text.Builder.Linear.Buffer+import Data.Text.Internal (Text(..))+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)+import Data.Text.Lazy.Builder.RealFloat (realFloat)+import GHC.Generics+import Test.Tasty+import Test.Tasty.QuickCheck hiding ((><))++instance Arbitrary Text where+  arbitrary = do+    xs ← T.pack <$> arbitrary+    d ← (`mod` (T.length xs + 1)) <$> arbitrary+    pure $ T.drop d xs+  shrink t@(Text arr off len)+    =  map (T.drop d . T.pack) (shrink ys)+    ++ map (\d' → T.drop d' $ T.pack $ drop (d - d') ys) (shrink d)+    where+      xs = T.unpack t+      ys = T.unpack (Text arr 0 (off + len))+      d  = length ys - length xs++data Action+  = AppendText Text+  | PrependText Text+  | AppendChar Char+  | PrependChar Char+  | AppendHex Word+  | PrependHex Word+  | AppendDec Int+  | PrependDec Int+  | AppendDouble Double+  | PrependDouble Double+  | AppendSpaces Word+  | PrependSpaces Word+  deriving (Eq, Ord, Show, Generic)++instance Arbitrary Action where+  arbitrary = oneof+    [ AppendText    <$> arbitrary+    , PrependText   <$> arbitrary+    , AppendChar    <$> arbitraryUnicodeChar+    , PrependChar   <$> arbitraryUnicodeChar+    , AppendHex     <$> arbitraryBoundedIntegral+    , PrependHex    <$> arbitraryBoundedIntegral+    , AppendDec     <$> arbitraryBoundedIntegral+    , PrependDec    <$> arbitraryBoundedIntegral+    , pure $ AppendHex minBound+    , pure $ AppendHex maxBound+    , pure $ AppendDec minBound+    , pure $ AppendDec maxBound+    , pure $ AppendDec 0+    , AppendDouble  <$> arbitrary+    , PrependDouble <$> arbitrary+    , AppendSpaces . getNonNegative <$> arbitrary+    , PrependSpaces . getNonNegative <$> arbitrary+    ]+  shrink = genericShrink++interpretOnText ∷ [Action] → Text → Text+interpretOnText xs z = foldl' go z xs+  where+    go ∷ Text → Action → Text+    go b (AppendText    x) = b <> x+    go b (PrependText   x) = x <> b+    go b (AppendChar    x) = T.snoc b x+    go b (PrependChar   x) = T.cons x b+    go b (AppendHex     x) = b <> toStrict (toLazyText (hexadecimal x))+    go b (PrependHex    x) = toStrict (toLazyText (hexadecimal x)) <> b+    go b (AppendDec     x) = b <> toStrict (toLazyText (decimal x))+    go b (PrependDec    x) = toStrict (toLazyText (decimal x)) <> b+    go b (AppendDouble  x) = b <> toStrict (toLazyText (realFloat x))+    go b (PrependDouble x) = toStrict (toLazyText (realFloat x)) <> b+    go b (AppendSpaces  n) = b <> T.replicate (fromIntegral n) (T.singleton ' ')+    go b (PrependSpaces n) = T.replicate (fromIntegral n) (T.singleton ' ') <> b++interpretOnBuffer ∷ [Action] → Buffer ⊸ Buffer+interpretOnBuffer xs z = foldlIntoBuffer go z xs+  where+    go ∷ Buffer ⊸ Action → Buffer+    go b (AppendText    x) = b |> x+    go b (PrependText   x) = x <| b+    go b (AppendChar    x) = b |>. x+    go b (PrependChar   x) = x .<| b+    go b (AppendHex     x) = b |>& x+    go b (PrependHex    x) = x &<| b+    go b (AppendDec     x) = b |>$ x+    go b (PrependDec    x) = x $<| b+    go b (AppendDouble  x) = b |>% x+    go b (PrependDouble x) = x %<| b+    go b (AppendSpaces  n) = b |>… n+    go b (PrependSpaces n) = n …<| b++main ∷ IO ()+main = defaultMain $ testGroup "All"+  [ testProperty "sequence of actions" prop1+  , testProperty "two sequences of actions" prop2+  , testProperty "append addr#" prop3+  , testProperty "prepend addr#" prop4+  ]++prop1 ∷ [Action] → Property+prop1 acts = interpretOnText acts mempty ===+  runBuffer (\b → interpretOnBuffer acts b)++prop2 ∷ [Action] → [Action] → Property+prop2 acts1 acts2 = interpretOnText acts1 mempty <> interpretOnText acts2 mempty ===+  runBuffer (\b → go (dupBuffer b))+  where+    go ∷ (# Buffer, Buffer #) ⊸ Buffer+    go (# b1, b2 #) = interpretOnBuffer acts1 b1 >< interpretOnBuffer acts2 b2++prop3 :: [Action] → Property+prop3 acts = runBuffer f1 === runBuffer f2+  where+    addr# = "foo"#+    f1, f2 :: Buffer ⊸ Buffer+    f1 = \b → interpretOnBuffer acts b |># addr#+    f2 = \b → interpretOnBuffer acts b |> T.pack "foo"++prop4 :: [Action] → Property+prop4 acts = runBuffer f1 === runBuffer f2+  where+    addr# = "foo"#+    f1, f2 :: Buffer ⊸ Buffer+    f1 = \b → addr# <|# interpretOnBuffer acts b+    f2 = \b → T.pack "foo" <| interpretOnBuffer acts b
+ text-builder-linear.cabal view
@@ -0,0 +1,89 @@+cabal-version:      2.4+name:               text-builder-linear+version:            0.1+license: BSD-3-Clause+license-file: LICENSE+copyright: 2022 Andrew Lelechenko+author: Andrew Lelechenko+maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+homepage: https://github.com/Bodigrim/linear-builder+category: Text+synopsis: Builder for Text based on linear types+description:+  Strict Text builder, which hides mutable buffer behind linear types+  and takes amortized linear time.+extra-source-files: changelog.md README.md+tested-with: GHC == 9.0.2, GHC == 9.2.2++source-repository head+  type: git+  location: git://github.com/Bodigrim/linear-builder.git++common stanza+  build-depends:    base >= 4.15 && < 5, text >= 2.0+  default-language: Haskell2010+  ghc-options: -Wall+  default-extensions:+    BangPatterns+    CPP+    DeriveGeneric+    GADTs+    KindSignatures+    LambdaCase+    LinearTypes+    MagicHash+    NumDecimals+    RankNTypes+    ScopedTypeVariables+    UnboxedTuples+    UnicodeSyntax+    ViewPatterns+  if impl(ghc >= 9.2)+    default-extensions:+      UnliftedDatatypes++library+  import: stanza+  build-depends: bytestring >= 0.10.12, quote-quot >= 0.2.1+  hs-source-dirs:   src+  ghc-options: -O2 -fexpose-all-unfoldings+  exposed-modules:+    Data.Text.Builder.Linear+    Data.Text.Builder.Linear.Buffer+    Data.Text.Builder.Linear.Core+  other-modules:+    Data.Text.Builder.Linear.Char+    Data.Text.Builder.Linear.Dec+    Data.Text.Builder.Linear.Double+    Data.Text.Builder.Linear.Hex++test-suite linear-builder-tests+  import: stanza+  type: exitcode-stdio-1.0+  main-is: Main.hs+  build-depends:+    text-builder-linear,+    tasty,+    tasty-quickcheck+  hs-source-dirs: test+  ghc-options: -Wno-orphans -threaded -rtsopts "-with-rtsopts -N"++benchmark linear-builder-bench+  import: stanza+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+    BenchChar+    BenchDecimal+    BenchDouble+    BenchHexadecimal+    BenchText+  hs-source-dirs: bench+  ghc-options: -rtsopts+  build-depends:+    text-builder-linear,+    -- text-builder,+    tasty,+    tasty-bench >= 0.3+  default-language: Haskell2010+  ghc-options: -O2