← Back to branch summary

~ubuntu-branches/ubuntu/trusty/haskell-text/trusty

« back to all changes in this revision

Viewing changes to Data/Text/Lazy/Builder.hs

  • Committer: Package Import Robot
  • Author(s): Joachim Breitner
  • Date: 2013-05-27 15:29:56 UTC
  • mfrom: (4.2.2 sid)
  • Revision ID: package-import@ubuntu.com-20130527152956-2mj3ud1ahuv386b1
Tags: 0.11.3.1-1
New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
Data/Text/Lazy/Builder.hs
3
3
-----------------------------------------------------------------------------
4
4
-- |
5
5
-- Module      : Data.Text.Lazy.Builder
 
6
-- Copyright   : (c) 2013 Bryan O'Sullivan
 
7
--               (c) 2010 Johan Tibell
6
8
-- License     : BSD3-style (see LICENSE)
7
9
--
8
10
-- Maintainer  : Johan Tibell <johan.tibell@gmail.com>
15
16
-- @fromLazyText@, which construct new builders, and 'mappend', which
16
17
-- concatenates two builders.
17
18
--
 
19
-- To get maximum performance when building lazy @Text@ values using a
 
20
-- builder, associate @mappend@ calls to the right.  For example,
 
21
-- prefer
18
22
--
19
23
-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
20
24
--
43
46
   , flush
44
47
   ) where
45
48
 
46
 
import Control.Monad.ST (ST, runST)
47
 
import Data.Bits ((.&.))
48
 
import Data.Monoid (Monoid(..))
49
 
import Data.Text.Internal (Text(..))
50
 
import Data.Text.Lazy.Internal (smallChunkSize)
51
 
import Data.Text.Unsafe (inlineInterleaveST)
52
 
import Data.Text.UnsafeChar (ord, unsafeWrite)
53
 
import Data.Text.UnsafeShift (shiftR)
54
 
import Prelude hiding (map, putChar)
55
 
 
56
 
import qualified Data.String as String
57
 
import qualified Data.Text as S
58
 
import qualified Data.Text.Array as A
59
 
import qualified Data.Text.Lazy as L
60
 
 
61
 
------------------------------------------------------------------------
62
 
 
63
 
--
64
 
newtype Builder = Builder {
65
 
     -- Invariant (from Data.Text.Lazy):
66
 
     --      The lists include no null Texts.
67
 
     runBuilder :: forall s. (Buffer s -> ST s [S.Text])
68
 
                -> Buffer s
69
 
                -> ST s [S.Text]
70
 
   }
71
 
 
72
 
instance Monoid Builder where
73
 
   mempty  = empty
74
 
   {-# INLINE mempty #-}
75
 
   mappend = append
76
 
   {-# INLINE mappend #-}
77
 
   mconcat = foldr mappend mempty
78
 
   {-# INLINE mconcat #-}
79
 
 
80
 
instance String.IsString Builder where
81
 
    fromString = fromString
82
 
    {-# INLINE fromString #-}
83
 
 
84
 
instance Show Builder where
85
 
    show = show . toLazyText
86
 
 
87
 
instance Eq Builder where
88
 
    a == b = toLazyText a == toLazyText b
89
 
 
90
 
instance Ord Builder where
91
 
    a <= b = toLazyText a <= toLazyText b
92
 
 
93
 
------------------------------------------------------------------------
94
 
 
95
 
--
96
 
--
97
 
empty :: Builder
98
 
empty = Builder (\ k buf -> k buf)
99
 
{-# INLINE empty #-}
100
 
 
101
 
--
102
 
--
103
 
singleton :: Char -> Builder
104
 
singleton c = writeAtMost 2 $ \ marr o ->
105
 
    if n < 0x10000
106
 
    then A.unsafeWrite marr o (fromIntegral n) >> return 1
107
 
    else do
108
 
        A.unsafeWrite marr o lo
109
 
        A.unsafeWrite marr (o+1) hi
110
 
        return 2
111
 
  where n = ord c
112
 
        m = n - 0x10000
113
 
        lo = fromIntegral $ (m `shiftR` 10) + 0xD800
114
 
        hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
115
 
{-# INLINE singleton #-}
116
 
 
117
 
------------------------------------------------------------------------
118
 
 
119
 
--
120
 
--
121
 
append :: Builder -> Builder -> Builder
122
 
append (Builder f) (Builder g) = Builder (f . g)
123
 
{-# INLINE [0] append #-}
124
 
 
125
 
copyLimit :: Int
126
 
copyLimit = 128
127
 
 
128
 
 
129
 
--
130
 
--
131
 
fromText :: S.Text -> Builder
132
 
fromText t@(Text arr off l)
133
 
    | S.null t       = empty
134
 
    | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
135
 
    | otherwise      = flush `append` mapBuilder (t :)
136
 
{-# INLINE [1] fromText #-}
137
 
 
138
 
{-# RULES
139
 
"fromText/pack" forall s .
140
 
        fromText (S.pack s) = fromString s
141
 
 #-}
142
 
 
143
 
--
144
 
--
145
 
fromString :: String -> Builder
146
 
fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
147
 
    let loop !marr !o !u !l [] = k (Buffer marr o u l)
148
 
        loop marr o u l s@(c:cs)
149
 
            | l <= 1 = do
150
 
                arr <- A.unsafeFreeze marr
151
 
                let !t = Text arr o u
152
 
                marr' <- A.new chunkSize
153
 
                ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
154
 
                return $ t : ts
155
 
            | otherwise = do
156
 
                n <- unsafeWrite marr (o+u) c
157
 
                loop marr o (u+n) (l-n) cs
158
 
    in loop p0 o0 u0 l0 str
159
 
  where
160
 
    chunkSize = smallChunkSize
161
 
{-# INLINE fromString #-}
162
 
 
163
 
--
164
 
--
165
 
fromLazyText :: L.Text -> Builder
166
 
fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
167
 
{-# INLINE fromLazyText #-}
168
 
 
169
 
------------------------------------------------------------------------
170
 
 
171
 
data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
172
 
                       {-# UNPACK #-} !Int  -- offset
173
 
                       {-# UNPACK #-} !Int  -- used units
174
 
                       {-# UNPACK #-} !Int  -- length left
175
 
 
176
 
------------------------------------------------------------------------
177
 
 
178
 
toLazyText :: Builder -> L.Text
179
 
toLazyText = toLazyTextWith smallChunkSize
180
 
 
181
 
--
182
 
toLazyTextWith :: Int -> Builder -> L.Text
183
 
toLazyTextWith chunkSize m = L.fromChunks (runST $
184
 
  newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))
185
 
 
186
 
flush :: Builder
187
 
flush = Builder $ \ k buf@(Buffer p o u l) ->
188
 
    if u == 0
189
 
    then k buf
190
 
    else do arr <- A.unsafeFreeze p
191
 
            let !b = Buffer p (o+u) 0 l
192
 
                !t = Text arr o u
193
 
            ts <- inlineInterleaveST (k b)
194
 
            return $! t : ts
195
 
 
196
 
------------------------------------------------------------------------
197
 
 
198
 
withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
199
 
withBuffer f = Builder $ \k buf -> f buf >>= k
200
 
{-# INLINE withBuffer #-}
201
 
 
202
 
withSize :: (Int -> Builder) -> Builder
203
 
withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
204
 
    runBuilder (f l) k buf
205
 
{-# INLINE withSize #-}
206
 
 
207
 
mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
208
 
mapBuilder f = Builder (fmap f .)
209
 
 
210
 
------------------------------------------------------------------------
211
 
 
212
 
ensureFree :: Int -> Builder
213
 
ensureFree !n = withSize $ \ l ->
214
 
    if n <= l
215
 
    then empty
216
 
    else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
217
 
{-# INLINE [0] ensureFree #-}
218
 
 
219
 
writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
220
 
writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
221
 
{-# INLINE [0] writeAtMost #-}
222
 
 
223
 
writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
224
 
writeN n f = writeAtMost n (\ p o -> f p o >> return n)
225
 
{-# INLINE writeN #-}
226
 
 
227
 
writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
228
 
writeBuffer f (Buffer p o u l) = do
229
 
    n <- f p (o+u)
230
 
    return $! Buffer p o (u+n) (l-n)
231
 
{-# INLINE writeBuffer #-}
232
 
 
233
 
newBuffer :: Int -> ST s (Buffer s)
234
 
newBuffer size = do
235
 
    arr <- A.new size
236
 
    return $! Buffer arr 0 0 size
237
 
{-# INLINE newBuffer #-}
238
 
 
239
 
------------------------------------------------------------------------
240
 
 
241
 
append' :: Builder -> Builder -> Builder
242
 
append' (Builder f) (Builder g) = Builder (f . g)
243
 
{-# INLINE append' #-}
244
 
 
245
 
{-# RULES
246
 
 
247
 
"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
248
 
                           (g::forall s. A.MArray s -> Int -> ST s Int) ws.
249
 
    append (writeAtMost a f) (append (writeAtMost b g) ws) =
250
 
        append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
251
 
                                    g marr (o+n) >>= \ m ->
252
 
                                    let s = n+m in s `seq` return s)) ws
253
 
 
254
 
"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
255
 
                           (g::forall s. A.MArray s -> Int -> ST s Int).
256
 
    append (writeAtMost a f) (writeAtMost b g) =
257
 
        writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
258
 
                            g marr (o+n) >>= \ m ->
259
 
                            let s = n+m in s `seq` return s)
260
 
 
261
 
"ensureFree/ensureFree" forall a b .
262
 
    append (ensureFree a) (ensureFree b) = ensureFree (max a b)
263
 
 
264
 
"flush/flush"
265
 
    append flush flush = flush
266
 
 
267
 
 #-}
 
49
import Data.Text.Lazy.Builder.Internal