module Data.Text.Internal.StrictBuilder
( StrictBuilder(..)
, toText
, fromChar
, fromText
, unsafeFromByteString
, unsafeFromWord8
) where
import Control.Monad.ST (ST, runST)
import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
import Data.Functor (void)
import Data.Word (Word8)
import Data.ByteString (ByteString)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Text.Internal (Text(..), empty, safe)
import Data.Text.Internal.ByteStringCompat (withBS)
import Data.Text.Internal.Encoding.Utf8 (utf8Length)
import Data.Text.Internal.Unsafe (unsafeWithForeignPtr)
import qualified Data.ByteString as B
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Unsafe.Char as Char
data StrictBuilder = StrictBuilder
{ sbLength :: !Int
, sbWrite :: forall s. A.MArray s -> Int -> ST s ()
}
toText :: StrictBuilder -> Text
toText (StrictBuilder 0 _) = empty
toText (StrictBuilder n write) = runST (do
dst <- A.new n
write dst 0
arr <- A.unsafeFreeze dst
pure (Text arr 0 n))
instance Semigroup StrictBuilder where
(<>) = appendRStrictBuilder
instance Monoid StrictBuilder where
mempty = emptyStrictBuilder
mappend = (<>)
emptyStrictBuilder :: StrictBuilder
emptyStrictBuilder = StrictBuilder 0 (\_ _ -> pure ())
appendRStrictBuilder :: StrictBuilder -> StrictBuilder -> StrictBuilder
appendRStrictBuilder (StrictBuilder 0 _) b2 = b2
appendRStrictBuilder b1 (StrictBuilder 0 _) = b1
appendRStrictBuilder (StrictBuilder n1 write1) (StrictBuilder n2 write2) =
StrictBuilder (n1 + n2) (\dst ofs -> do
write2 dst (ofs + n1)
write1 dst ofs)
copyFromByteString :: A.MArray s -> Int -> ByteString -> ST s ()
copyFromByteString dst ofs src = withBS src $ \ srcFPtr len ->
unsafeIOToST $ unsafeWithForeignPtr srcFPtr $ \ srcPtr -> do
unsafeSTToIO $ A.copyFromPointer dst ofs srcPtr len
unsafeFromByteString :: ByteString -> StrictBuilder
unsafeFromByteString bs =
StrictBuilder (B.length bs) (\dst ofs -> copyFromByteString dst ofs bs)
fromChar :: Char -> StrictBuilder
fromChar c =
StrictBuilder (utf8Length c) (\dst ofs -> void (Char.unsafeWrite dst ofs (safe c)))
unsafeFromWord8 :: Word8 -> StrictBuilder
unsafeFromWord8 !w =
StrictBuilder 1 (\dst ofs -> A.unsafeWrite dst ofs w)
fromText :: Text -> StrictBuilder
fromText (Text src srcOfs n) = StrictBuilder n (\dst dstOfs ->
A.copyI n dst dstOfs src srcOfs)