diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for bytestring-encoding + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2018, Masahiro Sakai +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 the copyright holder nor the names of its + 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 HOLDER 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,17 @@ +# bytestring-encoding: ByteString ↔ Text converter based on GHC.IO.Encoding + +[![Build Status (Travis CI)](https://travis-ci.org/msakai/bytestring-encoding.svg?branch=master)](https://travis-ci.org/msakai/bytestring-encoding) +[![Build status (AppVeyor)](https://ci.appveyor.com/api/projects/status/8pwtxsky05ge0ooc/branch/master?svg=true)](https://ci.appveyor.com/project/msakai/bytestring-encoding/branch/master) +[![Coverage Status](https://coveralls.io/repos/github/msakai/bytestring-encoding/badge.svg?branch=master)](https://coveralls.io/github/msakai/bytestring-encoding?branch=master) + +These library provides converter between `ByteString` and `Text` based +on `GHC.IO.Encoding`. +Compared to the [text-icu](http://hackage.haskell.org/package/text-icu) +package, it has only limited feature and platform dependent, but it is +light-weight and consistent with conversion by `System.IO`. + +## Limitations and Known issues + +* There are some cases that conversion can produce incomplete results due to the problem of `GHC.IO.Encoding` API. + see https://ghc.haskell.org/trac/ghc/ticket/15553 for details. + 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/bytestring-encoding.cabal b/bytestring-encoding.cabal new file mode 100644 --- /dev/null +++ b/bytestring-encoding.cabal @@ -0,0 +1,65 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 99947b66971c69e6b7b235634501b6daf5d8231b122ddf14addced7506a7acbe + +name: bytestring-encoding +version: 0.1.0.0 +synopsis: ByteString ↔ Text converter based on GHC.IO.Encoding +description: Please see the README on GitHub at +category: Data, Text +homepage: https://github.com/msakai/bytestring-encoding#readme +bug-reports: https://github.com/msakai/bytestring-encoding/issues +author: Masahiro Sakai +maintainer: masahiro.sakai@gmail.com +copyright: 2018 Masahiro Sakai +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/msakai/bytestring-encoding + +library + exposed-modules: + Data.ByteString.Encoding + Data.ByteString.Lazy.Encoding + Data.ByteString.Lazy.Encoding.Internal + other-modules: + Paths_bytestring_encoding + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , bytestring + , text + default-language: Haskell2010 + +test-suite bytestring-encoding-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Base + CodePage + Iconv + Paths_bytestring_encoding + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck + , base >=4.7 && <5 + , bytestring + , bytestring-encoding + , tasty >=0.10.1 + , tasty-hunit + , tasty-quickcheck + , tasty-th + , text + default-language: Haskell2010 diff --git a/src/Data/ByteString/Encoding.hs b/src/Data/ByteString/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Encoding.hs @@ -0,0 +1,50 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.ByteString.Encoding +-- Copyright : (c) Masahiro Sakai 2018 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable +-- +-- 'B.ByteString' ↔ 'T.Text' converter based on "GHC.IO.Encoding". +-- +----------------------------------------------------------------------------- +module Data.ByteString.Encoding + ( + -- * Converter functions + encode + , decode + + -- * Text encodings (re-exported from "System.IO") + , TextEncoding + , latin1 + , utf8 + , utf8_bom + , utf16 + , utf16le + , utf16be + , utf32 + , utf32le + , utf32be + , localeEncoding + , char8 + , mkTextEncoding + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Encoding as L +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import System.IO + +-- | Encode a strict 'T.Text' into strict 'B.ByteString' using a given 'Enc.TextEncoding'. +encode :: TextEncoding -> T.Text -> B.ByteString +encode enc = BL.toStrict . L.encode enc . TL.fromStrict + +-- | Decode a strict 'B.ByteString' to a strit 'T.Text' using a given 'Enc.TextEncoding'. +decode :: TextEncoding -> B.ByteString -> T.Text +decode enc = TL.toStrict . L.decode enc . BL.fromStrict + diff --git a/src/Data/ByteString/Lazy/Encoding.hs b/src/Data/ByteString/Lazy/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lazy/Encoding.hs @@ -0,0 +1,37 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.ByteString.Lazy.Encoding +-- Copyright : (c) Masahiro Sakai 2018 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable +-- +-- 'BL.ByteString' ↔ 'TL.Text' converter based on "GHC.IO.Encoding". +-- +----------------------------------------------------------------------------- +module Data.ByteString.Lazy.Encoding + ( + -- * Converter functions + encode + , decode + + -- * Text encodings (re-export from "System.IO") + , TextEncoding + , latin1 + , utf8 + , utf8_bom + , utf16 + , utf16le + , utf16be + , utf32 + , utf32le + , utf32be + , localeEncoding + , char8 + , mkTextEncoding + ) where + +import Data.ByteString.Lazy.Encoding.Internal +import System.IO diff --git a/src/Data/ByteString/Lazy/Encoding/Internal.hs b/src/Data/ByteString/Lazy/Encoding/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lazy/Encoding/Internal.hs @@ -0,0 +1,197 @@ +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Data.ByteString.Lazy.Encoding.Internal + ( encode + , encodeWith + , decode + , decodeWith + ) where + +import Control.Exception +import Control.Monad +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Foreign as T +import qualified Data.Text.Lazy as TL +import Data.Word +import Foreign +import qualified Foreign.Concurrent as Conc +import Foreign.ForeignPtr (touchForeignPtr) +import Foreign.Ptr (nullPtr) +import qualified GHC.IO.Encoding as Enc +import GHC.IO.Buffer +import System.IO.Unsafe + +-- | Encode a lazy 'TL.Text' into a lazy 'BL.ByteString' using a given 'Enc.TextEncoding'. +encode :: Enc.TextEncoding -> TL.Text -> BL.ByteString +encode enc = encodeWith enc 1024 1024 + +encodeWith :: Enc.TextEncoding -> Int -> Int -> TL.Text -> BL.ByteString +encodeWith enc inBufSize outBufSize = encodeStringWith enc inBufSize outBufSize . TL.unpack + +encodeStringWith :: Enc.TextEncoding -> Int -> Int -> String -> BL.ByteString +encodeStringWith Enc.TextEncoding{ .. } inBufSize outBufSize s = BL.fromChunks $ unsafePerformIO $ do + Enc.BufferCodec{ .. } <- mkTextEncoder + fp <- Conc.newForeignPtr nullPtr close + + let fillInBuf :: String -> CharBuffer -> IO (String, CharBuffer) + fillInBuf s buf + | isEmptyBuffer buf = go s buf{ bufL=0, bufR=0 } + | otherwise = go s buf + where + go :: String -> CharBuffer -> IO (String, CharBuffer) + go [] buf = return ([], buf) + go s@(c : cs) buf@Buffer{ bufR = r, bufRaw = iraw} + | isFullCharBuffer buf = return (s, buf) + | otherwise = do + r' <- writeCharBuf iraw r c + go cs buf{ bufR = r' } + + flushOutBuf :: Buffer Word8 -> IO ([B.ByteString], Buffer Word8) + flushOutBuf buf + | isEmptyBuffer buf = return ([], buf{ bufL=0, bufR=0 }) + | otherwise = do + withBuffer buf $ \p -> do + b <- B.packCStringLen (castPtr p, bufferElems buf) + return ([b], buf{ bufL=0, bufR=0 }) + + loop :: String -> CharBuffer -> Buffer Word8 -> IO [B.ByteString] + loop s inBuf outBuf = do + (s', inBuf1) <- fillInBuf s inBuf + if isEmptyBuffer inBuf1 then do + assert (null s') $ return () + (m, _outBuf') <- flushOutBuf outBuf + touchForeignPtr fp + return m + else do + (ret, inBuf2, outBuf2) <- encode inBuf1 outBuf + case ret of + Enc.InputUnderflow -> do + if isFullCharBuffer inBuf2 && not (isEmptyBuffer inBuf2) then do + withRawBuffer (bufRaw inBuf2) $ \p -> do + moveArray p (p `plusPtr` bufL inBuf2) (bufferElems inBuf2) + loop s' inBuf2{ bufL = 0, bufR = bufferElems inBuf2 } outBuf2 + else do + loop s' inBuf2 outBuf2 + Enc.OutputUnderflow -> do + (b, outBuf3) <- flushOutBuf outBuf2 + bs <- unsafeInterleaveIO $ loop s' inBuf2 outBuf3 + return $ b ++ bs + Enc.InvalidSequence -> do + -- recover assumes that to buffer has at least one element of free space. + if isFullBuffer outBuf2 then do + (b, outBuf3) <- flushOutBuf outBuf2 + (inBuf4, outBuf4) <- recover inBuf2 outBuf3 + bs <- unsafeInterleaveIO $ loop s' inBuf4 outBuf4 + return $ b ++ bs + else do + (inBuf3, outBuf3) <- recover inBuf2 outBuf2 + loop s' inBuf3 outBuf3 + + inBuf <- newCharBuffer inBufSize ReadBuffer + outBuf <- newByteBuffer outBufSize WriteBuffer + loop s inBuf outBuf + + +-- | Decode a lazy 'BL.ByteString' to a lazy 'TL.Text' using a given 'Enc.TextEncoding'. +decode :: Enc.TextEncoding -> BL.ByteString -> TL.Text +decode enc b = decodeWith enc 1024 1024 b + +decodeWith :: Enc.TextEncoding -> Int -> Int -> BL.ByteString -> TL.Text +decodeWith Enc.TextEncoding{ .. } inBufSize outBufSize b = TL.fromChunks $ unsafePerformIO $ do + Enc.BufferCodec{ .. } <- mkTextDecoder + fp <- Conc.newForeignPtr nullPtr close + + let fillInBuf :: [B.ByteString] -> Buffer Word8 -> IO ([B.ByteString], Buffer Word8) + fillInBuf bs buf + | isEmptyBuffer buf = go bs buf{ bufL=0, bufR=0 } + | otherwise = go bs buf + where + go :: [B.ByteString] -> Buffer Word8 -> IO ([B.ByteString], Buffer Word8) + go [] buf = return ([], buf) + go bbs@(b : bs) buf + | isFullBuffer buf = return (bbs, buf) + | B.null b = go bs buf + | otherwise = do + B.unsafeUseAsCString b $ \p -> do + withBuffer buf $ \q -> do + if B.length b <= bufferAvailable buf then do + moveBytes (q `plusPtr` bufR buf) p (B.length b) + go bs buf{ bufR = bufR buf + B.length b } + else do + moveBytes (q `plusPtr` bufR buf) p (bufferAvailable buf) + go (B.drop (bufferAvailable buf) b : bs) buf{ bufR = bufR buf + bufferAvailable buf } + + flushOutBuf :: CharBuffer -> Ptr Word16 -> IO ([T.Text], CharBuffer) + flushOutBuf buf workspace + | isEmptyBuffer buf = return ([], buf{ bufL=0, bufR=0 }) + | charSize==2 = do + withBuffer buf $ \p -> do + let p' :: Ptr Word16 + p' = castPtr p + t <- T.fromPtr (p' `plusPtr` bufL buf) (fromIntegral (bufferElems buf)) + return ([t], buf{ bufL=0, bufR=0 }) + | otherwise = do + withBuffer buf $ \p -> do + let p' :: Ptr Char + p' = castPtr p + f !i !j + | bufR buf <= i = return j + | otherwise = do + c <- liftM fromEnum $ peekElemOff p' i + if c < 0x10000 then do + pokeElemOff workspace j (fromIntegral c) + f (i+1) (j+1) + else do + let c' = c - 0x10000 + pokeElemOff workspace j (fromIntegral (c' `div` 0x400 + 0xd800)) + pokeElemOff workspace (j+1) (fromIntegral (c' `mod` 0x400 + 0xdc00)) + f (i+1) (j+2) + n <- f (bufL buf) 0 + t <- T.fromPtr workspace (fromIntegral n) + return ([t], buf{ bufL=0, bufR=0 }) + + loop :: [B.ByteString] -> Buffer Word8 -> CharBuffer -> Ptr Word16 -> IO [T.Text] + loop bs inBuf outBuf workspace = do + (bs', inBuf1) <- fillInBuf bs inBuf + if isEmptyBuffer inBuf1 then do + assert (null bs') $ return () + (m, _outBuf') <- flushOutBuf outBuf workspace + touchForeignPtr fp + return m + else do + (ret, inBuf2, outBuf2) <- encode inBuf1 outBuf + case ret of + Enc.InputUnderflow -> do + if isFullBuffer inBuf2 && not (isEmptyBuffer inBuf2) then do + inBuf3 <- slideContents inBuf2 + loop bs' inBuf3 outBuf2 workspace + else do + loop bs' inBuf2 outBuf2 workspace + Enc.OutputUnderflow -> do + (t, outBuf3) <- flushOutBuf outBuf2 workspace + ts <- unsafeInterleaveIO $ loop bs' inBuf2 outBuf3 workspace + return $ t ++ ts + Enc.InvalidSequence -> do + -- recover assumes that to buffer has at least one element of free space. + if isFullCharBuffer outBuf2 then do + (t, outBuf3) <- flushOutBuf outBuf2 workspace + (inBuf4, outBuf4) <- recover inBuf2 outBuf3 + ts <- unsafeInterleaveIO $ loop bs' inBuf4 outBuf4 workspace + return $ t ++ ts + else do + (inBuf3, outBuf3) <- recover inBuf2 outBuf2 + loop bs' inBuf3 outBuf3 workspace + + inBuf <- newByteBuffer inBufSize ReadBuffer + outBuf <- newCharBuffer outBufSize WriteBuffer + if charSize == 2 then do + loop (BL.toChunks b) inBuf outBuf nullPtr + else do + allocaArray (outBufSize * 2) $ \workspace -> + loop (BL.toChunks b) inBuf outBuf workspace diff --git a/test/Base.hs b/test/Base.hs new file mode 100644 --- /dev/null +++ b/test/Base.hs @@ -0,0 +1,68 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module Base (baseTestGroup) where + +import qualified Data.ByteString.Lazy.Encoding as Enc +import qualified Data.ByteString.Lazy.Encoding.Internal as Enc +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.TH + +checkEncode :: Enc.TextEncoding -> (TL.Text -> BL.ByteString) -> Property +checkEncode enc f = + forAll arbitrary $ \(s::String) -> + forAll (choose (2,16)) $ \inBufSize -> + forAll (choose (4,32)) $ \outBufSize -> + let s' = TL.pack s + in Enc.encodeWith enc inBufSize outBufSize s' == f s' + +checkRoundTrip :: Enc.TextEncoding -> Property +checkRoundTrip enc = + forAll arbitrary $ \(s::String) -> + forAll (choose (2,16)) $ \inBufSizeE -> + forAll (choose (4,32)) $ \outBufSizeE -> + forAll (choose (4,32)) $ \inBufSizeD -> + forAll (choose (2,16)) $ \outBufSizeD -> + let s' = TL.pack s + in (Enc.decodeWith enc inBufSizeD outBufSizeD $ Enc.encodeWith enc inBufSizeE outBufSizeE $ s') == s' + +prop_encode_utf8 :: Property +prop_encode_utf8 = checkEncode Enc.utf8 TL.encodeUtf8 + +prop_encode_utf16le :: Property +prop_encode_utf16le = checkEncode Enc.utf16le TL.encodeUtf16LE + +prop_encode_utf16be :: Property +prop_encode_utf16be = checkEncode Enc.utf16be TL.encodeUtf16BE + +prop_encode_utf32le :: Property +prop_encode_utf32le = checkEncode Enc.utf32le TL.encodeUtf32LE + +prop_encode_utf32be :: Property +prop_encode_utf32be = checkEncode Enc.utf32be TL.encodeUtf32BE + +prop_encode_decode_utf8 :: Property +prop_encode_decode_utf8 = checkRoundTrip Enc.utf8 + +prop_encode_decode_utf16le :: Property +prop_encode_decode_utf16le = checkRoundTrip Enc.utf16le + +prop_encode_decode_utf16be :: Property +prop_encode_decode_utf16be = checkRoundTrip Enc.utf16be + +prop_encode_decode_utf32le :: Property +prop_encode_decode_utf32le = checkRoundTrip Enc.utf32le + +prop_encode_decode_utf32be :: Property +prop_encode_decode_utf32be = checkRoundTrip Enc.utf32be + +-- --------------------------------------------------------------------- + +baseTestGroup :: TestTree +baseTestGroup = $(testGroupGenerator) diff --git a/test/CodePage.hs b/test/CodePage.hs new file mode 100644 --- /dev/null +++ b/test/CodePage.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module CodePage (codepageTestGroup) where + +import qualified Data.ByteString.Lazy.Encoding as Enc +import qualified Data.ByteString.Lazy.Encoding.Internal as Enc +import qualified Data.ByteString.Lazy as BL + +import qualified Test.QuickCheck.Monadic as QM +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +prop_encode_decode_cp932 :: Property +prop_encode_decode_cp932 = QM.monadicIO $ do + enc <- QM.run $ Enc.mkTextEncoding "CP932" + inBufSizeE <- QM.pick $ choose (2,16) + outBufSizeE <- QM.pick $ choose (2,16) + inBufSizeD <- QM.pick $ choose (2,16) + outBufSizeD <- QM.pick $ choose (2,16) + let s = "\12371\12435\12395\12385\12399ABC\19990\30028\65402\65437\65414\65409\65436\n" -- "こんにちはABC世界ｺﾝﾆﾁﾜ\n" + QM.assert $ Enc.decodeWith enc inBufSizeD outBufSizeD (Enc.encodeWith enc inBufSizeE outBufSizeE s) == s + +codepageTestGroup :: TestTree +codepageTestGroup = + testGroup "CodePage" + [ testProperty "encode decode cp932" prop_encode_decode_cp932 + ] diff --git a/test/Iconv.hs b/test/Iconv.hs new file mode 100644 --- /dev/null +++ b/test/Iconv.hs @@ -0,0 +1,68 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module Iconv (iconvTestGroup) where + +import qualified Data.ByteString.Lazy.Encoding as Enc +import qualified Data.ByteString.Lazy.Encoding.Internal as Enc +import qualified Data.ByteString.Lazy as BL + +import qualified Test.QuickCheck.Monadic as QM +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +{- +XXX: GHC.IO.Encoding.BufferCodec does not provide an API to reset +state at the end of the string. +-} + +prop_encode_decode_iso2022jp :: Property +prop_encode_decode_iso2022jp = QM.monadicIO $ do + enc <- QM.run $ Enc.mkTextEncoding "iso-2022-jp" + inBufSizeE <- QM.pick $ choose (2,16) + outBufSizeE <- QM.pick $ choose (5,32) + inBufSizeD <- QM.pick $ choose (4,32) + outBufSizeD <- QM.pick $ choose (2,16) + let s = "\12371\12435\12395\12385\12399ABC\19990\30028\n" -- "こんにちはABC世界\n" + QM.assert $ Enc.decodeWith enc inBufSizeD outBufSizeD (Enc.encodeWith enc inBufSizeE outBufSizeE s) == s + +case_decode_iso2022jp :: Assertion +case_decode_iso2022jp = do + enc <- Enc.mkTextEncoding "iso-2022-jp" + Enc.decode enc b1 @?= s + Enc.decode enc b2 @?= s + where + s = "\12371\12435\12395\12385\12399\19990\30028\n" -- "こんにちは世界\n" + b1 = BL.pack [0x1b,0x24,0x40,0x24,0x33,0x24,0x73,0x24,0x4b,0x24,0x41,0x24,0x4f,0x40,0x24,0x33,0x26,0x1b,0x28,0x42,0x0a] + b2 = BL.pack [0x1b,0x24,0x42,0x24,0x33,0x24,0x73,0x24,0x4b,0x24,0x41,0x24,0x4f,0x40,0x24,0x33,0x26,0x1b,0x28,0x42,0x0a] + +prop_encode_decode_shiftjis :: Property +prop_encode_decode_shiftjis = QM.monadicIO $ do + enc <- QM.run $ Enc.mkTextEncoding "shift_jis" + inBufSizeE <- QM.pick $ choose (2,16) + outBufSizeE <- QM.pick $ choose (2,16) + inBufSizeD <- QM.pick $ choose (2,16) + outBufSizeD <- QM.pick $ choose (2,16) + let s = "\12371\12435\12395\12385\12399ABC\19990\30028\65402\65437\65414\65409\65436\n" -- "こんにちはABC世界ｺﾝﾆﾁﾜ\n" + QM.assert $ Enc.decodeWith enc inBufSizeD outBufSizeD (Enc.encodeWith enc inBufSizeE outBufSizeE s) == s + +prop_encode_decode_eucjp :: Property +prop_encode_decode_eucjp = QM.monadicIO $ do + enc <- QM.run $ Enc.mkTextEncoding "euc-jp" + inBufSizeE <- QM.pick $ choose (2,16) + outBufSizeE <- QM.pick $ choose (3,16) + inBufSizeD <- QM.pick $ choose (3,16) + outBufSizeD <- QM.pick $ choose (2,16) + let s = "\12371\12435\12395\12385\12399ABC\19990\30028\65402\65437\65414\65409\65436\39439\39502\n" -- "こんにちはABC世界ｺﾝﾆﾁﾜ騏驎\n" + QM.assert $ Enc.decodeWith enc inBufSizeD outBufSizeD (Enc.encodeWith enc inBufSizeE outBufSizeE s) == s + +iconvTestGroup :: TestTree +iconvTestGroup = + testGroup "Iconv" + [ testProperty "encode decode iso2022jp" prop_encode_decode_iso2022jp + , testCase "decode iso2022jp" case_decode_iso2022jp + , testProperty "encode decode shiftjis" prop_encode_decode_shiftjis + , testProperty "encode decode eucjp" prop_encode_decode_eucjp + ] diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -Wall #-} +module Main where + +import qualified System.Info +import Test.Tasty + +import Base +import CodePage +import Iconv + +main :: IO () +main = defaultMain $ testGroup "bytestring-encoding" $ + [ baseTestGroup, codepageTestGroup ] ++ + [ iconvTestGroup | System.Info.os /= "mingw32" ] +