{-# LANGUAGE CPP, MagicHash #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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
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 #-}
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
| 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)
| 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
{-# NOINLINE unpackCString# #-}
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 #-}
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 #-}