module Data.Text.Builder.Linear.Core
( Buffer
, runBuffer
, dupBuffer
, consumeBuffer
, eraseBuffer
, byteSizeOfBuffer
, lengthOfBuffer
, dropBuffer
, takeBuffer
, appendBounded
, appendExact
, prependBounded
, prependExact
, (><)
) where
import qualified Data.Text as T
import Data.Text.Array (Array(..), MArray(..))
import qualified Data.Text.Array as A
import Data.Text.Internal (Text(..))
import GHC.Exts (unsafeCoerce#, Int(..), sizeofByteArray#)
#if MIN_VERSION_base(4,16,0)
import GHC.Exts (TYPE, Levity(..), RuntimeRep(..))
#endif
import GHC.ST (ST(..), runST)
#if MIN_VERSION_base(4,16,0)
data Buffer ∷ TYPE ('BoxedRep 'Unlifted) where
#else
data Buffer where
#endif
Buffer ∷ {-# UNPACK #-} !Text → Buffer
unBuffer ∷ Buffer ⊸ Text
unBuffer :: Buffer %1 -> Text
unBuffer (Buffer Text
x) = Text
x
runBuffer ∷ (Buffer ⊸ Buffer) ⊸ Text
runBuffer :: (Buffer %1 -> Buffer) %1 -> Text
runBuffer Buffer %1 -> Buffer
f = Buffer %1 -> Text
unBuffer (Buffer %1 -> Buffer
f (Text -> Buffer
Buffer Text
forall a. Monoid a => a
mempty))
dupBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)
dupBuffer :: Buffer %1 -> (# Buffer, Buffer #)
dupBuffer (Buffer Text
x) = (# Text -> Buffer
Buffer Text
x, Text -> Buffer
Buffer (Text -> Text
T.copy Text
x) #)
consumeBuffer ∷ Buffer ⊸ ()
consumeBuffer :: Buffer %1 -> ()
consumeBuffer Buffer{} = ()
eraseBuffer ∷ Buffer ⊸ Buffer
eraseBuffer :: Buffer %1 -> Buffer
eraseBuffer Buffer{} = Text -> Buffer
Buffer Text
forall a. Monoid a => a
mempty
byteSizeOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)
byteSizeOfBuffer :: Buffer %1 -> (# Buffer, Word #)
byteSizeOfBuffer (Buffer t :: Text
t@(Text Array
_ Int
_ Int
len)) = (# Text -> Buffer
Buffer Text
t, Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len #)
lengthOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)
lengthOfBuffer :: Buffer %1 -> (# Buffer, Word #)
lengthOfBuffer (Buffer Text
t) = (# Text -> Buffer
Buffer Text
t, Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
t) #)
dropBuffer ∷ Word → Buffer ⊸ Buffer
dropBuffer :: Word -> Buffer %1 -> Buffer
dropBuffer Word
nChar (Buffer t :: Text
t@(Text Array
arr Int
off Int
len))
| Int
nByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer (Array -> Int -> Int -> Text
Text Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int
0)
| Bool
otherwise = Text -> Buffer
Buffer (Array -> Int -> Int -> Text
Text Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nByte) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nByte))
where
nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nChar) Text
t
takeBuffer ∷ Word → Buffer ⊸ Buffer
takeBuffer :: Word -> Buffer %1 -> Buffer
takeBuffer Word
nChar (Buffer t :: Text
t@(Text Array
arr Int
off Int
_))
| Int
nByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer Text
t
| Bool
otherwise = Text -> Buffer
Buffer (Array -> Int -> Int -> Text
Text Array
arr Int
off Int
nByte)
where
nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nChar) Text
t
appendBounded
∷ Int
→ (forall s. MArray s → Int → ST s Int)
→ Buffer
⊸ Buffer
appendBounded :: Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
appender (Buffer (Text Array
dst Int
dstOff Int
dstLen)) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let dstFullLen :: Int
dstFullLen = Array -> Int
sizeofByteArray Array
dst
newFullLen :: Int
newFullLen = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen)
MArray s
newM ← if Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstFullLen
then Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
dst
else do
MArray s
tmpM ← Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
newFullLen
Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
dstLen MArray s
tmpM Int
dstOff Array
dst Int
dstOff
MArray s -> ST s (MArray s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MArray s
tmpM
Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
appender MArray s
newM (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
Text -> ST s Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
dstOff (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen)
{-# INLINE appendBounded #-}
appendExact
∷ Int
→ (forall s. MArray s → Int → ST s ())
→ Buffer
⊸ Buffer
appendExact :: Int
-> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
appendExact Int
srcLen forall s. MArray s -> Int -> ST s ()
appender = Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded
Int
srcLen
(\MArray s
dst Int
dstOff → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff ST s () -> ST s Int -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
{-# INLINE appendExact #-}
prependBounded
∷ Int
→ (forall s. MArray s → Int → ST s Int)
→ (forall s. MArray s → Int → ST s Int)
→ Buffer
⊸ Buffer
prependBounded :: Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
prepender forall s. MArray s -> Int -> ST s Int
appender (Buffer (Text Array
dst Int
dstOff Int
dstLen))
| Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstOff = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
MArray s
newM ← Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
dst
Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
prepender MArray s
newM Int
dstOff
Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
Text -> ST s Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) (Int
srcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
| Bool
otherwise = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let dstFullLen :: Int
dstFullLen = Array -> Int
sizeofByteArray Array
dst
newOff :: Int
newOff = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen
newFullLen :: Int
newFullLen = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
newOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
dstFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstLen)
MArray s
newM ← Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
newFullLen
Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
appender MArray s
newM Int
newOff
Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
dstLen MArray s
newM (Int
newOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen) Array
dst Int
dstOff
Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
Text -> ST s Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
newOff (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen)
{-# INLINE prependBounded #-}
prependExact
∷ Int
→ (forall s. MArray s → Int → ST s ())
→ Buffer
⊸ Buffer
prependExact :: Int
-> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
prependExact Int
srcLen forall s. MArray s -> Int -> ST s ()
appender = Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded
Int
srcLen
(\MArray s
dst Int
dstOff → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) ST s () -> ST s Int -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
(\MArray s
dst Int
dstOff → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff ST s () -> ST s Int -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
{-# INLINE prependExact #-}
unsafeThaw ∷ Array → ST s (MArray s)
unsafeThaw :: forall s. Array -> ST s (MArray s)
unsafeThaw (ByteArray ByteArray#
a) = STRep s (MArray s) -> ST s (MArray s)
forall s a. STRep s a -> ST s a
ST (STRep s (MArray s) -> ST s (MArray s))
-> STRep s (MArray s) -> ST s (MArray s)
forall a b. (a -> b) -> a -> b
$ \State# s
s# →
(# State# s
s#, MutableByteArray# s -> MArray s
forall s. MutableByteArray# s -> MArray s
MutableByteArray (ByteArray# -> MutableByteArray# s
unsafeCoerce# ByteArray#
a) #)
sizeofByteArray ∷ Array → Int
sizeofByteArray :: Array -> Int
sizeofByteArray (ByteArray ByteArray#
a) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
a)
(><) ∷ Buffer ⊸ Buffer ⊸ Buffer
infix 6 ><
Buffer (Text Array
left Int
leftOff Int
leftLen) >< :: Buffer %1 -> Buffer %1 -> Buffer
>< Buffer (Text Array
right Int
rightOff Int
rightLen) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let leftFullLen :: Int
leftFullLen = Array -> Int
sizeofByteArray Array
left
rightFullLen :: Int
rightFullLen = Array -> Int
sizeofByteArray Array
right
canCopyToLeft :: Bool
canCopyToLeft = Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
leftFullLen
canCopyToRight :: Bool
canCopyToRight = Int
leftLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rightOff
shouldCopyToLeft :: Bool
shouldCopyToLeft = Bool
canCopyToLeft Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
canCopyToRight Bool -> Bool -> Bool
|| Int
leftLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rightLen)
if Bool
shouldCopyToLeft then do
MArray s
newM ← Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
left
Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
rightLen MArray s
newM (Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) Array
right Int
rightOff
Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
Text -> ST s Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
leftOff (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
else if Bool
canCopyToRight then do
MArray s
newM ← Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
right
Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
leftLen MArray s
newM (Int
rightOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftLen) Array
left Int
leftOff
Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
Text -> ST s Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new (Int
rightOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftLen) (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
else do
let fullLen :: Int
fullLen = Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
rightFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightLen)
MArray s
newM ← Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
fullLen
Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
leftLen MArray s
newM Int
leftOff Array
left Int
leftOff
Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
rightLen MArray s
newM (Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) Array
right Int
rightOff
Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
Text -> ST s Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
leftOff (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)