8cf77b0a96d60668ed18b9552b86b712ab936c00
[ghc.git] / libraries / base / GHC / IO / Encoding / CodePage / API.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, NondecreasingIndentation,
3 RecordWildCards, ScopedTypeVariables #-}
4 {-# OPTIONS_GHC -Wno-name-shadowing #-}
5
6 module GHC.IO.Encoding.CodePage.API (
7 mkCodePageEncoding
8 ) where
9
10 import Foreign.C
11 import Foreign.Ptr
12 import Foreign.Marshal
13 import Foreign.Storable
14 import Data.Bits
15 import Data.Either
16 import Data.Word
17
18 import GHC.Base
19 import GHC.List
20 import GHC.IO.Buffer
21 import GHC.IO.Encoding.Failure
22 import GHC.IO.Encoding.Types
23 import GHC.IO.Encoding.UTF16
24 import GHC.Num
25 import GHC.Show
26 import GHC.Real
27 import GHC.Windows
28 import GHC.ForeignPtr (castForeignPtr)
29
30 import System.Posix.Internals
31
32
33 c_DEBUG_DUMP :: Bool
34 c_DEBUG_DUMP = False
35
36 debugIO :: String -> IO ()
37 debugIO s
38 | c_DEBUG_DUMP = puts s
39 | otherwise = return ()
40
41
42 #if defined(i386_HOST_ARCH)
43 # define WINDOWS_CCONV stdcall
44 #elif defined(x86_64_HOST_ARCH)
45 # define WINDOWS_CCONV ccall
46 #else
47 # error Unknown mingw32 arch
48 #endif
49
50
51 type LPCSTR = Ptr Word8
52
53
54 mAX_DEFAULTCHAR :: Int
55 mAX_DEFAULTCHAR = 2
56
57 mAX_LEADBYTES :: Int
58 mAX_LEADBYTES = 12
59
60 -- Don't really care about the contents of this, but we have to make sure the size is right
61 data CPINFO = CPINFO {
62 maxCharSize :: UINT,
63 defaultChar :: [BYTE], -- ^ Always of length mAX_DEFAULTCHAR
64 leadByte :: [BYTE] -- ^ Always of length mAX_LEADBYTES
65 }
66
67 -- | @since 4.7.0.0
68 instance Storable CPINFO where
69 sizeOf _ = sizeOf (undefined :: UINT) + (mAX_DEFAULTCHAR + mAX_LEADBYTES) * sizeOf (undefined :: BYTE)
70 alignment _ = alignment (undefined :: CInt)
71 peek ptr = do
72 ptr <- return $ castPtr ptr
73 a <- peek ptr
74 ptr <- return $ castPtr $ advancePtr ptr 1
75 b <- peekArray mAX_DEFAULTCHAR ptr
76 c <- peekArray mAX_LEADBYTES (advancePtr ptr mAX_DEFAULTCHAR)
77 return $ CPINFO a b c
78 poke ptr val = do
79 ptr <- return $ castPtr ptr
80 poke ptr (maxCharSize val)
81 ptr <- return $ castPtr $ advancePtr ptr 1
82 pokeArray' "CPINFO.defaultChar" mAX_DEFAULTCHAR ptr (defaultChar val)
83 pokeArray' "CPINFO.leadByte" mAX_LEADBYTES (advancePtr ptr mAX_DEFAULTCHAR) (leadByte val)
84
85 pokeArray' :: Storable a => String -> Int -> Ptr a -> [a] -> IO ()
86 pokeArray' msg sz ptr xs | length xs == sz = pokeArray ptr xs
87 | otherwise = errorWithoutStackTrace $ msg ++ ": expected " ++ show sz ++ " elements in list but got " ++ show (length xs)
88
89
90 foreign import WINDOWS_CCONV unsafe "windows.h GetCPInfo"
91 c_GetCPInfo :: UINT -- ^ CodePage
92 -> Ptr CPINFO -- ^ lpCPInfo
93 -> IO BOOL
94
95 foreign import WINDOWS_CCONV unsafe "windows.h MultiByteToWideChar"
96 c_MultiByteToWideChar :: UINT -- ^ CodePage
97 -> DWORD -- ^ dwFlags
98 -> LPCSTR -- ^ lpMultiByteStr
99 -> CInt -- ^ cbMultiByte
100 -> LPWSTR -- ^ lpWideCharStr
101 -> CInt -- ^ cchWideChar
102 -> IO CInt
103
104 foreign import WINDOWS_CCONV unsafe "windows.h WideCharToMultiByte"
105 c_WideCharToMultiByte :: UINT -- ^ CodePage
106 -> DWORD -- ^ dwFlags
107 -> LPWSTR -- ^ lpWideCharStr
108 -> CInt -- ^ cchWideChar
109 -> LPCSTR -- ^ lpMultiByteStr
110 -> CInt -- ^ cbMultiByte
111 -> LPCSTR -- ^ lpDefaultChar
112 -> LPBOOL -- ^ lpUsedDefaultChar
113 -> IO CInt
114
115 foreign import WINDOWS_CCONV unsafe "windows.h IsDBCSLeadByteEx"
116 c_IsDBCSLeadByteEx :: UINT -- ^ CodePage
117 -> BYTE -- ^ TestChar
118 -> IO BOOL
119
120
121 -- | Returns a slow but correct implementation of TextEncoding using the Win32 API.
122 --
123 -- This is useful for supporting DBCS text encoding on the console without having to statically link
124 -- in huge code tables into all of our executables, or just as a fallback mechanism if a new code page
125 -- is introduced that we don't know how to deal with ourselves yet.
126 mkCodePageEncoding :: CodingFailureMode -> Word32 -> TextEncoding
127 mkCodePageEncoding cfm cp
128 = TextEncoding {
129 textEncodingName = "CP" ++ show cp,
130 mkTextDecoder = newCP (recoverDecode cfm) cpDecode cp,
131 mkTextEncoder = newCP (recoverEncode cfm) cpEncode cp
132 }
133
134 newCP :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
135 -> (Word32 -> Int -> CodeBuffer from to)
136 -> Word32
137 -> IO (BufferCodec from to ())
138 newCP rec fn cp = do
139 -- Fail early if the code page doesn't exist, to match the behaviour of the IConv TextEncoding
140 max_char_size <- alloca $ \cpinfo_ptr -> do
141 success <- c_GetCPInfo cp cpinfo_ptr
142 when (not success) $ throwGetLastError ("GetCPInfo " ++ show cp)
143 fmap (fromIntegral . maxCharSize) $ peek cpinfo_ptr
144
145 debugIO $ "GetCPInfo " ++ show cp ++ " = " ++ show max_char_size
146
147 return $ BufferCodec {
148 encode = fn cp max_char_size,
149 recover = rec,
150 close = return (),
151 -- Windows doesn't supply a way to save/restore the state and doesn't need one
152 -- since it's a dumb string->string API rather than a clever streaming one.
153 getState = return (),
154 setState = const $ return ()
155 }
156
157
158 utf16_native_encode' :: EncodeBuffer
159 utf16_native_decode' :: DecodeBuffer
160 #ifdef WORDS_BIGENDIAN
161 utf16_native_encode' = utf16be_encode
162 utf16_native_decode' = utf16be_decode
163 #else
164 utf16_native_encode' = utf16le_encode
165 utf16_native_decode' = utf16le_decode
166 #endif
167
168 saner :: CodeBuffer from to
169 -> Buffer from -> Buffer to
170 -> IO (CodingProgress, Int, Buffer from, Buffer to)
171 saner code ibuf obuf = do
172 (why, ibuf', obuf') <- code ibuf obuf
173 -- Weird but true: the UTF16 codes have a special case (see the "done" functions)
174 -- whereby if they entirely consume the input instead of returning an input buffer
175 -- that is empty because bufL has reached bufR, they return a buffer that is empty
176 -- because bufL = bufR = 0.
177 --
178 -- This is really very odd and confusing for our code that expects the difference
179 -- between the old and new input buffer bufLs to indicate the number of elements
180 -- that were consumed!
181 --
182 -- We fix it by explicitly extracting an integer which is the # of things consumed, like so:
183 if isEmptyBuffer ibuf'
184 then return (InputUnderflow, bufferElems ibuf, ibuf', obuf')
185 else return (why, bufL ibuf' - bufL ibuf, ibuf', obuf')
186
187 byteView :: Buffer CWchar -> Buffer Word8
188 byteView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = bufSize * 2, bufL = bufL * 2, bufR = bufR * 2 }
189
190 cwcharView :: Buffer Word8 -> Buffer CWchar
191 cwcharView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = half bufSize, bufL = half bufL, bufR = half bufR }
192 where half x = case x `divMod` 2 of (y, 0) -> y
193 _ -> errorWithoutStackTrace "cwcharView: utf16_(encode|decode) (wrote out|consumed) non multiple-of-2 number of bytes"
194
195 utf16_native_encode :: CodeBuffer Char CWchar
196 utf16_native_encode ibuf obuf = do
197 (why, ibuf, obuf) <- utf16_native_encode' ibuf (byteView obuf)
198 return (why, ibuf, cwcharView obuf)
199
200 utf16_native_decode :: CodeBuffer CWchar Char
201 utf16_native_decode ibuf obuf = do
202 (why, ibuf, obuf) <- utf16_native_decode' (byteView ibuf) obuf
203 return (why, cwcharView ibuf, obuf)
204
205 cpDecode :: Word32 -> Int -> DecodeBuffer
206 cpDecode cp max_char_size = \ibuf obuf -> do
207 #ifdef CHARBUF_UTF16
208 let mbuf = obuf
209 #else
210 -- FIXME: share the buffer between runs, even if the buffer is not the perfect size
211 let sz = (bufferElems ibuf * 2) -- I guess in the worst case the input CP text consists of 1-byte sequences that map entirely to things outside the BMP and so require 2 UTF-16 chars
212 `min` (bufferAvailable obuf * 2) -- In the best case, each pair of UTF-16 points becomes a single UTF-32 point
213 mbuf <- newBuffer (2 * sz) sz WriteBuffer :: IO (Buffer CWchar)
214 #endif
215 debugIO $ "cpDecode " ++ summaryBuffer ibuf ++ " " ++ summaryBuffer mbuf
216 (why1, ibuf', mbuf') <- cpRecode try' is_valid_prefix max_char_size 1 0 1 ibuf mbuf
217 debugIO $ "cpRecode (cpDecode) = " ++ show why1 ++ " " ++ summaryBuffer ibuf' ++ " " ++ summaryBuffer mbuf'
218 #ifdef CHARBUF_UTF16
219 return (why1, ibuf', mbuf')
220 #else
221 -- Convert as much UTF-16 as possible to UTF-32. Note that it's impossible for this to fail
222 -- due to illegal characters since the output from Window's encoding function should be correct UTF-16.
223 -- However, it's perfectly possible to run out of either output or input buffer.
224 debugIO $ "utf16_native_decode " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
225 (why2, target_utf16_count, mbuf', obuf) <- saner utf16_native_decode (mbuf' { bufState = ReadBuffer }) obuf
226 debugIO $ "utf16_native_decode = " ++ show why2 ++ " " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
227 case why2 of
228 -- If we successfully translate all of the UTF-16 buffer, we need to know why we couldn't get any more
229 -- UTF-16 out of the Windows API
230 InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)
231 | otherwise -> errorWithoutStackTrace "cpDecode: impossible underflown UTF-16 buffer"
232 -- InvalidSequence should be impossible since mbuf' is output from Windows.
233 InvalidSequence -> errorWithoutStackTrace "InvalidSequence on output of Windows API"
234 -- If we run out of space in obuf, we need to ask for more output buffer space, while also returning
235 -- the characters we have managed to consume so far.
236 OutputUnderflow -> do
237 -- We have an interesting problem here similar to the cpEncode case where we have to figure out how much
238 -- of the byte buffer was consumed to reach as far as the last UTF-16 character we actually decoded to UTF-32 OK.
239 --
240 -- The minimum number of bytes it could take is half the number of UTF-16 chars we got on the output, since
241 -- one byte could theoretically generate two UTF-16 characters.
242 -- The common case (ASCII text) is that every byte in the input maps to a single UTF-16 character.
243 -- In the worst case max_char_size bytes map to each UTF-16 character.
244 byte_count <- bSearch "cpDecode" (cpRecode try' is_valid_prefix max_char_size 1 0 1) ibuf mbuf target_utf16_count (target_utf16_count `div` 2) target_utf16_count (target_utf16_count * max_char_size)
245 return (OutputUnderflow, bufferRemove byte_count ibuf, obuf)
246 #endif
247 where
248 is_valid_prefix = c_IsDBCSLeadByteEx cp
249 try' iptr icnt optr ocnt
250 -- MultiByteToWideChar does surprising things if you have ocnt == 0
251 | ocnt == 0 = return (Left True)
252 | otherwise = do
253 err <- c_MultiByteToWideChar (fromIntegral cp) 8 -- MB_ERR_INVALID_CHARS == 8: Fail if an invalid input character is encountered
254 iptr (fromIntegral icnt) optr (fromIntegral ocnt)
255 debugIO $ "MultiByteToWideChar " ++ show cp ++ " 8 " ++ show iptr ++ " " ++ show icnt ++ " " ++ show optr ++ " " ++ show ocnt ++ "\n = " ++ show err
256 case err of
257 -- 0 indicates that we did not succeed
258 0 -> do
259 err <- getLastError
260 case err of
261 122 -> return (Left True)
262 1113 -> return (Left False)
263 _ -> failWith "MultiByteToWideChar" err
264 wrote_chars -> return (Right (fromIntegral wrote_chars))
265
266 cpEncode :: Word32 -> Int -> EncodeBuffer
267 cpEncode cp _max_char_size = \ibuf obuf -> do
268 #ifdef CHARBUF_UTF16
269 let mbuf' = ibuf
270 #else
271 -- FIXME: share the buffer between runs, even though that means we can't size the buffer as we want.
272 let sz = (bufferElems ibuf * 2) -- UTF-32 always uses 4 bytes. UTF-16 uses at most 4 bytes.
273 `min` (bufferAvailable obuf * 2) -- In the best case, each pair of UTF-16 points fits into only 1 byte
274 mbuf <- newBuffer (2 * sz) sz WriteBuffer
275
276 -- Convert as much UTF-32 as possible to UTF-16. NB: this can't fail due to output underflow
277 -- since we sized the output buffer correctly. However, it could fail due to an illegal character
278 -- in the input if it encounters a lone surrogate. In this case, our recovery will be applied as normal.
279 (why1, ibuf', mbuf') <- utf16_native_encode ibuf mbuf
280 #endif
281 debugIO $ "\ncpEncode " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
282 (why2, target_utf16_count, mbuf', obuf) <- saner (cpRecode try' is_valid_prefix 2 1 1 0) (mbuf' { bufState = ReadBuffer }) obuf
283 debugIO $ "cpRecode (cpEncode) = " ++ show why2 ++ " " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
284 #ifdef CHARBUF_UTF16
285 return (why2, mbuf', obuf)
286 #else
287 case why2 of
288 -- If we succesfully translate all of the UTF-16 buffer, we need to know why
289 -- we weren't able to get any more UTF-16 out of the UTF-32 buffer
290 InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)
291 | otherwise -> errorWithoutStackTrace "cpEncode: impossible underflown UTF-16 buffer"
292 -- With OutputUnderflow/InvalidSequence we only care about the failings of the UTF-16->CP translation.
293 -- Yes, InvalidSequence is possible even though mbuf' is guaranteed to be valid UTF-16, because
294 -- the code page may not be able to represent the encoded Unicode codepoint.
295 _ -> do
296 -- Here is an interesting problem. If we have only managed to translate part of the mbuf'
297 -- then we need to return an ibuf which has consumed exactly those bytes required to obtain
298 -- that part of the mbuf'. To reconstruct this information, we binary search for the number of
299 -- UTF-32 characters required to get the consumed count of UTF-16 characters:
300 --
301 -- When dealing with data from the BMP (the common case), consuming N UTF-16 characters will be the same as consuming N
302 -- UTF-32 characters. We start our search there so that most binary searches will terminate in a single iteration.
303 -- Furthermore, the absolute minimum number of UTF-32 characters this can correspond to is 1/2 the UTF-16 byte count
304 -- (this will be realised when the input data is entirely not in the BMP).
305 utf32_count <- bSearch "cpEncode" utf16_native_encode ibuf mbuf target_utf16_count (target_utf16_count `div` 2) target_utf16_count target_utf16_count
306 return (why2, bufferRemove utf32_count ibuf, obuf)
307 #endif
308 where
309 -- Single characters should be mappable to bytes. If they aren't supported by the CP then we have an invalid input sequence.
310 is_valid_prefix _ = return False
311
312 try' iptr icnt optr ocnt
313 -- WideCharToMultiByte does surprising things if you call it with ocnt == 0
314 | ocnt == 0 = return (Left True)
315 | otherwise = alloca $ \defaulted_ptr -> do
316 poke defaulted_ptr False
317 err <- c_WideCharToMultiByte (fromIntegral cp) 0 -- NB: the WC_ERR_INVALID_CHARS flag is uselses: only has an effect with the UTF-8 code page
318 iptr (fromIntegral icnt) optr (fromIntegral ocnt)
319 nullPtr defaulted_ptr
320 defaulted <- peek defaulted_ptr
321 debugIO $ "WideCharToMultiByte " ++ show cp ++ " 0 " ++ show iptr ++ " " ++ show icnt ++ " " ++ show optr ++ " " ++ show ocnt ++ " NULL " ++ show defaulted_ptr ++ "\n = " ++ show err ++ ", " ++ show defaulted
322 case err of
323 -- 0 indicates that we did not succeed
324 0 -> do
325 err <- getLastError
326 case err of
327 122 -> return (Left True)
328 1113 -> return (Left False)
329 _ -> failWith "WideCharToMultiByte" err
330 wrote_bytes | defaulted -> return (Left False)
331 | otherwise -> return (Right (fromIntegral wrote_bytes))
332
333 bSearch :: String
334 -> CodeBuffer from to
335 -> Buffer from -> Buffer to -- From buffer (crucial data source) and to buffer (temporary storage only). To buffer must be empty (L=R).
336 -> Int -- Target size of to buffer
337 -> Int -> Int -> Int -- Binary search min, mid, max
338 -> IO Int -- Size of from buffer required to reach target size of to buffer
339 bSearch msg code ibuf mbuf target_to_elems = go
340 where
341 go mn md mx = do
342 -- NB: this loop repeatedly reencodes on top of mbuf using a varying fraction of ibuf. It doesn't
343 -- matter if we blast the contents of mbuf since we already consumed all of the contents we are going to use.
344 (_why, ibuf, mbuf) <- code (ibuf { bufR = bufL ibuf + md }) mbuf
345 debugIO $ "code (bSearch " ++ msg ++ ") " ++ show md ++ " = " ++ show _why ++ ", " ++ summaryBuffer ibuf ++ summaryBuffer mbuf
346 -- The normal case is to get InputUnderflow here, which indicates that coding basically
347 -- terminated normally.
348 --
349 -- However, InvalidSequence is also possible if we are being called from cpDecode if we
350 -- have just been unlucky enough to set md so that ibuf straddles a byte boundary.
351 -- In this case we have to be really careful, because we don't want to report that
352 -- "md" elements is the right number when in actual fact we could have had md-1 input
353 -- elements and still produced the same number of bufferElems in mbuf.
354 --
355 -- In fact, we have to worry about this possibility even if we get InputUnderflow
356 -- since that will report InputUnderflow rather than InvalidSequence if the buffer
357 -- ends in a valid lead byte. So the expedient thing to do is simply to check if
358 -- the input buffer was entirely consumed.
359 --
360 -- When called from cpDecode, OutputUnderflow is also possible.
361 --
362 -- Luckily if we have InvalidSequence/OutputUnderflow and we do not appear to have reached
363 -- the target, what we should do is the same as normal because the fraction of ibuf that our
364 -- first "code" coded succesfully must be invalid-sequence-free, and ibuf will always
365 -- have been decoded as far as the first invalid sequence in it.
366 case bufferElems mbuf `compare` target_to_elems of
367 -- Coding n "from" chars from the input yields exactly as many "to" chars
368 -- as were consumed by the recode. All is peachy:
369 EQ -> debugIO ("bSearch = " ++ show solution) >> return solution
370 where solution = md - bufferElems ibuf
371 -- If we encoded fewer "to" characters than the target number, try again with more "from" characters (and vice-versa)
372 LT -> go' (md+1) mx
373 GT -> go' mn (md-1)
374 go' mn mx | mn <= mx = go mn (mn + ((mx - mn) `div` 2)) mx
375 | otherwise = errorWithoutStackTrace $ "bSearch(" ++ msg ++ "): search crossed! " ++ show (summaryBuffer ibuf, summaryBuffer mbuf, target_to_elems, mn, mx)
376
377 cpRecode :: forall from to. Storable from
378 => (Ptr from -> Int -> Ptr to -> Int -> IO (Either Bool Int))
379 -> (from -> IO Bool)
380 -> Int -- ^ Maximum length of a complete translatable sequence in the input (e.g. 2 if the input is UTF-16, 1 if the input is a SBCS, 2 is the input is a DBCS). Must be at least 1.
381 -> Int -- ^ Minimum number of output elements per complete translatable sequence in the input (almost certainly 1)
382 -> Int -> Int
383 -> CodeBuffer from to
384 cpRecode try' is_valid_prefix max_i_size min_o_size iscale oscale = go
385 where
386 go :: CodeBuffer from to
387 go ibuf obuf | isEmptyBuffer ibuf = return (InputUnderflow, ibuf, obuf)
388 | bufferAvailable obuf < min_o_size = return (OutputUnderflow, ibuf, obuf)
389 | otherwise = try (bufferElems ibuf `min` ((max_i_size * bufferAvailable obuf) `div` min_o_size)) seek_smaller
390 where
391 done why = return (why, ibuf, obuf)
392
393 seek_smaller n longer_was_valid
394 -- In this case, we can't shrink any further via any method. Calling (try 0) wouldn't be right because that will always claim InputUnderflow...
395 | n <= 1 = if longer_was_valid
396 -- try m (where m >= n) was valid but we overflowed the output buffer with even a single input element
397 then done OutputUnderflow
398 -- there was no initial valid sequence in the input, but it might just be a truncated buffer - we need to check
399 else do byte <- withBuffer ibuf $ \ptr -> peekElemOff ptr (bufL ibuf)
400 valid_prefix <- is_valid_prefix byte
401 done (if valid_prefix && bufferElems ibuf < max_i_size then InputUnderflow else InvalidSequence)
402 -- If we're already looking at very small buffers, try every n down to 1, to ensure we spot as long a sequence as exists while avoiding trying 0.
403 -- Doing it this way ensures that we spot a single initial sequence of length <= max_i_size if any such exists.
404 | n < 2 * max_i_size = try (n - 1) (\pred_n pred_n_was_valid -> seek_smaller pred_n (longer_was_valid || pred_n_was_valid))
405 -- Otherwise, try a binary chop to try to either get the prefix before the invalid input, or shrink the output down so it fits
406 -- in the output buffer. After the chop, try to consume extra input elements to try to recover as much of the sequence as possible if we
407 -- end up chopping a multi-element input sequence into two parts.
408 --
409 -- Note that since max_i_size >= 1:
410 -- * (n `div` 2) >= 1, so we don't try 0
411 -- * ((n `div` 2) + (max_i_size - 1)) < n, so we don't get into a loop where (seek_smaller n) calls post_divide (n `div` 2) calls (seek_smaller n)
412 | let n' = n `div` 2 = try n' (post_divide n' longer_was_valid)
413
414 post_divide _ _ n True = seek_smaller n True
415 post_divide n' longer_was_valid n False | n < n' + max_i_size - 1 = try (n + 1) (post_divide n' longer_was_valid) -- There's still a chance..
416 | otherwise = seek_smaller n' longer_was_valid -- No amount of recovery could save us :(
417
418 try n k_fail = withBuffer ibuf $ \iptr -> withBuffer obuf $ \optr -> do
419 ei_err_wrote <- try' (iptr `plusPtr` (bufL ibuf `shiftL` iscale)) n
420 (optr `plusPtr` (bufR obuf `shiftL` oscale)) (bufferAvailable obuf)
421 debugIO $ "try " ++ show n ++ " = " ++ show ei_err_wrote
422 case ei_err_wrote of
423 -- ERROR_INSUFFICIENT_BUFFER: A supplied buffer size was not large enough, or it was incorrectly set to NULL.
424 Left True -> k_fail n True
425 -- ERROR_NO_UNICODE_TRANSLATION: Invalid Unicode was found in a string.
426 Left False -> k_fail n False
427 -- Must have interpreted all given bytes successfully
428 -- We need to iterate until we have consumed the complete contents of the buffer
429 Right wrote_elts -> go (bufferRemove n ibuf) (obuf { bufR = bufR obuf + wrote_elts })