{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Data.ByteString.Lazy.Encoding.Internal
( encode
, encodeWith
, decode
, decodeWith
) where
import Control.Exception
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as BL
import Data.Char (ord)
import qualified Data.Text as T
import qualified Data.Text.Foreign as T
import qualified Data.Text.Lazy as TL
import Data.Word
import Foreign
import qualified Foreign.Concurrent as Conc
import Foreign.ForeignPtr (touchForeignPtr)
import Foreign.Ptr (nullPtr)
import qualified GHC.IO.Encoding as Enc
import GHC.IO.Buffer
import System.IO.Unsafe
encode :: Enc.TextEncoding -> TL.Text -> BL.ByteString
encode :: TextEncoding -> Text -> ByteString
encode TextEncoding
enc = TextEncoding -> Int -> Int -> Text -> ByteString
encodeWith TextEncoding
enc Int
1024 Int
1024
encodeWith :: Enc.TextEncoding -> Int -> Int -> TL.Text -> BL.ByteString
encodeWith :: TextEncoding -> Int -> Int -> Text -> ByteString
encodeWith TextEncoding
enc Int
inBufSize Int
outBufSize = TextEncoding -> Int -> Int -> String -> ByteString
encodeStringWith TextEncoding
enc Int
inBufSize Int
outBufSize (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
encodeStringWith :: Enc.TextEncoding -> Int -> Int -> String -> BL.ByteString
encodeStringWith :: TextEncoding -> Int -> Int -> String -> ByteString
encodeStringWith Enc.TextEncoding{ String
IO (TextEncoder estate)
IO (TextDecoder dstate)
textEncodingName :: TextEncoding -> String
mkTextDecoder :: ()
mkTextEncoder :: ()
mkTextEncoder :: IO (TextEncoder estate)
mkTextDecoder :: IO (TextDecoder dstate)
textEncodingName :: String
.. } Int
inBufSize Int
outBufSize String
s = [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ IO [ByteString] -> [ByteString]
forall a. IO a -> a
unsafePerformIO (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ do
Enc.BufferCodec{ IO estate
IO ()
estate -> IO ()
Buffer CharBufElem
-> Buffer Word8 -> IO (Buffer CharBufElem, Buffer Word8)
CodeBuffer CharBufElem Word8
encode :: forall from to state.
BufferCodec from to state -> CodeBuffer from to
recover :: forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
close :: forall from to state. BufferCodec from to state -> IO ()
getState :: forall from to state. BufferCodec from to state -> IO state
setState :: forall from to state. BufferCodec from to state -> state -> IO ()
setState :: estate -> IO ()
getState :: IO estate
close :: IO ()
recover :: Buffer CharBufElem
-> Buffer Word8 -> IO (Buffer CharBufElem, Buffer Word8)
encode :: CodeBuffer CharBufElem Word8
.. } <- IO (TextEncoder estate)
mkTextEncoder
ForeignPtr Any
fp <- Ptr Any -> IO () -> IO (ForeignPtr Any)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
Conc.newForeignPtr Ptr Any
forall a. Ptr a
nullPtr IO ()
close
let fillInBuf :: String -> CharBuffer -> IO (String, CharBuffer)
fillInBuf :: String -> Buffer CharBufElem -> IO (String, Buffer CharBufElem)
fillInBuf String
s Buffer CharBufElem
buf
| Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf = String -> Buffer CharBufElem -> IO (String, Buffer CharBufElem)
go String
s Buffer CharBufElem
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
| Bool
otherwise = String -> Buffer CharBufElem -> IO (String, Buffer CharBufElem)
go String
s Buffer CharBufElem
buf
where
go :: String -> CharBuffer -> IO (String, CharBuffer)
go :: String -> Buffer CharBufElem -> IO (String, Buffer CharBufElem)
go [] Buffer CharBufElem
buf = (String, Buffer CharBufElem) -> IO (String, Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Buffer CharBufElem
buf)
go s :: String
s@(CharBufElem
c : String
cs) buf :: Buffer CharBufElem
buf@Buffer{ bufR :: forall e. Buffer e -> Int
bufR = Int
r, bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw = RawBuffer CharBufElem
iraw}
| Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isFullCharBuffer Buffer CharBufElem
buf = (String, Buffer CharBufElem) -> IO (String, Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s, Buffer CharBufElem
buf)
| Bool
otherwise = do
Int
r' <- RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
iraw Int
r CharBufElem
c
String -> Buffer CharBufElem -> IO (String, Buffer CharBufElem)
go String
cs Buffer CharBufElem
buf{ bufR :: Int
bufR = Int
r' }
flushOutBuf :: Buffer Word8 -> IO ([B.ByteString], Buffer Word8)
flushOutBuf :: Buffer Word8 -> IO ([ByteString], Buffer Word8)
flushOutBuf Buffer Word8
buf
| Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
buf = ([ByteString], Buffer Word8) -> IO ([ByteString], Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Buffer Word8
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 })
| Bool
otherwise = do
Buffer Word8
-> (Ptr Word8 -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8)
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
buf ((Ptr Word8 -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8))
-> (Ptr Word8 -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
ByteString
b <- CStringLen -> IO ByteString
B.packCStringLen (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p, Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferElems Buffer Word8
buf)
([ByteString], Buffer Word8) -> IO ([ByteString], Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString
b], Buffer Word8
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 })
loop :: String -> CharBuffer -> Buffer Word8 -> IO [B.ByteString]
loop :: String -> Buffer CharBufElem -> Buffer Word8 -> IO [ByteString]
loop String
s Buffer CharBufElem
inBuf Buffer Word8
outBuf = do
(String
s', Buffer CharBufElem
inBuf1) <- String -> Buffer CharBufElem -> IO (String, Buffer CharBufElem)
fillInBuf String
s Buffer CharBufElem
inBuf
if Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
inBuf1 then do
Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
([ByteString]
m, Buffer Word8
_outBuf') <- Buffer Word8 -> IO ([ByteString], Buffer Word8)
flushOutBuf Buffer Word8
outBuf
ForeignPtr Any -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Any
fp
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
m
else do
(CodingProgress
ret, Buffer CharBufElem
inBuf2, Buffer Word8
outBuf2) <- CodeBuffer CharBufElem Word8
encode Buffer CharBufElem
inBuf1 Buffer Word8
outBuf
case CodingProgress
ret of
CodingProgress
Enc.InputUnderflow -> do
if Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isFullCharBuffer Buffer CharBufElem
inBuf2 Bool -> Bool -> Bool
&& Bool -> Bool
not (Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
inBuf2) then do
RawBuffer CharBufElem -> (Ptr CharBufElem -> IO ()) -> IO ()
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer (Buffer CharBufElem -> RawBuffer CharBufElem
forall e. Buffer e -> RawBuffer e
bufRaw Buffer CharBufElem
inBuf2) ((Ptr CharBufElem -> IO ()) -> IO ())
-> (Ptr CharBufElem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CharBufElem
p -> do
Ptr CharBufElem -> Ptr CharBufElem -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
moveArray Ptr CharBufElem
p (Ptr CharBufElem
p Ptr CharBufElem -> Int -> Ptr CharBufElem
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufL Buffer CharBufElem
inBuf2) (Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufferElems Buffer CharBufElem
inBuf2)
String -> Buffer CharBufElem -> Buffer Word8 -> IO [ByteString]
loop String
s' Buffer CharBufElem
inBuf2{ bufL :: Int
bufL = Int
0, bufR :: Int
bufR = Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufferElems Buffer CharBufElem
inBuf2 } Buffer Word8
outBuf2
else do
String -> Buffer CharBufElem -> Buffer Word8 -> IO [ByteString]
loop String
s' Buffer CharBufElem
inBuf2 Buffer Word8
outBuf2
CodingProgress
Enc.OutputUnderflow -> do
([ByteString]
b, Buffer Word8
outBuf3) <- Buffer Word8 -> IO ([ByteString], Buffer Word8)
flushOutBuf Buffer Word8
outBuf2
[ByteString]
bs <- IO [ByteString] -> IO [ByteString]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [ByteString] -> IO [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> Buffer CharBufElem -> Buffer Word8 -> IO [ByteString]
loop String
s' Buffer CharBufElem
inBuf2 Buffer Word8
outBuf3
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
b [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
bs
CodingProgress
Enc.InvalidSequence -> do
if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isFullBuffer Buffer Word8
outBuf2 then do
([ByteString]
b, Buffer Word8
outBuf3) <- Buffer Word8 -> IO ([ByteString], Buffer Word8)
flushOutBuf Buffer Word8
outBuf2
(Buffer CharBufElem
inBuf4, Buffer Word8
outBuf4) <- Buffer CharBufElem
-> Buffer Word8 -> IO (Buffer CharBufElem, Buffer Word8)
recover Buffer CharBufElem
inBuf2 Buffer Word8
outBuf3
[ByteString]
bs <- IO [ByteString] -> IO [ByteString]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [ByteString] -> IO [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> Buffer CharBufElem -> Buffer Word8 -> IO [ByteString]
loop String
s' Buffer CharBufElem
inBuf4 Buffer Word8
outBuf4
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
b [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
bs
else do
(Buffer CharBufElem
inBuf3, Buffer Word8
outBuf3) <- Buffer CharBufElem
-> Buffer Word8 -> IO (Buffer CharBufElem, Buffer Word8)
recover Buffer CharBufElem
inBuf2 Buffer Word8
outBuf2
String -> Buffer CharBufElem -> Buffer Word8 -> IO [ByteString]
loop String
s' Buffer CharBufElem
inBuf3 Buffer Word8
outBuf3
Buffer CharBufElem
inBuf <- Int -> BufferState -> IO (Buffer CharBufElem)
newCharBuffer Int
inBufSize BufferState
ReadBuffer
Buffer Word8
outBuf <- Int -> BufferState -> IO (Buffer Word8)
newByteBuffer Int
outBufSize BufferState
WriteBuffer
String -> Buffer CharBufElem -> Buffer Word8 -> IO [ByteString]
loop String
s Buffer CharBufElem
inBuf Buffer Word8
outBuf
decode :: Enc.TextEncoding -> BL.ByteString -> TL.Text
decode :: TextEncoding -> ByteString -> Text
decode TextEncoding
enc ByteString
b = TextEncoding -> Int -> Int -> ByteString -> Text
decodeWith TextEncoding
enc Int
1024 Int
1024 ByteString
b
decodeWith :: Enc.TextEncoding -> Int -> Int -> BL.ByteString -> TL.Text
decodeWith :: TextEncoding -> Int -> Int -> ByteString -> Text
decodeWith Enc.TextEncoding{ String
IO (TextEncoder estate)
IO (TextDecoder dstate)
mkTextEncoder :: IO (TextEncoder estate)
mkTextDecoder :: IO (TextDecoder dstate)
textEncodingName :: String
textEncodingName :: TextEncoding -> String
mkTextDecoder :: ()
mkTextEncoder :: ()
.. } Int
inBufSize Int
outBufSize ByteString
b = [Text] -> Text
TL.fromChunks ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ IO [Text] -> [Text]
forall a. IO a -> a
unsafePerformIO (IO [Text] -> [Text]) -> IO [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ do
Enc.BufferCodec{ IO dstate
IO ()
dstate -> IO ()
Buffer Word8
-> Buffer CharBufElem -> IO (Buffer Word8, Buffer CharBufElem)
CodeBuffer Word8 CharBufElem
setState :: dstate -> IO ()
getState :: IO dstate
close :: IO ()
recover :: Buffer Word8
-> Buffer CharBufElem -> IO (Buffer Word8, Buffer CharBufElem)
encode :: CodeBuffer Word8 CharBufElem
encode :: forall from to state.
BufferCodec from to state -> CodeBuffer from to
recover :: forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
close :: forall from to state. BufferCodec from to state -> IO ()
getState :: forall from to state. BufferCodec from to state -> IO state
setState :: forall from to state. BufferCodec from to state -> state -> IO ()
.. } <- IO (TextDecoder dstate)
mkTextDecoder
ForeignPtr Any
fp <- Ptr Any -> IO () -> IO (ForeignPtr Any)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
Conc.newForeignPtr Ptr Any
forall a. Ptr a
nullPtr IO ()
close
let fillInBuf :: [B.ByteString] -> Buffer Word8 -> IO ([B.ByteString], Buffer Word8)
fillInBuf :: [ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
fillInBuf [ByteString]
bs Buffer Word8
buf
| Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
buf = [ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
go [ByteString]
bs Buffer Word8
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
| Bool
otherwise = [ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
go [ByteString]
bs Buffer Word8
buf
where
go :: [B.ByteString] -> Buffer Word8 -> IO ([B.ByteString], Buffer Word8)
go :: [ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
go [] Buffer Word8
buf = ([ByteString], Buffer Word8) -> IO ([ByteString], Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Buffer Word8
buf)
go bbs :: [ByteString]
bbs@(ByteString
b : [ByteString]
bs) Buffer Word8
buf
| Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isFullBuffer Buffer Word8
buf = ([ByteString], Buffer Word8) -> IO ([ByteString], Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString]
bbs, Buffer Word8
buf)
| ByteString -> Bool
B.null ByteString
b = [ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
go [ByteString]
bs Buffer Word8
buf
| Bool
otherwise = do
ByteString
-> (Ptr CChar -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8)
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
B.unsafeUseAsCString ByteString
b ((Ptr CChar -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8))
-> (Ptr CChar -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
p -> do
Buffer Word8
-> (Ptr Word8 -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8)
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
buf ((Ptr Word8 -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8))
-> (Ptr Word8 -> IO ([ByteString], Buffer Word8))
-> IO ([ByteString], Buffer Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
q -> do
if ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferAvailable Buffer Word8
buf then do
Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
moveBytes (Ptr Word8
q Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
buf) Ptr CChar
p (ByteString -> Int
B.length ByteString
b)
[ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
go [ByteString]
bs Buffer Word8
buf{ bufR :: Int
bufR = Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
b }
else do
Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
moveBytes (Ptr Word8
q Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
buf) Ptr CChar
p (Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferAvailable Buffer Word8
buf)
[ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
go (Int -> ByteString -> ByteString
B.drop (Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferAvailable Buffer Word8
buf) ByteString
b ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
bs) Buffer Word8
buf{ bufR :: Int
bufR = Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferAvailable Buffer Word8
buf }
#if MIN_VERSION_text(2,0,0)
flushOutBuf :: CharBuffer -> ForeignPtr Word8 -> IO ([T.Text], CharBuffer)
flushOutBuf buf workspace
| isEmptyBuffer buf = return ([], buf{ bufL=0, bufR=0 })
| otherwise =
withForeignPtr workspace $ \workspace' ->
withBuffer buf $ \p -> do
let f !i !j
| bufR buf <= i = return j
| otherwise = do
(c, i') <- readCharBufPtr (castPtr p) i
j' <- writeUTF8 workspace' j c
f i' j'
n <- f (bufL buf) 0
t <- T.fromPtr workspace' (fromIntegral n)
return ([t], buf{ bufL=0, bufR=0 })
#else
flushOutBuf :: CharBuffer -> ForeignPtr Word16 -> IO ([T.Text], CharBuffer)
flushOutBuf :: Buffer CharBufElem
-> ForeignPtr Word16 -> IO ([Text], Buffer CharBufElem)
flushOutBuf Buffer CharBufElem
buf ForeignPtr Word16
workspace
| Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf = ([Text], Buffer CharBufElem) -> IO ([Text], Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Buffer CharBufElem
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 })
| Int
charSizeInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
2 = do
Buffer CharBufElem
-> (Ptr CharBufElem -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem)
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer CharBufElem
buf ((Ptr CharBufElem -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem))
-> (Ptr CharBufElem -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem)
forall a b. (a -> b) -> a -> b
$ \Ptr CharBufElem
p -> do
let p' :: Ptr Word16
p' :: Ptr Word16
p' = Ptr CharBufElem -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr CharBufElem
p
Text
t <- Ptr Word16 -> I16 -> IO Text
T.fromPtr (Ptr Word16
p' Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufL Buffer CharBufElem
buf) (Int -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufferElems Buffer CharBufElem
buf))
([Text], Buffer CharBufElem) -> IO ([Text], Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text
t], Buffer CharBufElem
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 })
| Bool
otherwise =
ForeignPtr Word16
-> (Ptr Word16 -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem)
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withForeignPtr ForeignPtr Word16
workspace ((Ptr Word16 -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem))
-> (Ptr Word16 -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem)
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
workspace' ->
Buffer CharBufElem
-> (Ptr CharBufElem -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem)
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer CharBufElem
buf ((Ptr CharBufElem -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem))
-> (Ptr CharBufElem -> IO ([Text], Buffer CharBufElem))
-> IO ([Text], Buffer CharBufElem)
forall a b. (a -> b) -> a -> b
$ \Ptr CharBufElem
p -> do
let p' :: Ptr Char
p' :: Ptr CharBufElem
p' = Ptr CharBufElem -> Ptr CharBufElem
forall a b. Ptr a -> Ptr b
castPtr Ptr CharBufElem
p
f :: Int -> Int -> IO Int
f !Int
i !Int
j
| Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufR Buffer CharBufElem
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
j
| Bool
otherwise = do
Int
c <- (CharBufElem -> Int) -> IO CharBufElem -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CharBufElem -> Int
forall a. Enum a => a -> Int
fromEnum (IO CharBufElem -> IO Int) -> IO CharBufElem -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CharBufElem -> Int -> IO CharBufElem
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
p' Int
i
if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 then do
Ptr Word16 -> Int -> Word16 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word16
workspace' Int
j (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)
Int -> Int -> IO Int
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else do
let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
Ptr Word16 -> Int -> Word16 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word16
workspace' Int
j (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xd800))
Ptr Word16 -> Int -> Word16 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word16
workspace' (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xdc00))
Int -> Int -> IO Int
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
Int
n <- Int -> Int -> IO Int
f (Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufL Buffer CharBufElem
buf) Int
0
Text
t <- Ptr Word16 -> I16 -> IO Text
T.fromPtr Ptr Word16
workspace' (Int -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
([Text], Buffer CharBufElem) -> IO ([Text], Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text
t], Buffer CharBufElem
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 })
#endif
#if MIN_VERSION_text(2,0,0)
loop :: [B.ByteString] -> Buffer Word8 -> CharBuffer -> ForeignPtr Word8 -> IO [T.Text]
#else
loop :: [B.ByteString] -> Buffer Word8 -> CharBuffer -> ForeignPtr Word16 -> IO [T.Text]
#endif
loop :: [ByteString]
-> Buffer Word8
-> Buffer CharBufElem
-> ForeignPtr Word16
-> IO [Text]
loop [ByteString]
bs Buffer Word8
inBuf Buffer CharBufElem
outBuf ForeignPtr Word16
workspace = do
([ByteString]
bs', Buffer Word8
inBuf1) <- [ByteString] -> Buffer Word8 -> IO ([ByteString], Buffer Word8)
fillInBuf [ByteString]
bs Buffer Word8
inBuf
if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
inBuf1 then do
Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
bs') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
([Text]
m, Buffer CharBufElem
_outBuf') <- Buffer CharBufElem
-> ForeignPtr Word16 -> IO ([Text], Buffer CharBufElem)
flushOutBuf Buffer CharBufElem
outBuf ForeignPtr Word16
workspace
ForeignPtr Any -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Any
fp
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
m
else do
(CodingProgress
ret, Buffer Word8
inBuf2, Buffer CharBufElem
outBuf2) <- CodeBuffer Word8 CharBufElem
encode Buffer Word8
inBuf1 Buffer CharBufElem
outBuf
case CodingProgress
ret of
CodingProgress
Enc.InputUnderflow -> do
if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isFullBuffer Buffer Word8
inBuf2 Bool -> Bool -> Bool
&& Bool -> Bool
not (Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
inBuf2) then do
Buffer Word8
inBuf3 <- Buffer Word8 -> IO (Buffer Word8)
slideContents Buffer Word8
inBuf2
[ByteString]
-> Buffer Word8
-> Buffer CharBufElem
-> ForeignPtr Word16
-> IO [Text]
loop [ByteString]
bs' Buffer Word8
inBuf3 Buffer CharBufElem
outBuf2 ForeignPtr Word16
workspace
else do
[ByteString]
-> Buffer Word8
-> Buffer CharBufElem
-> ForeignPtr Word16
-> IO [Text]
loop [ByteString]
bs' Buffer Word8
inBuf2 Buffer CharBufElem
outBuf2 ForeignPtr Word16
workspace
CodingProgress
Enc.OutputUnderflow -> do
([Text]
t, Buffer CharBufElem
outBuf3) <- Buffer CharBufElem
-> ForeignPtr Word16 -> IO ([Text], Buffer CharBufElem)
flushOutBuf Buffer CharBufElem
outBuf2 ForeignPtr Word16
workspace
[Text]
ts <- IO [Text] -> IO [Text]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Text] -> IO [Text]) -> IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [ByteString]
-> Buffer Word8
-> Buffer CharBufElem
-> ForeignPtr Word16
-> IO [Text]
loop [ByteString]
bs' Buffer Word8
inBuf2 Buffer CharBufElem
outBuf3 ForeignPtr Word16
workspace
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
t [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ts
CodingProgress
Enc.InvalidSequence -> do
if Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isFullCharBuffer Buffer CharBufElem
outBuf2 then do
([Text]
t, Buffer CharBufElem
outBuf3) <- Buffer CharBufElem
-> ForeignPtr Word16 -> IO ([Text], Buffer CharBufElem)
flushOutBuf Buffer CharBufElem
outBuf2 ForeignPtr Word16
workspace
(Buffer Word8
inBuf4, Buffer CharBufElem
outBuf4) <- Buffer Word8
-> Buffer CharBufElem -> IO (Buffer Word8, Buffer CharBufElem)
recover Buffer Word8
inBuf2 Buffer CharBufElem
outBuf3
[Text]
ts <- IO [Text] -> IO [Text]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Text] -> IO [Text]) -> IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [ByteString]
-> Buffer Word8
-> Buffer CharBufElem
-> ForeignPtr Word16
-> IO [Text]
loop [ByteString]
bs' Buffer Word8
inBuf4 Buffer CharBufElem
outBuf4 ForeignPtr Word16
workspace
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
t [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ts
else do
(Buffer Word8
inBuf3, Buffer CharBufElem
outBuf3) <- Buffer Word8
-> Buffer CharBufElem -> IO (Buffer Word8, Buffer CharBufElem)
recover Buffer Word8
inBuf2 Buffer CharBufElem
outBuf2
[ByteString]
-> Buffer Word8
-> Buffer CharBufElem
-> ForeignPtr Word16
-> IO [Text]
loop [ByteString]
bs' Buffer Word8
inBuf3 Buffer CharBufElem
outBuf3 ForeignPtr Word16
workspace
Buffer Word8
inBuf <- Int -> BufferState -> IO (Buffer Word8)
newByteBuffer Int
inBufSize BufferState
ReadBuffer
Buffer CharBufElem
outBuf <- Int -> BufferState -> IO (Buffer CharBufElem)
newCharBuffer Int
outBufSize BufferState
WriteBuffer
#if MIN_VERSION_text(2,0,0)
workspace <- mallocForeignPtrArray (outBufSize * 4)
#else
ForeignPtr Word16
workspace <- if Int
charSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then Ptr Word16 -> IO (ForeignPtr Word16)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Word16
forall a. Ptr a
nullPtr else Int -> IO (ForeignPtr Word16)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray (Int
outBufSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
#endif
[ByteString]
-> Buffer Word8
-> Buffer CharBufElem
-> ForeignPtr Word16
-> IO [Text]
loop (ByteString -> [ByteString]
BL.toChunks ByteString
b) Buffer Word8
inBuf Buffer CharBufElem
outBuf ForeignPtr Word16
workspace
#if MIN_VERSION_text(2,0,0)
writeUTF8 :: Ptr Word8 -> Int -> Char -> IO Int
writeUTF8 p i c = do
let x = ord c
if x <= 0x7F then do
pokeElemOff p i (fromIntegral x)
return $! i+1
else if x <= 0x07FF then do
let (c1,c2) = ord2 c
pokeElemOff p i c1
pokeElemOff p (i+1) c2
return $! i+2
else if x <= 0xFFFF then do
let (c1,c2,c3) = ord3 c
pokeElemOff p i c1
pokeElemOff p (i+1) c2
pokeElemOff p (i+2) c3
return $! i+3
else do
let (c1,c2,c3,c4) = ord4 c
pokeElemOff p i c1
pokeElemOff p (i+1) c2
pokeElemOff p (i+2) c3
pokeElemOff p (i+3) c4
return $! i+4
ord2 :: Char -> (Word8,Word8)
ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)
where
n = ord c
x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
x2 = fromIntegral $ (n .&. 0x3F) + 0x80
ord3 :: Char -> (Word8,Word8,Word8)
ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)
where
n = ord c
x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
x3 = fromIntegral $ (n .&. 0x3F) + 0x80
ord4 :: Char -> (Word8,Word8,Word8,Word8)
ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)
where
n = ord c
x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
x4 = fromIntegral $ (n .&. 0x3F) + 0x80
#endif