text-builder-linear-0.1.2: Builder for Text and ByteString based on linear types
Copyright(c) 2022 Andrew Lelechenko
(c) 2023 Pierre Le Marre
LicenseBSD3
MaintainerAndrew Lelechenko <andrew.lelechenko@gmail.com>
Safe HaskellSafe-Inferred
LanguageGHC2021

Data.Text.Builder.Linear.Buffer

Description

Buffer for strict Text, based on linear types.

Synopsis

Type

data Buffer :: TYPE ('BoxedRep 'Unlifted) Source #

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 BufferBuffer 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.

Buffer is an unlifted datatype, so you can put it into an unboxed tuple (# ..., ... #), but not into (..., ...).

Basic interface

runBuffer :: (Buffer %1 -> Buffer) %1 -> Text Source #

Run a linear function on an empty Buffer, producing a strict 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 ($) from linear-base.

runBuffer is similar in spirit to mutable arrays API in Data.Array.Mutable.Linear, which provides functions like fromList ∷ [a] → (Vector aUr b) ⊸ Ur b. Here the initial buffer is always empty and b is Text. Since Text is Movable, Text and Ur Text are equivalent.

runBufferBS :: (Buffer %1 -> Buffer) %1 -> ByteString Source #

Same as runBuffer, but returning a UTF-8 encoded strict ByteString.

dupBuffer :: Buffer %1 -> (# Buffer, Buffer #) Source #

Duplicate builder. Feel free to process results in parallel threads. Similar to Dupable from linear-base.

It is a bit tricky to use because of 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 -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))
"foobar"

Note the unboxed tuple: Buffer is an unlifted datatype, so it cannot be put into (..., ...).

consumeBuffer :: Buffer %1 -> () Source #

Consume buffer linearly, similar to Consumable from linear-base.

eraseBuffer :: Buffer %1 -> Buffer Source #

Erase buffer's content, replacing it with an empty Text.

foldlIntoBuffer :: forall a. (Buffer %1 -> a -> Buffer) -> Buffer %1 -> [a] -> Buffer Source #

This is just a normal foldl', but with a linear arrow and unlifted accumulator.

newEmptyBuffer :: Buffer %1 -> (# Buffer, Buffer #) Source #

Create an empty Buffer.

The first Buffer is the input and the second is a new empty Buffer.

This function is needed in some situations, e.g. with justifyRight. The following example creates a utility function that justify a text and then append it to a buffer.

>>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples
>>> import Data.Text.Builder.Linear.Buffer
>>> import Data.Text (Text)
>>> :{
appendJustified :: Buffer %1 -> Text -> Buffer
appendJustified b t = case newEmptyBuffer b of
  -- Note that we need to create a new buffer from the text, in order
  -- to justify only the text and not the input buffer.
  (# b', empty #) -> b' >< justifyRight 12 ' ' (empty |> t)
:}
>>> runBuffer (\b -> (b |> "Test:") `appendJustified` "foo" `appendJustified` "bar")
"Test:         foo         bar"

Note: a previous buffer is necessary in order to create an empty buffer with the same characteristics.

(><) :: Buffer %1 -> Buffer %1 -> Buffer infix 6 Source #

Concatenate two Buffers, 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 -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))
"foobar"

Single character

(|>.) :: Buffer %1 -> Char -> Buffer infixl 6 Source #

Append Char to a Buffer by mutating it.

>>> :set -XLinearTypes
>>> runBuffer (\b -> b |>. 'q' |>. 'w')
"qw"

Warning: In contrast to singleton, it is the responsibility of the caller to sanitize surrogate code points with safe.

(.<|) :: Char -> Buffer %1 -> Buffer infixr 6 Source #

Prepend Char to a Buffer by mutating it.

>>> :set -XLinearTypes
>>> runBuffer (\b -> 'q' .<| 'w' .<| b)
"qw"

Warning: In contrast to singleton, it is the responsibility of the caller to sanitize surrogate code points with safe.

Multiple characters

Character replication

prependChars :: Word -> Char -> Buffer %1 -> Buffer Source #

Prepend a given count of a Char to a Buffer.

>>> :set -XLinearTypes
>>> runBuffer (\b -> prependChars 3 'x' (b |>. 'A'))
"xxxA"

appendChars :: Word -> Char -> Buffer %1 -> Buffer Source #

Apppend a given count of a Char to a Buffer.

>>> :set -XLinearTypes
>>> runBuffer (\b -> appendChars 3 'x' (b |>. 'A'))
"Axxx"

Text

(|>) :: Buffer %1 -> Text -> Buffer infixl 6 Source #

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"

(<|) :: Text -> Buffer %1 -> Buffer infixr 6 Source #

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"

(|>…) :: Buffer %1 -> Word -> Buffer infixr 6 Source #

Append given number of spaces.

(…<|) :: Word -> Buffer %1 -> Buffer infixr 6 Source #

Prepend given number of spaces.

Raw Addr#

(|>#) :: Buffer %1 -> Addr# -> Buffer infixl 6 Source #

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 and must be a valid UTF-8, these conditions are not checked.

(#<|) :: Addr# -> Buffer %1 -> Buffer infixr 6 Source #

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 and must be a valid UTF-8, these conditions are not checked.

Note: When the syntactic extensions UnboxedTuples or UnboxedSums are enabled, extra spaces are required when using parentheses: i.e. use ( #<| ) instead of (#<|). See the GHC User Guide chapter “[Unboxed types and primitive operations](https:/downloads.haskell.orgghclatestdocsusers_guideexts/primitives.html#unboxed-tuples)” for further information.

(<|#) :: Addr# -> Buffer %1 -> Buffer infixr 6 Source #

Deprecated: Use (#<|) instead

Alias for (#<|).

Padding

justifyLeft :: Word -> Char -> Buffer %1 -> Buffer Source #

Pad a builder from the right side to the specified length with the specified character.

>>> :set -XLinearTypes
>>> runBuffer (\b -> justifyLeft 10 'x' (appendChars 3 'A' b))
"AAAxxxxxxx"
>>> runBuffer (\b -> justifyLeft 5 'x' (appendChars 6 'A' b))
"AAAAAA"

Note that newEmptyBuffer is needed in some situations. See justifyRight for an example.

justifyRight :: Word -> Char -> Buffer %1 -> Buffer Source #

Pad a builder from the left side to the specified length with the specified character.

>>> :set -XLinearTypes
>>> runBuffer (\b -> justifyRight 10 'x' (appendChars 3 'A' b))
"xxxxxxxAAA"
>>> runBuffer (\b -> justifyRight 5 'x' (appendChars 6 'A' b))
"AAAAAA"

Note that newEmptyBuffer is needed in some situations. The following example creates a utility function that justify a text and then append it to a buffer.

>>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples
>>> import Data.Text.Builder.Linear.Buffer
>>> import Data.Text (Text)
>>> :{
appendJustified :: Buffer %1 -> Text -> Buffer
appendJustified b t = case newEmptyBuffer b of
  -- Note that we need to create a new buffer from the text, in order
  -- to justify only the text and not the input buffer.
  (# b', empty #) -> b' >< justifyRight 12 ' ' (empty |> t)
:}
>>> runBuffer (\b -> (b |> "Test:") `appendJustified` "foo" `appendJustified` "bar")
"Test:         foo         bar"

center :: Word -> Char -> Buffer %1 -> Buffer Source #

Center a builder to the specified length with the specified character.

>>> :set -XLinearTypes
>>> runBuffer (\b -> center 10 'x' (appendChars 3 'A' b))
"xxxxAAAxxx"
>>> runBuffer (\b -> center 5 'x' (appendChars 6 'A' b))
"AAAAAA"

Note that newEmptyBuffer is needed in some situations. See justifyRight for an example.

Number formatting

Decimal

(|>$) :: (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer infixl 6 Source #

Append decimal number.

($<|) :: (Integral a, FiniteBits a) => a -> Buffer %1 -> Buffer infixr 6 Source #

Prepend decimal number.

Hexadecimal

Lower-case

(|>&) :: (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer infixl 6 Source #

Append the lower-case hexadecimal represensation of a number.

Negative numbers are interpreted as their corresponding unsigned number, e.g.

>>> :set -XOverloadedStrings -XLinearTypes
>>> import Data.Int (Int8, Int16)
>>> runBuffer (\b -> b |>& (-1 :: Int8)) == "ff"
True
>>> runBuffer (\b -> b |>& (-1 :: Int16)) == "ffff"
True

(&<|) :: (Integral a, FiniteBits a) => a -> Buffer %1 -> Buffer infixr 6 Source #

Prepend the lower-case hexadecimal representation of a number.

Negative numbers are interpreted as their corresponding unsigned number, e.g.

>>> :set -XOverloadedStrings -XLinearTypes
>>> import Data.Int (Int8, Int16)
>>> runBuffer (\b -> (-1 :: Int8) &<| b) == "ff"
True
>>> runBuffer (\b -> (-1 :: Int16) &<| b) == "ffff"
True

Upper-case and padding

Note that no upper case hexadecimal formatting is provided. This package provides a minimal API with utility functions only for common cases. For other use cases, please adapt the code of this package, e.g. as shown in the Unicode code point example.

Double

(|>%) :: Buffer %1 -> Double -> Buffer infixl 6 Source #

Append double.

(%<|) :: Double -> Buffer %1 -> Buffer infixr 6 Source #

Prepend double.