{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.Text.Internal.Builder
(
Builder
, toLazyText
, toLazyTextWith
, singleton
, fromText
, fromLazyText
, fromString
, flush
, append'
, ensureFree
, writeN
) where
import Control.Monad.ST (ST, runST)
import Data.Monoid (Monoid(..))
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Text.Internal (Text(..), safe)
import Data.Text.Internal.Lazy (smallChunkSize)
import Data.Text.Unsafe (inlineInterleaveST)
import Data.Text.Internal.Unsafe.Char (unsafeWrite)
import Prelude hiding (map, putChar)
import qualified Data.String as String
import qualified Data.Text as S
import qualified Data.Text.Array as A
import qualified Data.Text.Lazy as L
#if defined(ASSERTS)
import GHC.Stack (HasCallStack)
#endif
newtype Builder = Builder {
Builder
-> forall s. (Buffer s -> ST s [Text]) -> Buffer s -> ST s [Text]
runBuilder :: forall s. (Buffer s -> ST s [S.Text])
-> Buffer s
-> ST s [S.Text]
}
instance Semigroup Builder where
<> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
append
{-# INLINE (<>) #-}
instance Monoid Builder where
mempty :: Builder
mempty = Builder
empty
{-# INLINE mempty #-}
mappend :: Builder -> Builder -> Builder
mappend = forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
mconcat :: [Builder] -> Builder
mconcat = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
Data.Monoid.mempty
{-# INLINE mconcat #-}
instance String.IsString Builder where
fromString :: String -> Builder
fromString = String -> Builder
fromString
{-# INLINE fromString #-}
instance Show Builder where
show :: Builder -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
instance Eq Builder where
Builder
a == :: Builder -> Builder -> Bool
== Builder
b = Builder -> Text
toLazyText Builder
a forall a. Eq a => a -> a -> Bool
== Builder -> Text
toLazyText Builder
b
instance Ord Builder where
Builder
a <= :: Builder -> Builder -> Bool
<= Builder
b = Builder -> Text
toLazyText Builder
a forall a. Ord a => a -> a -> Bool
<= Builder -> Text
toLazyText Builder
b
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)
{-# INLINE empty #-}
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
2 forall 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)
{-# INLINE singleton #-}
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 #-}
copyLimit :: Int
copyLimit :: Int
copyLimit = Int
128
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. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
marr Int
o Array
arr Int
off (Int
lforall a. Num a => a -> a -> a
+Int
o)
| 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" forall s .
fromText (S.pack s) = fromString s
#-}
fromString :: 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) ->
let loop :: 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
1 = do
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
0 Int
0 Int
chunkSize String
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
t forall a. a -> [a] -> [a]
: [Text]
ts
| Bool
otherwise = do
Int
n <- forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
oforall 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
uforall a. Num a => a -> a -> a
+Int
n) (Int
lforall a. Num a => a -> a -> a
-Int
n) String
cs
in MArray s -> Int -> Int -> Int -> String -> ST s [Text]
loop MArray s
p0 Int
o0 Int
u0 Int
l0 String
str
where
chunkSize :: Int
chunkSize = Int
smallChunkSize
{-# INLINE fromString #-}
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]
++)
{-# INLINE fromLazyText #-}
data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
toLazyText :: Builder -> L.Text
toLazyText :: Builder -> Text
toLazyText = Int -> Builder -> Text
toLazyTextWith Int
smallChunkSize
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
runST forall 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 [])))
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) ->
if Int
u forall a. Eq a => a -> a -> Bool
== Int
0
then Buffer s -> ST s [Text]
k Buffer s
buf
else do Array
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
oforall a. Num a => a -> a -> a
+Int
u) Int
0 Int
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
return forall a b. (a -> b) -> a -> b
$! Text
t forall a. a -> [a] -> [a]
: [Text]
ts
{-# INLINE [1] flush #-}
withBuffer :: (forall s. Buffer s -> ST s (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
{-# INLINE withBuffer #-}
withSize :: (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
{-# INLINE withSize #-}
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
.)
ensureFree :: Int -> Builder
ensureFree :: Int -> Builder
ensureFree !Int
n = (Int -> Builder) -> Builder
withSize forall a b. (a -> b) -> a -> b
$ \ Int
l ->
if Int
n forall a. Ord a => a -> a -> Bool
<= Int
l
then Builder
empty
else Builder
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
max Int
n Int
smallChunkSize)))
{-# INLINE [0] ensureFree #-}
writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s 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 #-}
writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> 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
return Int
n)
{-# INLINE writeN #-}
writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (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) = do
Int
n <- MArray s -> Int -> ST s Int
f MArray s
p (Int
oforall a. Num a => a -> a -> a
+Int
u)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall s. MArray s -> Int -> Int -> Int -> Buffer s
Buffer MArray s
p Int
o (Int
uforall a. Num a => a -> a -> a
+Int
n) (Int
lforall a. Num a => a -> a -> a
-Int
n)
{-# INLINE writeBuffer #-}
newBuffer :: Int -> ST s (Buffer s)
newBuffer :: forall s. Int -> ST s (Buffer s)
newBuffer Int
size = do
MArray s
arr <- forall s. Int -> ST s (MArray s)
A.new Int
size
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall s. MArray s -> Int -> Int -> Int -> Buffer s
Buffer MArray s
arr Int
0 Int
0 Int
size
{-# INLINE newBuffer #-}
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 append' #-}
{-# RULES
"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
(g::forall s. A.MArray s -> Int -> ST s 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 ->
let s = n+m in s `seq` return s)) ws
"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
(g::forall s. A.MArray s -> Int -> ST s Int).
append (writeAtMost a f) (writeAtMost b g) =
writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
g marr (o+n) >>= \ m ->
let s = n+m in s `seq` return s)
"ensureFree/ensureFree" forall a b .
append (ensureFree a) (ensureFree b) = ensureFree (max a b)
"flush/flush"
append flush flush = flush
#-}