    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CApiFFI #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE ViewPatterns #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}

    -- |
    -- Module      : Data.Text.Show
    -- Copyright   : (c) 2009-2015 Bryan O'Sullivan
    --
    -- License     : BSD-style
    -- Maintainer  : bos@serpentine.com
    -- Stability   : experimental
    -- Portability : GHC

    module Data.Text.Show
        (
          addrLen
        , singleton
        , unpack
        , unpackCString#
        , unpackCStringAscii#
        ) where

    import Control.Monad.ST (ST, runST)
    import Data.Text.Internal (Text(..), empty, safe, pack)
    import Data.Text.Internal.Encoding.Utf8 (utf8Length)
    import Data.Text.Internal.Unsafe.Char (unsafeWrite)
    import Data.Text.Unsafe (Iter(..), iterArray)
    import GHC.Exts (Ptr(..), Int(..), Addr#, indexWord8OffAddr#)
    import qualified GHC.Exts as Exts
    import GHC.Word (Word8(..))
    import qualified Data.Text.Array as A
    #if !MIN_VERSION_ghc_prim(0,7,0)
    import Foreign.C.String (CString)
    import Foreign.C.Types (CSize(..))
    #endif

    import qualified GHC.CString as GHC

    #if defined(ASSERTS)
    import GHC.Stack (HasCallStack)
    #endif

    instance Show Text where
        showsPrec :: Int -> Text -> ShowS
    showsPrec Int
    p Text
    ps String
    r = Int -> String -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p (Text -> String
    unpack Text
    ps) String
    r

    -- | /O(n)/ Convert a 'Text' into a 'String'.
    unpack ::
    #if defined(ASSERTS)
      HasCallStack =>
    #endif
      Text -> String
    unpack :: Text -> String
    unpack Text
    t = (Char -> ShowS) -> String -> Text -> String
    forall b. (Char -> b -> b) -> b -> Text -> b
    foldrText (:) [] Text
    t
    {-# NOINLINE unpack #-}

    foldrText :: (Char -> b -> b) -> b -> Text -> b
    foldrText :: forall b. (Char -> b -> b) -> b -> Text -> b
    foldrText Char -> b -> b
    f b
    z (Text Array
    arr Int
    off Int
    len) = Int -> b
    go Int
    off
      where
        go :: Int -> b
    go !Int
    i
          | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len = b
    z
          | Bool
    otherwise = let !(Iter Char
    c Int
    l) = Array -> Int -> Iter
    iterArray Array
    arr Int
    i in Char -> b -> b
    f Char
    c (Int -> b
    go (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    l))
    {-# INLINE foldrText #-}

    foldrTextFB :: (Char -> b -> b) -> b -> Text -> b
    foldrTextFB :: forall b. (Char -> b -> b) -> b -> Text -> b
    foldrTextFB = (Char -> b -> b) -> b -> Text -> b
    forall b. (Char -> b -> b) -> b -> Text -> b
    foldrText
    {-# INLINE [0] foldrTextFB #-}

    -- List fusion rules for `unpack`:
    -- * `unpack` rewrites to `build` up till (but not including) phase 1. `build`
    --   fuses if `foldr` is applied to it.
    -- * If it doesn't fuse: In phase 1, `build` inlines to give us
    --   `foldrTextFB (:) []` and we rewrite that back to `unpack`.
    -- * If it fuses: In phase 0, `foldrTextFB` inlines and `foldrText` inlines. GHC
    --   optimizes the fused code.
    {-# RULES
    "Text.unpack"     [~1] forall t. unpack t = Exts.build (\lcons lnil -> foldrTextFB lcons lnil t)
    "Text.unpackBack" [1]  foldrTextFB (:) [] = unpack
      #-}

    -- | /O(n)/ Convert a null-terminated
    -- <https://en.wikipedia.org/wiki/UTF-8#Modified_UTF-8 modified UTF-8>
    -- (but with a standard UTF-8 representation of characters from supplementary planes)
    -- string to a 'Text'. Counterpart to 'GHC.unpackCStringUtf8#'.
    -- No validation is performed, malformed input can lead to memory access violation.
    --
    -- @since 1.2.1.1
    unpackCString# :: Addr# -> Text
    unpackCString# :: Addr# -> Text
    unpackCString# Addr#
    addr# = (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 l :: Int
    l = Addr# -> Int
    addrLen Addr#
    addr#
          at :: Int -> Word8
    at (I# Int#
    i#) = Word8# -> Word8
    W8# (Addr# -> Int# -> Word8#
    indexWord8OffAddr# Addr#
    addr# Int#
    i#)
      marr <- Int -> ST s (MArray s)
    forall s. Int -> ST s (MArray s)
    A.new Int
    l
      let go srcOff :: Int
    srcOff@(Int -> Word8
    at -> Word8
    w8) Int
    dstOff
            | Int
    srcOff Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    l
            = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    dstOff
            -- Surrogate halves take 3 bytes and are replaced by \xfffd (also 3 bytes long).
            -- Cf. Data.Text.Internal.safe
            | Word8
    w8 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0xed, Int -> Word8
    at (Int
    srcOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    0xa0 = do
              MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr  Int
    dstOff      Word8
    0xef
              MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    dstOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Word8
    0xbf
              MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    dstOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) Word8
    0xbd
              Int -> Int -> ST s Int
    go (Int
    srcOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3) (Int
    dstOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)
            -- Byte sequence "\xc0\x80" is used to represent NUL
            | Word8
    w8 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0xc0, Int -> Word8
    at (Int
    srcOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x80
            = MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr Int
    dstOff Word8
    0  ST s () -> ST s Int -> ST s Int
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> Int -> ST s Int
    go (Int
    srcOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) (Int
    dstOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            | Bool
    otherwise
            = MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr Int
    dstOff Word8
    w8 ST s () -> ST s Int -> ST s Int
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> Int -> ST s Int
    go (Int
    srcOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    dstOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
      actualLen <- go 0 0
      A.shrinkM marr actualLen
      arr <- A.unsafeFreeze marr
      return $ Text arr 0 actualLen

    -- When a module contains many literal strings, 'unpackCString#' can easily
    -- bloat generated code to insane size. There is also very little to gain
    -- from inlining. Thus explicit NOINLINE is desired.
    {-# NOINLINE unpackCString# #-}

    -- | /O(n)/ Convert a null-terminated ASCII string to a 'Text'.
    -- Counterpart to 'GHC.unpackCString#'.
    -- No validation is performed, malformed input can lead to memory access violation.
    --
    -- @since 2.0
    unpackCStringAscii# :: Addr# -> Text
    unpackCStringAscii# :: Addr# -> Text
    unpackCStringAscii# Addr#
    addr# = Array -> Int -> Int -> Text
    Text Array
    ba Int
    0 Int
    l
      where
        l :: Int
    l = Addr# -> Int
    addrLen Addr#
    addr#
        ba :: Array
    ba = (forall s. ST s Array) -> Array
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s Array) -> Array)
    -> (forall s. ST s Array) -> Array
    forall a b. (a -> b) -> a -> b
    $ do
          marr <- Int -> ST s (MArray s)
    forall s. Int -> ST s (MArray s)
    A.new Int
    l
          A.copyFromPointer marr 0 (Ptr addr#) l
          A.unsafeFreeze marr
    {-# NOINLINE unpackCStringAscii# #-}

    addrLen :: Addr# -> Int
    #if MIN_VERSION_ghc_prim(0,7,0)
    addrLen :: Addr# -> Int
    addrLen Addr#
    addr# = Int# -> Int
    I# (Addr# -> Int#
    GHC.cstringLength# Addr#
    addr#)
    #else
    addrLen addr# = fromIntegral (c_strlen (Ptr addr#))

    foreign import capi unsafe "string.h strlen" c_strlen :: CString -> CSize
    #endif

    {-# RULES "TEXT literal" forall a.
        pack (GHC.unpackCString# a) = unpackCStringAscii# a #-}

    {-# RULES "TEXT literal UTF8" forall a.
        pack (GHC.unpackCStringUtf8# a) = unpackCString# a #-}

    {-# RULES "TEXT empty literal"
        pack [] = empty #-}

    {-# RULES "TEXT singleton literal" forall a.
        pack [a] = singleton a #-}

    -- | /O(1)/ Convert a character into a Text.
    -- Performs replacement on invalid scalar values.
    singleton ::
    #if defined(ASSERTS)
      HasCallStack =>
    #endif
      Char -> Text
    singleton :: Char -> Text
    singleton Char
    c = 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
      where x :: ST s (A.MArray s)
            x :: forall s. ST s (MArray s)
    x = do arr <- Int -> ST s (MArray s)
    forall s. Int -> ST s (MArray s)
    A.new Int
    len
                   _ <- unsafeWrite arr 0 d
                   return arr
            len :: Int
    len = Char -> Int
    utf8Length Char
    d
            d :: Char
    d = Char -> Char
    safe Char
    c
    {-# NOINLINE singleton #-}