Copyright | (c) 2022 Andrew Lelechenko (c) 2023 Pierre Le Marre |
---|---|
License | BSD3 |
Maintainer | Andrew Lelechenko <andrew.lelechenko@gmail.com> |
Safe Haskell | Safe-Inferred |
Language | GHC2021 |
Data.Text.Builder.Linear.Buffer
Synopsis
- data Buffer :: TYPE ('BoxedRep 'Unlifted)
- runBuffer :: (Buffer %1 -> Buffer) %1 -> Text
- runBufferBS :: (Buffer %1 -> Buffer) %1 -> ByteString
- dupBuffer :: Buffer %1 -> (# Buffer, Buffer #)
- consumeBuffer :: Buffer %1 -> ()
- eraseBuffer :: Buffer %1 -> Buffer
- foldlIntoBuffer :: forall a. (Buffer %1 -> a -> Buffer) -> Buffer %1 -> [a] -> Buffer
- newEmptyBuffer :: Buffer %1 -> (# Buffer, Buffer #)
- (><) :: Buffer %1 -> Buffer %1 -> Buffer
- (|>.) :: Buffer %1 -> Char -> Buffer
- (.<|) :: Char -> Buffer %1 -> Buffer
- prependChars :: Word -> Char -> Buffer %1 -> Buffer
- appendChars :: Word -> Char -> Buffer %1 -> Buffer
- (|>) :: Buffer %1 -> Text -> Buffer
- (<|) :: Text -> Buffer %1 -> Buffer
- (|>…) :: Buffer %1 -> Word -> Buffer
- (…<|) :: Word -> Buffer %1 -> Buffer
- (|>#) :: Buffer %1 -> Addr# -> Buffer
- (#<|) :: Addr# -> Buffer %1 -> Buffer
- (<|#) :: Addr# -> Buffer %1 -> Buffer
- justifyLeft :: Word -> Char -> Buffer %1 -> Buffer
- justifyRight :: Word -> Char -> Buffer %1 -> Buffer
- center :: Word -> Char -> Buffer %1 -> Buffer
- (|>$) :: (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer
- ($<|) :: (Integral a, FiniteBits a) => a -> Buffer %1 -> Buffer
- (|>$$) :: Integral a => Buffer %1 -> a -> Buffer
- ($$<|) :: Integral a => a -> Buffer %1 -> Buffer
- (|>&) :: (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer
- (&<|) :: (Integral a, FiniteBits a) => a -> Buffer %1 -> Buffer
- (|>%) :: Buffer %1 -> Double -> Buffer
- (%<|) :: Double -> Buffer %1 -> Buffer
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 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.
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
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.
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
.
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` "AAA" `appendJustified` "BBBBBBB")
"Test: AAA BBBBBBB"
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 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 -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))
"foobar"
Single character
Multiple characters
Character replication
Text
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 \NUL
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 \NUL
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”
for further information.#<|
)
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` "AAA" `appendJustified` "BBBBBBB")
"Test: AAA BBBBBBB"
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
Bounded numbers
(|>$) :: (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer infixl 6 Source #
Append the decimal representation of a bounded integral number.
($<|) :: (Integral a, FiniteBits a) => a -> Buffer %1 -> Buffer infixr 6 Source #
Prepend the decimal representation of a bounded integral number.
Unbounded numbers
(|>$$) :: Integral a => Buffer %1 -> a -> Buffer infixl 6 Source #
Append the decimal representation of an unbounded integral number.
Since: 0.1.3
($$<|) :: Integral a => a -> Buffer %1 -> Buffer infixr 6 Source #
Prepend the decimal representation of an unbounded integral number.
Since: 0.1.3
Hexadecimal
Lower-case
(|>&) :: (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer infixl 6 Source #
Append the lower-case hexadecimal representation of a bounded integral number.
Negative numbers are interpreted as their corresponding unsigned number:
>>>
: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 bounded integral number.
Negative numbers are interpreted as their corresponding unsigned number:
>>>
: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 neither upper case nor padded 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.