44-- Licence: BSD3
55-- Maintainer: Andrew Lelechenko <[email protected] > 66--
7- -- Internal routines for 'Buffer' manipulations.
7+ -- Internal routines for t 'Buffer' manipulations.
88module Data.Text.Builder.Linear.Internal (
99 -- * Type
1010 Buffer ,
@@ -41,15 +41,15 @@ import GHC.ST (ST (..), runST)
4141
4242import Data.Text.Builder.Linear.Array
4343
44- -- | Internally 'Buffer' is a mutable buffer.
45- -- If a client gets hold of a variable of type 'Buffer',
44+ -- | Internally t 'Buffer' is a mutable buffer.
45+ -- If a client gets hold of a variable of type t 'Buffer',
4646-- they'd be able to pass a mutable buffer to concurrent threads.
4747-- That's why API below is carefully designed to prevent such possibility:
48- -- clients always work with linear functions 'Buffer' ⊸ 'Buffer' instead
49- -- and run them on an empty 'Buffer' to extract results.
48+ -- clients always work with linear functions t 'Buffer' ⊸ t 'Buffer' instead
49+ -- and run them on an empty t 'Buffer' to extract results.
5050--
5151-- In terms of [@linear-base@](https://hackage.haskell.org/package/linear-base)
52- -- 'Buffer' is [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)
52+ -- t 'Buffer' is [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)
5353-- (see 'consumeBuffer')
5454-- and [@Dupable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Dupable)
5555-- (see 'dupBuffer'),
@@ -63,19 +63,19 @@ import Data.Text.Builder.Linear.Array
6363-- Remember: this is a strict builder, so on contrary to "Data.Text.Lazy.Builder"
6464-- for optimal performance you should use strict left folds instead of lazy right ones.
6565--
66- -- 'Buffer' is an unlifted datatype,
66+ -- t 'Buffer' is an unlifted datatype,
6767-- so you can put it into an unboxed tuple @(# ..., ... #)@,
6868-- but not into @(..., ...)@.
6969data Buffer ∷ TYPE ('BoxedRep 'Unlifted) where
7070 Buffer ∷ {-# UNPACK #-} ! Text → Buffer
7171
72- -- | Unwrap 'Buffer', no-op.
72+ -- | Unwrap t 'Buffer', no-op.
7373-- Most likely, this is not the function you're looking for
7474-- and you need 'runBuffer' instead.
7575unBuffer ∷ Buffer ⊸ Text
7676unBuffer (Buffer x) = x
7777
78- -- | Run a linear function on an empty 'Buffer', producing a strict 'Text'.
78+ -- | Run a linear function on an empty t 'Buffer', producing a strict t 'Text'.
7979--
8080-- Be careful to write @runBuffer (\\b -> ...)@ instead of @runBuffer $ \\b -> ...@,
8181-- because current implementation of linear types lacks special support for '($)'.
@@ -88,10 +88,8 @@ unBuffer (Buffer x) = x
8888-- 'runBuffer' is similar in spirit to mutable arrays API in
8989-- [@Data.Array.Mutable.Linear@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html),
9090-- which provides functions like
91- -- [@fromList@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html#v:fromList) ∷ [@a@] → (@Vector@ @a@ ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) b) ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) @b@.
92- -- Here the initial buffer is always empty and @b@ is 'Text'. Since 'Text' is
93- -- [@Movable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Movable),
94- -- 'Text' and [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) 'Text' are equivalent.
91+ -- [@fromList@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html#v:fromList) ∷ @Movable@ @b@ ⇒ [@a@] → (@Array@ @a@ ⊸ @b@) ⊸ @b@.
92+ -- Here the initial buffer is always empty and @b@ is t'Text'.
9593runBuffer ∷ (Buffer ⊸ Buffer ) ⊸ Text
9694runBuffer f = unBuffer (shrinkBuffer (f (Buffer mempty )))
9795{-# NOINLINE runBuffer #-}
@@ -100,7 +98,7 @@ runBuffer f = unBuffer (shrinkBuffer (f (Buffer mempty)))
10098 See https://github.com/Bodigrim/linear-builder/issues/19
10199 and https://github.com/tweag/linear-base/pull/187#discussion_r489081926
102100 for the discussion why NOINLINE here and below in 'runBufferBS' is necessary.
103- Without it CSE (common subexpression elimination) can pull out 'Buffer's from
101+ Without it CSE (common subexpression elimination) can pull out t 'Buffer's from
104102 different 'runBuffer's and share them, which is absolutely not what we want.
105103-}
106104
@@ -126,9 +124,9 @@ memptyPinned = runST $ do
126124 arr ← A. unsafeFreeze marr
127125 pure $ Text arr 0 0
128126
129- -- | Create an empty 'Buffer'.
127+ -- | Create an empty t 'Buffer'.
130128--
131- -- The first 'Buffer' is the input and the second is a new empty 'Buffer'.
129+ -- The first t 'Buffer' is the input and the second is a new empty t 'Buffer'.
132130--
133131-- This function is needed in some situations, e.g. with
134132-- 'Data.Text.Builder.Linear.Buffer.justifyRight'. The following example creates
@@ -172,7 +170,7 @@ newEmptyBuffer (Buffer t@(Text arr _ _)) =
172170-- >>> runBuffer (\b -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))
173171-- "foobar"
174172--
175- -- Note the unboxed tuple: 'Buffer' is an unlifted datatype,
173+ -- Note the unboxed tuple: t 'Buffer' is an unlifted datatype,
176174-- so it cannot be put into @(..., ...)@.
177175dupBuffer ∷ Buffer ⊸ (# Buffer , Buffer # )
178176dupBuffer (Buffer x) = (# Buffer x, Buffer (T. copy x) # )
@@ -184,7 +182,7 @@ dupBuffer (Buffer x) = (# Buffer x, Buffer (T.copy x) #)
184182consumeBuffer ∷ Buffer ⊸ ()
185183consumeBuffer Buffer {} = ()
186184
187- -- | Erase buffer's content, replacing it with an empty 'Text'.
185+ -- | Erase buffer's content, replacing it with an empty t 'Text'.
188186eraseBuffer ∷ Buffer ⊸ Buffer
189187eraseBuffer (Buffer (Text arr _ _)) =
190188 Buffer (if isPinned arr then memptyPinned else mempty )
@@ -208,23 +206,23 @@ byteSizeOfBuffer (Buffer t@(Text _ _ len)) = (# Buffer t, fromIntegral len #)
208206lengthOfBuffer ∷ Buffer ⊸ (# Buffer , Word # )
209207lengthOfBuffer (Buffer t) = (# Buffer t, fromIntegral (T. length t) # )
210208
211- -- | Slice 'Buffer' by dropping given number of 'Char's.
209+ -- | Slice t 'Buffer' by dropping given number of 'Char's.
212210dropBuffer ∷ Word → Buffer ⊸ Buffer
213211dropBuffer nChar (Buffer t@ (Text arr off len))
214212 | nByte <= 0 = Buffer (Text arr (off + len) 0 )
215213 | otherwise = Buffer (Text arr (off + nByte) (len - nByte))
216214 where
217215 nByte = T. measureOff (fromIntegral nChar) t
218216
219- -- | Slice 'Buffer' by taking given number of 'Char's.
217+ -- | Slice t 'Buffer' by taking given number of 'Char's.
220218takeBuffer ∷ Word → Buffer ⊸ Buffer
221219takeBuffer nChar (Buffer t@ (Text arr off _))
222220 | nByte <= 0 = Buffer t
223221 | otherwise = Buffer (Text arr off nByte)
224222 where
225223 nByte = T. measureOff (fromIntegral nChar) t
226224
227- -- | Low-level routine to append data of unknown size to a 'Buffer'.
225+ -- | Low-level routine to append data of unknown size to a t 'Buffer'.
228226appendBounded
229227 ∷ Int
230228 -- ^ Upper bound for the number of bytes, written by an action
@@ -248,7 +246,7 @@ appendBounded maxSrcLen appender (Buffer (Text dst dstOff dstLen)) = Buffer $ ru
248246 pure $ Text new dstOff (dstLen + srcLen)
249247{-# INLINE appendBounded #-}
250248
251- -- | Low-level routine to append data of unknown size to a 'Buffer', giving
249+ -- | Low-level routine to append data of unknown size to a t 'Buffer', giving
252250-- the action the choice between two strategies.
253251--
254252-- See also: 'appendBounded'.
@@ -301,7 +299,7 @@ appendBounded' maxSrcLen writer (Buffer (Text dst dstOff dstLen)) = Buffer $ run
301299 pure $ Text new dstOff' (dstLen + srcLen)
302300{-# INLINE appendBounded' #-}
303301
304- -- | Low-level routine to append data of known size to a 'Buffer'.
302+ -- | Low-level routine to append data of known size to a t 'Buffer'.
305303appendExact
306304 ∷ Int
307305 -- ^ Exact number of bytes, written by an action
@@ -315,7 +313,7 @@ appendExact srcLen appender =
315313 (\ dst dstOff → appender dst dstOff >> pure srcLen)
316314{-# INLINE appendExact #-}
317315
318- -- | Low-level routine to prepend data of unknown size to a 'Buffer'.
316+ -- | Low-level routine to prepend data of unknown size to a t 'Buffer'.
319317prependBounded
320318 ∷ Int
321319 -- ^ Upper bound for the number of bytes, written by an action
@@ -344,7 +342,7 @@ prependBounded maxSrcLen prepender appender (Buffer (Text dst dstOff dstLen))
344342 pure $ Text new newOff (dstLen + srcLen)
345343{-# INLINE prependBounded #-}
346344
347- -- | Low-level routine to prepend data of unknown size to a 'Buffer'.
345+ -- | Low-level routine to prepend data of unknown size to a t 'Buffer'.
348346--
349347-- Contrary to 'prependBounded', only use a prepend action.
350348--
@@ -374,7 +372,7 @@ prependBounded' maxSrcLen prepender (Buffer (Text dst dstOff dstLen))
374372 pure $ Text new (off - srcLen) (dstLen + srcLen)
375373{-# INLINE prependBounded' #-}
376374
377- -- | Low-level routine to append data of known size to a 'Buffer'.
375+ -- | Low-level routine to append data of known size to a t 'Buffer'.
378376prependExact
379377 ∷ Int
380378 -- ^ Exact number of bytes, written by an action
@@ -389,7 +387,7 @@ prependExact srcLen appender =
389387 (\ dst dstOff → appender dst dstOff >> pure srcLen)
390388{-# INLINE prependExact #-}
391389
392- -- | Concatenate two 'Buffer's, potentially mutating both of them.
390+ -- | Concatenate two t 'Buffer's, potentially mutating both of them.
393391--
394392-- You likely need to use 'dupBuffer' to get hold on two builders at once:
395393--
0 commit comments