diff --git a/Data/Conduit/IConv.hs b/Data/Conduit/IConv.hs --- a/Data/Conduit/IConv.hs +++ b/Data/Conduit/IConv.hs @@ -1,14 +1,14 @@ {-# LANGUAGE ForeignFunctionInterface #-} --- | A "Data.Conduit#t:Conduit" based on "Codec.Text.IConv" for --- converting a "Data.ByteString" from one character set encoding to another +-- | A `Conduit` based on the iconv library for +-- converting a `Data.ByteString` from one character set encoding to another module Data.Conduit.IConv ( - convert + CharacterEncoding + , 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 @@ -17,7 +17,13 @@ import Foreign hiding (unsafePerformIO) import Foreign.C import System.IO.Unsafe (unsafePerformIO) +import Control.Exception (mask_) +-- | Type synonym for character encoding names +-- +-- See `convert` for details. +type CharacterEncoding = String + -- | Convert text from one named character encoding to another. -- -- Encoding names can be e.g. @\"UTF-8\"@ or @\"ISO-8559-1\"@. Appending @@ -27,15 +33,14 @@ -- -- 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 +-- On errors this will call `fail` +convert :: Monad m => CharacterEncoding -- ^ Name of input character encoding + -> CharacterEncoding -- ^ Name of output character encoding -> Conduit B.ByteString m B.ByteString -convert inputEncoding outputEncoding = - let initialConvert = iconvConvert inputEncoding outputEncoding - in run initialConvert - +convert inputEncoding outputEncoding = run initialConvert where + initialConvert = iconvConvert inputEncoding outputEncoding + run f = do maybeInput <- await case maybeInput of @@ -43,10 +48,7 @@ Just input -> do let res = f input case res of - ConvertSuccess c f' -> do - CL.sourceList c - run f' - + ConvertSuccess c f' -> yield c >> run f' ConvertUnsupportedConversionError -> fail "Unsupported conversion" ConvertUnexpectedOpenError s -> fail ("Unexpected open error: " ++ s) ConvertInvalidInputError -> fail "Invalid input" @@ -54,66 +56,105 @@ -- Stream based API around iconv() data ConvertResult = - ConvertSuccess [B.ByteString] (B.ByteString -> ConvertResult) + ConvertSuccess B.ByteString (B.ByteString -> ConvertResult) | ConvertUnsupportedConversionError | ConvertUnexpectedOpenError String | ConvertInvalidInputError | ConvertUnexpectedConversionError String -iconvConvert :: String -> String -> B.ByteString -> ConvertResult +iconvConvert :: CharacterEncoding -> CharacterEncoding -> 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 + Right ctx -> convertInput ctx B.empty input where - convertInput ctx remaining converted newInput + -- Converts newInput with the given context + -- + -- If converted is not empty, this will be prepended to + -- the converted output. This will happen if we're called + -- after the remainder of a previous conversion was consumed. + -- converted is the result of the remainder conversion. + -- + -- If this conversion results in a remainder we return any + -- results we got so far but will use convertInputWithRemaining + -- with the remainder for the next call. + convertInput ctx converted newInput | B.null newInput = - ConvertSuccess converted (convertInput ctx remaining []) + ConvertSuccess converted (convertInput ctx B.empty) - | B.null remaining = - let res = iconv ctx newInput + | otherwise = + let res = iconv ctx newInput converted 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) + Converted c r -> ConvertSuccess c (convertInputWithRemaining ctx r) + InvalidInput c _ -> if B.null c then + ConvertInvalidInputError + else + -- Converted a bit but detected invalid input afterwards. + -- Let's return what was converted so far and fail with + -- the next call + ConvertSuccess c (const ConvertInvalidInputError) UnexpectedError (Errno errno) -> ConvertUnexpectedConversionError (show errno) + -- Convert any remainder from a previous conversion. We do + -- this by first appending the first 32 bytes of the newInput + -- to the remainder. With 32 bytes additionally we should be + -- able to convert the remainder from any possible charset + -- encoding that has 32 *bytes* per character at maximum. + -- 4 would've been enough too probably. + -- + -- If the conversion was successful, we take the remaining + -- newInput and the converted remainder, and hand it over + -- to the previous conversion function. Which then will + -- convert the remaining newInput and prepend the converted + -- remainder to it. + convertInputWithRemaining ctx remaining newInput + | B.null remaining = + convertInput ctx B.empty newInput + + | B.null newInput = + ConvertSuccess B.empty (convertInputWithRemaining ctx remaining) + | otherwise = let tmpInput = remaining `B.append` B.take 32 newInput - res = iconv ctx tmpInput + res = iconv ctx tmpInput B.empty 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 + Converted c r -> if processed < B.length remaining then + -- Didn't convert the complete remainder. Let's try again next + -- time with the additional newInput + ConvertSuccess B.empty (convertInputWithRemaining ctx (remaining `B.append` newInput)) + else + -- Converted the complete remainder. Now let's try to + -- convert the remaining new input + convertInput ctx c (B.drop consumedInput newInput) + + where + 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) + InvalidInput c _ -> if B.null c then + ConvertInvalidInputError + else + -- Converted a bit but detected invalid input afterwards. + -- Let's return what was converted so far and fail with + -- the next call + ConvertSuccess c (const ConvertInvalidInputError) UnexpectedError (Errno errno) -> ConvertUnexpectedConversionError (show errno) -- Thin wrapper around iconv_open() -newtype IConvT = IConvT (ForeignPtr IConvT) +data IConvT = IConvT (ForeignPtr IConvT) data IConvOpenError = UnsupportedConversion | UnexpectedOpenError Errno -iconvOpen :: String -> String -> Either IConvOpenError IConvT -iconvOpen inputEncoding outputEncoding = unsafePerformIO $ do +iconvOpen :: CharacterEncoding -> CharacterEncoding -> Either IConvOpenError IConvT +iconvOpen inputEncoding outputEncoding = unsafePerformIO $ + mask_ $ do -- mask async exceptions, we might otherwise leak ptr <- withCString inputEncoding $ \inputEncodingPtr -> withCString outputEncoding $ \outputEncodingPtr -> c_iconv_open outputEncodingPtr inputEncodingPtr @@ -132,46 +173,89 @@ -- 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 +iconv :: IConvT -> B.ByteString -> B.ByteString -> IConvResult +iconv (IConvT fPtr) input outputPrefix = unsafePerformIO $ + mask_ $ do -- mask async exceptions, we might otherwise leak + let outputPrefixLen = B.length outputPrefix + inputLen = B.length input + -- We allocate enough memory for the worst case: 1 + -- byte per character encodings to 4 bytes per + -- character encodings (e.g. ASCII to UTF32). + -- Additionally 16 bytes of padding just in case and + -- the length of the converted prefix we have to + -- prepend to the result + -- + -- We overallocate here but will resize later. The + -- alternative would be to produce potentially many + -- smaller chunks of output. + outputLen = inputLen * 4 + 16 + outputPrefixLen + convertLen = outputLen - outputPrefixLen - res <- c_iconv ptr inPtrPtr inLeftPtr outPtrPtr outLeftPtr + -- We allocate via malloc(), which does not give us memory inside + -- the GC heap. But this allows us to realloc() the memory later + -- to the actual size. + outputPtr <- mallocBytes outputLen - inLeft' <- fromIntegral <$> peek inLeftPtr - outLeft' <- fromIntegral <$> peek outLeftPtr - let output' = B.take (outLeft - outLeft') output - remaining = B.drop (inLeft - inLeft') input + BU.unsafeUseAsCString outputPrefix $ \outputPrefixPtr -> + copyBytes outputPtr outputPrefixPtr outputPrefixLen - 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 + -- Newly converted output should start at this pointer + let outputConvPtr = plusPtr outputPtr outputPrefixLen + + -- Do the actual conversion and calculate how many bytes we + -- read and wrote to update our state + (res, readCount, writeCount) <- + withForeignPtr fPtr $ \ptr -> + BU.unsafeUseAsCString input $ \inputPtr -> + with inputPtr $ \inputPtrPtr -> + with (fromIntegral inputLen) $ \inputLenPtr -> + with outputConvPtr $ \outputConvPtrPtr -> + with (fromIntegral convertLen) $ \convertLenPtr -> do + res <- c_iconv ptr inputPtrPtr inputLenPtr outputConvPtrPtr convertLenPtr + + -- The length pointers will be updated by iconv to the still + -- remaining length after conversion. That means we can calculate + -- the read/written number of bytes with: old - new + readCount <- (`subtract` inputLen) . fromIntegral <$> peek inputLenPtr + writeCount <- (`subtract` convertLen) . fromIntegral <$> peek convertLenPtr + return (res, readCount, writeCount) + + let remaining = B.drop readCount input + convertedLen = outputPrefixLen + writeCount + + -- Reallocate the memory to a memory area of the actual size. This + -- potentially allows the OS to reuse any memory we allocated too much and + -- in general does not cause the memory to be copied. + -- + -- This will return NULL if the output size is 0, but the resulting + -- ByteString will then be the empty ByteString as expected. + -- + -- Shadowing outputPtr to prevent accidential usage of old outputPtr + outputPtr <- reallocBytes outputPtr convertedLen + output <- BU.unsafePackMallocCStringLen (outputPtr, convertedLen) + + if res /= (-1) then + return $ Converted output remaining + else do + errno <- getErrno + case () of + -- The output buffer was too small! This should not happen + -- because we overallocate for any possible output charset + -- encoding + _ | errno == e2BIG -> return $ UnexpectedError errno + + -- Incomplete byte sequence was detected, which we might be + -- able to convert with further input later + | errno == eINVAL -> return $ Converted output remaining + + -- Invalid byte sequence was detected. We might've converted + -- something already but from here on we can't do anything + | errno == eILSEQ -> return $ InvalidInput output remaining + + | otherwise -> return $ UnexpectedError errno -- Taken from Codec.Text.IConv diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Benchmarks.hs @@ -0,0 +1,83 @@ +module Main where + +import Control.Monad.Identity + +import qualified Data.ByteString as B + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +import Criterion.Main + +import Data.Conduit +import qualified Data.Conduit.List as CL +import qualified Data.Conduit.IConv as I + +loremIpsum, loremIpsumUnicode :: String +-- https://en.wikipedia.org/wiki/Lorem_ipsum +loremIpsum = concat . replicate 128 $ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." +-- http://www.geertvanderploeg.com/unicode-gen/ +loremIpsumUnicode = concat . replicate 128 $ "L߀ｒèϻ ïρѕüｍ ԁòｌòｒ ѕｉｔ äｍéｔ, ｃòлｓêｃｔêｔúｒ ａԁìｐïѕｃìԉｇ ëｌïｔ, ｓéｄ Ꮷò éïüｓϻ߀ｄ ｔｅϻρ߀ｒ ìԉｃìԁíᏧûлｔ ûｔ ｌáƅ߀ｒｅ éｔ ｄ߀ｌòｒê ϻåǥｎà áｌïɋùå. Uｔ ëｎïϻ ａԁ ϻｉｎìϻ ｖｅлìäｍ, ｑúïѕ ｎ߀ѕｔｒüԁ èХêｒｃｉｔɑｔíòｎ ùｌɭàϻｃò ɭåｂ߀ｒïѕ ԉïｓí ûｔ àɭìɋûíｐ ｅх êà ｃ߀ｍｍòᏧ߀ ｃ߀ｎѕèɋûáｔ. Düïѕ ãüｔè ｉｒüｒé ｄ߀ｌòｒ ïｎ ｒｅρｒèհêｎᏧéｒìｔ ｉԉ ѵｏｌüｐｔãｔｅ ѵëɭｉｔ éｓｓê ｃｉɭｌûｍ ｄ߀ɭòｒè ëû ｆｕｇìɑｔ ԉúｌɭã ρɑｒìɑｔüｒ. Eӽｃëρｔéｕｒ ｓíԉｔ ｏｃｃɑéｃäｔ ｃùρíԁáｔâｔ лｏл ｐｒｏｉԁêлｔ, ѕúԉｔ íｎ ｃûɭｐä ｑｕｉ ߀ｆｆïｃｉä ｄèｓëｒùԉｔ ｍ߀ɭｌïｔ âԉïϻ íԁ ｅѕｔ ｌäƅｏｒùϻ." + +main :: IO () +main = defaultMain benchmarks + +data SplitMode = None + | Half + | Quarter + | ThreeBytes + | TwoBytes + | OneByte + +convert :: (String -> B.ByteString) -> I.CharacterEncoding -> I.CharacterEncoding -> SplitMode -> String -> [B.ByteString] +convert encode from to split input = runIdentity $ CL.sourceList preparedInput $$ I.convert from to =$ CL.consume + where + encodedInput = encode input + preparedInput = case split of + None -> [encodedInput] + Half -> halfByteString encodedInput + Quarter -> concatMap halfByteString (halfByteString encodedInput) + ThreeBytes -> chunksOf 3 encodedInput + TwoBytes -> chunksOf 2 encodedInput + OneByte -> chunksOf 1 encodedInput + + halfByteString b = let (s, s') = B.splitAt (B.length b `div` 2) b + in [s, s'] + + chunksOf c b | B.null b = [] + | otherwise = let (s, s') = B.splitAt c b + in s : chunksOf c s' + +benchmarks :: [Benchmark] +benchmarks = [ + bgroup "ascii" [ + bench "32LE-8-N" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" None) loremIpsum + , bench "32LE-8-H" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" Half) loremIpsum + , bench "32LE-8-Q" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" Quarter) loremIpsum + , bench "32LE-8-3" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" ThreeBytes) loremIpsum + , bench "32LE-8-2" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" TwoBytes) loremIpsum + , bench "32LE-8-1" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" OneByte) loremIpsum + + , bench "8-32LE-N" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" None) loremIpsum + , bench "8-32LE-H" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" Half) loremIpsum + , bench "8-32LE-Q" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" Quarter) loremIpsum + , bench "8-32LE-3" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" ThreeBytes) loremIpsum + , bench "8-32LE-2" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" TwoBytes) loremIpsum + , bench "8-32LE-1" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" OneByte) loremIpsum + ] + , bgroup "unicode" [ + bench "32LE-8-N" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" None) loremIpsumUnicode + , bench "32LE-8-H" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" Half) loremIpsumUnicode + , bench "32LE-8-Q" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" Quarter) loremIpsumUnicode + , bench "32LE-8-3" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" ThreeBytes) loremIpsumUnicode + , bench "32LE-8-2" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" TwoBytes) loremIpsumUnicode + , bench "32LE-8-1" $ whnf (convert (TE.encodeUtf32LE . T.pack) "UTF-32LE" "UTF-8" OneByte) loremIpsumUnicode + + , bench "8-32LE-N" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" None) loremIpsumUnicode + , bench "8-32LE-H" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" Half) loremIpsumUnicode + , bench "8-32LE-Q" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" Quarter) loremIpsumUnicode + , bench "8-32LE-3" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" ThreeBytes) loremIpsumUnicode + , bench "8-32LE-2" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" TwoBytes) loremIpsumUnicode + , bench "8-32LE-1" $ whnf (convert (TE.encodeUtf8 . T.pack) "UTF-8" "UTF-32LE" OneByte) loremIpsumUnicode + ] + ] diff --git a/conduit-iconv.cabal b/conduit-iconv.cabal --- a/conduit-iconv.cabal +++ b/conduit-iconv.cabal @@ -1,17 +1,17 @@ -name: conduit-iconv -version: 0.1.0.0 -synopsis: Conduit for character encoding conversion. +name: conduit-iconv +version: 0.1.1.0 +synopsis: Conduit for character encoding conversion. description: - @conduit-iconv@ provides a "Data.Conduit#t:Conduit" for character encoding + @conduit-iconv@ provides a 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 +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 @@ -29,21 +29,35 @@ 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 + 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 + +benchmark Benchmarks + type: exitcode-stdio-1.0 + build-depends: base == 4.* + , mtl == 2.* + , conduit + , bytestring + , text + , conduit-iconv + , criterion + ghc-options: -O2 -Wall + hs-source-dirs: benchmarks + default-language: Haskell2010 + main-is: Benchmarks.hs source-repository head type: git diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -37,68 +37,55 @@ 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_identityLatin1ToUTF8 = prop_identity BC.pack "Latin1" (T.unpack . TE.decodeUtf8) "UTF-8" 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_identityUTF8ToUTF16 = prop_identity (TE.encodeUtf8 . T.pack) "UTF-8" (T.unpack . TE.decodeUtf16LE) "UTF-16LE" 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_identityUTF16ToUTF8 = prop_identity (TE.encodeUtf16LE . T.pack) "UTF-16LE" (T.unpack . TE.decodeUtf8) "UTF-8" 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_identityUTF8ToUTF32 = prop_identity (TE.encodeUtf8 . T.pack) "UTF-8" (T.unpack . TE.decodeUtf32LE) "UTF-32LE" 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_identityUTF16ToUTF32 = prop_identity (TE.encodeUtf16LE . T.pack) "UTF-16LE" (T.unpack . TE.decodeUtf32LE) "UTF-32LE" 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_identityUTF32ToUTF16 = prop_identity (TE.encodeUtf32LE . T.pack) "UTF-32LE" (T.unpack . TE.decodeUtf16LE) "UTF-16LE" 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 +prop_identityUTF32ToUTF8 = prop_identity (TE.encodeUtf32LE . T.pack) "UTF-32LE" (T.unpack . TE.decodeUtf8) "UTF-8" +prop_identity :: (String -> BC.ByteString) + -> I.CharacterEncoding + -> (BC.ByteString -> String) + -> I.CharacterEncoding + -> String + -> Int + -> Int + -> Int + -> Int + -> Int + -> Bool +prop_identity encode encodeTo decode decodeTo inString n a b c d = inString == output + where input = chunkByteString n a b c d . encode $ inString + converted = runIdentity $ CL.sourceList input $$ I.convert encodeTo decodeTo =$ CL.consume + output = decode . 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 "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 + , testProperty "identityUTF32ToUTF8" prop_identityUTF32ToUTF8 ] ]