    {-# LANGUAGE CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Copyright   :  (c) 2006-2007 Duncan Coutts
    -- License     :  BSD-style
    --
    -- Maintainer  :  duncan@haskell.org
    -- Portability :  portable (H98 + FFI)
    --
    -- String encoding conversion
    --
    -----------------------------------------------------------------------------
    module Codec.Text.IConv (

      -- | This module provides pure functions for converting the string encoding
      -- of strings represented by lazy 'ByteString's. This makes it easy to use
      -- either in memory or with disk or network IO.
      --
      -- For example, a simple Latin1 to UTF-8 conversion program is just:
      --
      -- > import Codec.Text.IConv as IConv
      -- > import Data.ByteString.Lazy as ByteString
      -- >
      -- > main = ByteString.interact (convert "LATIN1" "UTF-8")
      --
      -- Or you could lazily read in and convert a UTF-8 file to UTF-32 using:
      --
      -- > content <- fmap (IConv.convert "UTF-8" "UTF-32") (readFile file)
      --
      -- This module uses the POSIX @iconv()@ library function. The primary
      -- advantage of using iconv is that it is widely available, most systems
      -- have a wide range of supported string encodings and the conversion speed
      -- it typically good. The iconv library is available on all unix systems
      -- (since it is required by the POSIX.1 standard) and GNU libiconv is
      -- available as a standalone library for other systems, including Windows.

      -- * Simple conversion API
      convert,
      EncodingName,

      -- * Variant that is lax about conversion errors
      convertFuzzy,
      Fuzzy(..),

      -- * Variants that are pedantic about conversion errors
      convertStrictly,
      convertLazily,
      ConversionError(..),
      reportConversionError,
      Span(..),

      ) where

    import Prelude hiding (length, span)

    import Control.Exception (assert)
    import qualified Control.Exception as Exception
    import Foreign.C.Error as C.Error (Errno, errnoToIOError)

    import qualified Data.ByteString.Lazy as L (ByteString, toChunks, fromChunks)
    import qualified Data.ByteString.Lazy.Internal as L (defaultChunkSize)
    import qualified Data.ByteString as S

    import qualified Codec.Text.IConv.Internal as IConv
    import Codec.Text.IConv.Internal (IConv)

    -- | A string encoding name, eg @\"UTF-8\"@ or @\"LATIN1\"@.
    --
    -- The range of string encodings available is determined by the capabilities
    -- of the underlying iconv implementation.
    --
    -- When using the GNU C or libiconv libraries, the permitted values are listed
    -- by the @iconv --list@ command, and all combinations of the listed values
    -- are supported.
    --
    type EncodingName = String

    -- | Output spans from encoding conversion. When nothing goes wrong we
    -- expect just a bunch of 'Span's. If there are conversion errors we get other
    -- span types.
    --
    data Span =

        -- | An ordinary output span in the target encoding
        Span !S.ByteString

        -- | An error in the conversion process. If this occurs it will be the
        -- last span.
      | ConversionError !ConversionError

    data ConversionError =
        -- | The conversion from the input to output string encoding is not
        -- supported by the underlying iconv implementation. This is usually
        -- because a named encoding is not recognised or support for it
        -- was not enabled on this system.
        --
        -- The POSIX standard does not guarantee that all possible combinations
        -- of recognised string encoding are supported, however most common
        -- implementations do support all possible combinations.
        --
        UnsuportedConversion EncodingName EncodingName

        -- | This covers two possible conversion errors:
        --
        -- * There is a byte sequence in the input that is not valid in the input
        -- encoding.
        --
        -- * There is a valid character in the input that has no corresponding
        -- character in the output encoding.
        --
        -- Unfortunately iconv does not let us distinguish these two cases. In
        -- either case, the Int parameter gives the byte offset in the input of
        -- the unrecognised bytes or unconvertable character.
        --
      | InvalidChar Int

        -- | This error covers the case where the end of the input has trailing
        -- bytes that are the initial bytes of a valid character in the input
        -- encoding. In other words, it looks like the input ended in the middle of
        -- a multi-byte character. This would often be an indication that the input
        -- was somehow truncated. Again, the Int parameter is the byte offset in
        -- the input where the incomplete character starts.
        --
      | IncompleteChar Int

        -- | An unexpected iconv error. The iconv spec lists a number of possible
        -- expected errors but does not guarantee that there might not be other
        -- errors.
        --
        -- This error can occur either immediately, which might indicate that the
        -- iconv installation is messed up somehow, or it could occur later which
        -- might indicate resource exhaustion or some other internal iconv error.
        --
        -- Use 'Foreign.C.Error.errnoToIOError' to get slightly more information
        -- on what the error could possibly be.
        --
      | UnexpectedError C.Error.Errno

    reportConversionError :: ConversionError -> IOError
    reportConversionError conversionError = case conversionError of
      UnsuportedConversion fromEncoding toEncoding
                              -> err $ "cannot convert from string encoding "
                                 ++ show fromEncoding ++ " to string encoding "
                                 ++ show toEncoding
      InvalidChar    inputPos -> err $ "invalid input sequence at byte offset "
                                   ++ show inputPos
      IncompleteChar inputPos -> err $ "incomplete input sequence at byte offset "
                                   ++ show inputPos
      UnexpectedError errno   -> C.Error.errnoToIOError
                                   "Codec.Text.IConv: unexpected error" errno
                                   Nothing Nothing
      where err msg = userError $ "Codec.Text.IConv: " ++ msg

    {-# NOINLINE convert #-}
    -- | Convert text from one named string encoding to another.
    --
    -- * The conversion is done lazily.
    --
    -- * An exception is thrown if conversion between the two encodings is not
    -- supported.
    --
    -- * An exception is thrown if there are any encoding conversion errors.
    --
    convert :: EncodingName      -- ^ Name of input string encoding
            -> EncodingName      -- ^ Name of output string encoding
            -> L.ByteString      -- ^ Input text
            -> L.ByteString      -- ^ Output text
    convert fromEncoding toEncoding =

        -- lazily convert the list of spans into an ordinary lazy ByteString:
        L.fromChunks
      . foldr span []
      . convertLazily fromEncoding toEncoding

      where
        span (Span c)            cs = c : cs
        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

    -- | Convert text ignoring encoding conversion problems.
    --
    -- If invalid byte sequences are found in the input they are ignored and
    -- conversion continues if possible. This is not always possible especially
    -- with stateful encodings. No placeholder character is inserted into the
    -- output so there will be no indication that invalid byte sequences were
    -- encountered.
    --
    -- If there are characters in the input that have no direct corresponding
    -- character in the output encoding then they are dealt in one of two ways,
    -- depending on the 'Fuzzy' argument. We can try and 'Transliterate' them into
    -- the nearest corresponding character(s) or use a replacement character
    -- (typically @\'?\'@ or the Unicode replacement character). Alternatively they
    -- can simply be 'Discard'ed.
    --
    -- In either case, no exceptions will occur. In the case of unrecoverable
    -- errors, the output will simply be truncated. This includes the case of
    -- unrecognised or unsupported encoding names; the output will be empty.
    --
    -- * This function only works with the GNU iconv implementation which provides
    -- this feature beyond what is required by the iconv specification.
    --
    convertFuzzy :: Fuzzy           -- ^ Whether to try and transliterate or
                                    -- discard characters with no direct conversion
                 -> EncodingName    -- ^ Name of input string encoding
                 -> EncodingName    -- ^ Name of output string encoding
                 -> L.ByteString    -- ^ Input text
                 -> L.ByteString    -- ^ Output text
    convertFuzzy fuzzy fromEncoding toEncoding =

        -- lazily convert the list of spans into an ordinary lazy ByteString:
        L.fromChunks
      . foldr span []
      . convertInternal IgnoreInvalidChar fromEncoding (toEncoding ++ mode)
      where
        mode = case fuzzy of
                 Transliterate -> "//IGNORE,TRANSLIT"
                 Discard       -> "//IGNORE"
        span (Span c)            cs = c : cs
        span (ConversionError _) cs = cs

    {-# NOINLINE convertStrictly #-}
    -- | This variant does the conversion all in one go, so it is able to report
    -- any conversion errors up front. It exposes all the possible error conditions
    -- and never throws exceptions
    --
    -- The disadvantage is that no output can be produced before the whole input
    -- is consumed. This might be problematic for very large inputs.
    --
    convertStrictly :: EncodingName      -- ^ Name of input string encoding
                    -> EncodingName      -- ^ Name of output string encoding
                    -> L.ByteString      -- ^ Input text
                    -> Either L.ByteString
                              ConversionError -- ^ Output text or conversion error
    convertStrictly fromEncoding toEncoding =
        -- strictly convert the list of spans into an ordinary lazy ByteString
        -- or an error
        strictify []
      . convertLazily fromEncoding toEncoding

      where
        strictify :: [S.ByteString] -> [Span] -> Either L.ByteString ConversionError
        strictify cs []                    = Left (L.fromChunks (reverse cs))
        strictify cs (Span c : ss)         = strictify (c:cs) ss
        strictify _  (ConversionError e:_) = Right e

    {-# NOINLINE convertLazily #-}
    -- | This version provides a more complete but less convenient conversion
    -- interface. It exposes all the possible error conditions and never throws
    -- exceptions.
    --
    -- The conversion is still lazy. It returns a list of spans, where a span may
    -- be an ordinary span of output text or a conversion error. This somewhat
    -- complex interface allows both for lazy conversion and for precise reporting
    -- of conversion problems. The other functions 'convert' and 'convertStrictly'
    -- are actually simple wrappers on this function.
    --
    convertLazily :: EncodingName  -- ^ Name of input string encoding
                  -> EncodingName  -- ^ Name of output string encoding
                  -> L.ByteString  -- ^ Input text
                  -> [Span]        -- ^ Output text spans
    convertLazily = convertInternal StopOnInvalidChar

    data InvalidCharBehaviour = StopOnInvalidChar | IgnoreInvalidChar

    convertInternal :: InvalidCharBehaviour
                    -> EncodingName -> EncodingName
                    -> L.ByteString -> [Span]
    convertInternal ignore fromEncoding toEncoding input =
      IConv.run fromEncoding toEncoding $ \status -> case status of
        IConv.InitOk -> do IConv.newOutputBuffer outChunkSize
                           fillInputBuffer ignore (L.toChunks input)

        IConv.UnsupportedConversion     -> failConversion (UnsuportedConversion
                                                             fromEncoding
                                                             toEncoding)
        IConv.UnexpectedInitError errno -> failConversion (UnexpectedError errno)

    fillInputBuffer :: InvalidCharBehaviour -> [S.ByteString] -> IConv [Span]
    fillInputBuffer ignore (inChunk : inChunks) = do
      IConv.pushInputBuffer inChunk
      drainBuffers ignore inChunks

    fillInputBuffer _ignore [] = do
      outputBufferBytesAvailable <- IConv.outputBufferBytesAvailable
      IConv.finalise
      if outputBufferBytesAvailable > 0
        then do outChunk <- IConv.popOutputBuffer
                return [Span outChunk]
        else return []

    drainBuffers :: InvalidCharBehaviour -> [S.ByteString] -> IConv [Span]
    drainBuffers ignore inChunks = do
      inputBufferEmpty_ <- IConv.inputBufferEmpty
      outputBufferFull <- IConv.outputBufferFull
      assert (not outputBufferFull && not inputBufferEmpty_) $ return ()
      -- this invariant guarantees we can always make forward progress

      status <- IConv.iconv

      case status of
        IConv.InputEmpty -> do
          inputBufferEmpty <- IConv.inputBufferEmpty
          assert inputBufferEmpty $ fillInputBuffer ignore inChunks

        IConv.OutputFull -> do
          outChunk <- IConv.popOutputBuffer
          outChunks <- IConv.unsafeInterleave $ do
            IConv.newOutputBuffer outChunkSize
            drainBuffers ignore inChunks
          return (Span outChunk : outChunks)

        IConv.InvalidChar -> invalidChar ignore inChunks

        IConv.IncompleteChar -> fixupBoundary ignore inChunks

        IConv.UnexpectedError errno -> failConversion (UnexpectedError errno)

    -- | The posix iconv api looks like it's designed specifically for streaming
    -- and it is, except for one really really annoying corner case...
    --
    -- Suppose you're converting a stream, say by reading a file in 4k chunks. This
    -- would seem to be the canonical use case for iconv, reading and converting an
    -- input file. However suppose the 4k read chunk happens to split a multi-byte
    -- character. Then iconv will stop just before that char and tell us that its
    -- an incomplete char. So far so good. Now what we'd like to do is have iconv
    -- remember those last few bytes in its conversion state so we can carry on
    -- with the next 4k block. Sadly it does not. It requires us to fix things up
    -- so that it can carry on with the next block starting with a complete multi-
    -- byte character. Do do that we have to somehow copy those few trailing bytes
    -- to the beginning of the next block. That's perhaps not too bad in an
    -- imperitive context using a mutable input buffer - we'd just copy the few
    -- trailing bytes to the beginning of the buffer and do a short read (ie 4k-n
    -- the number of trailing bytes). That's not terribly nice since it means the
    -- OS has to do IO on non-page aligned buffers which tends to be slower. It's
    -- worse for us though since we're not using a mutable input buffer, we're
    -- using a lazy bytestring which is a sequence of immutable buffers.
    --
    -- So we have to do more cunning things. We could just prepend the trailing
    -- bytes to the next block, but that would mean alocating and copying the whole
    -- next block just to prepend a couple bytes. This probably happens quite
    -- frequently so would be pretty slow. So we have to be even more cunning.
    --
    -- The solution is to create a very small buffer to cover the few bytes making
    -- up the character spanning the block boundary. So we copy the trailing bytes
    -- plus a few from the beginning of the next block. Then we run iconv again on
    -- that small buffer. How many bytes from the next block to copy is a slightly
    -- tricky issue. If we copy too few there's no guarantee that we have enough to
    -- give a complete character. We opt for a maximum size of 16, 'tmpChunkSize'
    -- on the theory that no encoding in existance uses that many bytes to encode a
    -- single character, so it ought to be enough. Yeah, it's a tad dodgey.
    --
    -- Having papered over the block boundary, we still have to cross the boundary
    -- of this small buffer. It looks like we've still got the same problem,
    -- however this time we should have crossed over into bytes that are wholly
    -- part of the large following block so we can abandon our small temp buffer
    -- an continue with the following block, with a slight offset for the few bytes
    -- taken up by the chars that fit into the small buffer.
    --
    -- So yeah, pretty complex. Check out the proof below of the tricky case.
    --
    fixupBoundary :: InvalidCharBehaviour -> [S.ByteString] -> IConv [Span]
    fixupBoundary _ignore [] = do
      inputPos <- IConv.inputPosition
      failConversion (IncompleteChar inputPos)
    fixupBoundary ignore inChunks@(inChunk : inChunks') = do
      inSize <- IConv.inputBufferSize
      assert (inSize < tmpChunkSize) $ return ()
      let extraBytes = tmpChunkSize - inSize

      if S.length inChunk <= extraBytes
        then do
          IConv.replaceInputBuffer (`S.append` inChunk)
          drainBuffers ignore inChunks'
        else do
          IConv.replaceInputBuffer (`S.append` S.take extraBytes inChunk)

          before <- IConv.inputBufferSize
          assert (before == tmpChunkSize) $ return ()

          status <- IConv.iconv
          after <- IConv.inputBufferSize
          let consumed = before - after

          case status of
            IConv.InputEmpty ->
              assert (consumed == tmpChunkSize) $
              fillInputBuffer ignore (S.drop extraBytes inChunk : inChunks')

            IConv.OutputFull -> do
              outChunk <- IConv.popOutputBuffer
              outChunks <- IConv.unsafeInterleave $ do
                IConv.newOutputBuffer outChunkSize
                drainBuffers ignore inChunks
              return (Span outChunk : outChunks)

            IConv.InvalidChar -> invalidChar ignore inChunks

            IConv.IncompleteChar ->
              assert (inSize < consumed && consumed < tmpChunkSize) $
              --    inSize < consumed < tmpChunkSize
              -- => { subtract inSize from each side }
              --    0 < consumed - inSize < tmpChunkSize - inSize
              -- => { by definition that extraBytes = tmpChunkSize - inSize }
              --    0 < consumed - inSize < extraBytes
              -- => { since we're in the False case of the if, we know:
              --        not (S.length inChunk <= extraBytes)
              --      =      S.length inChunk > extraBytes
              --      =      extraBytes < S.length inChunk }
              --    0 < consumed - inSize < extraBytes < S.length inChunk
              --
              -- And we're done! We know it's safe to drop (consumed - inSize) from
              -- inChunk since it's more than 0 and less than the inChunk size, so
              -- we're not being left with an empty chunk (which is not allowed).

              drainBuffers ignore (S.drop (consumed - inSize) inChunk : inChunks')

            IConv.UnexpectedError errno -> failConversion (UnexpectedError errno)

    invalidChar :: InvalidCharBehaviour -> [S.ByteString] -> IConv [Span]
    invalidChar StopOnInvalidChar _ = do
      inputPos <- IConv.inputPosition
      failConversion (InvalidChar inputPos)

    invalidChar IgnoreInvalidChar inChunks = do
      inputPos  <- IConv.inputPosition
      let invalidCharError = ConversionError (InvalidChar inputPos)
      outputBufferBytesAvailable <- IConv.outputBufferBytesAvailable
      if outputBufferBytesAvailable > 0
        then do outChunk  <- IConv.popOutputBuffer
                outChunks <- IConv.unsafeInterleave $ do
                  IConv.newOutputBuffer outChunkSize
                  inputBufferEmpty <- IConv.inputBufferEmpty
                  if inputBufferEmpty
                    then fillInputBuffer IgnoreInvalidChar inChunks
                    else drainBuffers    IgnoreInvalidChar inChunks
                return (Span outChunk : invalidCharError : outChunks)
        else do outChunks <- IConv.unsafeInterleave $ do
                  IConv.newOutputBuffer outChunkSize
                  inputBufferEmpty <- IConv.inputBufferEmpty
                  if inputBufferEmpty
                    then fillInputBuffer IgnoreInvalidChar inChunks
                    else drainBuffers    IgnoreInvalidChar inChunks
                return (invalidCharError : outChunks)

    failConversion :: ConversionError -> IConv [Span]
    failConversion err = do
      outputBufferBytesAvailable <- IConv.outputBufferBytesAvailable
      IConv.finalise
      if outputBufferBytesAvailable > 0
        then do outChunk <- IConv.popOutputBuffer
                return [Span outChunk, ConversionError err]
        else    return [               ConversionError err]

    outChunkSize :: Int
    outChunkSize = L.defaultChunkSize

    tmpChunkSize :: Int
    tmpChunkSize = 16