diff --git a/Codec/Text/IConv.hs b/Codec/Text/IConv.hs --- a/Codec/Text/IConv.hs +++ b/Codec/Text/IConv.hs @@ -1,10 +1,10 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Copyright : (c) 2006-2007 Duncan Coutts -- License : BSD-style -- -- Maintainer : duncan@haskell.org --- Stability : experimental -- Portability : portable (H98 + FFI) -- -- String encoding conversion @@ -58,9 +58,7 @@ import Foreign.C.Error as C.Error (Errno, errnoToIOError) import qualified Data.ByteString.Lazy as L (ByteString, toChunks, fromChunks) -#ifndef BYTESTRING_IN_BASE import qualified Data.ByteString.Lazy.Internal as L (defaultChunkSize) -#endif import qualified Data.ByteString as S import qualified Codec.Text.IConv.Internal as IConv @@ -139,7 +137,7 @@ -- | UnexpectedError C.Error.Errno -reportConversionError :: ConversionError -> Exception.Exception +reportConversionError :: ConversionError -> IOError reportConversionError conversionError = case conversionError of UnsuportedConversion fromEncoding toEncoding -> err $ "cannot convert from string encoding " @@ -149,11 +147,10 @@ ++ show inputPos IncompleteChar inputPos -> err $ "incomplete input sequence at byte offset " ++ show inputPos - UnexpectedError errno -> Exception.IOException $ C.Error.errnoToIOError + UnexpectedError errno -> C.Error.errnoToIOError "Codec.Text.IConv: unexpected error" errno Nothing Nothing - where err msg = Exception.ErrorCall $ "Codec.Text.IConv: " ++ msg - + where err msg = userError $ "Codec.Text.IConv: " ++ msg {-# NOINLINE convert #-} -- | Convert text from one named string encoding to another. @@ -178,7 +175,12 @@ where span (Span c) cs = c : cs - span (ConversionError e) _ = Exception.throw (reportConversionError e) + span (ConversionError e) _ = +#if MIN_VERSION_base(4,0,0) + Exception.throw (reportConversionError e) +#else + Exception.throw (Exception.IOException (reportConversionError e)) +#endif data Fuzzy = Transliterate | Discard @@ -405,7 +407,7 @@ IConv.InvalidChar -> invalidChar ignore inChunks - IConv.IncompleteChar -> + IConv.IncompleteChar -> assert (inSize < consumed && consumed < tmpChunkSize) $ -- inSize < consumed < tmpChunkSize -- => { subtract inSize from each side } @@ -463,13 +465,7 @@ else return [ ConversionError err] outChunkSize :: Int -#ifdef BYTESTRING_IN_BASE -outChunkSize = 32 * k - overhead - where k = 1024 - overhead = 16 -#else outChunkSize = L.defaultChunkSize -#endif tmpChunkSize :: Int tmpChunkSize = 16 diff --git a/Codec/Text/IConv/Internal.hs b/Codec/Text/IConv/Internal.hs --- a/Codec/Text/IConv/Internal.hs +++ b/Codec/Text/IConv/Internal.hs @@ -4,7 +4,6 @@ -- License : BSD-style -- -- Maintainer : duncan@haskell.org --- Stability : experimental -- Portability : portable (H98 + FFI) -- -- IConv wrapper layer @@ -46,11 +45,7 @@ import Foreign import Foreign.C -#ifdef BYTESTRING_IN_BASE -import qualified Data.ByteString.Base as S -#else import qualified Data.ByteString.Internal as S -#endif import System.IO.Unsafe (unsafeInterleaveIO) import System.IO (hPutStrLn, stderr) import Control.Exception (assert) @@ -66,7 +61,7 @@ assert (inAvail == 0) $ return () -- now set the available input buffer ptr and length - modify $ \bufs -> bufs { + modify $ \bufs -> bufs { inBuffer = inBuffer', inOffset = inOffset', inLength = inLength' @@ -86,18 +81,15 @@ replaceInputBuffer :: (S.ByteString -> S.ByteString) -> IConv () -replaceInputBuffer replace = do - modify $ \bufs@Buffers { - inBuffer = inBuffer, - inOffset = inOffset, - inLength = inLength - } -> case replace (S.PS inBuffer inOffset inLength) of - S.PS inBuffer' inOffset' inLength' -> - bufs { - inBuffer = inBuffer', - inOffset = inOffset', - inLength = inLength' - } +replaceInputBuffer replace = + modify $ \bufs -> + case replace (S.PS (inBuffer bufs) (inOffset bufs) (inLength bufs)) of + S.PS inBuffer' inOffset' inLength' -> + bufs { + inBuffer = inBuffer', + inOffset = inOffset', + inLength = inLength' + } newOutputBuffer :: Int -> IConv () @@ -111,9 +103,9 @@ -- there's only a few free bytes left. -- now set the available output buffer ptr and length - outBuffer <- unsafeLiftIO $ S.mallocByteString size + outBuffer' <- unsafeLiftIO $ S.mallocByteString size modify $ \bufs -> bufs { - outBuffer = outBuffer, + outBuffer = outBuffer', outOffset = 0, outLength = 0, outFree = size @@ -126,21 +118,17 @@ popOutputBuffer :: IConv S.ByteString popOutputBuffer = do - Buffers { - outBuffer = outBuffer, - outOffset = outOffset, - outLength = outLength - } <- get + bufs <- get -- there really should be something to pop, otherwise it's silly - assert (outLength > 0) $ return () + assert (outLength bufs > 0) $ return () modify $ \buf -> buf { - outOffset = outOffset + outLength, + outOffset = outOffset bufs + outLength bufs, outLength = 0 } - return (S.PS outBuffer outOffset outLength) + return (S.PS (outBuffer bufs) (outOffset bufs) (outLength bufs)) -- this is the number of bytes available in the output buffer @@ -255,10 +243,6 @@ else return (cd, UnexpectedInitError errno) (_,a) <- unI (m status) (ConversionDescriptor cd) nullBuffers return a -#if __GLASGOW_HASKELL__<=604 - where ptrToIntPtr :: Ptr a -> Int - ptrToIntPtr p = p `minusPtr` nullPtr -#endif unsafeLiftIO :: IO a -> IConv a unsafeLiftIO m = I $ \_ bufs -> do @@ -269,8 +253,8 @@ -- between running this and forcing the result then you'll get an inconsistent -- iconv state. unsafeInterleave :: IConv a -> IConv a -unsafeInterleave m = I $ \iconv st -> do - res <- unsafeInterleaveIO (unI m iconv st) +unsafeInterleave m = I $ \cd st -> do + res <- unsafeInterleaveIO (unI m cd st) return (st, snd res) get :: IConv Buffers @@ -307,36 +291,28 @@ | UnexpectedError Errno iconv :: IConv Status -iconv = I $ \(ConversionDescriptor cdfptr) bufs@Buffers { - inBuffer = inBuffer, - inOffset = inOffset, - inLength = inLength, - inTotal = inTotal, - outBuffer = outBuffer, - outOffset = outOffset, - outLength = outLength, - outFree = outFree - } -> - assert (outFree > 0) $ +iconv = I $ \(ConversionDescriptor cdfptr) bufs -> + assert (outFree bufs > 0) $ --TODO: optimise all this allocation - withForeignPtr cdfptr $ \cdPtr -> - withForeignPtr inBuffer $ \inBufPtr -> - with (inBufPtr `plusPtr` inOffset) $ \inBufPtrPtr -> - with (fromIntegral inLength) $ \inLengthPtr -> - withForeignPtr outBuffer $ \outBufPtr -> - with (outBufPtr `plusPtr` (outOffset + outLength)) $ \outBufPtrPtr -> - with (fromIntegral outFree) $ \outFreePtr -> do - + withForeignPtr cdfptr $ \cdPtr -> + withForeignPtr (inBuffer bufs) $ \inBufPtr -> + with (inBufPtr `plusPtr` inOffset bufs) $ \inBufPtrPtr -> + with (fromIntegral (inLength bufs)) $ \inLengthPtr -> + withForeignPtr (outBuffer bufs) $ \outBufPtr -> + let outBufPtr' = outBufPtr `plusPtr` (outOffset bufs + outLength bufs) in + with outBufPtr' $ \outBufPtrPtr -> + with (fromIntegral (outFree bufs)) $ \outFreePtr -> do + result <- c_iconv cdPtr inBufPtrPtr inLengthPtr outBufPtrPtr outFreePtr inLength' <- fromIntegral `fmap` peek inLengthPtr outFree' <- fromIntegral `fmap` peek outFreePtr - let inByteCount = inLength - inLength' - outByteCount = outFree - outFree' + let inByteCount = inLength bufs - inLength' + outByteCount = outFree bufs - outFree' bufs' = bufs { - inOffset = inOffset + inByteCount, + inOffset = inOffset bufs + inByteCount, inLength = inLength', - inTotal = inTotal + inByteCount, - outLength = outLength + outByteCount, + inTotal = inTotal bufs + inByteCount, + outLength = outLength bufs + outByteCount, outFree = outFree' } if result /= errVal @@ -368,12 +344,12 @@ newtype ConversionDescriptor = ConversionDescriptor (ForeignPtr ConversionDescriptor) -- iconv_t -foreign import ccall unsafe "iconv.h iconv_open" +foreign import ccall unsafe "hsiconv.h hs_wrap_iconv_open" c_iconv_open :: CString -- to code -> CString -- from code -> IO (Ptr ConversionDescriptor) -foreign import ccall unsafe "iconv.h iconv" +foreign import ccall unsafe "hsiconv.h hs_wrap_iconv" c_iconv :: Ptr ConversionDescriptor -> Ptr (Ptr CChar) -- in buf -> Ptr CSize -- in buf bytes left @@ -381,5 +357,5 @@ -> Ptr CSize -- out buf bytes left -> IO CSize -foreign import ccall unsafe "iconv.h &iconv_close" +foreign import ccall unsafe "hsiconv.h &hs_wrap_iconv_close" c_iconv_close :: FinalizerPtr ConversionDescriptor 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/cbits/hsiconv.h b/cbits/hsiconv.h new file mode 100644 --- /dev/null +++ b/cbits/hsiconv.h @@ -0,0 +1,9 @@ +#include + +iconv_t hs_wrap_iconv_open(const char *tocode, const char *fromcode); + +size_t hs_wrap_iconv(iconv_t cd, + char **inbuf, size_t *inbytesleft, + char **outbuf, size_t *outbytesleft); + +int hs_wrap_iconv_close(iconv_t cd); diff --git a/iconv.cabal b/iconv.cabal --- a/iconv.cabal +++ b/iconv.cabal @@ -1,37 +1,34 @@ name: iconv -version: 0.4.0.2 +version: 0.4.1.0 copyright: (c) 2006-2008 Duncan Coutts license: BSD3 license-file: LICENSE -author: Duncan Coutts -maintainer: Duncan Coutts +author: Duncan Coutts +maintainer: Duncan Coutts category: Text synopsis: String encoding conversion description: Provides an interface to the POSIX iconv library functions for string encoding conversion. -stability: experimental build-type: Simple -cabal-version: >= 1.2.1 -extra-source-files: README examples/hiconv.hs +cabal-version: >= 1.6 +extra-source-files: README examples/hiconv.hs cbits/hsiconv.h -flag bytestring_in_base +source-repository head + type: darcs + location: http://code.haskell.org/iconv/ library exposed-modules: Codec.Text.IConv other-modules: Codec.Text.IConv.Internal - if flag(bytestring_in_base) - -- bytestring was in base-2.0 and 2.1.1 - build-depends: base >= 2.0 && < 2.2 - cpp-options: -DBYTESTRING_IN_BASE - else - build-depends: base < 2.0 || >= 2.2, bytestring >= 0.9 - extensions: CPP, ForeignFunctionInterface - includes: iconv.h + build-depends: base >= 3 && < 5, + bytestring == 0.9.* + extensions: ForeignFunctionInterface + 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 - -- We need to compile via C because on some platforms (notably darwin) - -- iconv is a macro rather than real C function. doh! - ghc-options: -fvia-C -Wall + ghc-options: -Wall