{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
           , NoImplicitPrelude
           , NondecreasingIndentation
  #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Encoding.Iconv
-- Copyright   :  (c) The University of Glasgow, 2008-2009
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  internal
-- Portability :  non-portable
--
-- This module provides text encoding/decoding using iconv
--
-----------------------------------------------------------------------------

module GHC.IO.Encoding.Iconv (
#if !defined(mingw32_HOST_OS)
   iconvEncoding, mkIconvEncoding,
   localeEncodingName
#endif
 ) where

#include "MachDeps.h"
#include "HsBaseConfig.h"

#if defined(mingw32_HOST_OS)
import GHC.Base () -- For build ordering
#else

import Foreign
import Foreign.C hiding (charIsRepresentable)
import Data.Maybe
import GHC.Base
import GHC.Foreign (charIsRepresentable)
import GHC.IO.Buffer
import GHC.IO.Encoding.Failure
import GHC.IO.Encoding.Types
import GHC.List (span)
import GHC.Num
import GHC.Show
import GHC.Real
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Internals

c_DEBUG_DUMP :: Bool
c_DEBUG_DUMP :: Bool
c_DEBUG_DUMP = Bool
False

iconv_trace :: String -> IO ()
iconv_trace :: String -> IO ()
iconv_trace String
s
 | Bool
c_DEBUG_DUMP = String -> IO ()
puts String
s
 | Bool
otherwise    = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()

-- -----------------------------------------------------------------------------
-- iconv encoders/decoders

{-# NOINLINE localeEncodingName #-}
localeEncodingName :: String
localeEncodingName :: String
localeEncodingName = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
   -- Use locale_charset() or nl_langinfo(CODESET) to get the encoding
   -- if we have either of them.
   CString
cstr <- IO CString
c_localeEncoding
   CString -> IO String
peekCAString CString
cstr -- Assume charset names are ASCII

-- We hope iconv_t is a storable type.  It should be, since it has at least the
-- value -1, which is a possible return value from iconv_open.
type IConv = CLong -- ToDo: (#type iconv_t)

foreign import ccall unsafe "hs_iconv_open"
    hs_iconv_open :: CString -> CString -> IO IConv

foreign import ccall unsafe "hs_iconv_close"
    hs_iconv_close :: IConv -> IO CInt

foreign import ccall unsafe "hs_iconv"
    hs_iconv :: IConv -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize
          -> IO CSize

foreign import ccall unsafe "localeEncoding"
    c_localeEncoding :: IO CString

haskellChar :: String
#if defined(WORDS_BIGENDIAN)
haskellChar | charSize == 2 = "UTF-16BE"
            | otherwise     = "UTF-32BE"
#else
haskellChar :: String
haskellChar | Int
charSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
2 = String
"UTF-16LE"
            | Bool
otherwise     = String
"UTF-32LE"
#endif

char_shift :: Int
char_shift :: Int
char_shift | Int
charSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
2 = Int
1
           | Bool
otherwise     = Int
2

iconvEncoding :: String -> IO (Maybe TextEncoding)
iconvEncoding :: String -> IO (Maybe TextEncoding)
iconvEncoding = CodingFailureMode -> String -> IO (Maybe TextEncoding)
mkIconvEncoding CodingFailureMode
ErrorOnCodingFailure

-- | Construct an iconv-based 'TextEncoding' for the given character set and
-- 'CodingFailureMode'.
--
-- As iconv is missing in some minimal environments (e.g. #10298), this
-- checks to ensure that iconv is working properly before returning the
-- encoding, returning 'Nothing' if not.
mkIconvEncoding :: CodingFailureMode -> String -> IO (Maybe TextEncoding)
mkIconvEncoding :: CodingFailureMode -> String -> IO (Maybe TextEncoding)
mkIconvEncoding CodingFailureMode
cfm String
charset = do
    let enc :: TextEncoding
enc = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding {
                  textEncodingName :: String
textEncodingName = String
charset,
                  mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = String
-> String
-> (Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char))
-> (IConv
    -> Buffer Word8
    -> Buffer Char
    -> IO (CodingProgress, Buffer Word8, Buffer Char))
-> IO (TextDecoder ())
forall a b.
String
-> String
-> (Buffer a -> Buffer b -> IO (Buffer a, Buffer b))
-> (IConv
    -> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (BufferCodec a b ())
newIConv String
raw_charset (String
haskellChar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix)
                                           (CodingFailureMode
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recoverDecode CodingFailureMode
cfm) IConv
-> Buffer Word8
-> Buffer Char
-> IO (CodingProgress, Buffer Word8, Buffer Char)
iconvDecode,
                  mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = String
-> String
-> (Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8))
-> (IConv
    -> Buffer Char
    -> Buffer Word8
    -> IO (CodingProgress, Buffer Char, Buffer Word8))
-> IO (TextEncoder ())
forall a b.
String
-> String
-> (Buffer a -> Buffer b -> IO (Buffer a, Buffer b))
-> (IConv
    -> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (BufferCodec a b ())
newIConv String
haskellChar String
charset
                                           (CodingFailureMode
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recoverEncode CodingFailureMode
cfm) IConv
-> Buffer Char
-> Buffer Word8
-> IO (CodingProgress, Buffer Char, Buffer Word8)
iconvEncode}
    Bool
good <- TextEncoding -> Char -> IO Bool
charIsRepresentable TextEncoding
enc Char
'a'
    Maybe TextEncoding -> IO (Maybe TextEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Maybe TextEncoding -> IO (Maybe TextEncoding))
-> Maybe TextEncoding -> IO (Maybe TextEncoding)
forall a b. (a -> b) -> a -> b
$ if Bool
good
               then TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just TextEncoding
enc
               else Maybe TextEncoding
forall a. Maybe a
Nothing
  where
    -- An annoying feature of GNU iconv is that the //PREFIXES only take
    -- effect when they appear on the tocode parameter to iconv_open:
    (String
raw_charset, String
suffix) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
/= Char
'/') String
charset

newIConv :: String -> String
   -> (Buffer a -> Buffer b -> IO (Buffer a, Buffer b))
   -> (IConv -> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b))
   -> IO (BufferCodec a b ())
newIConv :: String
-> String
-> (Buffer a -> Buffer b -> IO (Buffer a, Buffer b))
-> (IConv
    -> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (BufferCodec a b ())
newIConv String
from String
to Buffer a -> Buffer b -> IO (Buffer a, Buffer b)
rec IConv
-> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b)
fn =
  -- Assume charset names are ASCII
  String
-> (CString -> IO (BufferCodec a b ())) -> IO (BufferCodec a b ())
forall a. String -> (CString -> IO a) -> IO a
withCAString String
from ((CString -> IO (BufferCodec a b ())) -> IO (BufferCodec a b ()))
-> (CString -> IO (BufferCodec a b ())) -> IO (BufferCodec a b ())
forall a b. (a -> b) -> a -> b
$ \ CString
from_str ->
  String
-> (CString -> IO (BufferCodec a b ())) -> IO (BufferCodec a b ())
forall a. String -> (CString -> IO a) -> IO a
withCAString String
to   ((CString -> IO (BufferCodec a b ())) -> IO (BufferCodec a b ()))
-> (CString -> IO (BufferCodec a b ())) -> IO (BufferCodec a b ())
forall a b. (a -> b) -> a -> b
$ \ CString
to_str -> do
    IConv
iconvt <- String -> IO IConv -> IO IConv
forall a. (Eq a, Num a) => String -> IO a -> IO a
External instance of the constraint type Num IConv
External instance of the constraint type Eq IConv
throwErrnoIfMinus1 String
"mkTextEncoding" (IO IConv -> IO IConv) -> IO IConv -> IO IConv
forall a b. (a -> b) -> a -> b
$ CString -> CString -> IO IConv
hs_iconv_open CString
to_str CString
from_str
    let iclose :: IO ()
iclose = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
External instance of the constraint type Num CInt
External instance of the constraint type Eq CInt
throwErrnoIfMinus1_ String
"Iconv.close" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ IConv -> IO CInt
hs_iconv_close IConv
iconvt
    BufferCodec a b () -> IO (BufferCodec a b ())
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec{
                encode :: Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b)
encode = IConv
-> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b)
fn IConv
iconvt,
                recover :: Buffer a -> Buffer b -> IO (Buffer a, Buffer b)
recover = Buffer a -> Buffer b -> IO (Buffer a, Buffer b)
rec,
                close :: IO ()
close  = IO ()
iclose,
                -- iconv doesn't supply a way to save/restore the state
                getState :: IO ()
getState = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (),
                setState :: () -> IO ()
setState = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()
                }

iconvDecode :: IConv -> DecodeBuffer
iconvDecode :: IConv
-> Buffer Word8
-> Buffer Char
-> IO (CodingProgress, Buffer Word8, Buffer Char)
iconvDecode IConv
iconv_t Buffer Word8
ibuf Buffer Char
obuf = IConv
-> Buffer Word8
-> Int
-> Buffer Char
-> Int
-> IO (CodingProgress, Buffer Word8, Buffer Char)
forall a b.
IConv
-> Buffer a
-> Int
-> Buffer b
-> Int
-> IO (CodingProgress, Buffer a, Buffer b)
iconvRecode IConv
iconv_t Buffer Word8
ibuf Int
0 Buffer Char
obuf Int
char_shift

iconvEncode :: IConv -> EncodeBuffer
iconvEncode :: IConv
-> Buffer Char
-> Buffer Word8
-> IO (CodingProgress, Buffer Char, Buffer Word8)
iconvEncode IConv
iconv_t Buffer Char
ibuf Buffer Word8
obuf = IConv
-> Buffer Char
-> Int
-> Buffer Word8
-> Int
-> IO (CodingProgress, Buffer Char, Buffer Word8)
forall a b.
IConv
-> Buffer a
-> Int
-> Buffer b
-> Int
-> IO (CodingProgress, Buffer a, Buffer b)
iconvRecode IConv
iconv_t Buffer Char
ibuf Int
char_shift Buffer Word8
obuf Int
0

iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int
            -> IO (CodingProgress, Buffer a, Buffer b)
iconvRecode :: IConv
-> Buffer a
-> Int
-> Buffer b
-> Int
-> IO (CodingProgress, Buffer a, Buffer b)
iconvRecode IConv
iconv_t
  input :: Buffer a
input@Buffer{  bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer a
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_  }  Int
iscale
  output :: Buffer b
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer b
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_,  bufR :: forall e. Buffer e -> Int
bufR=Int
ow, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }  Int
oscale
  = do
    String -> IO ()
iconv_trace (String
"haskellChar=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show String
haskellChar)
    String -> IO ()
iconv_trace (String
"iconvRecode before, input=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show (Buffer a -> String
forall a. Buffer a -> String
summaryBuffer Buffer a
input))
    String -> IO ()
iconv_trace (String
"iconvRecode before, output=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show (Buffer b -> String
forall a. Buffer a -> String
summaryBuffer Buffer b
output))
    RawBuffer a
-> (Ptr a -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer a
iraw ((Ptr a -> IO (CodingProgress, Buffer a, Buffer b))
 -> IO (CodingProgress, Buffer a, Buffer b))
-> (Ptr a -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. (a -> b) -> a -> b
$ \ Ptr a
piraw -> do
    RawBuffer b
-> (Ptr b -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer b
oraw ((Ptr b -> IO (CodingProgress, Buffer a, Buffer b))
 -> IO (CodingProgress, Buffer a, Buffer b))
-> (Ptr b -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. (a -> b) -> a -> b
$ \ Ptr b
poraw -> do
    CString
-> (Ptr CString -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
External instance of the constraint type forall a. Storable (Ptr a)
with (Ptr a
piraw Ptr a -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
ir Int -> Int -> Int
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Int
`shiftL` Int
iscale)) ((Ptr CString -> IO (CodingProgress, Buffer a, Buffer b))
 -> IO (CodingProgress, Buffer a, Buffer b))
-> (Ptr CString -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. (a -> b) -> a -> b
$ \ Ptr CString
p_inbuf -> do
    CString
-> (Ptr CString -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
External instance of the constraint type forall a. Storable (Ptr a)
with (Ptr b
poraw Ptr b -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
ow Int -> Int -> Int
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Int
`shiftL` Int
oscale)) ((Ptr CString -> IO (CodingProgress, Buffer a, Buffer b))
 -> IO (CodingProgress, Buffer a, Buffer b))
-> (Ptr CString -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. (a -> b) -> a -> b
$ \ Ptr CString
p_outbuf -> do
    CSize
-> (Ptr CSize -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
External instance of the constraint type Storable CSize
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num CSize
External instance of the constraint type Integral Int
fromIntegral ((Int
iwInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
ir) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Int
`shiftL` Int
iscale)) ((Ptr CSize -> IO (CodingProgress, Buffer a, Buffer b))
 -> IO (CodingProgress, Buffer a, Buffer b))
-> (Ptr CSize -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
p_inleft -> do
    CSize
-> (Ptr CSize -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
External instance of the constraint type Storable CSize
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num CSize
External instance of the constraint type Integral Int
fromIntegral ((Int
osInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
ow) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Int
`shiftL` Int
oscale)) ((Ptr CSize -> IO (CodingProgress, Buffer a, Buffer b))
 -> IO (CodingProgress, Buffer a, Buffer b))
-> (Ptr CSize -> IO (CodingProgress, Buffer a, Buffer b))
-> IO (CodingProgress, Buffer a, Buffer b)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
p_outleft -> do
      CSize
res <- IConv
-> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize -> IO CSize
hs_iconv IConv
iconv_t Ptr CString
p_inbuf Ptr CSize
p_inleft Ptr CString
p_outbuf Ptr CSize
p_outleft
      CSize
new_inleft  <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
External instance of the constraint type Storable CSize
peek Ptr CSize
p_inleft
      CSize
new_outleft <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
External instance of the constraint type Storable CSize
peek Ptr CSize
p_outleft
      let
          new_inleft' :: Int
new_inleft'  = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral CSize
fromIntegral CSize
new_inleft Int -> Int -> Int
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Int
`shiftR` Int
iscale
          new_outleft' :: Int
new_outleft' = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral CSize
fromIntegral CSize
new_outleft Int -> Int -> Int
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Int
`shiftR` Int
oscale
          new_input :: Buffer a
new_input
            | CSize
new_inleft CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq CSize
== CSize
0  = Buffer a
input { bufL :: Int
bufL = Int
0, bufR :: Int
bufR = Int
0 }
            | Bool
otherwise        = Buffer a
input { bufL :: Int
bufL = Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
new_inleft' }
          new_output :: Buffer b
new_output = Buffer b
output{ bufR :: Int
bufR = Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
new_outleft' }
      String -> IO ()
iconv_trace (String
"iconv res=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CSize -> String
forall a. Show a => a -> String
External instance of the constraint type Show CSize
show CSize
res)
      String -> IO ()
iconv_trace (String
"iconvRecode after,  input=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show (Buffer a -> String
forall a. Buffer a -> String
summaryBuffer Buffer a
new_input))
      String -> IO ()
iconv_trace (String
"iconvRecode after,  output=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show (Buffer b -> String
forall a. Buffer a -> String
summaryBuffer Buffer b
new_output))
      if (CSize
res CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq CSize
/= -CSize
1)
        then do -- all input translated
           (CodingProgress, Buffer a, Buffer b)
-> IO (CodingProgress, Buffer a, Buffer b)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (CodingProgress
InputUnderflow, Buffer a
new_input, Buffer b
new_output)
        else do
      Errno
errno <- IO Errno
getErrno
      case Errno
errno of
        Errno
e | Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Errno
== Errno
e2BIG  -> (CodingProgress, Buffer a, Buffer b)
-> IO (CodingProgress, Buffer a, Buffer b)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (CodingProgress
OutputUnderflow, Buffer a
new_input, Buffer b
new_output)
          | Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Errno
== Errno
eINVAL -> (CodingProgress, Buffer a, Buffer b)
-> IO (CodingProgress, Buffer a, Buffer b)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (CodingProgress
InputUnderflow, Buffer a
new_input, Buffer b
new_output)
           -- Sometimes iconv reports EILSEQ for a
           -- character in the input even when there is no room
           -- in the output; in this case we might be about to
           -- change the encoding anyway, so the following bytes
           -- could very well be in a different encoding.
           --
           -- Because we can only say InvalidSequence if there is at least
           -- one element left in the output, we have to special case this.
          | Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Errno
== Errno
eILSEQ -> (CodingProgress, Buffer a, Buffer b)
-> IO (CodingProgress, Buffer a, Buffer b)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (if Int
new_outleft' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 then CodingProgress
OutputUnderflow else CodingProgress
InvalidSequence, Buffer a
new_input, Buffer b
new_output)
          | Bool
otherwise -> do
              String -> IO ()
iconv_trace (String
"iconv returned error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
External instance of the constraint type Show IOError
show (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"iconv" Errno
e Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing))
              String -> IO (CodingProgress, Buffer a, Buffer b)
forall a. String -> IO a
throwErrno String
"iconvRecoder"

#endif /* !mingw32_HOST_OS */