module Codec.Text.IConv.Internal (
IConv,
run,
InitStatus(..),
unsafeInterleave,
unsafeLiftIO,
finalise,
iconv,
Status(..),
pushInputBuffer,
inputBufferSize,
inputBufferEmpty,
inputPosition,
replaceInputBuffer,
newOutputBuffer,
popOutputBuffer,
outputBufferBytesAvailable,
outputBufferFull,
dump,
trace
) where
import Foreign hiding (unsafePerformIO)
import Foreign.C
import qualified Data.ByteString.Internal as S
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
import System.IO (hPutStrLn, stderr)
import Control.Exception (assert)
import Control.Applicative
import Control.Monad (ap)
import Prelude hiding (length)
pushInputBuffer :: S.ByteString -> IConv ()
pushInputBuffer :: ByteString -> IConv ()
pushInputBuffer (S.PS inBuffer' :: ForeignPtr Word8
inBuffer' inOffset' :: Int
inOffset' inLength' :: Int
inLength') = do
Int
inAvail <- (Buffers -> Int) -> IConv Int
forall a. (Buffers -> a) -> IConv a
gets Buffers -> Int
inLength
Bool -> IConv () -> IConv ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
inAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IConv () -> IConv ()) -> IConv () -> IConv ()
forall a b. (a -> b) -> a -> b
$ () -> IConv ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Buffers -> Buffers) -> IConv ()
modify ((Buffers -> Buffers) -> IConv ())
-> (Buffers -> Buffers) -> IConv ()
forall a b. (a -> b) -> a -> b
$ \bufs :: Buffers
bufs -> Buffers
bufs {
inBuffer :: ForeignPtr Word8
inBuffer = ForeignPtr Word8
inBuffer',
inOffset :: Int
inOffset = Int
inOffset',
inLength :: Int
inLength = Int
inLength'
}
inputBufferEmpty :: IConv Bool
inputBufferEmpty :: IConv Bool
inputBufferEmpty = (Buffers -> Bool) -> IConv Bool
forall a. (Buffers -> a) -> IConv a
gets ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0) (Int -> Bool) -> (Buffers -> Int) -> Buffers -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffers -> Int
inLength)
inputBufferSize :: IConv Int
inputBufferSize :: IConv Int
inputBufferSize = (Buffers -> Int) -> IConv Int
forall a. (Buffers -> a) -> IConv a
gets Buffers -> Int
inLength
inputPosition :: IConv Int
inputPosition :: IConv Int
inputPosition = (Buffers -> Int) -> IConv Int
forall a. (Buffers -> a) -> IConv a
gets Buffers -> Int
inTotal
replaceInputBuffer :: (S.ByteString -> S.ByteString) -> IConv ()
replaceInputBuffer :: (ByteString -> ByteString) -> IConv ()
replaceInputBuffer replace :: ByteString -> ByteString
replace =
(Buffers -> Buffers) -> IConv ()
modify ((Buffers -> Buffers) -> IConv ())
-> (Buffers -> Buffers) -> IConv ()
forall a b. (a -> b) -> a -> b
$ \bufs :: Buffers
bufs ->
case ByteString -> ByteString
replace (ForeignPtr Word8 -> Int -> Int -> ByteString
S.PS (Buffers -> ForeignPtr Word8
inBuffer Buffers
bufs) (Buffers -> Int
inOffset Buffers
bufs) (Buffers -> Int
inLength Buffers
bufs)) of
S.PS inBuffer' :: ForeignPtr Word8
inBuffer' inOffset' :: Int
inOffset' inLength' :: Int
inLength' ->
Buffers
bufs {
inBuffer :: ForeignPtr Word8
inBuffer = ForeignPtr Word8
inBuffer',
inOffset :: Int
inOffset = Int
inOffset',
inLength :: Int
inLength = Int
inLength'
}
newOutputBuffer :: Int -> IConv ()
newOutputBuffer :: Int -> IConv ()
newOutputBuffer size :: Int
size = do
Int
outAvail <- (Buffers -> Int) -> IConv Int
forall a. (Buffers -> a) -> IConv a
gets Buffers -> Int
outLength
Bool -> IConv () -> IConv ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
outAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IConv () -> IConv ()) -> IConv () -> IConv ()
forall a b. (a -> b) -> a -> b
$ () -> IConv ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ForeignPtr Word8
outBuffer' <- IO (ForeignPtr Word8) -> IConv (ForeignPtr Word8)
forall a. IO a -> IConv a
unsafeLiftIO (IO (ForeignPtr Word8) -> IConv (ForeignPtr Word8))
-> IO (ForeignPtr Word8) -> IConv (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
size
(Buffers -> Buffers) -> IConv ()
modify ((Buffers -> Buffers) -> IConv ())
-> (Buffers -> Buffers) -> IConv ()
forall a b. (a -> b) -> a -> b
$ \bufs :: Buffers
bufs -> Buffers
bufs {
outBuffer :: ForeignPtr Word8
outBuffer = ForeignPtr Word8
outBuffer',
outOffset :: Int
outOffset = 0,
outLength :: Int
outLength = 0,
outFree :: Int
outFree = Int
size
}
popOutputBuffer :: IConv S.ByteString
popOutputBuffer :: IConv ByteString
popOutputBuffer = do
Buffers
bufs <- IConv Buffers
get
Bool -> IConv () -> IConv ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Buffers -> Int
outLength Buffers
bufs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (IConv () -> IConv ()) -> IConv () -> IConv ()
forall a b. (a -> b) -> a -> b
$ () -> IConv ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Buffers -> Buffers) -> IConv ()
modify ((Buffers -> Buffers) -> IConv ())
-> (Buffers -> Buffers) -> IConv ()
forall a b. (a -> b) -> a -> b
$ \buf :: Buffers
buf -> Buffers
buf {
outOffset :: Int
outOffset = Buffers -> Int
outOffset Buffers
bufs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Buffers -> Int
outLength Buffers
bufs,
outLength :: Int
outLength = 0
}
ByteString -> IConv ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
S.PS (Buffers -> ForeignPtr Word8
outBuffer Buffers
bufs) (Buffers -> Int
outOffset Buffers
bufs) (Buffers -> Int
outLength Buffers
bufs))
outputBufferBytesAvailable :: IConv Int
outputBufferBytesAvailable :: IConv Int
outputBufferBytesAvailable = (Buffers -> Int) -> IConv Int
forall a. (Buffers -> a) -> IConv a
gets Buffers -> Int
outLength
outputBufferFull :: IConv Bool
outputBufferFull :: IConv Bool
outputBufferFull = (Buffers -> Bool) -> IConv Bool
forall a. (Buffers -> a) -> IConv a
gets ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0) (Int -> Bool) -> (Buffers -> Int) -> Buffers -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffers -> Int
outFree)
data Buffers = Buffers {
Buffers -> ForeignPtr Word8
inBuffer :: {-# UNPACK #-} !(ForeignPtr Word8),
Buffers -> Int
inOffset :: {-# UNPACK #-} !Int,
Buffers -> Int
inLength :: {-# UNPACK #-} !Int,
Buffers -> Int
inTotal :: {-# UNPACK #-} !Int,
Buffers -> ForeignPtr Word8
outBuffer :: {-# UNPACK #-} !(ForeignPtr Word8),
Buffers -> Int
outOffset :: {-# UNPACK #-} !Int,
Buffers -> Int
outLength :: {-# UNPACK #-} !Int,
Buffers -> Int
outFree :: {-# UNPACK #-} !Int
} deriving Int -> Buffers -> ShowS
[Buffers] -> ShowS
Buffers -> String
(Int -> Buffers -> ShowS)
-> (Buffers -> String) -> ([Buffers] -> ShowS) -> Show Buffers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Buffers] -> ShowS
$cshowList :: [Buffers] -> ShowS
show :: Buffers -> String
$cshow :: Buffers -> String
showsPrec :: Int -> Buffers -> ShowS
$cshowsPrec :: Int -> Buffers -> ShowS
Show
nullBuffers :: Buffers
nullBuffers :: Buffers
nullBuffers = ForeignPtr Word8
-> Int
-> Int
-> Int
-> ForeignPtr Word8
-> Int
-> Int
-> Int
-> Buffers
Buffers ForeignPtr Word8
S.nullForeignPtr 0 0 0 ForeignPtr Word8
S.nullForeignPtr 0 0 0
newtype IConv a = I {
IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
unI :: ConversionDescriptor
-> Buffers
-> IO (Buffers, a)
}
instance Functor IConv where
fmap :: (a -> b) -> IConv a -> IConv b
fmap f :: a -> b
f a :: IConv a
a = IConv a
a IConv a -> (a -> IConv b) -> IConv b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> IConv b
forall a. a -> IConv a
returnI (b -> IConv b) -> (a -> b) -> a -> IConv b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
instance Applicative IConv where
pure :: a -> IConv a
pure = a -> IConv a
forall a. a -> IConv a
returnI
<*> :: IConv (a -> b) -> IConv a -> IConv b
(<*>) = IConv (a -> b) -> IConv a -> IConv b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad IConv where
>>= :: IConv a -> (a -> IConv b) -> IConv b
(>>=) = IConv a -> (a -> IConv b) -> IConv b
forall a b. IConv a -> (a -> IConv b) -> IConv b
bindI
>> :: IConv a -> IConv b -> IConv b
(>>) = IConv a -> IConv b -> IConv b
forall a b. IConv a -> IConv b -> IConv b
thenI
return :: a -> IConv a
return = a -> IConv a
forall a. a -> IConv a
returnI
returnI :: a -> IConv a
returnI :: a -> IConv a
returnI a :: a
a = (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a b. (a -> b) -> a -> b
$ \_ bufs :: Buffers
bufs -> (Buffers, a) -> IO (Buffers, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs, a
a)
{-# INLINE returnI #-}
bindI :: IConv a -> (a -> IConv b) -> IConv b
bindI :: IConv a -> (a -> IConv b) -> IConv b
bindI m :: IConv a
m f :: a -> IConv b
f = (ConversionDescriptor -> Buffers -> IO (Buffers, b)) -> IConv b
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, b)) -> IConv b)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, b)) -> IConv b
forall a b. (a -> b) -> a -> b
$ \cd :: ConversionDescriptor
cd bufs :: Buffers
bufs -> do
(bufs' :: Buffers
bufs', a :: a
a) <- IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
forall a.
IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
unI IConv a
m ConversionDescriptor
cd Buffers
bufs
IConv b -> ConversionDescriptor -> Buffers -> IO (Buffers, b)
forall a.
IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
unI (a -> IConv b
f a
a) ConversionDescriptor
cd Buffers
bufs'
{-# INLINE bindI #-}
thenI :: IConv a -> IConv b -> IConv b
thenI :: IConv a -> IConv b -> IConv b
thenI m :: IConv a
m f :: IConv b
f = (ConversionDescriptor -> Buffers -> IO (Buffers, b)) -> IConv b
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, b)) -> IConv b)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, b)) -> IConv b
forall a b. (a -> b) -> a -> b
$ \cd :: ConversionDescriptor
cd bufs :: Buffers
bufs -> do
(bufs' :: Buffers
bufs', _) <- IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
forall a.
IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
unI IConv a
m ConversionDescriptor
cd Buffers
bufs
IConv b -> ConversionDescriptor -> Buffers -> IO (Buffers, b)
forall a.
IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
unI IConv b
f ConversionDescriptor
cd Buffers
bufs'
{-# INLINE thenI #-}
data InitStatus = InitOk | UnsupportedConversion | UnexpectedInitError Errno
{-# NOINLINE run #-}
run :: String -> String -> (InitStatus -> IConv a) -> a
run :: String -> String -> (InitStatus -> IConv a) -> a
run from :: String
from to :: String
to m :: InitStatus -> IConv a
m = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
Ptr ConversionDescriptor
ptr <- String
-> (CString -> IO (Ptr ConversionDescriptor))
-> IO (Ptr ConversionDescriptor)
forall a. String -> (CString -> IO a) -> IO a
withCString String
from ((CString -> IO (Ptr ConversionDescriptor))
-> IO (Ptr ConversionDescriptor))
-> (CString -> IO (Ptr ConversionDescriptor))
-> IO (Ptr ConversionDescriptor)
forall a b. (a -> b) -> a -> b
$ \fromPtr :: CString
fromPtr ->
String
-> (CString -> IO (Ptr ConversionDescriptor))
-> IO (Ptr ConversionDescriptor)
forall a. String -> (CString -> IO a) -> IO a
withCString String
to ((CString -> IO (Ptr ConversionDescriptor))
-> IO (Ptr ConversionDescriptor))
-> (CString -> IO (Ptr ConversionDescriptor))
-> IO (Ptr ConversionDescriptor)
forall a b. (a -> b) -> a -> b
$ \toPtr :: CString
toPtr ->
CString -> CString -> IO (Ptr ConversionDescriptor)
c_iconv_open CString
toPtr CString
fromPtr
(cd :: ForeignPtr ConversionDescriptor
cd, status :: InitStatus
status) <- if Ptr ConversionDescriptor -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr ConversionDescriptor
ptr IntPtr -> IntPtr -> Bool
forall a. Eq a => a -> a -> Bool
/= (-1)
then do ForeignPtr ConversionDescriptor
cd <- FinalizerPtr ConversionDescriptor
-> Ptr ConversionDescriptor -> IO (ForeignPtr ConversionDescriptor)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ConversionDescriptor
c_iconv_close Ptr ConversionDescriptor
ptr
(ForeignPtr ConversionDescriptor, InitStatus)
-> IO (ForeignPtr ConversionDescriptor, InitStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr ConversionDescriptor
cd, InitStatus
InitOk)
else do Errno
errno <- IO Errno
getErrno
ForeignPtr ConversionDescriptor
cd <- Ptr ConversionDescriptor -> IO (ForeignPtr ConversionDescriptor)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr ConversionDescriptor
forall a. Ptr a
nullPtr
if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINVAL
then (ForeignPtr ConversionDescriptor, InitStatus)
-> IO (ForeignPtr ConversionDescriptor, InitStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr ConversionDescriptor
cd, InitStatus
UnsupportedConversion)
else (ForeignPtr ConversionDescriptor, InitStatus)
-> IO (ForeignPtr ConversionDescriptor, InitStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr ConversionDescriptor
cd, Errno -> InitStatus
UnexpectedInitError Errno
errno)
(_,a :: a
a) <- IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
forall a.
IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
unI (InitStatus -> IConv a
m InitStatus
status) (ForeignPtr ConversionDescriptor -> ConversionDescriptor
ConversionDescriptor ForeignPtr ConversionDescriptor
cd) Buffers
nullBuffers
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
unsafeLiftIO :: IO a -> IConv a
unsafeLiftIO :: IO a -> IConv a
unsafeLiftIO m :: IO a
m = (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a b. (a -> b) -> a -> b
$ \_ bufs :: Buffers
bufs -> do
a
a <- IO a
m
(Buffers, a) -> IO (Buffers, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs, a
a)
unsafeInterleave :: IConv a -> IConv a
unsafeInterleave :: IConv a -> IConv a
unsafeInterleave m :: IConv a
m = (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a b. (a -> b) -> a -> b
$ \cd :: ConversionDescriptor
cd st :: Buffers
st -> do
(Buffers, a)
res <- IO (Buffers, a) -> IO (Buffers, a)
forall a. IO a -> IO a
unsafeInterleaveIO (IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
forall a.
IConv a -> ConversionDescriptor -> Buffers -> IO (Buffers, a)
unI IConv a
m ConversionDescriptor
cd Buffers
st)
(Buffers, a) -> IO (Buffers, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
st, (Buffers, a) -> a
forall a b. (a, b) -> b
snd (Buffers, a)
res)
get :: IConv Buffers
get :: IConv Buffers
get = (ConversionDescriptor -> Buffers -> IO (Buffers, Buffers))
-> IConv Buffers
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, Buffers))
-> IConv Buffers)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, Buffers))
-> IConv Buffers
forall a b. (a -> b) -> a -> b
$ \_ buf :: Buffers
buf -> (Buffers, Buffers) -> IO (Buffers, Buffers)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
buf, Buffers
buf)
gets :: (Buffers -> a) -> IConv a
gets :: (Buffers -> a) -> IConv a
gets getter :: Buffers -> a
getter = (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
forall a b. (a -> b) -> a -> b
$ \_ buf :: Buffers
buf -> (Buffers, a) -> IO (Buffers, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
buf, Buffers -> a
getter Buffers
buf)
modify :: (Buffers -> Buffers) -> IConv ()
modify :: (Buffers -> Buffers) -> IConv ()
modify change :: Buffers -> Buffers
change = (ConversionDescriptor -> Buffers -> IO (Buffers, ())) -> IConv ()
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, ())) -> IConv ())
-> (ConversionDescriptor -> Buffers -> IO (Buffers, ()))
-> IConv ()
forall a b. (a -> b) -> a -> b
$ \_ buf :: Buffers
buf -> (Buffers, ()) -> IO (Buffers, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers -> Buffers
change Buffers
buf, ())
trace :: String -> IConv ()
trace :: String -> IConv ()
trace = IO () -> IConv ()
forall a. IO a -> IConv a
unsafeLiftIO (IO () -> IConv ()) -> (String -> IO ()) -> String -> IConv ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr
dump :: IConv ()
dump :: IConv ()
dump = do
Buffers
bufs <- IConv Buffers
get
IO () -> IConv ()
forall a. IO a -> IConv a
unsafeLiftIO (IO () -> IConv ()) -> IO () -> IConv ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Buffers -> String
forall a. Show a => a -> String
show Buffers
bufs
data Status =
InputEmpty
| OutputFull
| IncompleteChar
| InvalidChar
| UnexpectedError Errno
iconv :: IConv Status
iconv :: IConv Status
iconv = (ConversionDescriptor -> Buffers -> IO (Buffers, Status))
-> IConv Status
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, Status))
-> IConv Status)
-> (ConversionDescriptor -> Buffers -> IO (Buffers, Status))
-> IConv Status
forall a b. (a -> b) -> a -> b
$ \(ConversionDescriptor cdfptr :: ForeignPtr ConversionDescriptor
cdfptr) bufs :: Buffers
bufs ->
Bool -> IO (Buffers, Status) -> IO (Buffers, Status)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Buffers -> Int
outFree Buffers
bufs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (IO (Buffers, Status) -> IO (Buffers, Status))
-> IO (Buffers, Status) -> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$
ForeignPtr ConversionDescriptor
-> (Ptr ConversionDescriptor -> IO (Buffers, Status))
-> IO (Buffers, Status)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ConversionDescriptor
cdfptr ((Ptr ConversionDescriptor -> IO (Buffers, Status))
-> IO (Buffers, Status))
-> (Ptr ConversionDescriptor -> IO (Buffers, Status))
-> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$ \cdPtr :: Ptr ConversionDescriptor
cdPtr ->
ForeignPtr Word8
-> (Ptr Word8 -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Buffers -> ForeignPtr Word8
inBuffer Buffers
bufs) ((Ptr Word8 -> IO (Buffers, Status)) -> IO (Buffers, Status))
-> (Ptr Word8 -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$ \inBufPtr :: Ptr Word8
inBufPtr ->
CString
-> (Ptr CString -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Ptr Word8
inBufPtr Ptr Word8 -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffers -> Int
inOffset Buffers
bufs) ((Ptr CString -> IO (Buffers, Status)) -> IO (Buffers, Status))
-> (Ptr CString -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$ \inBufPtrPtr :: Ptr CString
inBufPtrPtr ->
CSize
-> (Ptr CSize -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Buffers -> Int
inLength Buffers
bufs)) ((Ptr CSize -> IO (Buffers, Status)) -> IO (Buffers, Status))
-> (Ptr CSize -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$ \inLengthPtr :: Ptr CSize
inLengthPtr ->
ForeignPtr Word8
-> (Ptr Word8 -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Buffers -> ForeignPtr Word8
outBuffer Buffers
bufs) ((Ptr Word8 -> IO (Buffers, Status)) -> IO (Buffers, Status))
-> (Ptr Word8 -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$ \outBufPtr :: Ptr Word8
outBufPtr ->
let outBufPtr' :: Ptr b
outBufPtr' = Ptr Word8
outBufPtr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Buffers -> Int
outOffset Buffers
bufs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Buffers -> Int
outLength Buffers
bufs) in
CString
-> (Ptr CString -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CString
forall a. Ptr a
outBufPtr' ((Ptr CString -> IO (Buffers, Status)) -> IO (Buffers, Status))
-> (Ptr CString -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$ \outBufPtrPtr :: Ptr CString
outBufPtrPtr ->
CSize
-> (Ptr CSize -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Buffers -> Int
outFree Buffers
bufs)) ((Ptr CSize -> IO (Buffers, Status)) -> IO (Buffers, Status))
-> (Ptr CSize -> IO (Buffers, Status)) -> IO (Buffers, Status)
forall a b. (a -> b) -> a -> b
$ \outFreePtr :: Ptr CSize
outFreePtr -> do
CSize
result <- Ptr ConversionDescriptor
-> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize -> IO CSize
c_iconv Ptr ConversionDescriptor
cdPtr Ptr CString
inBufPtrPtr Ptr CSize
inLengthPtr Ptr CString
outBufPtrPtr Ptr CSize
outFreePtr
Int
inLength' <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
inLengthPtr
Int
outFree' <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
outFreePtr
let inByteCount :: Int
inByteCount = Buffers -> Int
inLength Buffers
bufs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inLength'
outByteCount :: Int
outByteCount = Buffers -> Int
outFree Buffers
bufs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
outFree'
bufs' :: Buffers
bufs' = Buffers
bufs {
inOffset :: Int
inOffset = Buffers -> Int
inOffset Buffers
bufs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inByteCount,
inLength :: Int
inLength = Int
inLength',
inTotal :: Int
inTotal = Buffers -> Int
inTotal Buffers
bufs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inByteCount,
outLength :: Int
outLength = Buffers -> Int
outLength Buffers
bufs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outByteCount,
outFree :: Int
outFree = Int
outFree'
}
if CSize
result CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
/= CSize
errVal
then (Buffers, Status) -> IO (Buffers, Status)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs', Status
InputEmpty)
else do Errno
errno <- IO Errno
getErrno
case () of
_ | Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
e2BIG -> (Buffers, Status) -> IO (Buffers, Status)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs', Status
OutputFull)
| Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINVAL -> (Buffers, Status) -> IO (Buffers, Status)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs', Status
IncompleteChar)
| Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eILSEQ -> (Buffers, Status) -> IO (Buffers, Status)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs', Status
InvalidChar)
| Bool
otherwise -> (Buffers, Status) -> IO (Buffers, Status)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs', Errno -> Status
UnexpectedError Errno
errno)
where errVal :: CSize
errVal :: CSize
errVal = (-1)
finalise :: IConv ()
finalise :: IConv ()
finalise = (ConversionDescriptor -> Buffers -> IO (Buffers, ())) -> IConv ()
forall a.
(ConversionDescriptor -> Buffers -> IO (Buffers, a)) -> IConv a
I ((ConversionDescriptor -> Buffers -> IO (Buffers, ())) -> IConv ())
-> (ConversionDescriptor -> Buffers -> IO (Buffers, ()))
-> IConv ()
forall a b. (a -> b) -> a -> b
$ \(ConversionDescriptor cd :: ForeignPtr ConversionDescriptor
cd) bufs :: Buffers
bufs -> do
ForeignPtr ConversionDescriptor -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ConversionDescriptor
cd
(Buffers, ()) -> IO (Buffers, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffers
bufs, ())
newtype ConversionDescriptor = ConversionDescriptor (ForeignPtr ConversionDescriptor)
foreign import ccall unsafe "hsiconv.h hs_wrap_iconv_open"
c_iconv_open :: CString
-> CString
-> IO (Ptr ConversionDescriptor)
foreign import ccall unsafe "hsiconv.h hs_wrap_iconv"
c_iconv :: Ptr ConversionDescriptor
-> Ptr (Ptr CChar)
-> Ptr CSize
-> Ptr (Ptr CChar)
-> Ptr CSize
-> IO CSize
foreign import ccall unsafe "hsiconv.h &hs_wrap_iconv_close"
c_iconv_close :: FinalizerPtr ConversionDescriptor