{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,
    UnliftedFFITypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
-- |
-- Module      : Data.Text.Encoding
-- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan,
--               (c) 2009 Duncan Coutts,
--               (c) 2008, 2009 Tom Harper
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Portability : portable
--
-- Functions for converting 'Text' values to and from 'ByteString',
-- using several standard encodings.
--
-- To gain access to a much larger family of encodings, use the
-- <http://hackage.haskell.org/package/text-icu text-icu package>.

module Data.Text.Encoding
    (
    -- * Decoding ByteStrings to Text
    -- $strict
      decodeASCII
    , decodeLatin1
    , decodeUtf8
    , decodeUtf16LE
    , decodeUtf16BE
    , decodeUtf32LE
    , decodeUtf32BE

    -- ** Catchable failure
    , decodeUtf8'

    -- ** Controllable error handling
    , decodeUtf8With
    , decodeUtf16LEWith
    , decodeUtf16BEWith
    , decodeUtf32LEWith
    , decodeUtf32BEWith

    -- ** Stream oriented decoding
    -- $stream
    , streamDecodeUtf8
    , streamDecodeUtf8With
    , Decoding(..)

    -- * Encoding Text to ByteStrings
    , encodeUtf8
    , encodeUtf16LE
    , encodeUtf16BE
    , encodeUtf32LE
    , encodeUtf32BE

    -- * Encoding Text using ByteString Builders
    , encodeUtf8Builder
    , encodeUtf8BuilderEscaped
    ) where

import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))
import Control.Monad.ST (runST)
import Data.Bits ((.&.))
import Data.ByteString as B
import qualified Data.ByteString.Internal as B
import Data.Foldable (traverse_)
import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
import Data.Text.Internal (Text(..), safe, text)
import Data.Text.Internal.Functions
import Data.Text.Internal.Private (runText)
import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
import Data.Text.Internal.Unsafe.Shift (shiftR)
import Data.Text.Show ()
import Data.Text.Unsafe (unsafeDupablePerformIO)
import Data.Word (Word8, Word16, Word32)
import Foreign.C.Types (CSize(CSize))
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable, peek, poke)
import GHC.Base (ByteArray#, MutableByteArray#)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
import qualified Data.ByteString.Builder.Prim as BP
import qualified Data.ByteString.Builder.Prim.Internal as BP
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Encoding.Fusion as E
import qualified Data.Text.Internal.Encoding.Utf16 as U16
import qualified Data.Text.Internal.Fusion as F
import Data.Text.Internal.ByteStringCompat
#if defined(ASSERTS)
import GHC.Stack (HasCallStack)
#endif

#include "text_cbits.h"

-- $strict
--
-- All of the single-parameter functions for decoding bytestrings
-- encoded in one of the Unicode Transformation Formats (UTF) operate
-- in a /strict/ mode: each will throw an exception if given invalid
-- input.
--
-- Each function has a variant, whose name is suffixed with -'With',
-- that gives greater control over the handling of decoding errors.
-- For instance, 'decodeUtf8' will throw an exception, but
-- 'decodeUtf8With' allows the programmer to determine what to do on a
-- decoding error.

-- | /Deprecated/.  Decode a 'ByteString' containing 7-bit ASCII
-- encoded text.
decodeASCII :: ByteString -> Text
decodeASCII :: ByteString -> Text
decodeASCII = ByteString -> Text
decodeUtf8
{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
--
-- 'decodeLatin1' is semantically equivalent to
--  @Data.Text.pack . Data.ByteString.Char8.unpack@
decodeLatin1 ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  ByteString -> Text
decodeLatin1 :: ByteString -> Text
decodeLatin1 ByteString
bs = ByteString -> (ForeignPtr Word8 -> Int -> Text) -> Text
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs ForeignPtr Word8 -> Int -> Text
aux where
  aux :: ForeignPtr Word8 -> Int -> Text
aux ForeignPtr Word8
fp Int
len = Array -> Int -> Int -> Text
text Array
a Int
0 Int
len
   where
    a :: Array
a = (forall s. ST s (MArray s)) -> Array
A.run (Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len ST s (MArray s) -> (MArray s -> ST s (MArray s)) -> ST s (MArray s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (MArray s) -> ST s (MArray s)
forall a s. IO a -> ST s a
unsafeIOToST (IO (MArray s) -> ST s (MArray s))
-> (MArray s -> IO (MArray s)) -> MArray s -> ST s (MArray s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MArray s -> IO (MArray s)
forall {s}. MArray s -> IO (MArray s)
go)
    go :: MArray s -> IO (MArray s)
go MArray s
dest = ForeignPtr Word8 -> (Ptr Word8 -> IO (MArray s)) -> IO (MArray s)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (MArray s)) -> IO (MArray s))
-> (Ptr Word8 -> IO (MArray s)) -> IO (MArray s)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
      MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
forall s. MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
c_decode_latin1 (MArray s -> MutableByteArray# s
forall s. MArray s -> MutableByteArray# s
A.maBA MArray s
dest) Ptr Word8
ptr (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
      MArray s -> IO (MArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
dest

-- | Decode a 'ByteString' containing UTF-8 encoded text.
--
-- __NOTE__: The replacement character returned by 'OnDecodeError'
-- MUST be within the BMP plane; surrogate code points will
-- automatically be remapped to the replacement char @U+FFFD@
-- (/since 0.11.3.0/), whereas code points beyond the BMP will throw an
-- 'error' (/since 1.2.3.1/); For earlier versions of @text@ using
-- those unsupported code points would result in undefined behavior.
decodeUtf8With ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  OnDecodeError -> ByteString -> Text
decodeUtf8With :: OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
onErr ByteString
bs = ByteString -> (ForeignPtr Word8 -> Int -> Text) -> Text
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs ForeignPtr Word8 -> Int -> Text
aux
 where
  aux :: ForeignPtr Word8 -> Int -> Text
aux ForeignPtr Word8
fp Int
len = (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
runText ((forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text)
-> (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ \MArray s -> Int -> ST s Text
done -> do
    let go :: MArray s -> IO Text
go MArray s
dest = ForeignPtr Word8 -> (Ptr Word8 -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Text) -> IO Text)
-> (Ptr Word8 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          CSize -> (Ptr CSize -> IO Text) -> IO Text
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CSize
0::CSize) ((Ptr CSize -> IO Text) -> IO Text)
-> (Ptr CSize -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
destOffPtr -> do
            let end :: Ptr b
end = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
                loop :: Ptr Word8 -> IO Text
loop Ptr Word8
curPtr = do
                  Ptr Word8
curPtr' <- MutableByteArray# s
-> Ptr CSize -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall s.
MutableByteArray# s
-> Ptr CSize -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
c_decode_utf8 (MArray s -> MutableByteArray# s
forall s. MArray s -> MutableByteArray# s
A.maBA MArray s
dest) Ptr CSize
destOffPtr Ptr Word8
curPtr Ptr Word8
forall {b}. Ptr b
end
                  if Ptr Word8
curPtr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall {b}. Ptr b
end
                    then do
                      CSize
n <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
destOffPtr
                      ST s Text -> IO Text
forall s a. ST s a -> IO a
unsafeSTToIO (MArray s -> Int -> ST s Text
done MArray s
dest (CSize -> Int
cSizeToInt CSize
n))
                    else do
                      Word8
x <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
curPtr'
                      case OnDecodeError
onErr String
desc (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
x) of
                        Maybe Char
Nothing -> Ptr Word8 -> IO Text
loop (Ptr Word8 -> IO Text) -> Ptr Word8 -> IO Text
forall a b. (a -> b) -> a -> b
$ Ptr Word8
curPtr' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                        Just Char
c
                          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\xFFFF' -> IO Text
forall {a}. IO a
throwUnsupportedReplChar
                          | Bool
otherwise -> do
                              CSize
destOff <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
destOffPtr
                              Int
w <- ST s Int -> IO Int
forall s a. ST s a -> IO a
unsafeSTToIO (ST s Int -> IO Int) -> ST s Int -> IO Int
forall a b. (a -> b) -> a -> b
$
                                   MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dest (CSize -> Int
cSizeToInt CSize
destOff)
                                               (Char -> Char
safe Char
c)
                              Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
destOffPtr (CSize
destOff CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ Int -> CSize
intToCSize Int
w)
                              Ptr Word8 -> IO Text
loop (Ptr Word8 -> IO Text) -> Ptr Word8 -> IO Text
forall a b. (a -> b) -> a -> b
$ Ptr Word8
curPtr' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
            Ptr Word8 -> IO Text
loop Ptr Word8
ptr
    (IO Text -> ST s Text
forall a s. IO a -> ST s a
unsafeIOToST (IO Text -> ST s Text)
-> (MArray s -> IO Text) -> MArray s -> ST s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MArray s -> IO Text
go) (MArray s -> ST s Text) -> ST s (MArray s) -> ST s Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
   where
    desc :: String
desc = String
"Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"

    throwUnsupportedReplChar :: IO a
throwUnsupportedReplChar = ErrorCall -> IO a
forall e a. Exception e => e -> IO a
throwIO (ErrorCall -> IO a) -> ErrorCall -> IO a
forall a b. (a -> b) -> a -> b
$
      String -> ErrorCall
ErrorCall String
"decodeUtf8With: non-BMP replacement characters not supported"
  -- TODO: The code currently assumes that the transcoded UTF-16
  -- stream is at most twice as long (in bytes) as the input UTF-8
  -- stream. To justify this assumption one has to assume that the
  -- error handler replacement character also satisfies this
  -- invariant, by emitting at most one UTF16 code unit.
  --
  -- One easy way to support the full range of code-points for
  -- replacement characters in the error handler is to simply change
  -- the (over-)allocation to `A.new (2*len)` and then shrink back the
  -- `ByteArray#` to the real size (recent GHCs have a cheap
  -- `ByteArray#` resize-primop for that which allow the GC to reclaim
  -- the overallocation). However, this would require 4 times as much
  -- (temporary) storage as the original UTF-8 required.
  --
  -- Another strategy would be to optimistically assume that
  -- replacement characters are within the BMP, and if the case of a
  -- non-BMP replacement occurs reallocate the target buffer (or throw
  -- an exception, and fallback to a pessimistic codepath, like e.g.
  -- `decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)`)
  --
  -- Alternatively, `OnDecodeError` could become a datastructure which
  -- statically encodes the replacement-character range,
  -- e.g. something isomorphic to
  --
  --   Either (... -> Maybe Word16) (... -> Maybe Char)
  --
  -- And allow to statically switch between the BMP/non-BMP
  -- replacement-character codepaths. There's multiple ways to address
  -- this with different tradeoffs; but ideally we should optimise for
  -- the optimistic/error-free case.
{- INLINE[0] decodeUtf8With #-}

-- $stream
--
-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
-- a 'ByteString' that represents a possibly incomplete input (e.g. a
-- packet from a network stream) that may not end on a UTF-8 boundary.
--
-- 1. The maximal prefix of 'Text' that could be decoded from the
--    given input.
--
-- 2. The suffix of the 'ByteString' that could not be decoded due to
--    insufficient input.
--
-- 3. A function that accepts another 'ByteString'.  That string will
--    be assumed to directly follow the string that was passed as
--    input to the original function, and it will in turn be decoded.
--
-- To help understand the use of these functions, consider the Unicode
-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
-- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.
--
-- Now suppose that we receive this encoded string as 3 packets that
-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
-- have received all three packets, but we would like to make progress
-- as we receive each one.
--
-- @
-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
-- ghci> s0
-- 'Some' \"hi \" \"\\xe2\" _
-- @
--
-- We use the continuation @f0@ to decode our second packet.
--
-- @
-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
-- ghci> s1
-- 'Some' \"\" \"\\xe2\\x98\"
-- @
--
-- We could not give @f0@ enough input to decode anything, so it
-- returned an empty string. Once we feed our second continuation @f1@
-- the last byte of input, it will make progress.
--
-- @
-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
-- ghci> s2
-- 'Some' \"\\x2603\" \"\" _
-- @
--
-- If given invalid input, an exception will be thrown by the function
-- or continuation where it is encountered.

-- | A stream oriented decoding result.
--
-- @since 1.0.0.0
data Decoding = Some Text ByteString (ByteString -> Decoding)

instance Show Decoding where
    showsPrec :: Int -> Decoding -> ShowS
showsPrec Int
d (Some Text
t ByteString
bs ByteString -> Decoding
_) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                                String -> ShowS
showString String
"Some " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec' Text
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec' ByteString
bs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
" _"
      where prec :: Int
prec = Int
10; prec' :: Int
prec' = Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

newtype CodePoint = CodePoint Word32 deriving (CodePoint -> CodePoint -> Bool
(CodePoint -> CodePoint -> Bool)
-> (CodePoint -> CodePoint -> Bool) -> Eq CodePoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodePoint -> CodePoint -> Bool
$c/= :: CodePoint -> CodePoint -> Bool
== :: CodePoint -> CodePoint -> Bool
$c== :: CodePoint -> CodePoint -> Bool
Eq, Int -> CodePoint -> ShowS
[CodePoint] -> ShowS
CodePoint -> String
(Int -> CodePoint -> ShowS)
-> (CodePoint -> String)
-> ([CodePoint] -> ShowS)
-> Show CodePoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodePoint] -> ShowS
$cshowList :: [CodePoint] -> ShowS
show :: CodePoint -> String
$cshow :: CodePoint -> String
showsPrec :: Int -> CodePoint -> ShowS
$cshowsPrec :: Int -> CodePoint -> ShowS
Show, Integer -> CodePoint
CodePoint -> CodePoint
CodePoint -> CodePoint -> CodePoint
(CodePoint -> CodePoint -> CodePoint)
-> (CodePoint -> CodePoint -> CodePoint)
-> (CodePoint -> CodePoint -> CodePoint)
-> (CodePoint -> CodePoint)
-> (CodePoint -> CodePoint)
-> (CodePoint -> CodePoint)
-> (Integer -> CodePoint)
-> Num CodePoint
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CodePoint
$cfromInteger :: Integer -> CodePoint
signum :: CodePoint -> CodePoint
$csignum :: CodePoint -> CodePoint
abs :: CodePoint -> CodePoint
$cabs :: CodePoint -> CodePoint
negate :: CodePoint -> CodePoint
$cnegate :: CodePoint -> CodePoint
* :: CodePoint -> CodePoint -> CodePoint
$c* :: CodePoint -> CodePoint -> CodePoint
- :: CodePoint -> CodePoint -> CodePoint
$c- :: CodePoint -> CodePoint -> CodePoint
+ :: CodePoint -> CodePoint -> CodePoint
$c+ :: CodePoint -> CodePoint -> CodePoint
Num, Ptr CodePoint -> IO CodePoint
Ptr CodePoint -> Int -> IO CodePoint
Ptr CodePoint -> Int -> CodePoint -> IO ()
Ptr CodePoint -> CodePoint -> IO ()
CodePoint -> Int
(CodePoint -> Int)
-> (CodePoint -> Int)
-> (Ptr CodePoint -> Int -> IO CodePoint)
-> (Ptr CodePoint -> Int -> CodePoint -> IO ())
-> (forall b. Ptr b -> Int -> IO CodePoint)
-> (forall b. Ptr b -> Int -> CodePoint -> IO ())
-> (Ptr CodePoint -> IO CodePoint)
-> (Ptr CodePoint -> CodePoint -> IO ())
-> Storable CodePoint
forall b. Ptr b -> Int -> IO CodePoint
forall b. Ptr b -> Int -> CodePoint -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr CodePoint -> CodePoint -> IO ()
$cpoke :: Ptr CodePoint -> CodePoint -> IO ()
peek :: Ptr CodePoint -> IO CodePoint
$cpeek :: Ptr CodePoint -> IO CodePoint
pokeByteOff :: forall b. Ptr b -> Int -> CodePoint -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CodePoint -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO CodePoint
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CodePoint
pokeElemOff :: Ptr CodePoint -> Int -> CodePoint -> IO ()
$cpokeElemOff :: Ptr CodePoint -> Int -> CodePoint -> IO ()
peekElemOff :: Ptr CodePoint -> Int -> IO CodePoint
$cpeekElemOff :: Ptr CodePoint -> Int -> IO CodePoint
alignment :: CodePoint -> Int
$calignment :: CodePoint -> Int
sizeOf :: CodePoint -> Int
$csizeOf :: CodePoint -> Int
Storable)
newtype DecoderState = DecoderState Word32 deriving (DecoderState -> DecoderState -> Bool
(DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> Bool) -> Eq DecoderState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderState -> DecoderState -> Bool
$c/= :: DecoderState -> DecoderState -> Bool
== :: DecoderState -> DecoderState -> Bool
$c== :: DecoderState -> DecoderState -> Bool
Eq, Int -> DecoderState -> ShowS
[DecoderState] -> ShowS
DecoderState -> String
(Int -> DecoderState -> ShowS)
-> (DecoderState -> String)
-> ([DecoderState] -> ShowS)
-> Show DecoderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderState] -> ShowS
$cshowList :: [DecoderState] -> ShowS
show :: DecoderState -> String
$cshow :: DecoderState -> String
showsPrec :: Int -> DecoderState -> ShowS
$cshowsPrec :: Int -> DecoderState -> ShowS
Show, Integer -> DecoderState
DecoderState -> DecoderState
DecoderState -> DecoderState -> DecoderState
(DecoderState -> DecoderState -> DecoderState)
-> (DecoderState -> DecoderState -> DecoderState)
-> (DecoderState -> DecoderState -> DecoderState)
-> (DecoderState -> DecoderState)
-> (DecoderState -> DecoderState)
-> (DecoderState -> DecoderState)
-> (Integer -> DecoderState)
-> Num DecoderState
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> DecoderState
$cfromInteger :: Integer -> DecoderState
signum :: DecoderState -> DecoderState
$csignum :: DecoderState -> DecoderState
abs :: DecoderState -> DecoderState
$cabs :: DecoderState -> DecoderState
negate :: DecoderState -> DecoderState
$cnegate :: DecoderState -> DecoderState
* :: DecoderState -> DecoderState -> DecoderState
$c* :: DecoderState -> DecoderState -> DecoderState
- :: DecoderState -> DecoderState -> DecoderState
$c- :: DecoderState -> DecoderState -> DecoderState
+ :: DecoderState -> DecoderState -> DecoderState
$c+ :: DecoderState -> DecoderState -> DecoderState
Num, Ptr DecoderState -> IO DecoderState
Ptr DecoderState -> Int -> IO DecoderState
Ptr DecoderState -> Int -> DecoderState -> IO ()
Ptr DecoderState -> DecoderState -> IO ()
DecoderState -> Int
(DecoderState -> Int)
-> (DecoderState -> Int)
-> (Ptr DecoderState -> Int -> IO DecoderState)
-> (Ptr DecoderState -> Int -> DecoderState -> IO ())
-> (forall b. Ptr b -> Int -> IO DecoderState)
-> (forall b. Ptr b -> Int -> DecoderState -> IO ())
-> (Ptr DecoderState -> IO DecoderState)
-> (Ptr DecoderState -> DecoderState -> IO ())
-> Storable DecoderState
forall b. Ptr b -> Int -> IO DecoderState
forall b. Ptr b -> Int -> DecoderState -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DecoderState -> DecoderState -> IO ()
$cpoke :: Ptr DecoderState -> DecoderState -> IO ()
peek :: Ptr DecoderState -> IO DecoderState
$cpeek :: Ptr DecoderState -> IO DecoderState
pokeByteOff :: forall b. Ptr b -> Int -> DecoderState -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DecoderState -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO DecoderState
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DecoderState
pokeElemOff :: Ptr DecoderState -> Int -> DecoderState -> IO ()
$cpokeElemOff :: Ptr DecoderState -> Int -> DecoderState -> IO ()
peekElemOff :: Ptr DecoderState -> Int -> IO DecoderState
$cpeekElemOff :: Ptr DecoderState -> Int -> IO DecoderState
alignment :: DecoderState -> Int
$calignment :: DecoderState -> Int
sizeOf :: DecoderState -> Int
$csizeOf :: DecoderState -> Int
Storable)

-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
-- encoded text that is known to be valid.
--
-- If the input contains any invalid UTF-8 data, an exception will be
-- thrown (either by this function or a continuation) that cannot be
-- caught in pure code.  For more control over the handling of invalid
-- data, use 'streamDecodeUtf8With'.
--
-- @since 1.0.0.0
streamDecodeUtf8 ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  ByteString -> Decoding
streamDecodeUtf8 :: ByteString -> Decoding
streamDecodeUtf8 = OnDecodeError -> ByteString -> Decoding
streamDecodeUtf8With OnDecodeError
strictDecode

-- | Decode, in a stream oriented way, a lazy 'ByteString' containing UTF-8
-- encoded text.
--
-- @since 1.0.0.0
streamDecodeUtf8With ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  OnDecodeError -> ByteString -> Decoding
streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
streamDecodeUtf8With OnDecodeError
onErr = ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding
decodeChunk ByteString
B.empty CodePoint
0 DecoderState
0
 where
  -- We create a slightly larger than necessary buffer to accommodate a
  -- potential surrogate pair started in the last buffer (@undecoded0@), or
  -- replacement characters for each byte in @undecoded0@ if the
  -- sequence turns out to be invalid. There can be up to three bytes there,
  -- hence we allocate @len+3@ 16-bit words.
  decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
              -> Decoding
  decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding
decodeChunk ByteString
undecoded0 CodePoint
codepoint0 DecoderState
state0 ByteString
bs = ByteString -> (ForeignPtr Word8 -> Int -> Decoding) -> Decoding
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs ForeignPtr Word8 -> Int -> Decoding
aux where
    aux :: ForeignPtr Word8 -> Int -> Decoding
aux ForeignPtr Word8
fp Int
len = (forall s. ST s Decoding) -> Decoding
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Decoding) -> Decoding)
-> (forall s. ST s Decoding) -> Decoding
forall a b. (a -> b) -> a -> b
$ (IO Decoding -> ST s Decoding
forall a s. IO a -> ST s a
unsafeIOToST (IO Decoding -> ST s Decoding)
-> (MArray s -> IO Decoding) -> MArray s -> ST s Decoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MArray s -> IO Decoding
forall s. MArray s -> IO Decoding
decodeChunkToBuffer) (MArray s -> ST s Decoding) -> ST s (MArray s) -> ST s Decoding
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
       where
        decodeChunkToBuffer :: A.MArray s -> IO Decoding
        decodeChunkToBuffer :: forall s. MArray s -> IO Decoding
decodeChunkToBuffer MArray s
dest = ForeignPtr Word8 -> (Ptr Word8 -> IO Decoding) -> IO Decoding
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Decoding) -> IO Decoding)
-> (Ptr Word8 -> IO Decoding) -> IO Decoding
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          CSize -> (Ptr CSize -> IO Decoding) -> IO Decoding
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CSize
0::CSize) ((Ptr CSize -> IO Decoding) -> IO Decoding)
-> (Ptr CSize -> IO Decoding) -> IO Decoding
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
destOffPtr ->
          CodePoint -> (Ptr CodePoint -> IO Decoding) -> IO Decoding
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CodePoint
codepoint0 ((Ptr CodePoint -> IO Decoding) -> IO Decoding)
-> (Ptr CodePoint -> IO Decoding) -> IO Decoding
forall a b. (a -> b) -> a -> b
$ \Ptr CodePoint
codepointPtr ->
          DecoderState -> (Ptr DecoderState -> IO Decoding) -> IO Decoding
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with DecoderState
state0 ((Ptr DecoderState -> IO Decoding) -> IO Decoding)
-> (Ptr DecoderState -> IO Decoding) -> IO Decoding
forall a b. (a -> b) -> a -> b
$ \Ptr DecoderState
statePtr ->
          Ptr Word8 -> (Ptr (Ptr Word8) -> IO Decoding) -> IO Decoding
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr Word8
forall {b}. Ptr b
nullPtr ((Ptr (Ptr Word8) -> IO Decoding) -> IO Decoding)
-> (Ptr (Ptr Word8) -> IO Decoding) -> IO Decoding
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
curPtrPtr ->
            let end :: Ptr b
end = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
                loop :: Ptr Word8 -> IO Decoding
loop Ptr Word8
curPtr = do
                  DecoderState
prevState <- Ptr DecoderState -> IO DecoderState
forall a. Storable a => Ptr a -> IO a
peek Ptr DecoderState
statePtr
                  Ptr (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Word8)
curPtrPtr Ptr Word8
curPtr
                  Ptr Word8
lastPtr <- MutableByteArray# s
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr Word8
-> Ptr CodePoint
-> Ptr DecoderState
-> IO (Ptr Word8)
forall s.
MutableByteArray# s
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr Word8
-> Ptr CodePoint
-> Ptr DecoderState
-> IO (Ptr Word8)
c_decode_utf8_with_state (MArray s -> MutableByteArray# s
forall s. MArray s -> MutableByteArray# s
A.maBA MArray s
dest) Ptr CSize
destOffPtr
                             Ptr (Ptr Word8)
curPtrPtr Ptr Word8
forall {b}. Ptr b
end Ptr CodePoint
codepointPtr Ptr DecoderState
statePtr
                  DecoderState
state <- Ptr DecoderState -> IO DecoderState
forall a. Storable a => Ptr a -> IO a
peek Ptr DecoderState
statePtr
                  case DecoderState
state of
                    UTF8_REJECT -> do
                      -- We encountered an encoding error
                      poke statePtr 0
                      let skipByte x = case onErr desc (Just x) of
                            Nothing -> return ()
                            Just c -> do
                              destOff <- peek destOffPtr
                              w <- unsafeSTToIO $
                                   unsafeWrite dest (cSizeToInt destOff) (safe c)
                              poke destOffPtr (destOff + intToCSize w)
                      if ptr == lastPtr && prevState /= UTF8_ACCEPT then do
                        -- If we can't complete the sequence @undecoded0@ from
                        -- the previous chunk, we invalidate the bytes from
                        -- @undecoded0@ and retry decoding the current chunk from
                        -- the initial state.
                        traverse_ skipByte (B.unpack undecoded0 )
                        loop lastPtr
                      else do
                        peek lastPtr >>= skipByte
                        loop (lastPtr `plusPtr` 1)

                    DecoderState
_ -> do
                      -- We encountered the end of the buffer while decoding
                      CSize
n <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
destOffPtr
                      CodePoint
codepoint <- Ptr CodePoint -> IO CodePoint
forall a. Storable a => Ptr a -> IO a
peek Ptr CodePoint
codepointPtr
                      Text
chunkText <- ST s Text -> IO Text
forall s a. ST s a -> IO a
unsafeSTToIO (ST s Text -> IO Text) -> ST s Text -> IO Text
forall a b. (a -> b) -> a -> b
$ do
                          Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dest
                          Text -> ST s Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Text
text Array
arr Int
0 (CSize -> Int
cSizeToInt CSize
n)
                      let left :: Int
left = Ptr Word8
lastPtr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
                          !undecoded :: ByteString
undecoded = case DecoderState
state of
                            UTF8_ACCEPT -> B.empty
                            DecoderState
_ | Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& DecoderState
prevState DecoderState -> DecoderState -> Bool
forall a. Eq a => a -> a -> Bool
/= UTF8_ACCEPT -> B.append undecoded0 bs
                              | Bool
otherwise -> Int -> ByteString -> ByteString
B.drop Int
left ByteString
bs
                      Decoding -> IO Decoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoding -> IO Decoding) -> Decoding -> IO Decoding
forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> (ByteString -> Decoding) -> Decoding
Some Text
chunkText ByteString
undecoded
                               (ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding
decodeChunk ByteString
undecoded CodePoint
codepoint DecoderState
state)
            in Ptr Word8 -> IO Decoding
loop Ptr Word8
ptr
  desc :: String
desc = String
"Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"

-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
-- to be valid.
--
-- If the input contains any invalid UTF-8 data, an exception will be
-- thrown that cannot be caught in pure code.  For more control over
-- the handling of invalid data, use 'decodeUtf8'' or
-- 'decodeUtf8With'.
decodeUtf8 :: ByteString -> Text
decodeUtf8 :: ByteString -> Text
decodeUtf8 = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
strictDecode
{-# INLINE[0] decodeUtf8 #-}
{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
    forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

-- | Decode a 'ByteString' containing UTF-8 encoded text.
--
-- If the input contains any invalid UTF-8 data, the relevant
-- exception will be returned, otherwise the decoded text.
decodeUtf8' ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  ByteString -> Either UnicodeException Text
decodeUtf8' :: ByteString -> Either UnicodeException Text
decodeUtf8' = IO (Either UnicodeException Text) -> Either UnicodeException Text
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either UnicodeException Text) -> Either UnicodeException Text)
-> (ByteString -> IO (Either UnicodeException Text))
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> IO (Either UnicodeException Text)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Text -> IO (Either UnicodeException Text))
-> (ByteString -> IO Text)
-> ByteString
-> IO (Either UnicodeException Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO Text
forall a. a -> IO a
evaluate (Text -> IO Text) -> (ByteString -> Text) -> ByteString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
strictDecode
{-# INLINE decodeUtf8' #-}

-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
--
-- @since 1.1.0.0
encodeUtf8Builder :: Text -> B.Builder
encodeUtf8Builder :: Text -> Builder
encodeUtf8Builder = BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
BP.word8)

-- | Encode text using UTF-8 encoding and escape the ASCII characters using
-- a 'BP.BoundedPrim'.
--
-- Use this function is to implement efficient encoders for text-based formats
-- like JSON or HTML.
--
-- @since 1.1.0.0
{-# INLINE encodeUtf8BuilderEscaped #-}
-- TODO: Extend documentation with references to source code in @blaze-html@
-- or @aeson@ that uses this function.
encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
encodeUtf8BuilderEscaped :: BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped BoundedPrim Word8
be =
    -- manual eta-expansion to ensure inlining works as expected
    \Text
txt -> (forall r. BuildStep r -> BuildStep r) -> Builder
B.builder (Text
-> (BufferRange -> IO (BuildSignal r))
-> BufferRange
-> IO (BuildSignal r)
forall {a}.
Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
mkBuildstep Text
txt)
  where
    bound :: Int
bound = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ BoundedPrim Word8 -> Int
forall a. BoundedPrim a -> Int
BP.sizeBound BoundedPrim Word8
be

    mkBuildstep :: Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
mkBuildstep (Text Array
arr Int
off Int
len) !BufferRange -> IO (BuildSignal a)
k =
        Int -> BufferRange -> IO (BuildSignal a)
outerLoop Int
off
      where
        iend :: Int
iend = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len

        outerLoop :: Int -> BufferRange -> IO (BuildSignal a)
outerLoop !Int
i0 !br :: BufferRange
br@(B.BufferRange Ptr Word8
op0 Ptr Word8
ope)
          | Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iend       = BufferRange -> IO (BuildSignal a)
k BufferRange
br
          | Int
outRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> IO (BuildSignal a)
goPartial (Int
i0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
outRemaining Int
inpRemaining)
          -- TODO: Use a loop with an integrated bound's check if outRemaining
          -- is smaller than 8, as this will save on divisions.
          | Bool
otherwise        = BuildSignal a -> IO (BuildSignal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int
-> Ptr Word8
-> (BufferRange -> IO (BuildSignal a))
-> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
B.bufferFull Int
bound Ptr Word8
op0 (Int -> BufferRange -> IO (BuildSignal a)
outerLoop Int
i0)
          where
            outRemaining :: Int
outRemaining = (Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op0) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bound
            inpRemaining :: Int
inpRemaining = Int
iend Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i0

            goPartial :: Int -> IO (BuildSignal a)
goPartial !Int
iendTmp = Int -> Ptr Word8 -> IO (BuildSignal a)
go Int
i0 Ptr Word8
op0
              where
                go :: Int -> Ptr Word8 -> IO (BuildSignal a)
go !Int
i !Ptr Word8
op
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
iendTmp = case Array -> Int -> Word16
A.unsafeIndex Array
arr Int
i of
                      Word16
w | Word16
w Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0x7F -> do
                            BoundedPrim Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
BP.runB BoundedPrim Word8
be (Word16 -> Word8
word16ToWord8 Word16
w) Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                        | Word16
w Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0x7FF -> do
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
0 (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word16
w Word16 -> Int -> Word16
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
6) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
0xC0
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
1 (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word16
w Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x3f) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
0x80
                            Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
                        | Word16
0xD800 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
w Bool -> Bool -> Bool
&& Word16
w Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDBFF -> do
                            let c :: Int
c = Char -> Int
ord (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Char
U16.chr2 Word16
w (Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
0 (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int
c Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
18) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xF0
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
1 (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Int
c Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
2 (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Int
c Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
3 (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
                            Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)
                        | Bool
otherwise -> do
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
0 (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word16
w Word16 -> Int -> Word16
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
12) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
0xE0
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
1 (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Word16
w Word16 -> Int -> Word16
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
6) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x3F) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
0x80
                            forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
2 (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word16
w Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x3F) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
0x80
                            Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
                  | Bool
otherwise =
                      Int -> BufferRange -> IO (BuildSignal a)
outerLoop Int
i (Ptr Word8 -> Ptr Word8 -> BufferRange
B.BufferRange Ptr Word8
op Ptr Word8
ope)
                  where
                    -- Take care, a is either Word16 or Int above
                    poke8 :: Integral a => Int -> a -> IO ()
                    poke8 :: forall a. Integral a => Int -> a -> IO ()
poke8 Int
j a
v = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
j) (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v :: Word8)

-- | Encode text using UTF-8 encoding.
encodeUtf8 :: Text -> ByteString
encodeUtf8 :: Text -> ByteString
encodeUtf8 (Text Array
arr Int
off Int
len)
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = ByteString
B.empty
  | Bool
otherwise = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
  ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
    Ptr Word8 -> (Ptr (Ptr Word8) -> IO ByteString) -> IO ByteString
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr Word8
ptr ((Ptr (Ptr Word8) -> IO ByteString) -> IO ByteString)
-> (Ptr (Ptr Word8) -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
destPtr -> do
      Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
c_encode_utf8 Ptr (Ptr Word8)
destPtr (Array -> ByteArray#
A.aBA Array
arr) (Int -> CSize
intToCSize Int
off) (Int -> CSize
intToCSize Int
len)
      Ptr Word8
newDest <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
destPtr
      let utf8len :: Int
utf8len = Ptr Word8
newDest Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
      if Int
utf8len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
1
        then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
fp Int
utf8len)
        else do
          ForeignPtr Word8
fp' <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
utf8len
          ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp' ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr' -> do
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
ptr' Ptr Word8
ptr Int
utf8len
            ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
fp' Int
utf8len)

-- | Decode text from little endian UTF-16 encoding.
decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16LEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf16LE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf16LEWith #-}

-- | Decode text from little endian UTF-16 encoding.
--
-- If the input contains any invalid little endian UTF-16 data, an
-- exception will be thrown.  For more control over the handling of
-- invalid data, use 'decodeUtf16LEWith'.
decodeUtf16LE :: ByteString -> Text
decodeUtf16LE :: ByteString -> Text
decodeUtf16LE = OnDecodeError -> ByteString -> Text
decodeUtf16LEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf16LE #-}

-- | Decode text from big endian UTF-16 encoding.
decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16BEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf16BE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf16BEWith #-}

-- | Decode text from big endian UTF-16 encoding.
--
-- If the input contains any invalid big endian UTF-16 data, an
-- exception will be thrown.  For more control over the handling of
-- invalid data, use 'decodeUtf16BEWith'.
decodeUtf16BE :: ByteString -> Text
decodeUtf16BE :: ByteString -> Text
decodeUtf16BE = OnDecodeError -> ByteString -> Text
decodeUtf16BEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf16BE #-}

-- | Encode text using little endian UTF-16 encoding.
encodeUtf16LE :: Text -> ByteString
encodeUtf16LE :: Text -> ByteString
encodeUtf16LE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf16LE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf16LE #-}

-- | Encode text using big endian UTF-16 encoding.
encodeUtf16BE :: Text -> ByteString
encodeUtf16BE :: Text -> ByteString
encodeUtf16BE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf16BE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf16BE #-}

-- | Decode text from little endian UTF-32 encoding.
decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32LEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf32LE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf32LEWith #-}

-- | Decode text from little endian UTF-32 encoding.
--
-- If the input contains any invalid little endian UTF-32 data, an
-- exception will be thrown.  For more control over the handling of
-- invalid data, use 'decodeUtf32LEWith'.
decodeUtf32LE :: ByteString -> Text
decodeUtf32LE :: ByteString -> Text
decodeUtf32LE = OnDecodeError -> ByteString -> Text
decodeUtf32LEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf32LE #-}

-- | Decode text from big endian UTF-32 encoding.
decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32BEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf32BE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf32BEWith #-}

-- | Decode text from big endian UTF-32 encoding.
--
-- If the input contains any invalid big endian UTF-32 data, an
-- exception will be thrown.  For more control over the handling of
-- invalid data, use 'decodeUtf32BEWith'.
decodeUtf32BE :: ByteString -> Text
decodeUtf32BE :: ByteString -> Text
decodeUtf32BE = OnDecodeError -> ByteString -> Text
decodeUtf32BEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf32BE #-}

-- | Encode text using little endian UTF-32 encoding.
encodeUtf32LE :: Text -> ByteString
encodeUtf32LE :: Text -> ByteString
encodeUtf32LE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf32LE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf32LE #-}

-- | Encode text using big endian UTF-32 encoding.
encodeUtf32BE :: Text -> ByteString
encodeUtf32BE :: Text -> ByteString
encodeUtf32BE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf32BE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf32BE #-}

cSizeToInt :: CSize -> Int
cSizeToInt :: CSize -> Int
cSizeToInt = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral

word16ToWord8 :: Word16 -> Word8
word16ToWord8 :: Word16 -> Word8
word16ToWord8 = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
    :: MutableByteArray# s -> Ptr CSize
    -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
    :: MutableByteArray# s -> Ptr CSize
    -> Ptr (Ptr Word8) -> Ptr Word8
    -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)

foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
    :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()

foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
    :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()