diff --git a/Data/Conduit/IConv.hs b/Data/Conduit/IConv.hs new file mode 100644 --- /dev/null +++ b/Data/Conduit/IConv.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | A "Data.Conduit#t:Conduit" based on "Codec.Text.IConv" for +-- converting a "Data.ByteString" from one character set encoding to another +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 text from one named character encoding to another. +-- +-- Encoding names can be e.g. @\"UTF-8\"@ or @\"ISO-8559-1\"@. Appending +-- @\"\/\/IGNORE\"@ to the output encoding will cause encoding errors to be +-- ignored and the characters to be dropped, @\"\/\/IGNORE,TRANSLIT\"@ will +-- cause them to be replaced by a replacement character. +-- +-- Without this encoding errors will cause an exception. +-- +-- On errors this will call "Control.Monad#v:fail" +convert :: Monad m => String -- ^ Name of input character encoding + -> String -- ^ Name of output character encoding + -> 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) + +-- Stream based API around iconv() +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) + + +-- Thin wrapper around iconv_open() +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) + +-- Thin wrapper around iconv() +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 -- 16 byte padding just in case + mallocBytes outLeft >>= \outPtr -> + BU.unsafePackCStringLen (outPtr, outLeft) >>= \output -> -- created here already to be garbage collected in case of async exceptions + 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 -- we processed nothing and it's still too big?! + UnexpectedError errno + else + MoreData output' remaining + | errno == eINVAL -> return $ Converted output' remaining -- nothing converted here is no error as with future data we might be able to convert + | errno == eILSEQ -> return $ + if outLeft == outLeft' then -- we processed nothing + UnexpectedError errno + else + InvalidInput output' remaining + | otherwise -> return $ UnexpectedError errno + + +-- Taken from Codec.Text.IConv +foreign import ccall unsafe "hsiconv.h hs_wrap_iconv_open" + c_iconv_open :: CString -- to code + -> CString -- from code + -> IO (Ptr IConvT) + +foreign import ccall unsafe "hsiconv.h hs_wrap_iconv" + c_iconv :: Ptr IConvT + -> Ptr (Ptr CChar) -- in buf + -> Ptr CSize -- in buf bytes left + -> Ptr (Ptr CChar) -- out buf + -> Ptr CSize -- out buf bytes left + -> IO CSize + +foreign import ccall unsafe "hsiconv.h &hs_wrap_iconv_close" + c_iconv_close :: FinalizerPtr IConvT + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Sebastian Dröge + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Sebastian Dröge nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/hsiconv.c b/cbits/hsiconv.c new file mode 100644 --- /dev/null +++ b/cbits/hsiconv.c @@ -0,0 +1,20 @@ +#include "hsiconv.h" + +/* On some platforms (notably darwin) the iconv functions are defined as + * a macro rather than a real C function. Doh! That means we need these + * wrappers to get a real C functions we can import via the Haskell FFI. + */ + +iconv_t hs_wrap_iconv_open(const char *tocode, const char *fromcode) { + return iconv_open(tocode, fromcode); +} + +size_t hs_wrap_iconv(iconv_t cd, + char **inbuf, size_t *inbytesleft, + char **outbuf, size_t *outbytesleft) { + return iconv(cd, inbuf, inbytesleft, outbuf, outbytesleft); +} + +int hs_wrap_iconv_close(iconv_t cd) { + return iconv_close(cd); +} diff --git a/conduit-iconv.cabal b/conduit-iconv.cabal new file mode 100644 --- /dev/null +++ b/conduit-iconv.cabal @@ -0,0 +1,51 @@ +name: conduit-iconv +version: 0.1.0.0 +synopsis: Conduit for character encoding conversion. +description: + @conduit-iconv@ provides a "Data.Conduit#t:Conduit" for character encoding + conversion, based on the iconv library. +homepage: https://github.com/sdroege/conduit-iconv +license: BSD3 +license-file: LICENSE +author: Sebastian Dröge +maintainer: slomo@coaxion.net +category: Conduit, Text +build-type: Simple +cabal-version: >= 1.10 + +library + exposed-modules: Data.Conduit.IConv + build-depends: base == 4.* + , conduit >= 1.1 && < 1.3 + , bytestring >= 0.10 && < 0.11 + default-language: Haskell2010 + ghc-options: -Wall + includes: hsiconv.h + include-dirs: cbits + c-sources: cbits/hsiconv.c + if os(darwin) || os(freebsd) + -- on many systems the iconv api is part of the standard C library + -- but on some others we have to link to an external libiconv: + extra-libraries: iconv + +test-suite Tests + type: exitcode-stdio-1.0 + x-uses-tf: true + build-depends: base == 4.* + , QuickCheck >= 2.4 + , mtl == 2.* + , test-framework >= 0.4.1 + , test-framework-quickcheck2 + , bytestring + , text + , conduit + , conduit-iconv + ghc-options: -Wall + hs-source-dirs: tests + default-language: Haskell2010 + main-is: Tests.hs + +source-repository head + type: git + location: git://github.com/sdroege/conduit-iconv.git + diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,104 @@ +module Main where + +import Control.Monad.Identity + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +import Data.Conduit +import qualified Data.Conduit.List as CL +import qualified Data.Conduit.IConv as I + +import Test.Framework +import Test.Framework.Providers.QuickCheck2 (testProperty) + +-- Divide a bytestring into up to 5 chunks +chunkByteString :: Int -> Int -> Int -> Int -> Int -> B.ByteString -> [B.ByteString] +chunkByteString n a b c d s = case n `mod` 5 of + 0 -> [s] + 1 -> let (s', s'') = B.splitAt (a `safeMod` B.length s) s + in [s', s''] + 2 -> let (s', s'') = B.splitAt (a `safeMod` B.length s) s + (t'', t''') = B.splitAt (b `safeMod` B.length s'') s'' + in [s', t'', t'''] + 3 -> let (s', s'') = B.splitAt (a `safeMod` B.length s) s + (t'', t''') = B.splitAt (b `safeMod` B.length s'') s'' + (u''', u'''') = B.splitAt (c `safeMod` B.length t''') t''' + in [s', t'', u''', u''''] + _ -> let (s', s'') = B.splitAt (a `safeMod` B.length s) s + (t'', t''') = B.splitAt (b `safeMod` B.length s'') s'' + (u''', u'''') = B.splitAt (c `safeMod` B.length t''') t''' + (v'''', v''''') = B.splitAt (d `safeMod` B.length u'''') u'''' + in [s', t'', u''', v'''', v'''''] + where + safeMod _ 0 = 0 + safeMod m o = abs $ m `mod` abs o + +prop_identityASCIIToUTF8 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityASCIIToUTF8 inString n a b c d = input == output + where input = B.map (\w -> if w >= 128 then w - 128 else w) . BC.pack $ inString + cInput = chunkByteString n a b c d input + converted = runIdentity $ CL.sourceList cInput $$ I.convert "ASCII" "UTF-8" =$ CL.consume + output = B.concat converted + +prop_identityLatin1ToUTF8 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityLatin1ToUTF8 inString n a b c d = inString == output + where input = chunkByteString n a b c d . BC.pack $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert "Latin1" "UTF-8" =$ CL.consume + output = T.unpack . TE.decodeUtf8 . B.concat $ converted + +prop_identityUTF8ToUTF16 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityUTF8ToUTF16 inString n a b c d = inString == output + where input = chunkByteString n a b c d . TE.encodeUtf8 . T.pack $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert "UTF-8" "UTF-16LE" =$ CL.consume + output = T.unpack . TE.decodeUtf16LE . B.concat $ converted + +prop_identityUTF16ToUTF8 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityUTF16ToUTF8 inString n a b c d = inString == output + where input = chunkByteString n a b c d . TE.encodeUtf16LE . T.pack $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert "UTF-16LE" "UTF-8" =$ CL.consume + output = T.unpack . TE.decodeUtf8 . B.concat $ converted + +prop_identityUTF8ToUTF32 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityUTF8ToUTF32 inString n a b c d = inString == output + where input = chunkByteString n a b c d . TE.encodeUtf8 . T.pack $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert "UTF-8" "UTF-32LE" =$ CL.consume + output = T.unpack . TE.decodeUtf32LE . B.concat $ converted + +prop_identityUTF16ToUTF32 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityUTF16ToUTF32 inString n a b c d = inString == output + where input = chunkByteString n a b c d . TE.encodeUtf16LE . T.pack $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert "UTF-16LE" "UTF-32LE" =$ CL.consume + output = T.unpack . TE.decodeUtf32LE . B.concat $ converted + +prop_identityUTF32ToUTF16 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityUTF32ToUTF16 inString n a b c d = inString == output + where input = chunkByteString n a b c d . TE.encodeUtf32LE . T.pack $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert "UTF-32LE" "UTF-16LE" =$ CL.consume + output = T.unpack . TE.decodeUtf16LE . B.concat $ converted + +prop_identityUTF32ToUTF8 :: String -> Int -> Int -> Int -> Int -> Int -> Bool +prop_identityUTF32ToUTF8 inString n a b c d = inString == output + where input = chunkByteString n a b c d . TE.encodeUtf32LE . T.pack $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert "UTF-32LE" "UTF-8" =$ CL.consume + output = T.unpack . TE.decodeUtf8 . B.concat $ converted + +main :: IO () +main = defaultMain tests + +tests :: [Test] +tests = [ + testGroup "QuickCheck Data.Conduit.IConv" [ + testProperty "identityASCIIToUTF8" prop_identityASCIIToUTF8 + , testProperty "identityLatin1ToUTF8" prop_identityLatin1ToUTF8 + , testProperty "identityUTF8ToUTF16" prop_identityUTF8ToUTF16 + , testProperty "identityUTF16ToUTF8" prop_identityUTF16ToUTF8 + , testProperty "identityUTF8ToUTF32" prop_identityUTF8ToUTF32 + , testProperty "identityUTF16ToUTF32" prop_identityUTF16ToUTF32 + , testProperty "identityUTF32ToUTF16" prop_identityUTF32ToUTF16 + , testProperty "identityUTF32ToUTF8" prop_identityUTF32ToUTF8 + ] + ]