{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Data.Text.Internal.Builder
-- License     : BSD-style (see LICENSE)
-- Stability   : experimental
--
-- /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!
--
-- @since 2.0.2

module Data.Text.Internal.StrictBuilder
  ( StrictBuilder(..)
  , toText
  , fromChar
  , fromText

    -- * Unsafe
    -- $unsafe
  , 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

-- | A delayed representation of strict 'Text'.
--
-- @since 2.0.2
data StrictBuilder = StrictBuilder
  { StrictBuilder -> Int
sbLength :: {-# UNPACK #-} !Int
  , StrictBuilder -> forall s. MArray s -> Int -> ST s ()
sbWrite :: forall s. A.MArray s -> Int -> ST s ()
  }

-- | Use 'StrictBuilder' to build 'Text'.
--
-- @since 2.0.2
toText :: StrictBuilder -> Text
toText :: StrictBuilder -> Text
toText (StrictBuilder Int
0 forall s. MArray s -> Int -> ST s ()
_) = Text
empty
toText (StrictBuilder Int
n forall s. MArray s -> Int -> ST s ()
write) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST (do
  MArray s
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
n
  MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
write MArray s
dst Int
0
  Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
  Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
n))

-- | Concatenation of 'StrictBuilder' is right-biased:
-- the right builder will be run first. This allows a builder to
-- run tail-recursively when it was accumulated left-to-right.
instance Semigroup StrictBuilder where
  <> :: StrictBuilder -> StrictBuilder -> StrictBuilder
(<>) = StrictBuilder -> StrictBuilder -> StrictBuilder
appendRStrictBuilder

instance Monoid StrictBuilder where
  mempty :: StrictBuilder
mempty = StrictBuilder
emptyStrictBuilder
  mappend :: StrictBuilder -> StrictBuilder -> StrictBuilder
mappend = StrictBuilder -> StrictBuilder -> StrictBuilder
forall a. Semigroup a => a -> a -> a
(<>)

emptyStrictBuilder :: StrictBuilder
emptyStrictBuilder :: StrictBuilder
emptyStrictBuilder = Int -> (forall s. MArray s -> Int -> ST s ()) -> StrictBuilder
StrictBuilder Int
0 (\MArray s
_ Int
_ -> () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

appendRStrictBuilder :: StrictBuilder -> StrictBuilder -> StrictBuilder
appendRStrictBuilder :: StrictBuilder -> StrictBuilder -> StrictBuilder
appendRStrictBuilder (StrictBuilder Int
0 forall s. MArray s -> Int -> ST s ()
_) StrictBuilder
b2 = StrictBuilder
b2
appendRStrictBuilder StrictBuilder
b1 (StrictBuilder Int
0 forall s. MArray s -> Int -> ST s ()
_) = StrictBuilder
b1
appendRStrictBuilder (StrictBuilder Int
n1 forall s. MArray s -> Int -> ST s ()
write1) (StrictBuilder Int
n2 forall s. MArray s -> Int -> ST s ()
write2) =
  Int -> (forall s. MArray s -> Int -> ST s ()) -> StrictBuilder
StrictBuilder (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) (\MArray s
dst Int
ofs -> do
    MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
write2 MArray s
dst (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1)
    MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
write1 MArray s
dst Int
ofs)

copyFromByteString :: A.MArray s -> Int -> ByteString -> ST s ()
copyFromByteString :: forall s. MArray s -> Int -> ByteString -> ST s ()
copyFromByteString MArray s
dst Int
ofs ByteString
src = ByteString -> (ForeignPtr Word8 -> Int -> ST s ()) -> ST s ()
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
src ((ForeignPtr Word8 -> Int -> ST s ()) -> ST s ())
-> (ForeignPtr Word8 -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \ ForeignPtr Word8
srcFPtr Int
len ->
  IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
srcFPtr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
srcPtr -> do
    ST s () -> IO ()
forall s a. ST s a -> IO a
unsafeSTToIO (ST s () -> IO ()) -> ST s () -> IO ()
forall a b. (a -> b) -> a -> b
$ MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
dst Int
ofs Ptr Word8
srcPtr Int
len

-- | Copy a 'ByteString'.
--
-- Unsafe: This may not be valid UTF-8 text.
--
-- @since 2.0.2
unsafeFromByteString :: ByteString -> StrictBuilder
unsafeFromByteString :: ByteString -> StrictBuilder
unsafeFromByteString ByteString
bs =
  Int -> (forall s. MArray s -> Int -> ST s ()) -> StrictBuilder
StrictBuilder (ByteString -> Int
B.length ByteString
bs) (\MArray s
dst Int
ofs -> MArray s -> Int -> ByteString -> ST s ()
forall s. MArray s -> Int -> ByteString -> ST s ()
copyFromByteString MArray s
dst Int
ofs ByteString
bs)

-- |
-- @since 2.0.2
{-# INLINE fromChar #-}
fromChar :: Char -> StrictBuilder
fromChar :: Char -> StrictBuilder
fromChar Char
c =
  Int -> (forall s. MArray s -> Int -> ST s ()) -> StrictBuilder
StrictBuilder (Char -> Int
utf8Length Char
c) (\MArray s
dst Int
ofs -> ST s Int -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
Char.unsafeWrite MArray s
dst Int
ofs (Char -> Char
safe Char
c)))

-- $unsafe
-- For internal purposes, we abuse 'StrictBuilder' as a delayed 'Array' rather
-- than 'Text': it may not actually be valid 'Text'.

-- | Unsafe: This may not be valid UTF-8 text.
--
-- @since 2.0.2
unsafeFromWord8 :: Word8 -> StrictBuilder
unsafeFromWord8 :: Word8 -> StrictBuilder
unsafeFromWord8 !Word8
w =
  Int -> (forall s. MArray s -> Int -> ST s ()) -> StrictBuilder
StrictBuilder Int
1 (\MArray s
dst Int
ofs -> MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
ofs Word8
w)

-- | Copy 'Text' in a 'StrictBuilder'
--
-- @since 2.0.2
fromText :: Text -> StrictBuilder
fromText :: Text -> StrictBuilder
fromText (Text Array
src Int
srcOfs Int
n) = Int -> (forall s. MArray s -> Int -> ST s ()) -> StrictBuilder
StrictBuilder Int
n (\MArray s
dst Int
dstOfs ->
  Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
n MArray s
dst Int
dstOfs Array
src Int
srcOfs)