conduit-iconv (empty) → 0.1.0.0
raw patch · 6 files changed
+400/−0 lines, 6 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, conduit, conduit-iconv, mtl, test-framework, test-framework-quickcheck2, text
Files
- Data/Conduit/IConv.hs +193/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- cbits/hsiconv.c +20/−0
- conduit-iconv.cabal +51/−0
- tests/Tests.hs +104/−0
+ Data/Conduit/IConv.hs view
@@ -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+
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/hsiconv.c view
@@ -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);+}
+ conduit-iconv.cabal view
@@ -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+
+ tests/Tests.hs view
@@ -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+ ]+ ]