module Data.Conduit.IConv
(
convert
) where
import Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import Control.Applicative ((<$>))
import Foreign hiding (unsafePerformIO)
import Foreign.C
import System.IO.Unsafe (unsafePerformIO)
convert :: Monad m => String
-> String
-> Conduit B.ByteString m B.ByteString
convert inputEncoding outputEncoding =
let initialConvert = iconvConvert inputEncoding outputEncoding
in run initialConvert
where
run f = do
maybeInput <- await
case maybeInput of
Nothing -> return ()
Just input -> do
let res = f input
case res of
ConvertSuccess c f' -> do
CL.sourceList c
run f'
ConvertUnsupportedConversionError -> fail "Unsupported conversion"
ConvertUnexpectedOpenError s -> fail ("Unexpected open error: " ++ s)
ConvertInvalidInputError -> fail "Invalid input"
ConvertUnexpectedConversionError s -> fail ("Unexpected conversion error: " ++ s)
data ConvertResult =
ConvertSuccess [B.ByteString] (B.ByteString -> ConvertResult)
| ConvertUnsupportedConversionError
| ConvertUnexpectedOpenError String
| ConvertInvalidInputError
| ConvertUnexpectedConversionError String
iconvConvert :: String -> String -> B.ByteString -> ConvertResult
iconvConvert inputEncoding outputEncoding input =
let eCtx = iconvOpen inputEncoding outputEncoding
in
case eCtx of
Left UnsupportedConversion -> ConvertUnsupportedConversionError
Left (UnexpectedOpenError (Errno errno)) -> ConvertUnexpectedOpenError (show errno)
Right ctx -> convertInput ctx B.empty [] input
where
convertInput ctx remaining converted newInput
| B.null newInput =
ConvertSuccess converted (convertInput ctx remaining [])
| B.null remaining =
let res = iconv ctx newInput
in
case res of
Converted c r -> ConvertSuccess (converted ++ [c]) (convertInput ctx r [])
MoreData c r -> convertInput ctx B.empty (converted ++ [c]) r
InvalidInput c _ -> ConvertSuccess (converted ++ [c]) (const ConvertInvalidInputError)
UnexpectedError (Errno errno) -> ConvertUnexpectedConversionError (show errno)
| otherwise =
let tmpInput = remaining `B.append` B.take 32 newInput
res = iconv ctx tmpInput
in
case res of
Converted c r -> let processed = B.length tmpInput B.length r
consumedInput = processed B.length remaining
in
if processed < B.length remaining then
ConvertSuccess converted (convertInput ctx (remaining `B.append` newInput) [])
else
convertInput ctx B.empty (converted ++ [c]) (B.drop consumedInput newInput)
MoreData c r -> let processed = B.length tmpInput B.length r
consumedInput = processed B.length remaining
in
if processed < B.length remaining then
ConvertSuccess converted (convertInput ctx (remaining `B.append` newInput) [])
else
convertInput ctx B.empty (converted ++ [c]) (B.drop consumedInput newInput)
InvalidInput c _ -> ConvertSuccess (converted ++ [c]) (const ConvertInvalidInputError)
UnexpectedError (Errno errno) -> ConvertUnexpectedConversionError (show errno)
newtype IConvT = IConvT (ForeignPtr IConvT)
data IConvOpenError =
UnsupportedConversion
| UnexpectedOpenError Errno
iconvOpen :: String -> String -> Either IConvOpenError IConvT
iconvOpen inputEncoding outputEncoding = unsafePerformIO $ do
ptr <- withCString inputEncoding $ \inputEncodingPtr ->
withCString outputEncoding $ \outputEncodingPtr ->
c_iconv_open outputEncodingPtr inputEncodingPtr
case ptrToIntPtr ptr of
(1) -> do
errno <- getErrno
return $ Left $
if errno == eINVAL then
UnsupportedConversion
else
UnexpectedOpenError errno
_ -> do
fPtr <- newForeignPtr c_iconv_close ptr
return $ Right (IConvT fPtr)
data IConvResult =
Converted B.ByteString B.ByteString
| MoreData B.ByteString B.ByteString
| InvalidInput B.ByteString B.ByteString
| UnexpectedError Errno
iconv :: IConvT -> B.ByteString -> IConvResult
iconv (IConvT fPtr) input = unsafePerformIO $
withForeignPtr fPtr $ \ptr ->
BU.unsafeUseAsCStringLen input $ \(inPtr, inLeft) ->
with inPtr $ \inPtrPtr ->
with (fromIntegral inLeft) $ \inLeftPtr ->
let outLeft = max (inLeft + 16) 4096 in
mallocBytes outLeft >>= \outPtr ->
BU.unsafePackCStringLen (outPtr, outLeft) >>= \output ->
with outPtr $ \outPtrPtr ->
with (fromIntegral outLeft) $ \outLeftPtr -> do
res <- c_iconv ptr inPtrPtr inLeftPtr outPtrPtr outLeftPtr
inLeft' <- fromIntegral <$> peek inLeftPtr
outLeft' <- fromIntegral <$> peek outLeftPtr
let output' = B.take (outLeft outLeft') output
remaining = B.drop (inLeft inLeft') input
if res /= (1) then
return $ Converted output' remaining
else do
errno <- getErrno
case () of
_ | errno == e2BIG -> return $
if outLeft == outLeft' then
UnexpectedError errno
else
MoreData output' remaining
| errno == eINVAL -> return $ Converted output' remaining
| errno == eILSEQ -> return $
if outLeft == outLeft' then
UnexpectedError errno
else
InvalidInput output' remaining
| otherwise -> return $ UnexpectedError errno
foreign import ccall unsafe "hsiconv.h hs_wrap_iconv_open"
c_iconv_open :: CString
-> CString
-> IO (Ptr IConvT)
foreign import ccall unsafe "hsiconv.h hs_wrap_iconv"
c_iconv :: Ptr IConvT
-> 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 IConvT