{-# LANGUAGE CPP, MagicHash #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CApiFFI #-}
{-# 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.Fusion (stream)
import Data.Text.Internal.Unsafe.Char (unsafeWrite)
import GHC.Exts (Ptr(..), Int(..), Addr#, indexWord8OffAddr#)
import GHC.Word (Word8(..))
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Fusion.Common as S
#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 = 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 = forall a. Stream a -> [a]
S.unstreamList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
stream
{-# INLINE [1] 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 a. (forall s. ST s a) -> a
runST 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#)
  MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new Int
l
  let go :: Int -> Int -> ST s Int
go srcOff :: Int
srcOff@(Int -> Word8
at -> Word8
w8) Int
dstOff
        | Int
srcOff forall a. Ord a => a -> a -> Bool
>= Int
l
        = 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 forall a. Eq a => a -> a -> Bool
== Word8
0xed, Int -> Word8
at (Int
srcOff forall a. Num a => a -> a -> a
+ Int
1) forall a. Ord a => a -> a -> Bool
>= Word8
0xa0 = do
          forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr  Int
dstOff      Word8
0xef
          forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) Word8
0xbf
          forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2) Word8
0xbd
          Int -> Int -> ST s Int
go (Int
srcOff forall a. Num a => a -> a -> a
+ Int
3) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
3)
        -- Byte sequence "\xc0\x80" is used to represent NUL
        | Word8
w8 forall a. Eq a => a -> a -> Bool
== Word8
0xc0, Int -> Word8
at (Int
srcOff forall a. Num a => a -> a -> a
+ Int
1) forall a. Eq a => a -> a -> Bool
== Word8
0x80
        = forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
dstOff Word8
0  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> ST s Int
go (Int
srcOff forall a. Num a => a -> a -> a
+ Int
2) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise
        = forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
dstOff Word8
w8 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> ST s Int
go (Int
srcOff forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1)
  Int
actualLen <- Int -> Int -> ST s Int
go Int
0 Int
0
  forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
marr Int
actualLen
  Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
      MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new Int
l
      forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
marr Int
0 (forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
l
      forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
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 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 MArray s
arr <- forall s. Int -> ST s (MArray s)
A.new Int
len
               Int
_ <- forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
0 Char
d
               forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
arr
        len :: Int
len = Char -> Int
utf8Length Char
d
        d :: Char
d = Char -> Char
safe Char
c
{-# NOINLINE singleton #-}