git.iko.soy/text
on 2fc429e help sign in
text/Data/Text/Encoding/Fusion/Common.hs
147 lines 5.1 kB history raw
1{-# LANGUAGE BangPatterns #-}
3-- |
4-- Module : Data.Text.Encoding.Fusion.Common
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009,
8-- (c) Jasper Van der Jeugt 2011
9--
10-- License : BSD-style
11-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
12-- duncan@haskell.org
13-- Stability : experimental
14-- Portability : portable
15--
16-- Fusible 'Stream'-oriented functions for converting between 'Text'
17-- and several common encodings.
19module Data.Text.Encoding.Fusion.Common
20 (
21 -- * Restreaming
22 -- Restreaming is the act of converting from one 'Stream'
23 -- representation to another.
24 restreamUtf8
25 , restreamUtf16LE
26 , restreamUtf16BE
27 , restreamUtf32LE
28 , restreamUtf32BE
29 ) where
31import Data.Bits ((.&.))
32import Data.Text.Fusion (Step(..), Stream(..))
33import Data.Text.Fusion.Internal (RS(..))
34import Data.Text.UnsafeChar (ord)
35import Data.Text.UnsafeShift (shiftR)
36import Data.Word (Word8)
37import qualified Data.Text.Encoding.Utf8 as U8
39-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
40restreamUtf8 :: Stream Char -> Stream Word8
41restreamUtf8 (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
42 where
43 next (RS0 s) = case next0 s of
44 Done -> Done
45 Skip s' -> Skip (RS0 s')
46 Yield x s'
47 | n <= 0x7F -> Yield c (RS0 s')
48 | n <= 0x07FF -> Yield a2 (RS1 s' b2)
49 | n <= 0xFFFF -> Yield a3 (RS2 s' b3 c3)
50 | otherwise -> Yield a4 (RS3 s' b4 c4 d4)
51 where
52 n = ord x
53 c = fromIntegral n
54 (a2,b2) = U8.ord2 x
55 (a3,b3,c3) = U8.ord3 x
56 (a4,b4,c4,d4) = U8.ord4 x
57 next (RS1 s x2) = Yield x2 (RS0 s)
58 next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
59 next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
60 {-# INLINE next #-}
61{-# INLINE restreamUtf8 #-}
63restreamUtf16BE :: Stream Char -> Stream Word8
64restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
65 where
66 next (RS0 s) = case next0 s of
67 Done -> Done
68 Skip s' -> Skip (RS0 s')
69 Yield x s'
70 | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
71 RS1 s' (fromIntegral n)
72 | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
73 where
74 n = ord x
75 n1 = n - 0x10000
76 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
77 c2 = fromIntegral (n1 `shiftR` 10)
78 n2 = n1 .&. 0x3FF
79 c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
80 c4 = fromIntegral n2
81 next (RS1 s x2) = Yield x2 (RS0 s)
82 next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
83 next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
84 {-# INLINE next #-}
85{-# INLINE restreamUtf16BE #-}
87restreamUtf16LE :: Stream Char -> Stream Word8
88restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
89 where
90 next (RS0 s) = case next0 s of
91 Done -> Done
92 Skip s' -> Skip (RS0 s')
93 Yield x s'
94 | n < 0x10000 -> Yield (fromIntegral n) $
95 RS1 s' (fromIntegral $ shiftR n 8)
96 | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
97 where
98 n = ord x
99 n1 = n - 0x10000
100 c2 = fromIntegral (shiftR n1 18 + 0xD8)
101 c1 = fromIntegral (shiftR n1 10)
102 n2 = n1 .&. 0x3FF
103 c4 = fromIntegral (shiftR n2 8 + 0xDC)
104 c3 = fromIntegral n2
105 next (RS1 s x2) = Yield x2 (RS0 s)
106 next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
107 next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
108 {-# INLINE next #-}
109{-# INLINE restreamUtf16LE #-}
111restreamUtf32BE :: Stream Char -> Stream Word8
112restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
113 where
114 next (RS0 s) = case next0 s of
115 Done -> Done
116 Skip s' -> Skip (RS0 s')
117 Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
118 where
119 n = ord x
120 c1 = fromIntegral $ shiftR n 24
121 c2 = fromIntegral $ shiftR n 16
122 c3 = fromIntegral $ shiftR n 8
123 c4 = fromIntegral n
124 next (RS1 s x2) = Yield x2 (RS0 s)
125 next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
126 next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
127 {-# INLINE next #-}
128{-# INLINE restreamUtf32BE #-}
130restreamUtf32LE :: Stream Char -> Stream Word8
131restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
132 where
133 next (RS0 s) = case next0 s of
134 Done -> Done
135 Skip s' -> Skip (RS0 s')
136 Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
137 where
138 n = ord x
139 c4 = fromIntegral $ shiftR n 24
140 c3 = fromIntegral $ shiftR n 16
141 c2 = fromIntegral $ shiftR n 8
142 c1 = fromIntegral n
143 next (RS1 s x2) = Yield x2 (RS0 s)
144 next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
145 next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
146 {-# INLINE next #-}
147{-# INLINE restreamUtf32LE #-}