git.iko.soy/text
on master help sign in
Merge pull request #18 from hvr/pull-req-16

Add new `Data.Text.Encoding.decodeLatin1` ISO-8859-1 decoding function

commit54fca94244d5d1684d824e9b267c0e0b2950dc13 authorBryan O'Sullivan <bos@serpentine.com> dateMon 3 Dec 2012, 10:22 (14 years ago) parent61ad70eea0e522
4 files changed+75−3
compare with master
unifiedsplit
Data/Text/Encoding.hs+18−2 Data/Text/Lazy/Encoding.hs+6−1 cbits/cbits.c+38 tests/Tests/Properties.hs+13
Data/Text/Encoding.hs+18−2
@@ -26,6 +26,7 @@ module Data.Text.Encoding
2626 -- * Decoding ByteStrings to Text
2727 -- $strict
2828 decodeASCII
29+ , decodeLatin1
2930 , decodeUtf8
3031 , decodeUtf16LE
3132 , decodeUtf16BE
@@ -60,7 +61,7 @@ import Data.Bits ((.&.))
6061import Data.ByteString as B
6162import Data.ByteString.Internal as B
6263import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
63−import Data.Text.Internal (Text(..))
64+import Data.Text.Internal (Text(..), textP)
6465import Data.Text.Private (runText)
6566import Data.Text.UnsafeChar (ord, unsafeWrite)
6667import Data.Text.UnsafeShift (shiftL, shiftR)
@@ -93,11 +94,23 @@ import qualified Data.Text.Fusion as F
9394-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
9495-- encoded text.
9596--
96−-- This function is deprecated. Use 'decodeUtf8' instead.
97+-- This function is deprecated. Use 'decodeLatin1' instead.
9798decodeASCII :: ByteString -> Text
9899decodeASCII = decodeUtf8
99100{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
100101
102+-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
103+--
104+-- 'decodeLatin1' is semantically equivalent to
105+-- @Data.Text.pack . Data.ByteString.Char8.unpack@
106+decodeLatin1 :: ByteString -> Text
107+decodeLatin1 (PS fp off len) = textP a 0 len
108+ where
109+ a = A.run (A.new len >>= unsafeIOToST . go)
110+ go dest = withForeignPtr fp $ \ptr -> do
111+ c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
112+ return dest
113+
101114-- | Decode a 'ByteString' containing UTF-8 encoded text.
102115decodeUtf8With :: OnDecodeError -> ByteString -> Text
103116decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
@@ -282,3 +295,6 @@ encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
282295foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
283296 :: MutableByteArray# s -> Ptr CSize
284297 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
298+
299+foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
300+ :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
Data/Text/Lazy/Encoding.hs+6−1
@@ -23,6 +23,7 @@ module Data.Text.Lazy.Encoding
2323 -- * Decoding ByteStrings to Text
2424 -- $strict
2525 decodeASCII
26+ , decodeLatin1
2627 , decodeUtf8
2728 , decodeUtf16LE
2829 , decodeUtf16BE
@@ -77,11 +78,15 @@ import qualified Data.Text.Lazy.Fusion as F
7778-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
7879-- encoded text.
7980--
80−-- This function is deprecated. Use 'decodeUtf8' instead.
81+-- This function is deprecated. Use 'decodeLatin1' instead.
8182decodeASCII :: B.ByteString -> Text
8283decodeASCII = decodeUtf8
8384{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
8485
86+-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
87+decodeLatin1 :: B.ByteString -> Text
88+decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks
89+
8590-- | Decode a 'ByteString' containing UTF-8 encoded text.
8691decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
8792decodeUtf8With onErr bs0 = fast bs0
cbits/cbits.c+38
@@ -61,6 +61,44 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {
6161 return *state = utf8d[256 + *state + type];
6262}
6363
64+/*
65+ * The ISO 8859-1 (aka latin-1) code points correspond exactly to the first 256 unicode
66+ * code-points, therefore we can trivially convert from a latin-1 encoded bytestring to
67+ * an UTF16 array
68+ */
69+void
70+_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
71+ const uint8_t const *srcend)
72+{
73+ const uint8_t *p = src;
74+
75+#if defined(__i386__) || defined(__x86_64__)
76+ /* This optimization works on a little-endian systems by using
77+ (aligned) 32-bit loads instead of 8-bit loads
78+ */
79+
80+ /* consume unaligned prefix */
81+ while (p != srcend && (uintptr_t)p & 0x3)
82+ *dest++ = *p++;
83+
84+ /* iterate over 32-bit aligned loads */
85+ while (p < srcend - 3) {
86+ const uint32_t w = *((const uint32_t *)p);
87+
88+ *dest++ = w & 0xff;
89+ *dest++ = (w >> 8) & 0xff;
90+ *dest++ = (w >> 16) & 0xff;
91+ *dest++ = (w >> 24) & 0xff;
92+
93+ p += 4;
94+ }
95+#endif
96+
97+ /* handle unaligned suffix */
98+ while (p != srcend)
99+ *dest++ = *p++;
100+}
101+
64102/*
65103 * A best-effort decoder. Runs until it hits either end of input or
66104 * the start of an invalid byte sequence.
tests/Tests/Properties.hs+13
@@ -32,6 +32,7 @@ import Test.Framework (Test, testGroup)
3232import Test.Framework.Providers.QuickCheck2 (testProperty)
3333import qualified Data.Bits as Bits (shiftL, shiftR)
3434import qualified Data.ByteString as B
35+import qualified Data.ByteString.Lazy as BL
3536import qualified Data.List as L
3637import qualified Data.Text as T
3738import qualified Data.Text.Encoding as E
@@ -65,10 +66,20 @@ tl_unstreamChunks x = f 11 x == f 1000 x
6566tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
6667tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
6768
69+-- Note: this silently truncates code-points > 255 to 8-bit due to 'B.pack'
70+encodeL1 :: T.Text -> B.ByteString
71+encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
72+encodeLazyL1 :: TL.Text -> BL.ByteString
73+encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
74+
6875t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
6976 where a = T.map (\c -> chr (ord c `mod` 128)) t
7077tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
7178 where a = TL.map (\c -> chr (ord c `mod` 128)) t
79+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
80+ where a = T.map (\c -> chr (ord c `mod` 256)) t
81+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
82+ where a = TL.map (\c -> chr (ord c `mod` 256)) t
7283t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
7384t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
7485tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
@@ -754,6 +765,8 @@ tests =
754765 testGroup "transcoding" [
755766 testProperty "t_ascii" t_ascii,
756767 testProperty "tl_ascii" tl_ascii,
768+ testProperty "t_latin1" t_latin1,
769+ testProperty "tl_latin1" tl_latin1,
757770 testProperty "t_utf8" t_utf8,
758771 testProperty "t_utf8'" t_utf8',
759772 testProperty "tl_utf8" tl_utf8,