{-# LANGUAGE BangPatterns, CPP, RankNTypes #-}{-# OPTIONS_HADDOCK not-home #-}------------------------------------------------------------------------------- |-- Module : Data.Text.Internal.Builder-- Copyright : (c) 2013 Bryan O'Sullivan-- (c) 2010 Johan Tibell-- License : BSD-style (see LICENSE)---- Maintainer : Johan Tibell <johan.tibell@gmail.com>-- Stability : experimental-- Portability : portable to Hugs and GHC---- /Warning/: this is an internal module, and does not have a stable-- API or name. Functions in this module may not check or enforce-- preconditions expected by public modules. Use at your own risk!---- Efficient construction of lazy @Text@ values. The principal-- operations on a @Builder@ are @singleton@, @fromText@, and-- @fromLazyText@, which construct new builders, and 'mappend', which-- concatenates two builders.---- To get maximum performance when building lazy @Text@ values using a-- builder, associate @mappend@ calls to the right. For example,-- prefer---- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')---- to---- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'---- as the latter associates @mappend@ to the left.-------------------------------------------------------------------------------moduleData.Text.Internal.Builder(-- * Public API-- ** The Builder typeBuilder ,toLazyText ,toLazyTextWith -- ** Constructing Builders,singleton ,fromText ,fromLazyText ,fromString -- ** Flushing the buffer state,flush -- * Internal functions,append' ,ensureFree ,writeN )whereimportControl.Monad.ST(ST,runST)importData.Monoid(Monoid(..))
#if !MIN_VERSION_base(4,11,0)
importData.Semigroup(Semigroup(..))
#endif
importData.Text.Internal (Text (..),safe )importData.Text.Internal.Lazy (smallChunkSize )importData.Text.Unsafe (inlineInterleaveST )importData.Text.Internal.Unsafe.Char (unsafeWrite )importPreludehiding(map,putChar)importqualifiedData.StringasStringimportqualifiedData.Text asSimportqualifiedData.Text.Array asAimportqualifiedData.Text.Lazy asL
#if defined(ASSERTS)
importGHC.Stack(HasCallStack)
#endif
-------------------------------------------------------------------------- | A @Builder@ is an efficient way to build lazy @Text@ values.-- There are several functions for constructing builders, but only one-- to inspect them: to extract any data, you have to turn them into-- lazy @Text@ values using @toLazyText@.---- Internally, a builder constructs a lazy @Text@ by filling arrays-- piece by piece. As each buffer is filled, it is \'popped\' off, to-- become a new chunk of the resulting lazy @Text@. All this is-- hidden from the user of the @Builder@.newtypeBuilder =Builder {-- Invariant (from Data.Text.Lazy):-- The lists include no null Texts.Builder
-> forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
runBuilder ::foralls .(Buffer s ->STs [S.Text ])->Buffer s ->STs [S.Text ]}instanceSemigroupBuilder where<> :: Builder -> Builder -> Builder
(<>)=Builder -> Builder -> Builder
append {-# INLINE(<>)#-}instanceMonoidBuilder wheremempty :: Builder
mempty=Builder
empty {-# INLINEmempty#-}mappend :: Builder -> Builder -> Builder
mappend=forall a. Semigroup a => a -> a -> a
(<>){-# INLINEmappend#-}mconcat :: [Builder] -> Builder
mconcat=forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldrforall a. Monoid a => a -> a -> a
mappendforall a. Monoid a => a
Data.Monoid.mempty{-# INLINEmconcat#-}-- | Performs replacement on invalid scalar values:---- >>> :set -XOverloadedStrings-- >>> "55555円" :: Builder-- "65533円"instanceString.IsStringBuilder wherefromString :: String -> Builder
fromString=String -> Builder
fromString {-# INLINEfromString#-}instanceShowBuilder whereshow :: Builder -> String
show=forall a. Show a => a -> String
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.Builder -> Text
toLazyText instanceEqBuilder whereBuilder
a == :: Builder -> Builder -> Bool
==Builder
b =Builder -> Text
toLazyText Builder
a forall a. Eq a => a -> a -> Bool
==Builder -> Text
toLazyText Builder
b instanceOrdBuilder whereBuilder
a <= :: Builder -> Builder -> Bool
<=Builder
b =Builder -> Text
toLazyText Builder
a forall a. Ord a => a -> a -> Bool
<=Builder -> Text
toLazyText Builder
b -------------------------------------------------------------------------- | /O(1)./ The empty @Builder@, satisfying---- * @'toLazyText' 'empty' = 'L.empty'@--empty ::Builder empty :: Builder
empty =(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder (\Buffer s -> ST s [Text]
k Buffer s
buf ->Buffer s -> ST s [Text]
k Buffer s
buf ){-# INLINEempty #-}-- | /O(1)./ A @Builder@ taking a single character, satisfying---- * @'toLazyText' ('singleton' c) = 'L.singleton' c@--singleton ::
#if defined(ASSERTS)
HasCallStack=>
#endif
Char->Builder singleton :: Char -> Builder
singleton Char
c =Int -> (forall s. MArray s -> Int -> ST s Int) -> Builder
writeAtMost Int
4forall a b. (a -> b) -> a -> b
$\MArray s
marr Int
o ->forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
o (Char -> Char
safe Char
c ){-# INLINEsingleton #-}-------------------------------------------------------------------------- | /O(1)./ The concatenation of two builders, an associative-- operation with identity 'empty', satisfying---- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@--append ::Builder ->Builder ->Builder append :: Builder -> Builder -> Builder
append (Builder forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
f )(Builder forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
g )=(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder (forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
g ){-# INLINE[0]append #-}-- TODO: Experiment to find the right threshold.copyLimit ::IntcopyLimit :: Int
copyLimit =Int
128-- This function attempts to merge small @Text@ values instead of-- treating each value as its own chunk. We may not always want this.-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying---- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@--fromText ::S.Text ->Builder fromText :: Text -> Builder
fromText t :: Text
t @(Text Array
arr Int
off Int
l )|Text -> Bool
S.null Text
t =Builder
empty |Int
l forall a. Ord a => a -> a -> Bool
<=Int
copyLimit =Int -> (forall s. MArray s -> Int -> ST s ()) -> Builder
writeN Int
l forall a b. (a -> b) -> a -> b
$\MArray s
marr Int
o ->forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
l MArray s
marr Int
o Array
arr Int
off |Bool
otherwise=Builder
flush Builder -> Builder -> Builder
`append` ([Text] -> [Text]) -> Builder
mapBuilder (Text
t forall a. a -> [a] -> [a]
:){-# INLINE[1]fromText #-}{-# RULES"fromText/pack"foralls .fromText (S.pack s )=fromString s #-}-- | /O(1)./ A Builder taking a @String@, satisfying---- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@---- Performs replacement on invalid scalar values:---- >>> fromString "55555円"-- "65533円"---- @since 1.2.0.0fromString ::String->Builder fromString :: String -> Builder
fromString String
str =(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder forall a b. (a -> b) -> a -> b
$\Buffer s -> ST s [Text]
k (Buffer MArray s
p0 Int
o0 Int
u0 Int
l0 )->letloop :: MArray s -> Int -> Int -> Int -> String -> ST s [Text]
loop !MArray s
marr !Int
o !Int
u !Int
l []=Buffer s -> ST s [Text]
k (forall s. MArray s -> Int -> Int -> Int -> Buffer s
Buffer MArray s
marr Int
o Int
u Int
l )loop MArray s
marr Int
o Int
u Int
l s :: String
s @(Char
c :String
cs )|Int
l forall a. Ord a => a -> a -> Bool
<=Int
3=doforall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
marr (Int
o forall a. Num a => a -> a -> a
+Int
u )Array
arr <-forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr let!t :: Text
t =Array -> Int -> Int -> Text
Text Array
arr Int
o Int
u MArray s
marr' <-forall s. Int -> ST s (MArray s)
A.new Int
chunkSize [Text]
ts <-forall s a. ST s a -> ST s a
inlineInterleaveST (MArray s -> Int -> Int -> Int -> String -> ST s [Text]
loop MArray s
marr' Int
0Int
0Int
chunkSize String
s )forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$Text
t forall a. a -> [a] -> [a]
:[Text]
ts |Bool
otherwise=doInt
n <-forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
o forall a. Num a => a -> a -> a
+Int
u )(Char -> Char
safe Char
c )MArray s -> Int -> Int -> Int -> String -> ST s [Text]
loop MArray s
marr Int
o (Int
u forall a. Num a => a -> a -> a
+Int
n )(Int
l forall a. Num a => a -> a -> a
-Int
n )String
cs inMArray s -> Int -> Int -> Int -> String -> ST s [Text]
loop MArray s
p0 Int
o0 Int
u0 Int
l0 String
str wherechunkSize :: Int
chunkSize =Int
smallChunkSize {-# INLINEfromString #-}-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying---- * @'toLazyText' ('fromLazyText' t) = t@--fromLazyText ::L.Text ->Builder fromLazyText :: Text -> Builder
fromLazyText Text
ts =Builder
flush Builder -> Builder -> Builder
`append` ([Text] -> [Text]) -> Builder
mapBuilder (Text -> [Text]
L.toChunks Text
ts forall a. [a] -> [a] -> [a]
++){-# INLINEfromLazyText #-}-------------------------------------------------------------------------- Our internal buffer typedataBuffer s =Buffer {-# UNPACK#-}!(A.MArray s ){-# UNPACK#-}!Int-- offset{-# UNPACK#-}!Int-- used units{-# UNPACK#-}!Int-- length left-------------------------------------------------------------------------- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default-- buffer size. The construction work takes place if and when the-- relevant part of the lazy @Text@ is demanded.toLazyText ::Builder ->L.Text toLazyText :: Builder -> Text
toLazyText =Int -> Builder -> Text
toLazyTextWith Int
smallChunkSize -- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given-- size for the initial buffer. The construction work takes place if-- and when the relevant part of the lazy @Text@ is demanded.---- If the initial buffer is too small to hold all data, subsequent-- buffers will be the default buffer size.toLazyTextWith ::Int->Builder ->L.Text toLazyTextWith :: Int -> Builder -> Text
toLazyTextWith Int
chunkSize Builder
m =[Text] -> Text
L.fromChunks (forall a. (forall s. ST s a) -> a
runSTforall a b. (a -> b) -> a -> b
$forall s. Int -> ST s (Buffer s)
newBuffer Int
chunkSize forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=Builder
-> forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
runBuilder (Builder
m Builder -> Builder -> Builder
`append` Builder
flush )(forall a b. a -> b -> a
const(forall (m :: * -> *) a. Monad m => a -> m a
return[])))-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,-- yielding a new chunk in the result lazy @Text@.flush ::Builder flush :: Builder
flush =(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder forall a b. (a -> b) -> a -> b
$\Buffer s -> ST s [Text]
k buf :: Buffer s
buf @(Buffer MArray s
p Int
o Int
u Int
l )->ifInt
u forall a. Eq a => a -> a -> Bool
==Int
0thenBuffer s -> ST s [Text]
k Buffer s
buf elsedoArray
arr <-forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
p let!b :: Buffer s
b =forall s. MArray s -> Int -> Int -> Int -> Buffer s
Buffer MArray s
p (Int
o forall a. Num a => a -> a -> a
+Int
u )Int
0Int
l !t :: Text
t =Array -> Int -> Int -> Text
Text Array
arr Int
o Int
u [Text]
ts <-forall s a. ST s a -> ST s a
inlineInterleaveST (Buffer s -> ST s [Text]
k Buffer s
b )forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$!Text
t forall a. a -> [a] -> [a]
:[Text]
ts {-# INLINE[1]flush #-}-- defer inlining so that flush/flush rule may fire.-------------------------------------------------------------------------- | Sequence an ST operation on the bufferwithBuffer ::(foralls .Buffer s ->STs (Buffer s ))->Builder withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
withBuffer forall s. Buffer s -> ST s (Buffer s)
f =(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder forall a b. (a -> b) -> a -> b
$\Buffer s -> ST s [Text]
k Buffer s
buf ->forall s. Buffer s -> ST s (Buffer s)
f Buffer s
buf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=Buffer s -> ST s [Text]
k {-# INLINEwithBuffer #-}-- | Get the size of the bufferwithSize ::(Int->Builder )->Builder withSize :: (Int -> Builder) -> Builder
withSize Int -> Builder
f =(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder forall a b. (a -> b) -> a -> b
$\Buffer s -> ST s [Text]
k buf :: Buffer s
buf @(Buffer MArray s
_Int
_Int
_Int
l )->Builder
-> forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
runBuilder (Int -> Builder
f Int
l )Buffer s -> ST s [Text]
k Buffer s
buf {-# INLINEwithSize #-}-- | Map the resulting list of texts.mapBuilder ::([S.Text ]->[S.Text ])->Builder mapBuilder :: ([Text] -> [Text]) -> Builder
mapBuilder [Text] -> [Text]
f =(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap[Text] -> [Text]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.)-------------------------------------------------------------------------- | Ensure that there are at least @n@ many elements available.ensureFree ::Int->Builder ensureFree :: Int -> Builder
ensureFree !Int
n =(Int -> Builder) -> Builder
withSize forall a b. (a -> b) -> a -> b
$\Int
l ->ifInt
n forall a. Ord a => a -> a -> Bool
<=Int
l thenBuilder
empty elseBuilder
flush Builder -> Builder -> Builder
`append'` (forall s. Buffer s -> ST s (Buffer s)) -> Builder
withBuffer (forall a b. a -> b -> a
const(forall s. Int -> ST s (Buffer s)
newBuffer (forall a. Ord a => a -> a -> a
maxInt
n Int
smallChunkSize ))){-# INLINE[0]ensureFree #-}writeAtMost ::Int->(foralls .A.MArray s ->Int->STs Int)->Builder writeAtMost :: Int -> (forall s. MArray s -> Int -> ST s Int) -> Builder
writeAtMost Int
n forall s. MArray s -> Int -> ST s Int
f =Int -> Builder
ensureFree Int
n Builder -> Builder -> Builder
`append'` (forall s. Buffer s -> ST s (Buffer s)) -> Builder
withBuffer (forall s.
(MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
writeBuffer forall s. MArray s -> Int -> ST s Int
f ){-# INLINE[0]writeAtMost #-}-- | Ensure that @n@ many elements are available, and then use @f@ to-- write some elements into the memory.writeN ::Int->(foralls .A.MArray s ->Int->STs ())->Builder writeN :: Int -> (forall s. MArray s -> Int -> ST s ()) -> Builder
writeN Int
n forall s. MArray s -> Int -> ST s ()
f =Int -> (forall s. MArray s -> Int -> ST s Int) -> Builder
writeAtMost Int
n (\MArray s
p Int
o ->forall s. MArray s -> Int -> ST s ()
f MArray s
p Int
o forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>forall (m :: * -> *) a. Monad m => a -> m a
returnInt
n ){-# INLINEwriteN #-}writeBuffer ::(A.MArray s ->Int->STs Int)->Buffer s ->STs (Buffer s )writeBuffer :: forall s.
(MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
writeBuffer MArray s -> Int -> ST s Int
f (Buffer MArray s
p Int
o Int
u Int
l )=doInt
n <-MArray s -> Int -> ST s Int
f MArray s
p (Int
o forall a. Num a => a -> a -> a
+Int
u )forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$!forall s. MArray s -> Int -> Int -> Int -> Buffer s
Buffer MArray s
p Int
o (Int
u forall a. Num a => a -> a -> a
+Int
n )(Int
l forall a. Num a => a -> a -> a
-Int
n ){-# INLINEwriteBuffer #-}newBuffer ::Int->STs (Buffer s )newBuffer :: forall s. Int -> ST s (Buffer s)
newBuffer Int
size =doMArray s
arr <-forall s. Int -> ST s (MArray s)
A.new Int
size forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$!forall s. MArray s -> Int -> Int -> Int -> Buffer s
Buffer MArray s
arr Int
0Int
0Int
size {-# INLINEnewBuffer #-}-------------------------------------------------------------------------- Some nice rules for Builder-- This function makes GHC understand that 'writeN' and 'ensureFree'-- are *not* recursive in the precense of the rewrite rules below.-- This is not needed with GHC 7+.append' ::Builder ->Builder ->Builder append' :: Builder -> Builder -> Builder
append' (Builder forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
f )(Builder forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
g )=(forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text])
-> Builder
Builder (forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
g ){-# INLINEappend' #-}{-# RULES"append/writeAtMost"foralla b (f ::foralls .A.MArray s ->Int->STs Int)(g ::foralls .A.MArray s ->Int->STs Int)ws .append (writeAtMost a f )(append (writeAtMost b g )ws )=append (writeAtMost (a +b )(\marr o ->f marr o >>=\n ->g marr (o +n )>>=\m ->lets =n +m ins `seq`returns ))ws "writeAtMost/writeAtMost"foralla b (f ::foralls .A.MArray s ->Int->STs Int)(g ::foralls .A.MArray s ->Int->STs Int).append (writeAtMost a f )(writeAtMost b g )=writeAtMost (a +b )(\marr o ->f marr o >>=\n ->g marr (o +n )>>=\m ->lets =n +m ins `seq`returns )"ensureFree/ensureFree"foralla b .append (ensureFree a )(ensureFree b )=ensureFree (maxa b )"flush/flush"append flush flush =flush #-}