]>
Commit | Line | Data |
---|---|---|
87cfe567 | 1 | {-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns#-} |
9667f797 | 2 | |
955edd33 | 3 | {-| The module @Pipes.Text@ closely follows @Pipes.ByteString@ from |
4 | the @pipes-bytestring@ package. A draft tutorial can be found in | |
5 | @Pipes.Text.Tutorial@. | |
6 | -} | |
2f4a83f8 | 7 | |
955edd33 | 8 | module Pipes.Text ( |
91727d11 | 9 | -- * Producers |
1a83ae4e | 10 | fromLazy |
91727d11 | 11 | |
12 | -- * Pipes | |
1677dc12 | 13 | , map |
14 | , concatMap | |
15 | , take | |
1677dc12 | 16 | , takeWhile |
1677dc12 | 17 | , filter |
1677dc12 | 18 | , toCaseFold |
19 | , toLower | |
20 | , toUpper | |
21 | , stripStart | |
2f4a83f8 | 22 | , scan |
91727d11 | 23 | |
24 | -- * Folds | |
1677dc12 | 25 | , toLazy |
26 | , toLazyM | |
27 | , foldChars | |
28 | , head | |
29 | , last | |
30 | , null | |
31 | , length | |
32 | , any | |
33 | , all | |
34 | , maximum | |
35 | , minimum | |
36 | , find | |
37 | , index | |
1677dc12 | 38 | |
39 | -- * Primitive Character Parsers | |
1677dc12 | 40 | , nextChar |
41 | , drawChar | |
42 | , unDrawChar | |
43 | , peekChar | |
9e9bb0ce | 44 | , isEndOfChars |
1677dc12 | 45 | |
2f4a83f8 | 46 | -- * Parsing Lenses |
9e9bb0ce | 47 | , splitAt |
1677dc12 | 48 | , span |
49 | , break | |
50 | , groupBy | |
51 | , group | |
9e9bb0ce | 52 | , word |
53 | , line | |
1677dc12 | 54 | |
2f4a83f8 | 55 | -- * Transforming Text and Character Streams |
56 | , drop | |
57 | , dropWhile | |
58 | , pack | |
59 | , unpack | |
60 | , intersperse | |
61 | ||
62 | -- * FreeT Transformations | |
1677dc12 | 63 | , chunksOf |
64 | , splitsWith | |
0f8c6f1b | 65 | , splits |
1a83ae4e | 66 | , groupsBy |
67 | , groups | |
1677dc12 | 68 | , lines |
1677dc12 | 69 | , unlines |
2f4a83f8 | 70 | , words |
1677dc12 | 71 | , unwords |
2f4a83f8 | 72 | , intercalate |
9e9bb0ce | 73 | |
1a83ae4e | 74 | -- * Re-exports |
91727d11 | 75 | -- $reexports |
1677dc12 | 76 | , module Data.ByteString |
77 | , module Data.Text | |
1677dc12 | 78 | , module Pipes.Parse |
7ed76745 | 79 | , module Pipes.Group |
91727d11 | 80 | ) where |
81 | ||
2d8448ec | 82 | import Control.Applicative ((<*)) |
70125641 | 83 | import Control.Monad (liftM, join) |
7657ba62 | 84 | import Data.Functor.Constant (Constant(..)) |
85 | import Data.Functor.Identity (Identity) | |
e8336ba6 | 86 | import Control.Monad.Trans.State.Strict (modify) |
7657ba62 | 87 | |
91727d11 | 88 | import qualified Data.Text as T |
91727d11 | 89 | import Data.Text (Text) |
90 | import qualified Data.Text.Lazy as TL | |
31f41a5d | 91 | import Data.ByteString (ByteString) |
7657ba62 | 92 | import Data.Char (isSpace) |
93 | import Foreign.Storable (sizeOf) | |
94 | import Data.Bits (shiftL) | |
2f4a83f8 | 95 | |
91727d11 | 96 | import Pipes |
2f4a83f8 | 97 | import Pipes.Group (folds, maps, concats, intercalates, FreeT(..), FreeF(..)) |
7ed76745 | 98 | import qualified Pipes.Group as PG |
91727d11 | 99 | import qualified Pipes.Parse as PP |
7ed76745 | 100 | import Pipes.Parse (Parser) |
91727d11 | 101 | import qualified Pipes.Prelude as P |
7657ba62 | 102 | |
103 | ||
104 | ||
91727d11 | 105 | import Prelude hiding ( |
106 | all, | |
107 | any, | |
108 | break, | |
109 | concat, | |
110 | concatMap, | |
111 | drop, | |
112 | dropWhile, | |
113 | elem, | |
114 | filter, | |
115 | head, | |
116 | last, | |
117 | lines, | |
118 | length, | |
119 | map, | |
120 | maximum, | |
121 | minimum, | |
122 | notElem, | |
123 | null, | |
124 | readFile, | |
125 | span, | |
126 | splitAt, | |
127 | take, | |
128 | takeWhile, | |
129 | unlines, | |
130 | unwords, | |
131 | words, | |
132 | writeFile ) | |
133 | ||
e20590eb | 134 | -- $setup |
135 | -- >>> :set -XOverloadedStrings | |
136 | -- >>> import Data.Text (Text) | |
137 | -- >>> import qualified Data.Text as T | |
138 | -- >>> import qualified Data.Text.Lazy.IO as TL | |
139 | -- >>> import Data.Char | |
140 | ||
141 | -- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's. Producers in | |
142 | -- IO can be found in 'Pipes.Text.IO' or in pipes-bytestring, employed with the | |
143 | -- decoding lenses in 'Pipes.Text.Encoding' | |
91727d11 | 144 | fromLazy :: (Monad m) => TL.Text -> Producer' Text m () |
2f4a83f8 | 145 | fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ()) |
ca6f90a0 | 146 | {-# INLINE fromLazy #-} |
91727d11 | 147 | |
d199072b | 148 | (^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b |
149 | a ^. lens = getConstant (lens Constant a) | |
150 | ||
91727d11 | 151 | -- | Apply a transformation to each 'Char' in the stream |
e20590eb | 152 | |
153 | -- >>> let margaret = ["Margaret, are you grieving\nOver Golde","ngrove unleaving?":: Text] | |
b28660f6 | 154 | -- >>> TL.putStrLn . toLazy $ each margaret >-> map Data.Char.toUpper |
e20590eb | 155 | -- MARGARET, ARE YOU GRIEVING |
156 | -- OVER GOLDENGROVE UNLEAVING? | |
91727d11 | 157 | map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r |
158 | map f = P.map (T.map f) | |
159 | {-# INLINABLE map #-} | |
160 | ||
31f41a5d | 161 | -- | Map a function over the characters of a text stream and concatenate the results |
e20590eb | 162 | |
91727d11 | 163 | concatMap |
164 | :: (Monad m) => (Char -> Text) -> Pipe Text Text m r | |
165 | concatMap f = P.map (T.concatMap f) | |
166 | {-# INLINABLE concatMap #-} | |
167 | ||
2f4a83f8 | 168 | -- | @(take n)@ only allows @n@ individual characters to pass; |
31f41a5d | 169 | -- contrast @Pipes.Prelude.take@ which would let @n@ chunks pass. |
91727d11 | 170 | take :: (Monad m, Integral a) => a -> Pipe Text Text m () |
171 | take n0 = go n0 where | |
172 | go n | |
173 | | n <= 0 = return () | |
b28660f6 | 174 | | otherwise = do |
31f41a5d | 175 | txt <- await |
176 | let len = fromIntegral (T.length txt) | |
91727d11 | 177 | if (len > n) |
31f41a5d | 178 | then yield (T.take (fromIntegral n) txt) |
91727d11 | 179 | else do |
31f41a5d | 180 | yield txt |
91727d11 | 181 | go (n - len) |
182 | {-# INLINABLE take #-} | |
183 | ||
31f41a5d | 184 | -- | Take characters until they fail the predicate |
91727d11 | 185 | takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m () |
186 | takeWhile predicate = go | |
187 | where | |
188 | go = do | |
31f41a5d | 189 | txt <- await |
190 | let (prefix, suffix) = T.span predicate txt | |
91727d11 | 191 | if (T.null suffix) |
192 | then do | |
31f41a5d | 193 | yield txt |
91727d11 | 194 | go |
195 | else yield prefix | |
196 | {-# INLINABLE takeWhile #-} | |
197 | ||
91727d11 | 198 | -- | Only allows 'Char's to pass if they satisfy the predicate |
199 | filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r | |
200 | filter predicate = P.map (T.filter predicate) | |
201 | {-# INLINABLE filter #-} | |
202 | ||
31f41a5d | 203 | -- | Strict left scan over the characters |
e20590eb | 204 | -- >>> let margaret = ["Margaret, are you grieving\nOver Golde","ngrove unleaving?":: Text] |
205 | -- >>> let title_caser a x = case a of ' ' -> Data.Char.toUpper x; _ -> x | |
206 | -- >>> toLazy $ each margaret >-> scan title_caser ' ' | |
207 | -- " Margaret, Are You Grieving\nOver Goldengrove Unleaving?" | |
208 | ||
91727d11 | 209 | scan |
210 | :: (Monad m) | |
211 | => (Char -> Char -> Char) -> Char -> Pipe Text Text m r | |
11645cdc GG |
212 | scan step begin = do |
213 | yield (T.singleton begin) | |
214 | go begin | |
91727d11 | 215 | where |
31f41a5d | 216 | go c = do |
217 | txt <- await | |
218 | let txt' = T.scanl step c txt | |
219 | c' = T.last txt' | |
11645cdc | 220 | yield (T.tail txt') |
31f41a5d | 221 | go c' |
91727d11 | 222 | {-# INLINABLE scan #-} |
223 | ||
2f4a83f8 | 224 | -- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities, |
225 | -- here acting as 'Text' pipes, rather as they would on a lazy text | |
226 | toCaseFold :: Monad m => Pipe Text Text m r | |
227 | toCaseFold = P.map T.toCaseFold | |
228 | {-# INLINEABLE toCaseFold #-} | |
229 | ||
230 | -- | lowercase incoming 'Text' | |
231 | toLower :: Monad m => Pipe Text Text m r | |
232 | toLower = P.map T.toLower | |
233 | {-# INLINEABLE toLower #-} | |
234 | ||
235 | -- | uppercase incoming 'Text' | |
236 | toUpper :: Monad m => Pipe Text Text m r | |
237 | toUpper = P.map T.toUpper | |
238 | {-# INLINEABLE toUpper #-} | |
239 | ||
240 | -- | Remove leading white space from an incoming succession of 'Text's | |
241 | stripStart :: Monad m => Pipe Text Text m r | |
242 | stripStart = do | |
243 | chunk <- await | |
244 | let text = T.stripStart chunk | |
245 | if T.null text | |
246 | then stripStart | |
247 | else do yield text | |
248 | cat | |
249 | {-# INLINEABLE stripStart #-} | |
250 | ||
91727d11 | 251 | {-| Fold a pure 'Producer' of strict 'Text's into a lazy |
252 | 'TL.Text' | |
253 | -} | |
254 | toLazy :: Producer Text Identity () -> TL.Text | |
255 | toLazy = TL.fromChunks . P.toList | |
256 | {-# INLINABLE toLazy #-} | |
257 | ||
258 | {-| Fold an effectful 'Producer' of strict 'Text's into a lazy | |
259 | 'TL.Text' | |
260 | ||
261 | Note: 'toLazyM' is not an idiomatic use of @pipes@, but I provide it for | |
262 | simple testing purposes. Idiomatic @pipes@ style consumes the chunks | |
263 | immediately as they are generated instead of loading them all into memory. | |
264 | -} | |
265 | toLazyM :: (Monad m) => Producer Text m () -> m TL.Text | |
266 | toLazyM = liftM TL.fromChunks . P.toListM | |
267 | {-# INLINABLE toLazyM #-} | |
268 | ||
31f41a5d | 269 | -- | Reduce the text stream using a strict left fold over characters |
64e03122 | 270 | foldChars |
91727d11 | 271 | :: Monad m |
272 | => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r | |
64e03122 | 273 | foldChars step begin done = P.fold (T.foldl' step) begin done |
1677dc12 | 274 | {-# INLINABLE foldChars #-} |
91727d11 | 275 | |
2f4a83f8 | 276 | |
91727d11 | 277 | -- | Retrieve the first 'Char' |
278 | head :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
279 | head = go | |
280 | where | |
281 | go p = do | |
282 | x <- nextChar p | |
283 | case x of | |
284 | Left _ -> return Nothing | |
31f41a5d | 285 | Right (c, _) -> return (Just c) |
91727d11 | 286 | {-# INLINABLE head #-} |
287 | ||
288 | -- | Retrieve the last 'Char' | |
289 | last :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
290 | last = go Nothing | |
291 | where | |
292 | go r p = do | |
293 | x <- next p | |
294 | case x of | |
295 | Left () -> return r | |
31f41a5d | 296 | Right (txt, p') -> |
297 | if (T.null txt) | |
91727d11 | 298 | then go r p' |
31f41a5d | 299 | else go (Just $ T.last txt) p' |
91727d11 | 300 | {-# INLINABLE last #-} |
301 | ||
302 | -- | Determine if the stream is empty | |
303 | null :: (Monad m) => Producer Text m () -> m Bool | |
304 | null = P.all T.null | |
305 | {-# INLINABLE null #-} | |
306 | ||
62e8521c | 307 | -- | Count the number of characters in the stream |
91727d11 | 308 | length :: (Monad m, Num n) => Producer Text m () -> m n |
31f41a5d | 309 | length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id |
91727d11 | 310 | {-# INLINABLE length #-} |
311 | ||
312 | -- | Fold that returns whether 'M.Any' received 'Char's satisfy the predicate | |
313 | any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool | |
314 | any predicate = P.any (T.any predicate) | |
315 | {-# INLINABLE any #-} | |
316 | ||
317 | -- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate | |
318 | all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool | |
319 | all predicate = P.all (T.all predicate) | |
320 | {-# INLINABLE all #-} | |
321 | ||
62e8521c | 322 | -- | Return the maximum 'Char' within a text stream |
91727d11 | 323 | maximum :: (Monad m) => Producer Text m () -> m (Maybe Char) |
324 | maximum = P.fold step Nothing id | |
325 | where | |
31f41a5d | 326 | step mc txt = |
327 | if (T.null txt) | |
328 | then mc | |
329 | else Just $ case mc of | |
330 | Nothing -> T.maximum txt | |
331 | Just c -> max c (T.maximum txt) | |
91727d11 | 332 | {-# INLINABLE maximum #-} |
333 | ||
62e8521c | 334 | -- | Return the minimum 'Char' within a text stream (surely very useful!) |
91727d11 | 335 | minimum :: (Monad m) => Producer Text m () -> m (Maybe Char) |
336 | minimum = P.fold step Nothing id | |
337 | where | |
31f41a5d | 338 | step mc txt = |
339 | if (T.null txt) | |
340 | then mc | |
341 | else case mc of | |
342 | Nothing -> Just (T.minimum txt) | |
343 | Just c -> Just (min c (T.minimum txt)) | |
91727d11 | 344 | {-# INLINABLE minimum #-} |
345 | ||
91727d11 | 346 | -- | Find the first element in the stream that matches the predicate |
347 | find | |
348 | :: (Monad m) | |
349 | => (Char -> Bool) -> Producer Text m () -> m (Maybe Char) | |
350 | find predicate p = head (p >-> filter predicate) | |
351 | {-# INLINABLE find #-} | |
352 | ||
62e8521c | 353 | -- | Index into a text stream |
91727d11 | 354 | index |
355 | :: (Monad m, Integral a) | |
356 | => a-> Producer Text m () -> m (Maybe Char) | |
2f4a83f8 | 357 | index n p = head (drop n p) |
91727d11 | 358 | {-# INLINABLE index #-} |
359 | ||
63ea9ffd | 360 | |
9e9bb0ce | 361 | |
1a83ae4e | 362 | -- | Consume the first character from a stream of 'Text' |
2f4a83f8 | 363 | -- |
1a83ae4e | 364 | -- 'next' either fails with a 'Left' if the 'Producer' has no more characters or |
365 | -- succeeds with a 'Right' providing the next character and the remainder of the | |
366 | -- 'Producer'. | |
9e9bb0ce | 367 | |
9e9bb0ce | 368 | nextChar |
369 | :: (Monad m) | |
370 | => Producer Text m r | |
371 | -> m (Either r (Char, Producer Text m r)) | |
372 | nextChar = go | |
373 | where | |
374 | go p = do | |
375 | x <- next p | |
376 | case x of | |
377 | Left r -> return (Left r) | |
378 | Right (txt, p') -> case (T.uncons txt) of | |
379 | Nothing -> go p' | |
380 | Just (c, txt') -> return (Right (c, yield txt' >> p')) | |
381 | {-# INLINABLE nextChar #-} | |
382 | ||
1a83ae4e | 383 | -- | Draw one 'Char' from a stream of 'Text', returning 'Left' if the 'Producer' is empty |
384 | ||
9e9bb0ce | 385 | drawChar :: (Monad m) => Parser Text m (Maybe Char) |
386 | drawChar = do | |
387 | x <- PP.draw | |
388 | case x of | |
389 | Nothing -> return Nothing | |
390 | Just txt -> case (T.uncons txt) of | |
391 | Nothing -> drawChar | |
392 | Just (c, txt') -> do | |
393 | PP.unDraw txt' | |
394 | return (Just c) | |
395 | {-# INLINABLE drawChar #-} | |
396 | ||
397 | -- | Push back a 'Char' onto the underlying 'Producer' | |
398 | unDrawChar :: (Monad m) => Char -> Parser Text m () | |
399 | unDrawChar c = modify (yield (T.singleton c) >>) | |
400 | {-# INLINABLE unDrawChar #-} | |
401 | ||
402 | {-| 'peekChar' checks the first 'Char' in the stream, but uses 'unDrawChar' to | |
403 | push the 'Char' back | |
404 | ||
405 | > peekChar = do | |
406 | > x <- drawChar | |
407 | > case x of | |
408 | > Left _ -> return () | |
409 | > Right c -> unDrawChar c | |
410 | > return x | |
1a83ae4e | 411 | |
9e9bb0ce | 412 | -} |
1a83ae4e | 413 | |
9e9bb0ce | 414 | peekChar :: (Monad m) => Parser Text m (Maybe Char) |
415 | peekChar = do | |
416 | x <- drawChar | |
417 | case x of | |
418 | Nothing -> return () | |
419 | Just c -> unDrawChar c | |
420 | return x | |
421 | {-# INLINABLE peekChar #-} | |
422 | ||
423 | {-| Check if the underlying 'Producer' has no more characters | |
424 | ||
425 | Note that this will skip over empty 'Text' chunks, unlike | |
426 | 'PP.isEndOfInput' from @pipes-parse@, which would consider | |
427 | an empty 'Text' a valid bit of input. | |
428 | ||
429 | > isEndOfChars = liftM isLeft peekChar | |
430 | -} | |
431 | isEndOfChars :: (Monad m) => Parser Text m Bool | |
432 | isEndOfChars = do | |
433 | x <- peekChar | |
434 | return (case x of | |
435 | Nothing -> True | |
436 | Just _-> False ) | |
437 | {-# INLINABLE isEndOfChars #-} | |
438 | ||
31f41a5d | 439 | -- | Splits a 'Producer' after the given number of characters |
91727d11 | 440 | splitAt |
441 | :: (Monad m, Integral n) | |
442 | => n | |
57454c33 | 443 | -> Lens' (Producer Text m r) |
d199072b | 444 | (Producer Text m (Producer Text m r)) |
9e9bb0ce | 445 | splitAt n0 k p0 = fmap join (k (go n0 p0)) |
91727d11 | 446 | where |
447 | go 0 p = return p | |
448 | go n p = do | |
449 | x <- lift (next p) | |
450 | case x of | |
451 | Left r -> return (return r) | |
31f41a5d | 452 | Right (txt, p') -> do |
453 | let len = fromIntegral (T.length txt) | |
91727d11 | 454 | if (len <= n) |
455 | then do | |
31f41a5d | 456 | yield txt |
91727d11 | 457 | go (n - len) p' |
458 | else do | |
31f41a5d | 459 | let (prefix, suffix) = T.splitAt (fromIntegral n) txt |
91727d11 | 460 | yield prefix |
461 | return (yield suffix >> p') | |
462 | {-# INLINABLE splitAt #-} | |
463 | ||
91727d11 | 464 | |
1a83ae4e | 465 | -- | Split a text stream in two, producing the longest |
466 | -- consecutive group of characters that satisfies the predicate | |
467 | -- and returning the rest | |
468 | ||
91727d11 | 469 | span |
470 | :: (Monad m) | |
471 | => (Char -> Bool) | |
57454c33 | 472 | -> Lens' (Producer Text m r) |
d199072b | 473 | (Producer Text m (Producer Text m r)) |
9e9bb0ce | 474 | span predicate k p0 = fmap join (k (go p0)) |
91727d11 | 475 | where |
476 | go p = do | |
477 | x <- lift (next p) | |
478 | case x of | |
479 | Left r -> return (return r) | |
31f41a5d | 480 | Right (txt, p') -> do |
481 | let (prefix, suffix) = T.span predicate txt | |
91727d11 | 482 | if (T.null suffix) |
483 | then do | |
31f41a5d | 484 | yield txt |
91727d11 | 485 | go p' |
486 | else do | |
487 | yield prefix | |
488 | return (yield suffix >> p') | |
489 | {-# INLINABLE span #-} | |
490 | ||
1a83ae4e | 491 | {-| Split a text stream in two, producing the longest |
62e8521c | 492 | consecutive group of characters that don't satisfy the predicate |
91727d11 | 493 | -} |
494 | break | |
495 | :: (Monad m) | |
496 | => (Char -> Bool) | |
57454c33 | 497 | -> Lens' (Producer Text m r) |
d199072b | 498 | (Producer Text m (Producer Text m r)) |
91727d11 | 499 | break predicate = span (not . predicate) |
500 | {-# INLINABLE break #-} | |
501 | ||
9e9bb0ce | 502 | {-| Improper lens that splits after the first group of equivalent Chars, as |
503 | defined by the given equivalence relation | |
504 | -} | |
505 | groupBy | |
506 | :: (Monad m) | |
507 | => (Char -> Char -> Bool) | |
57454c33 | 508 | -> Lens' (Producer Text m r) |
d199072b | 509 | (Producer Text m (Producer Text m r)) |
9e9bb0ce | 510 | groupBy equals k p0 = fmap join (k ((go p0))) where |
511 | go p = do | |
512 | x <- lift (next p) | |
513 | case x of | |
514 | Left r -> return (return r) | |
515 | Right (txt, p') -> case T.uncons txt of | |
516 | Nothing -> go p' | |
2f4a83f8 | 517 | Just (c, _) -> (yield txt >> p') ^. span (equals c) |
9e9bb0ce | 518 | {-# INLINABLE groupBy #-} |
519 | ||
520 | -- | Improper lens that splits after the first succession of identical 'Char' s | |
2f4a83f8 | 521 | group :: Monad m |
57454c33 | 522 | => Lens' (Producer Text m r) |
9e9bb0ce | 523 | (Producer Text m (Producer Text m r)) |
524 | group = groupBy (==) | |
525 | {-# INLINABLE group #-} | |
526 | ||
527 | {-| Improper lens that splits a 'Producer' after the first word | |
528 | ||
2f4a83f8 | 529 | Unlike 'words', this does not drop leading whitespace |
9e9bb0ce | 530 | -} |
2f4a83f8 | 531 | word :: (Monad m) |
57454c33 | 532 | => Lens' (Producer Text m r) |
d199072b | 533 | (Producer Text m (Producer Text m r)) |
9e9bb0ce | 534 | word k p0 = fmap join (k (to p0)) |
535 | where | |
536 | to p = do | |
537 | p' <- p^.span isSpace | |
538 | p'^.break isSpace | |
539 | {-# INLINABLE word #-} | |
540 | ||
2f4a83f8 | 541 | line :: (Monad m) |
57454c33 | 542 | => Lens' (Producer Text m r) |
d199072b | 543 | (Producer Text m (Producer Text m r)) |
9e9bb0ce | 544 | line = break (== '\n') |
9e9bb0ce | 545 | {-# INLINABLE line #-} |
546 | ||
2f4a83f8 | 547 | -- | @(drop n)@ drops the first @n@ characters |
548 | drop :: (Monad m, Integral n) | |
549 | => n -> Producer Text m r -> Producer Text m r | |
550 | drop n p = do | |
551 | p' <- lift $ runEffect (for (p ^. splitAt n) discard) | |
552 | p' | |
553 | {-# INLINABLE drop #-} | |
554 | ||
555 | -- | Drop characters until they fail the predicate | |
556 | dropWhile :: (Monad m) | |
557 | => (Char -> Bool) -> Producer Text m r -> Producer Text m r | |
558 | dropWhile predicate p = do | |
559 | p' <- lift $ runEffect (for (p ^. span predicate) discard) | |
560 | p' | |
561 | {-# INLINABLE dropWhile #-} | |
9e9bb0ce | 562 | |
563 | -- | Intersperse a 'Char' in between the characters of stream of 'Text' | |
564 | intersperse | |
565 | :: (Monad m) => Char -> Producer Text m r -> Producer Text m r | |
566 | intersperse c = go0 | |
567 | where | |
568 | go0 p = do | |
569 | x <- lift (next p) | |
570 | case x of | |
571 | Left r -> return r | |
572 | Right (txt, p') -> do | |
573 | yield (T.intersperse c txt) | |
574 | go1 p' | |
575 | go1 p = do | |
576 | x <- lift (next p) | |
577 | case x of | |
578 | Left r -> return r | |
579 | Right (txt, p') -> do | |
580 | yield (T.singleton c) | |
581 | yield (T.intersperse c txt) | |
582 | go1 p' | |
583 | {-# INLINABLE intersperse #-} | |
584 | ||
585 | ||
2f4a83f8 | 586 | -- | Improper lens from unpacked 'Word8's to packaged 'ByteString's |
587 | pack :: Monad m => Lens' (Producer Char m r) (Producer Text m r) | |
588 | pack k p = fmap _unpack (k (_pack p)) | |
589 | {-# INLINABLE pack #-} | |
590 | ||
591 | -- | Improper lens from packed 'ByteString's to unpacked 'Word8's | |
592 | unpack :: Monad m => Lens' (Producer Text m r) (Producer Char m r) | |
593 | unpack k p = fmap _pack (k (_unpack p)) | |
594 | {-# INLINABLE unpack #-} | |
9e9bb0ce | 595 | |
2f4a83f8 | 596 | _pack :: Monad m => Producer Char m r -> Producer Text m r |
597 | _pack p = folds step id done (p^.PG.chunksOf defaultChunkSize) | |
598 | where | |
599 | step diffAs w8 = diffAs . (w8:) | |
9e9bb0ce | 600 | |
601 | done diffAs = T.pack (diffAs []) | |
2f4a83f8 | 602 | {-# INLINABLE _pack #-} |
9e9bb0ce | 603 | |
2f4a83f8 | 604 | _unpack :: Monad m => Producer Text m r -> Producer Char m r |
605 | _unpack p = for p (each . T.unpack) | |
606 | {-# INLINABLE _unpack #-} | |
9e9bb0ce | 607 | |
79917d53 | 608 | defaultChunkSize :: Int |
609 | defaultChunkSize = 16384 - (sizeOf (undefined :: Int) `shiftL` 1) | |
0f8c6f1b | 610 | |
2f4a83f8 | 611 | |
0f8c6f1b | 612 | -- | Split a text stream into 'FreeT'-delimited text streams of fixed size |
613 | chunksOf | |
614 | :: (Monad m, Integral n) | |
2f4a83f8 | 615 | => n -> Lens' (Producer Text m r) |
d199072b | 616 | (FreeT (Producer Text m) m r) |
0f8c6f1b | 617 | chunksOf n k p0 = fmap concats (k (FreeT (go p0))) |
618 | where | |
619 | go p = do | |
620 | x <- next p | |
621 | return $ case x of | |
7ed76745 | 622 | Left r -> Pure r |
623 | Right (txt, p') -> Free $ do | |
2f4a83f8 | 624 | p'' <- (yield txt >> p') ^. splitAt n |
7ed76745 | 625 | return $ FreeT (go p'') |
0f8c6f1b | 626 | {-# INLINABLE chunksOf #-} |
627 | ||
628 | ||
62e8521c | 629 | {-| Split a text stream into sub-streams delimited by characters that satisfy the |
91727d11 | 630 | predicate |
631 | -} | |
1677dc12 | 632 | splitsWith |
91727d11 | 633 | :: (Monad m) |
634 | => (Char -> Bool) | |
2f4a83f8 | 635 | -> Producer Text m r -> FreeT (Producer Text m) m r |
7ed76745 | 636 | splitsWith predicate p0 = FreeT (go0 p0) |
91727d11 | 637 | where |
638 | go0 p = do | |
639 | x <- next p | |
640 | case x of | |
7ed76745 | 641 | Left r -> return (Pure r) |
31f41a5d | 642 | Right (txt, p') -> |
643 | if (T.null txt) | |
91727d11 | 644 | then go0 p' |
7ed76745 | 645 | else return $ Free $ do |
9e9bb0ce | 646 | p'' <- (yield txt >> p') ^. span (not . predicate) |
7ed76745 | 647 | return $ FreeT (go1 p'') |
91727d11 | 648 | go1 p = do |
649 | x <- nextChar p | |
650 | return $ case x of | |
7ed76745 | 651 | Left r -> Pure r |
652 | Right (_, p') -> Free $ do | |
2f4a83f8 | 653 | p'' <- p' ^. span (not . predicate) |
7ed76745 | 654 | return $ FreeT (go1 p'') |
1677dc12 | 655 | {-# INLINABLE splitsWith #-} |
91727d11 | 656 | |
31f41a5d | 657 | -- | Split a text stream using the given 'Char' as the delimiter |
0f8c6f1b | 658 | splits :: (Monad m) |
d199072b | 659 | => Char |
57454c33 | 660 | -> Lens' (Producer Text m r) |
d199072b | 661 | (FreeT (Producer Text m) m r) |
0f8c6f1b | 662 | splits c k p = |
2f4a83f8 | 663 | fmap (intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) |
0f8c6f1b | 664 | {-# INLINABLE splits #-} |
665 | ||
666 | {-| Isomorphism between a stream of 'Text' and groups of equivalent 'Char's , using the | |
667 | given equivalence relation | |
668 | -} | |
669 | groupsBy | |
670 | :: Monad m | |
671 | => (Char -> Char -> Bool) | |
57454c33 | 672 | -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x) |
2f4a83f8 | 673 | groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where |
0f8c6f1b | 674 | go p = do x <- next p |
7ed76745 | 675 | case x of Left r -> return (Pure r) |
0f8c6f1b | 676 | Right (bs, p') -> case T.uncons bs of |
677 | Nothing -> go p' | |
7ed76745 | 678 | Just (c, _) -> do return $ Free $ do |
0f8c6f1b | 679 | p'' <- (yield bs >> p')^.span (equals c) |
7ed76745 | 680 | return $ FreeT (go p'') |
0f8c6f1b | 681 | {-# INLINABLE groupsBy #-} |
682 | ||
683 | ||
684 | -- | Like 'groupsBy', where the equality predicate is ('==') | |
685 | groups | |
686 | :: Monad m | |
57454c33 | 687 | => Lens' (Producer Text m x) (FreeT (Producer Text m) m x) |
0f8c6f1b | 688 | groups = groupsBy (==) |
689 | {-# INLINABLE groups #-} | |
690 | ||
91727d11 | 691 | |
91727d11 | 692 | |
62e8521c | 693 | {-| Split a text stream into 'FreeT'-delimited lines |
91727d11 | 694 | -} |
695 | lines | |
2f4a83f8 | 696 | :: (Monad m) => Lens' (Producer Text m r) (FreeT (Producer Text m) m r) |
697 | lines k p = fmap _unlines (k (_lines p)) | |
698 | {-# INLINABLE lines #-} | |
699 | ||
700 | unlines | |
701 | :: Monad m | |
702 | => Lens' (FreeT (Producer Text m) m r) (Producer Text m r) | |
703 | unlines k p = fmap _lines (k (_unlines p)) | |
704 | {-# INLINABLE unlines #-} | |
705 | ||
706 | _lines :: Monad m | |
707 | => Producer Text m r -> FreeT (Producer Text m) m r | |
708 | _lines p0 = FreeT (go0 p0) | |
0f8c6f1b | 709 | where |
710 | go0 p = do | |
711 | x <- next p | |
712 | case x of | |
7ed76745 | 713 | Left r -> return (Pure r) |
0f8c6f1b | 714 | Right (txt, p') -> |
715 | if (T.null txt) | |
716 | then go0 p' | |
7ed76745 | 717 | else return $ Free $ go1 (yield txt >> p') |
0f8c6f1b | 718 | go1 p = do |
719 | p' <- p ^. break ('\n' ==) | |
7ed76745 | 720 | return $ FreeT $ do |
0f8c6f1b | 721 | x <- nextChar p' |
722 | case x of | |
7ed76745 | 723 | Left r -> return $ Pure r |
0f8c6f1b | 724 | Right (_, p'') -> go0 p'' |
2f4a83f8 | 725 | {-# INLINABLE _lines #-} |
0f8c6f1b | 726 | |
2f4a83f8 | 727 | _unlines :: Monad m |
728 | => FreeT (Producer Text m) m r -> Producer Text m r | |
729 | _unlines = concats . maps (<* yield (T.singleton '\n')) | |
730 | {-# INLINABLE _unlines #-} | |
91727d11 | 731 | |
2f4a83f8 | 732 | -- | Split a text stream into 'FreeT'-delimited words. Note that |
733 | -- roundtripping with e.g. @over words id@ eliminates extra space | |
734 | -- characters as with @Prelude.unwords . Prelude.words@ | |
91727d11 | 735 | words |
2f4a83f8 | 736 | :: (Monad m) => Lens' (Producer Text m r) (FreeT (Producer Text m) m r) |
737 | words k p = fmap _unwords (k (_words p)) | |
738 | {-# INLINABLE words #-} | |
739 | ||
740 | unwords | |
741 | :: Monad m | |
742 | => Lens' (FreeT (Producer Text m) m r) (Producer Text m r) | |
743 | unwords k p = fmap _words (k (_unwords p)) | |
744 | {-# INLINABLE unwords #-} | |
745 | ||
746 | _words :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r | |
747 | _words p = FreeT $ do | |
748 | x <- next (dropWhile isSpace p) | |
cf10d6f1 | 749 | return $ case x of |
7ed76745 | 750 | Left r -> Pure r |
751 | Right (bs, p') -> Free $ do | |
9e9bb0ce | 752 | p'' <- (yield bs >> p') ^. break isSpace |
2f4a83f8 | 753 | return (_words p'') |
754 | {-# INLINABLE _words #-} | |
755 | ||
756 | _unwords :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r | |
757 | _unwords = intercalates (yield $ T.singleton ' ') | |
758 | {-# INLINABLE _unwords #-} | |
91727d11 | 759 | |
cf10d6f1 | 760 | |
31f41a5d | 761 | {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after |
762 | interspersing a text stream in between them | |
91727d11 | 763 | -} |
764 | intercalate | |
765 | :: (Monad m) | |
2f4a83f8 | 766 | => Producer Text m () -> FreeT (Producer Text m) m r -> Producer Text m r |
91727d11 | 767 | intercalate p0 = go0 |
768 | where | |
769 | go0 f = do | |
7ed76745 | 770 | x <- lift (runFreeT f) |
91727d11 | 771 | case x of |
7ed76745 | 772 | Pure r -> return r |
773 | Free p -> do | |
91727d11 | 774 | f' <- p |
775 | go1 f' | |
776 | go1 f = do | |
7ed76745 | 777 | x <- lift (runFreeT f) |
91727d11 | 778 | case x of |
7ed76745 | 779 | Pure r -> return r |
780 | Free p -> do | |
91727d11 | 781 | p0 |
782 | f' <- p | |
783 | go1 f' | |
784 | {-# INLINABLE intercalate #-} | |
785 | ||
91727d11 | 786 | |
91727d11 | 787 | |
91727d11 | 788 | {- $reexports |
2f4a83f8 | 789 | |
91727d11 | 790 | @Data.Text@ re-exports the 'Text' type. |
791 | ||
2f4a83f8 | 792 | @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym. |
64e03122 | 793 | -} |
794 | ||
bbdfd305 | 795 | |
5e387e52 | 796 | type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) |