    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-# OPTIONS_HADDOCK not-home #-}

    -- |
    -- Module      : Data.Text.Internal
    -- Copyright   : (c) 2008, 2009 Tom Harper,
    --               (c) 2009, 2010 Bryan O'Sullivan,
    --               (c) 2009 Duncan Coutts
    --
    -- License     : BSD-style
    -- Maintainer  : bos@serpentine.com
    -- Stability   : experimental
    -- Portability : GHC
    --
    -- A module containing private 'Text' internals. This exposes the
    -- 'Text' representation and low level construction functions.
    -- Modules which extend the 'Text' system may need to use this module.
    --
    -- You should not use this module unless you are determined to monkey
    -- with the internals, as the functions here do just about nothing to
    -- preserve data invariants.  You have been warned!

    module Data.Text.Internal
        (
        -- * Types
        -- $internals
          Text(..)
        -- * Construction
        , text
        , textP
        -- * Safety
        , safe
        -- * Code that must be here for accessibility
        , empty
        , empty_
        , append
        -- * Utilities
        , firstf
        -- * Checked multiplication
        , mul
        , mul32
        , mul64
        -- * Debugging
        , showText
        -- * Conversions
        , pack
        ) where

    #if defined(ASSERTS)
    import Control.Exception (assert)
    import GHC.Stack (HasCallStack)
    #endif
    import Control.Monad.ST (ST, runST)
    import Data.Bits
    import Data.Int (Int32, Int64)
    import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
    import Data.Typeable (Typeable)
    import qualified Data.Text.Array as A

    -- | A space efficient, packed, unboxed Unicode text type.
    data Text = Text
        {-# UNPACK #-} !A.Array -- ^ bytearray encoded as UTF-8
        {-# UNPACK #-} !Int     -- ^ offset in bytes (not in Char!), pointing to a start of UTF-8 sequence
        {-# UNPACK #-} !Int     -- ^ length in bytes (not in Char!), pointing to an end of UTF-8 sequence
        deriving (Typeable)

    -- | Smart constructor.
    text_ ::
    #if defined(ASSERTS)
      HasCallStack =>
    #endif
         A.Array -- ^ bytearray encoded as UTF-8
      -> Int     -- ^ offset in bytes (not in Char!), pointing to a start of UTF-8 sequence
      -> Int     -- ^ length in bytes (not in Char!), pointing to an end of UTF-8 sequence
      -> Text
    text_ :: Array -> Int -> Int -> Text
    text_ Array
    arr Int
    off Int
    len =
    #if defined(ASSERTS)
      let c    = A.unsafeIndex arr off
      in assert (len >= 0) .
         assert (off >= 0) .
         assert (len == 0 || c < 0x80 || c >= 0xC0) $
    #endif
         Array -> Int -> Int -> Text
    Text Array
    arr Int
    off Int
    len
    {-# INLINE text_ #-}

    -- | /O(1)/ The empty 'Text'.
    empty :: Text
    empty :: Text
    empty = Array -> Int -> Int -> Text
    Text Array
    A.empty Int
    0 Int
    0
    {-# INLINE [1] empty #-}

    -- | A non-inlined version of 'empty'.
    empty_ :: Text
    empty_ :: Text
    empty_ = Array -> Int -> Int -> Text
    Text Array
    A.empty Int
    0 Int
    0
    {-# NOINLINE empty_ #-}

    -- | /O(n)/ Appends one 'Text' to the other by copying both of them
    -- into a new 'Text'.
    append :: Text -> Text -> Text
    append :: Text -> Text -> Text
    append a :: Text
    a@(Text Array
    arr1 Int
    off1 Int
    len1) b :: Text
    b@(Text Array
    arr2 Int
    off2 Int
    len2)
        | Int
    len1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Text
    b
        | Int
    len2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Text
    a
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0   = Array -> Int -> Int -> Text
    Text ((forall s. ST s (MArray s)) -> Array
    A.run ST s (MArray s)
    forall s. ST s (MArray s)
    x) Int
    0 Int
    len
        | Bool
    otherwise = [Char] -> Text
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.Text.append: size overflow"
        where
          len :: Int
    len = Int
    len1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    len2
          x :: ST s (A.MArray s)
          x :: forall s. ST s (MArray s)
    x = do
            MArray s
    arr <- Int -> ST s (MArray s)
    forall s. Int -> ST s (MArray s)
    A.new Int
    len
            Int -> MArray s -> Int -> Array -> Int -> ST s ()
    forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
    A.copyI Int
    len1 MArray s
    arr Int
    0 Array
    arr1 Int
    off1
            Int -> MArray s -> Int -> Array -> Int -> ST s ()
    forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
    A.copyI Int
    len2 MArray s
    arr Int
    len1 Array
    arr2 Int
    off2
            MArray s -> ST s (MArray s)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MArray s
    arr
    {-# NOINLINE append #-}

    -- | Construct a 'Text' without invisibly pinning its byte array in
    -- memory if its length has dwindled to zero.
    text ::
    #if defined(ASSERTS)
      HasCallStack =>
    #endif
         A.Array -- ^ bytearray encoded as UTF-8
      -> Int     -- ^ offset in bytes (not in Char!), pointing to a start of UTF-8 sequence
      -> Int     -- ^ length in bytes (not in Char!), pointing to an end of UTF-8 sequence
      -> Text
    text :: Array -> Int -> Int -> Text
    text Array
    arr Int
    off Int
    len | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0  = Text
    empty
                     | Bool
    otherwise = Array -> Int -> Int -> Text
    text_ Array
    arr Int
    off Int
    len
    {-# INLINE text #-}

    textP :: A.Array -> Int -> Int -> Text
    {-# DEPRECATED textP "Use text instead" #-}
    textP :: Array -> Int -> Int -> Text
    textP = Array -> Int -> Int -> Text
    text

    -- | A useful 'show'-like function for debugging purposes.
    showText :: Text -> String
    showText :: Text -> [Char]
    showText (Text Array
    arr Int
    off Int
    len) =
        [Char]
    "Text " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Word8] -> [Char]
    forall a. Show a => a -> [Char]
    show (Array -> Int -> Int -> [Word8]
    A.toList Array
    arr Int
    off Int
    len) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char
    ' ' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :
                Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    off [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char
    ' ' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    len

    -- | Map a 'Char' to a 'Text'-safe value.
    --
    -- Unicode 'Data.Char.Surrogate' code points are not included in the set of Unicode
    -- scalar values, but are unfortunately admitted as valid 'Char'
    -- values by Haskell.  They cannot be represented in a 'Text'.  This
    -- function remaps those code points to the Unicode replacement
    -- character (U+FFFD, \'&#xfffd;\'), and leaves other code points
    -- unchanged.
    safe :: Char -> Char
    safe :: Char -> Char
    safe Char
    c
        | Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    0x1ff800 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0xd800 = Char
    c
        | Bool
    otherwise                    = Char
    '\xfffd'
    {-# INLINE [0] safe #-}

    -- | Apply a function to the first element of an optional pair.
    firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
    firstf :: forall a c b. (a -> c) -> Maybe (a, b) -> Maybe (c, b)
    firstf a -> c
    f (Just (a
    a, b
    b)) = (c, b) -> Maybe (c, b)
    forall a. a -> Maybe a
    Just (a -> c
    f a
    a, b
    b)
    firstf a -> c
    _  Maybe (a, b)
    Nothing      = Maybe (c, b)
    forall a. Maybe a
    Nothing

    -- | Checked multiplication.  Calls 'error' if the result would
    -- overflow.
    mul :: Int -> Int -> Int
    mul :: Int -> Int -> Int
    mul Int
    a Int
    b
      | Word -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize (Word
    0 :: Word) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    64
      = Int64 -> Int
    int64ToInt (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int64
    intToInt64 Int
    a Int64 -> Int64 -> Int64
    `mul64` Int -> Int64
    intToInt64 Int
    b
      | Bool
    otherwise
      = Int32 -> Int
    int32ToInt (Int32 -> Int) -> Int32 -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int32
    intToInt32 Int
    a Int32 -> Int32 -> Int32
    `mul32` Int -> Int32
    intToInt32 Int
    b
    {-# INLINE mul #-}
    infixl 7 `mul`

    -- | Checked multiplication.  Calls 'error' if the result would
    -- overflow.
    mul64 :: Int64 -> Int64 -> Int64
    mul64 :: Int64 -> Int64 -> Int64
    mul64 Int64
    a Int64
    b
      | Int64
    a Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int64
    0 Bool -> Bool -> Bool
    && Int64
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int64
    0 =  Int64 -> Int64 -> Int64
    mul64_ Int64
    a Int64
    b
      | Int64
    a Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int64
    0           = -Int64 -> Int64 -> Int64
    mul64_ Int64
    a (-Int64
    b)
      | Int64
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int64
    0           = -Int64 -> Int64 -> Int64
    mul64_ (-Int64
    a) Int64
    b
      | Bool
    otherwise        =  Int64 -> Int64 -> Int64
    mul64_ (-Int64
    a) (-Int64
    b)
    {-# INLINE mul64 #-}
    infixl 7 `mul64`

    mul64_ :: Int64 -> Int64 -> Int64
    mul64_ :: Int64 -> Int64 -> Int64
    mul64_ Int64
    a Int64
    b
      | Int64
    ahi Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0 Bool -> Bool -> Bool
    && Int64
    bhi Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0 = [Char] -> Int64
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "overflow"
      | Int64
    top Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0x7fffffff   = [Char] -> Int64
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "overflow"
      | Int64
    total Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int64
    0          = [Char] -> Int64
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "overflow"
      | Bool
    otherwise          = Int64
    total
      where (# Int64
    ahi, Int64
    alo #) = (# Int64
    a Int64 -> Int -> Int64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32, Int64
    a Int64 -> Int64 -> Int64
    forall a. Bits a => a -> a -> a
    .&. Int64
    0xffffffff #)
            (# Int64
    bhi, Int64
    blo #) = (# Int64
    b Int64 -> Int -> Int64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32, Int64
    b Int64 -> Int64 -> Int64
    forall a. Bits a => a -> a -> a
    .&. Int64
    0xffffffff #)
            top :: Int64
    top            = Int64
    ahi Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    blo Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    alo Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    bhi
            total :: Int64
    total          = (Int64
    top Int64 -> Int -> Int64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    32) Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    alo Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    blo
    {-# INLINE mul64_ #-}

    -- | Checked multiplication.  Calls 'error' if the result would
    -- overflow.
    mul32 :: Int32 -> Int32 -> Int32
    mul32 :: Int32 -> Int32 -> Int32
    mul32 Int32
    a Int32
    b = case Int32 -> Int64
    int32ToInt64 Int32
    a Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int32 -> Int64
    int32ToInt64 Int32
    b of
                  Int64
    ab | Int64
    ab Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int64
    min32 Bool -> Bool -> Bool
    || Int64
    ab Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    max32 -> [Char] -> Int32
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "overflow"
                     | Bool
    otherwise                -> Int64 -> Int32
    int64ToInt32 Int64
    ab
      where min32 :: Int64
    min32 = -Int64
    0x80000000 :: Int64
            max32 :: Int64
    max32 =  Int64
    0x7fffffff
    {-# INLINE mul32 #-}
    infixl 7 `mul32`

    intToInt64 :: Int -> Int64
    intToInt64 :: Int -> Int64
    intToInt64 = Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    int64ToInt :: Int64 -> Int
    int64ToInt :: Int64 -> Int
    int64ToInt = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    intToInt32 :: Int -> Int32
    intToInt32 :: Int -> Int32
    intToInt32 = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    int32ToInt :: Int32 -> Int
    int32ToInt :: Int32 -> Int
    int32ToInt = Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    int32ToInt64 :: Int32 -> Int64
    int32ToInt64 :: Int32 -> Int64
    int32ToInt64 = Int32 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    int64ToInt32 :: Int64 -> Int32
    int64ToInt32 :: Int64 -> Int32
    int64ToInt32 = Int64 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    -- $internals
    --
    -- Internally, the 'Text' type is represented as an array of 'Word8'
    -- UTF-8 code units. The offset and length fields in the constructor
    -- are in these units, /not/ units of 'Char'.
    --
    -- Invariants that all functions must maintain:
    --
    -- * Since the 'Text' type uses UTF-8 internally, it cannot represent
    --   characters in the reserved surrogate code point range U+D800 to
    --   U+DFFF. To maintain this invariant, the 'safe' function maps
    --   'Char' values in this range to the replacement character (U+FFFD,
    --   \'&#xfffd;\').
    --
    -- * Offset and length must point to a valid UTF-8 sequence of bytes.
    --   Violation of this may cause memory access violation and divergence.

    -- -----------------------------------------------------------------------------
    -- * Conversion to/from 'Text'

    -- | /O(n)/ Convert a 'String' into a 'Text'.
    -- Performs replacement on invalid scalar values, so @'Data.Text.unpack' . 'pack'@ is not 'id':
    --
    -- >>> Data.Text.unpack (pack "\55555")
    -- "\65533"
    pack :: String -> Text
    pack :: [Char] -> Text
    pack [Char]
    xs = (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
      -- It's tempting to allocate a buffer of 4 * length xs bytes,
      -- but not only it's wasteful for predominantly ASCII arguments,
      -- the computation of length xs would force allocation of the entire xs at once.
      let dstLen :: Int
    dstLen = Int
    64
      MArray s
    dst <- Int -> ST s (MArray s)
    forall s. Int -> ST s (MArray s)
    A.new Int
    dstLen
      MArray s -> Int -> Int -> [Char] -> ST s Text
    forall s. MArray s -> Int -> Int -> [Char] -> ST s Text
    outer MArray s
    dst Int
    dstLen Int
    0 [Char]
    xs
      where
        outer :: forall s. A.MArray s -> Int -> Int -> String -> ST s Text
        outer :: forall s. MArray s -> Int -> Int -> [Char] -> ST s Text
    outer !MArray s
    dst !Int
    dstLen = Int -> [Char] -> ST s Text
    inner
          where
            inner :: Int -> [Char] -> ST s Text
    inner !Int
    dstOff [] = do
              MArray s -> Int -> ST s ()
    forall s. MArray s -> Int -> ST s ()
    A.shrinkM MArray s
    dst Int
    dstOff
              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 (m :: * -> *) a. Monad m => a -> m a
    return (Array -> Int -> Int -> Text
    Text Array
    arr Int
    0 Int
    dstOff)
            inner !Int
    dstOff ccs :: [Char]
    ccs@(Char
    c : [Char]
    cs)
              -- Each 'Char' takes up to 4 bytes
              | Int
    dstOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    dstLen = do
                -- Double size of the buffer
                let !dstLen' :: Int
    dstLen' = Int
    dstLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2
                MArray s
    dst' <- MArray s -> Int -> ST s (MArray s)
    forall s. MArray s -> Int -> ST s (MArray s)
    A.resizeM MArray s
    dst Int
    dstLen'
                MArray s -> Int -> Int -> [Char] -> ST s Text
    forall s. MArray s -> Int -> Int -> [Char] -> ST s Text
    outer MArray s
    dst' Int
    dstLen' Int
    dstOff [Char]
    ccs
              | Bool
    otherwise = do
                Int
    d <- MArray s -> Int -> Char -> ST s Int
    forall s. MArray s -> Int -> Char -> ST s Int
    unsafeWrite MArray s
    dst Int
    dstOff (Char -> Char
    safe Char
    c)
                Int -> [Char] -> ST s Text
    inner (Int
    dstOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    d) [Char]
    cs
    {-# NOINLINE [0] pack #-}