{-# LANGUAGE CPP, MagicHash #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Text.Show
(
singleton
, unpack
, unpackCString#
) where
import Control.Monad.ST (ST)
import Data.Text.Internal (Text(..), empty_, safe)
import Data.Text.Internal.Fusion (stream, unstream)
import Data.Text.Internal.Unsafe.Char (unsafeWrite)
import GHC.Prim (Addr#)
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Fusion.Common as S
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
unpack ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Text -> String
unpack :: Text -> String
unpack = Stream Char -> String
forall a. Stream a -> [a]
S.unstreamList (Stream Char -> String) -> (Text -> Stream Char) -> Text -> String
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# = Stream Char -> Text
unstream (Addr# -> Stream Char
S.streamCString# Addr#
addr#)
{-# NOINLINE unpackCString# #-}
{-# RULES "TEXT literal" [1] forall a.
unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
= unpackCString# a #-}
{-# RULES "TEXT literal UTF8" [1] forall a.
unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
= unpackCString# a #-}
{-# RULES "TEXT empty literal" [1]
unstream (S.map safe (S.streamList []))
= empty_ #-}
{-# RULES "TEXT singleton literal" [1] forall a.
unstream (S.map safe (S.streamList [a]))
= singleton_ a #-}
singleton ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Char -> Text
singleton :: Char -> Text
singleton = Stream Char -> Text
unstream (Stream Char -> Text) -> (Char -> Stream Char) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Stream Char
S.singleton (Char -> Stream Char) -> (Char -> Char) -> Char -> Stream Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
safe
{-# INLINE [1] singleton #-}
{-# RULES "TEXT singleton" forall a.
unstream (S.singleton (safe 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 <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
Int
_ <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
0 Char
d
MArray s -> ST s (MArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
arr
len :: Int
len | Char
d Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x10000' = Int
1
| Bool
otherwise = Int
2
d :: Char
d = Char -> Char
safe Char
c
{-# NOINLINE singleton_ #-}