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