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 p ps r = showsPrec p (unpack ps) r
unpack ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Text -> String
unpack = S.unstreamList . stream
unpackCString# :: Addr# -> Text
unpackCString# addr# = runST $ do
let l = addrLen addr#
at (I# i#) = W8# (indexWord8OffAddr# addr# i#)
marr <- A.new l
let go srcOff@(at -> w8) dstOff
| srcOff >= l
= return dstOff
| w8 == 0xed, at (srcOff + 1) >= 0xa0 = do
A.unsafeWrite marr dstOff 0xef
A.unsafeWrite marr (dstOff + 1) 0xbf
A.unsafeWrite marr (dstOff + 2) 0xbd
go (srcOff + 3) (dstOff + 3)
| w8 == 0xc0, at (srcOff + 1) == 0x80
= A.unsafeWrite marr dstOff 0 >> go (srcOff + 2) (dstOff + 1)
| otherwise
= A.unsafeWrite marr dstOff w8 >> go (srcOff + 1) (dstOff + 1)
actualLen <- go 0 0
A.shrinkM marr actualLen
arr <- A.unsafeFreeze marr
return $ Text arr 0 actualLen
unpackCStringAscii# :: Addr# -> Text
unpackCStringAscii# addr# = Text ba 0 l
where
l = addrLen addr#
ba = runST $ do
marr <- A.new l
A.copyFromPointer marr 0 (Ptr addr#) l
A.unsafeFreeze marr
addrLen :: Addr# -> Int
#if MIN_VERSION_ghc_prim(0,7,0)
addrLen addr# = I# (GHC.cstringLength# addr#)
#else
addrLen addr# = fromIntegral (c_strlen (Ptr addr#))
foreign import capi unsafe "string.h strlen" c_strlen :: CString -> CSize
#endif
singleton ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Char -> Text
singleton c = Text (A.run x) 0 len
where x :: ST s (A.MArray s)
x = do arr <- A.new len
_ <- unsafeWrite arr 0 d
return arr
len = utf8Length d
d = safe c