]>
Commit | Line | Data |
---|---|---|
1677dc12 | 1 | {-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns, CPP #-} |
64e03122 | 2 | #if __GLASGOW_HASKELL__ >= 702 |
3 | {-# LANGUAGE Trustworthy #-} | |
4 | #endif | |
13a43263 | 5 | {-| This module provides @pipes@ utilities for \"text streams\", which are |
64e03122 | 6 | streams of 'Text' chunks. The individual chunks are uniformly @strict@, but |
7 | a 'Producer' can be converted to and from lazy 'Text's, though this is generally | |
8 | unwise. Where pipes IO replaces lazy IO, 'Producer Text m r' replaces lazy 'Text'. | |
9 | An 'IO.Handle' can be associated with a 'Producer' or 'Consumer' according as it is read or written to. | |
91727d11 | 10 | |
63ea9ffd | 11 | To stream to or from 'IO.Handle's, one can use 'fromHandle' or 'toHandle'. For |
31f41a5d | 12 | example, the following program copies a document from one file to another: |
91727d11 | 13 | |
14 | > import Pipes | |
31f41a5d | 15 | > import qualified Data.Text.Pipes as Text |
91727d11 | 16 | > import System.IO |
17 | > | |
18 | > main = | |
19 | > withFile "inFile.txt" ReadMode $ \hIn -> | |
20 | > withFile "outFile.txt" WriteMode $ \hOut -> | |
31f41a5d | 21 | > runEffect $ Text.fromHandle hIn >-> Text.toHandle hOut |
22 | ||
23 | To stream from files, the following is perhaps more Prelude-like (note that it uses Pipes.Safe): | |
91727d11 | 24 | |
13a43263 | 25 | > import Pipes |
31f41a5d | 26 | > import qualified Data.Text.Pipes as Text |
13a43263 | 27 | > import Pipes.Safe |
28 | > | |
31f41a5d | 29 | > main = runSafeT $ runEffect $ Text.readFile "inFile.txt" >-> Text.writeFile "outFile.txt" |
13a43263 | 30 | |
91727d11 | 31 | You can stream to and from 'stdin' and 'stdout' using the predefined 'stdin' |
c8027236 | 32 | and 'stdout' pipes, as with the following \"echo\" program: |
91727d11 | 33 | |
31f41a5d | 34 | > main = runEffect $ Text.stdin >-> Text.stdout |
91727d11 | 35 | |
c8027236 | 36 | You can also translate pure lazy 'TL.Text's to and from pipes: |
91727d11 | 37 | |
31f41a5d | 38 | > main = runEffect $ Text.fromLazy (TL.pack "Hello, world!\n") >-> Text.stdout |
91727d11 | 39 | |
40 | In addition, this module provides many functions equivalent to lazy | |
31f41a5d | 41 | 'Text' functions so that you can transform or fold text streams. For |
91727d11 | 42 | example, to stream only the first three lines of 'stdin' to 'stdout' you |
31f41a5d | 43 | might write: |
91727d11 | 44 | |
45 | > import Pipes | |
31f41a5d | 46 | > import qualified Pipes.Text as Text |
47 | > import qualified Pipes.Parse as Parse | |
91727d11 | 48 | > |
31f41a5d | 49 | > main = runEffect $ takeLines 3 Text.stdin >-> Text.stdout |
91727d11 | 50 | > where |
31f41a5d | 51 | > takeLines n = Text.unlines . Parse.takeFree n . Text.lines |
91727d11 | 52 | |
31f41a5d | 53 | The above program will never bring more than one chunk of text (~ 32 KB) into |
91727d11 | 54 | memory, no matter how long the lines are. |
55 | ||
56 | Note that functions in this library are designed to operate on streams that | |
31f41a5d | 57 | are insensitive to text boundaries. This means that they may freely split |
64e03122 | 58 | text into smaller texts, /discard empty texts/. However, apart from the |
59 | special case of 'concatMap', they will /never concatenate texts/ in order | |
60 | to provide strict upper bounds on memory usage -- with the single exception of 'concatMap'. | |
91727d11 | 61 | -} |
62 | ||
7faef8bc | 63 | module Pipes.Text ( |
91727d11 | 64 | -- * Producers |
1677dc12 | 65 | fromLazy |
66 | , stdin | |
67 | , fromHandle | |
68 | , readFile | |
91727d11 | 69 | |
70 | -- * Consumers | |
1677dc12 | 71 | , stdout |
1677dc12 | 72 | , toHandle |
73 | , writeFile | |
91727d11 | 74 | |
75 | -- * Pipes | |
1677dc12 | 76 | , map |
77 | , concatMap | |
78 | , take | |
79 | , drop | |
80 | , takeWhile | |
81 | , dropWhile | |
82 | , filter | |
83 | , scan | |
84 | , encodeUtf8 | |
85 | , pack | |
86 | , unpack | |
87 | , toCaseFold | |
88 | , toLower | |
89 | , toUpper | |
90 | , stripStart | |
91727d11 | 91 | |
92 | -- * Folds | |
1677dc12 | 93 | , toLazy |
94 | , toLazyM | |
95 | , foldChars | |
96 | , head | |
97 | , last | |
98 | , null | |
99 | , length | |
100 | , any | |
101 | , all | |
102 | , maximum | |
103 | , minimum | |
104 | , find | |
105 | , index | |
106 | , count | |
107 | ||
108 | -- * Primitive Character Parsers | |
109 | -- $parse | |
110 | , nextChar | |
111 | , drawChar | |
112 | , unDrawChar | |
113 | , peekChar | |
9e9bb0ce | 114 | , isEndOfChars |
1677dc12 | 115 | |
116 | -- * Parsing Lenses | |
9e9bb0ce | 117 | , splitAt |
1677dc12 | 118 | , span |
119 | , break | |
120 | , groupBy | |
121 | , group | |
9e9bb0ce | 122 | , word |
123 | , line | |
90189414 | 124 | |
125 | -- * Decoding Lenses | |
1677dc12 | 126 | , decodeUtf8 |
90189414 | 127 | , codec |
128 | ||
129 | -- * Codecs | |
130 | , utf8 | |
131 | , utf16_le | |
132 | , utf16_be | |
133 | , utf32_le | |
134 | , utf32_be | |
135 | ||
136 | -- * Other Decoding/Encoding Functions | |
137 | , decodeIso8859_1 | |
138 | , decodeAscii | |
139 | , encodeIso8859_1 | |
140 | , encodeAscii | |
1677dc12 | 141 | |
142 | -- * FreeT Splitters | |
143 | , chunksOf | |
144 | , splitsWith | |
0f8c6f1b | 145 | , splits |
1677dc12 | 146 | -- , groupsBy |
147 | -- , groups | |
148 | , lines | |
149 | , words | |
150 | ||
91727d11 | 151 | -- * Transformations |
1677dc12 | 152 | , intersperse |
9e9bb0ce | 153 | , packChars |
31f41a5d | 154 | |
91727d11 | 155 | -- * Joiners |
1677dc12 | 156 | , intercalate |
157 | , unlines | |
158 | , unwords | |
9e9bb0ce | 159 | |
1677dc12 | 160 | -- * Re-exports |
91727d11 | 161 | -- $reexports |
a008fca5 | 162 | , Decoding(..) |
163 | , streamDecodeUtf8 | |
164 | , decodeSomeUtf8 | |
165 | , Codec(..) | |
166 | , TextException(..) | |
1677dc12 | 167 | , module Data.ByteString |
168 | , module Data.Text | |
169 | , module Data.Profunctor | |
170 | , module Data.Word | |
171 | , module Pipes.Parse | |
7ed76745 | 172 | , module Pipes.Group |
91727d11 | 173 | ) where |
174 | ||
175 | import Control.Exception (throwIO, try) | |
0f8c6f1b | 176 | import Control.Applicative ((<*)) |
64e03122 | 177 | import Control.Monad (liftM, unless, join) |
9e9bb0ce | 178 | import Control.Monad.Trans.State.Strict (StateT(..), modify) |
ca6f90a0 | 179 | import Data.Monoid ((<>)) |
91727d11 | 180 | import qualified Data.Text as T |
181 | import qualified Data.Text.IO as T | |
31f41a5d | 182 | import qualified Data.Text.Encoding as TE |
63ea9ffd | 183 | import qualified Data.Text.Encoding.Error as TE |
91727d11 | 184 | import Data.Text (Text) |
185 | import qualified Data.Text.Lazy as TL | |
186 | import qualified Data.Text.Lazy.IO as TL | |
187 | import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize) | |
188 | import Data.ByteString.Unsafe (unsafeTake, unsafeDrop) | |
31f41a5d | 189 | import Data.ByteString (ByteString) |
190 | import qualified Data.ByteString as B | |
90189414 | 191 | import qualified Data.ByteString.Char8 as B8 |
cf10d6f1 | 192 | import Data.Char (ord, isSpace) |
1677dc12 | 193 | import Data.Functor.Constant (Constant(Constant, getConstant)) |
91727d11 | 194 | import Data.Functor.Identity (Identity) |
1677dc12 | 195 | import Data.Profunctor (Profunctor) |
196 | import qualified Data.Profunctor | |
91727d11 | 197 | import qualified Data.List as List |
198 | import Foreign.C.Error (Errno(Errno), ePIPE) | |
199 | import qualified GHC.IO.Exception as G | |
200 | import Pipes | |
5e3f5409 | 201 | import qualified Pipes.ByteString as PB |
7c9f2b8b | 202 | import qualified Pipes.Text.Internal as PI |
203 | import Pipes.Text.Internal | |
91727d11 | 204 | import Pipes.Core (respond, Server') |
7fc48f7c | 205 | import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..)) |
7ed76745 | 206 | import qualified Pipes.Group as PG |
91727d11 | 207 | import qualified Pipes.Parse as PP |
7ed76745 | 208 | import Pipes.Parse (Parser) |
91727d11 | 209 | import qualified Pipes.Safe.Prelude as Safe |
210 | import qualified Pipes.Safe as Safe | |
211 | import Pipes.Safe (MonadSafe(..), Base(..)) | |
212 | import qualified Pipes.Prelude as P | |
213 | import qualified System.IO as IO | |
214 | import Data.Char (isSpace) | |
63ea9ffd | 215 | import Data.Word (Word8) |
1677dc12 | 216 | |
91727d11 | 217 | import Prelude hiding ( |
218 | all, | |
219 | any, | |
220 | break, | |
221 | concat, | |
222 | concatMap, | |
223 | drop, | |
224 | dropWhile, | |
225 | elem, | |
226 | filter, | |
227 | head, | |
228 | last, | |
229 | lines, | |
230 | length, | |
231 | map, | |
232 | maximum, | |
233 | minimum, | |
234 | notElem, | |
235 | null, | |
236 | readFile, | |
237 | span, | |
238 | splitAt, | |
239 | take, | |
240 | takeWhile, | |
241 | unlines, | |
242 | unwords, | |
243 | words, | |
244 | writeFile ) | |
245 | ||
246 | -- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's | |
247 | fromLazy :: (Monad m) => TL.Text -> Producer' Text m () | |
248 | fromLazy = foldrChunks (\e a -> yield e >> a) (return ()) | |
ca6f90a0 | 249 | {-# INLINE fromLazy #-} |
91727d11 | 250 | |
62e8521c | 251 | -- | Stream text from 'stdin' |
ca6f90a0 | 252 | stdin :: MonadIO m => Producer Text m () |
91727d11 | 253 | stdin = fromHandle IO.stdin |
ca6f90a0 | 254 | {-# INLINE stdin #-} |
91727d11 | 255 | |
31f41a5d | 256 | {-| Convert a 'IO.Handle' into a text stream using a text size |
ca6f90a0 | 257 | determined by the good sense of the text library; note that this |
258 | is distinctly slower than @decideUtf8 (Pipes.ByteString.fromHandle h)@ | |
259 | but uses the system encoding and has other `Data.Text.IO` features | |
31f41a5d | 260 | -} |
261 | ||
ca6f90a0 | 262 | fromHandle :: MonadIO m => IO.Handle -> Producer Text m () |
263 | fromHandle h = go where | |
264 | go = do txt <- liftIO (T.hGetChunk h) | |
4cbc92cc | 265 | unless (T.null txt) ( do yield txt |
266 | go ) | |
91727d11 | 267 | {-# INLINABLE fromHandle#-} |
ca6f90a0 | 268 | |
269 | ||
270 | {-| Stream text from a file in the simple fashion of @Data.Text.IO@ | |
6f6f9974 | 271 | |
31f41a5d | 272 | >>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout |
273 | MAIN = PUTSTRLN "HELLO WORLD" | |
6f6f9974 | 274 | -} |
275 | ||
ca6f90a0 | 276 | readFile :: MonadSafe m => FilePath -> Producer Text m () |
91727d11 | 277 | readFile file = Safe.withFile file IO.ReadMode fromHandle |
ca6f90a0 | 278 | {-# INLINE readFile #-} |
91727d11 | 279 | |
91727d11 | 280 | |
31f41a5d | 281 | {-| Stream text to 'stdout' |
91727d11 | 282 | |
283 | Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe. | |
284 | ||
4cbc92cc | 285 | Note: For best performance, it might be best just to use @(for source (liftIO . putStr))@ |
286 | instead of @(source >-> stdout)@ . | |
91727d11 | 287 | -} |
288 | stdout :: MonadIO m => Consumer' Text m () | |
289 | stdout = go | |
290 | where | |
291 | go = do | |
292 | txt <- await | |
293 | x <- liftIO $ try (T.putStr txt) | |
294 | case x of | |
295 | Left (G.IOError { G.ioe_type = G.ResourceVanished | |
296 | , G.ioe_errno = Just ioe }) | |
297 | | Errno ioe == ePIPE | |
298 | -> return () | |
299 | Left e -> liftIO (throwIO e) | |
300 | Right () -> go | |
301 | {-# INLINABLE stdout #-} | |
302 | ||
91727d11 | 303 | |
31f41a5d | 304 | {-| Convert a text stream into a 'Handle' |
91727d11 | 305 | |
31f41a5d | 306 | Note: again, for best performance, where possible use |
307 | @(for source (liftIO . hPutStr handle))@ instead of @(source >-> toHandle handle)@. | |
91727d11 | 308 | -} |
309 | toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r | |
310 | toHandle h = for cat (liftIO . T.hPutStr h) | |
311 | {-# INLINABLE toHandle #-} | |
312 | ||
d4732515 | 313 | {-# RULES "p >-> toHandle h" forall p h . |
ff38b9f0 | 314 | p >-> toHandle h = for p (\txt -> liftIO (T.hPutStr h txt)) |
d4732515 | 315 | #-} |
316 | ||
317 | ||
31f41a5d | 318 | -- | Stream text into a file. Uses @pipes-safe@. |
ca6f90a0 | 319 | writeFile :: (MonadSafe m) => FilePath -> Consumer' Text m () |
91727d11 | 320 | writeFile file = Safe.withFile file IO.WriteMode toHandle |
ca6f90a0 | 321 | {-# INLINE writeFile #-} |
91727d11 | 322 | |
1677dc12 | 323 | |
324 | type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) | |
325 | ||
326 | type Iso' a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a) | |
327 | ||
328 | (^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b | |
329 | a ^. lens = getConstant (lens Constant a) | |
330 | ||
331 | ||
91727d11 | 332 | -- | Apply a transformation to each 'Char' in the stream |
333 | map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r | |
334 | map f = P.map (T.map f) | |
335 | {-# INLINABLE map #-} | |
336 | ||
ff38b9f0 | 337 | {-# RULES "p >-> map f" forall p f . |
338 | p >-> map f = for p (\txt -> yield (T.map f txt)) | |
339 | #-} | |
340 | ||
31f41a5d | 341 | -- | Map a function over the characters of a text stream and concatenate the results |
91727d11 | 342 | concatMap |
343 | :: (Monad m) => (Char -> Text) -> Pipe Text Text m r | |
344 | concatMap f = P.map (T.concatMap f) | |
345 | {-# INLINABLE concatMap #-} | |
346 | ||
ff38b9f0 | 347 | {-# RULES "p >-> concatMap f" forall p f . |
348 | p >-> concatMap f = for p (\txt -> yield (T.concatMap f txt)) | |
349 | #-} | |
7faef8bc | 350 | |
351 | -- | Transform a Pipe of 'Text' into a Pipe of 'ByteString's using UTF-8 | |
a02a69ad | 352 | -- encoding; @encodeUtf8 = Pipes.Prelude.map TE.encodeUtf8@ so more complex |
353 | -- encoding pipes can easily be constructed with the functions in @Data.Text.Encoding@ | |
7faef8bc | 354 | encodeUtf8 :: Monad m => Pipe Text ByteString m r |
355 | encodeUtf8 = P.map TE.encodeUtf8 | |
356 | {-# INLINEABLE encodeUtf8 #-} | |
357 | ||
ff38b9f0 | 358 | {-# RULES "p >-> encodeUtf8" forall p . |
359 | p >-> encodeUtf8 = for p (\txt -> yield (TE.encodeUtf8 txt)) | |
360 | #-} | |
361 | ||
c0343bc9 | 362 | -- | Transform a Pipe of 'String's into one of 'Text' chunks |
7faef8bc | 363 | pack :: Monad m => Pipe String Text m r |
364 | pack = P.map T.pack | |
365 | {-# INLINEABLE pack #-} | |
366 | ||
ff38b9f0 | 367 | {-# RULES "p >-> pack" forall p . |
368 | p >-> pack = for p (\txt -> yield (T.pack txt)) | |
369 | #-} | |
370 | ||
371 | -- | Transform a Pipes of 'Text' chunks into one of 'String's | |
7faef8bc | 372 | unpack :: Monad m => Pipe Text String m r |
d4732515 | 373 | unpack = for cat (\t -> yield (T.unpack t)) |
7faef8bc | 374 | {-# INLINEABLE unpack #-} |
375 | ||
ff38b9f0 | 376 | {-# RULES "p >-> unpack" forall p . |
377 | p >-> unpack = for p (\txt -> yield (T.unpack txt)) | |
378 | #-} | |
d4732515 | 379 | |
b0d86a59 | 380 | -- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities, |
381 | -- here acting as 'Text' pipes, rather as they would on a lazy text | |
7faef8bc | 382 | toCaseFold :: Monad m => Pipe Text Text m () |
383 | toCaseFold = P.map T.toCaseFold | |
384 | {-# INLINEABLE toCaseFold #-} | |
385 | ||
ff38b9f0 | 386 | {-# RULES "p >-> toCaseFold" forall p . |
387 | p >-> toCaseFold = for p (\txt -> yield (T.toCaseFold txt)) | |
388 | #-} | |
389 | ||
390 | ||
c0343bc9 | 391 | -- | lowercase incoming 'Text' |
7faef8bc | 392 | toLower :: Monad m => Pipe Text Text m () |
393 | toLower = P.map T.toLower | |
394 | {-# INLINEABLE toLower #-} | |
395 | ||
ff38b9f0 | 396 | {-# RULES "p >-> toLower" forall p . |
397 | p >-> toLower = for p (\txt -> yield (T.toLower txt)) | |
398 | #-} | |
399 | ||
c0343bc9 | 400 | -- | uppercase incoming 'Text' |
7faef8bc | 401 | toUpper :: Monad m => Pipe Text Text m () |
402 | toUpper = P.map T.toUpper | |
403 | {-# INLINEABLE toUpper #-} | |
404 | ||
ff38b9f0 | 405 | {-# RULES "p >-> toUpper" forall p . |
406 | p >-> toUpper = for p (\txt -> yield (T.toUpper txt)) | |
407 | #-} | |
408 | ||
c0343bc9 | 409 | -- | Remove leading white space from an incoming succession of 'Text's |
7faef8bc | 410 | stripStart :: Monad m => Pipe Text Text m r |
411 | stripStart = do | |
412 | chunk <- await | |
413 | let text = T.stripStart chunk | |
414 | if T.null text | |
415 | then stripStart | |
b0d86a59 | 416 | else do yield text |
417 | cat | |
7faef8bc | 418 | {-# INLINEABLE stripStart #-} |
419 | ||
31f41a5d | 420 | -- | @(take n)@ only allows @n@ individual characters to pass; |
421 | -- contrast @Pipes.Prelude.take@ which would let @n@ chunks pass. | |
91727d11 | 422 | take :: (Monad m, Integral a) => a -> Pipe Text Text m () |
423 | take n0 = go n0 where | |
424 | go n | |
425 | | n <= 0 = return () | |
426 | | otherwise = do | |
31f41a5d | 427 | txt <- await |
428 | let len = fromIntegral (T.length txt) | |
91727d11 | 429 | if (len > n) |
31f41a5d | 430 | then yield (T.take (fromIntegral n) txt) |
91727d11 | 431 | else do |
31f41a5d | 432 | yield txt |
91727d11 | 433 | go (n - len) |
434 | {-# INLINABLE take #-} | |
435 | ||
31f41a5d | 436 | -- | @(drop n)@ drops the first @n@ characters |
91727d11 | 437 | drop :: (Monad m, Integral a) => a -> Pipe Text Text m r |
438 | drop n0 = go n0 where | |
439 | go n | |
440 | | n <= 0 = cat | |
441 | | otherwise = do | |
31f41a5d | 442 | txt <- await |
443 | let len = fromIntegral (T.length txt) | |
91727d11 | 444 | if (len >= n) |
445 | then do | |
31f41a5d | 446 | yield (T.drop (fromIntegral n) txt) |
91727d11 | 447 | cat |
448 | else go (n - len) | |
449 | {-# INLINABLE drop #-} | |
450 | ||
31f41a5d | 451 | -- | Take characters until they fail the predicate |
91727d11 | 452 | takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m () |
453 | takeWhile predicate = go | |
454 | where | |
455 | go = do | |
31f41a5d | 456 | txt <- await |
457 | let (prefix, suffix) = T.span predicate txt | |
91727d11 | 458 | if (T.null suffix) |
459 | then do | |
31f41a5d | 460 | yield txt |
91727d11 | 461 | go |
462 | else yield prefix | |
463 | {-# INLINABLE takeWhile #-} | |
464 | ||
31f41a5d | 465 | -- | Drop characters until they fail the predicate |
91727d11 | 466 | dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r |
467 | dropWhile predicate = go where | |
468 | go = do | |
31f41a5d | 469 | txt <- await |
470 | case T.findIndex (not . predicate) txt of | |
91727d11 | 471 | Nothing -> go |
472 | Just i -> do | |
31f41a5d | 473 | yield (T.drop i txt) |
91727d11 | 474 | cat |
475 | {-# INLINABLE dropWhile #-} | |
476 | ||
477 | -- | Only allows 'Char's to pass if they satisfy the predicate | |
478 | filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r | |
479 | filter predicate = P.map (T.filter predicate) | |
480 | {-# INLINABLE filter #-} | |
481 | ||
ff38b9f0 | 482 | {-# RULES "p >-> filter q" forall p q . |
483 | p >-> filter q = for p (\txt -> yield (T.filter q txt)) | |
484 | #-} | |
485 | ||
31f41a5d | 486 | -- | Strict left scan over the characters |
91727d11 | 487 | scan |
488 | :: (Monad m) | |
489 | => (Char -> Char -> Char) -> Char -> Pipe Text Text m r | |
490 | scan step begin = go begin | |
491 | where | |
31f41a5d | 492 | go c = do |
493 | txt <- await | |
494 | let txt' = T.scanl step c txt | |
495 | c' = T.last txt' | |
496 | yield txt' | |
497 | go c' | |
91727d11 | 498 | {-# INLINABLE scan #-} |
499 | ||
500 | {-| Fold a pure 'Producer' of strict 'Text's into a lazy | |
501 | 'TL.Text' | |
502 | -} | |
503 | toLazy :: Producer Text Identity () -> TL.Text | |
504 | toLazy = TL.fromChunks . P.toList | |
505 | {-# INLINABLE toLazy #-} | |
506 | ||
507 | {-| Fold an effectful 'Producer' of strict 'Text's into a lazy | |
508 | 'TL.Text' | |
509 | ||
510 | Note: 'toLazyM' is not an idiomatic use of @pipes@, but I provide it for | |
511 | simple testing purposes. Idiomatic @pipes@ style consumes the chunks | |
512 | immediately as they are generated instead of loading them all into memory. | |
513 | -} | |
514 | toLazyM :: (Monad m) => Producer Text m () -> m TL.Text | |
515 | toLazyM = liftM TL.fromChunks . P.toListM | |
516 | {-# INLINABLE toLazyM #-} | |
517 | ||
31f41a5d | 518 | -- | Reduce the text stream using a strict left fold over characters |
64e03122 | 519 | foldChars |
91727d11 | 520 | :: Monad m |
521 | => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r | |
64e03122 | 522 | foldChars step begin done = P.fold (T.foldl' step) begin done |
1677dc12 | 523 | {-# INLINABLE foldChars #-} |
91727d11 | 524 | |
525 | -- | Retrieve the first 'Char' | |
526 | head :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
527 | head = go | |
528 | where | |
529 | go p = do | |
530 | x <- nextChar p | |
531 | case x of | |
532 | Left _ -> return Nothing | |
31f41a5d | 533 | Right (c, _) -> return (Just c) |
91727d11 | 534 | {-# INLINABLE head #-} |
535 | ||
536 | -- | Retrieve the last 'Char' | |
537 | last :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
538 | last = go Nothing | |
539 | where | |
540 | go r p = do | |
541 | x <- next p | |
542 | case x of | |
543 | Left () -> return r | |
31f41a5d | 544 | Right (txt, p') -> |
545 | if (T.null txt) | |
91727d11 | 546 | then go r p' |
31f41a5d | 547 | else go (Just $ T.last txt) p' |
91727d11 | 548 | {-# INLINABLE last #-} |
549 | ||
550 | -- | Determine if the stream is empty | |
551 | null :: (Monad m) => Producer Text m () -> m Bool | |
552 | null = P.all T.null | |
553 | {-# INLINABLE null #-} | |
554 | ||
62e8521c | 555 | -- | Count the number of characters in the stream |
91727d11 | 556 | length :: (Monad m, Num n) => Producer Text m () -> m n |
31f41a5d | 557 | length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id |
91727d11 | 558 | {-# INLINABLE length #-} |
559 | ||
560 | -- | Fold that returns whether 'M.Any' received 'Char's satisfy the predicate | |
561 | any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool | |
562 | any predicate = P.any (T.any predicate) | |
563 | {-# INLINABLE any #-} | |
564 | ||
565 | -- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate | |
566 | all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool | |
567 | all predicate = P.all (T.all predicate) | |
568 | {-# INLINABLE all #-} | |
569 | ||
62e8521c | 570 | -- | Return the maximum 'Char' within a text stream |
91727d11 | 571 | maximum :: (Monad m) => Producer Text m () -> m (Maybe Char) |
572 | maximum = P.fold step Nothing id | |
573 | where | |
31f41a5d | 574 | step mc txt = |
575 | if (T.null txt) | |
576 | then mc | |
577 | else Just $ case mc of | |
578 | Nothing -> T.maximum txt | |
579 | Just c -> max c (T.maximum txt) | |
91727d11 | 580 | {-# INLINABLE maximum #-} |
581 | ||
62e8521c | 582 | -- | Return the minimum 'Char' within a text stream (surely very useful!) |
91727d11 | 583 | minimum :: (Monad m) => Producer Text m () -> m (Maybe Char) |
584 | minimum = P.fold step Nothing id | |
585 | where | |
31f41a5d | 586 | step mc txt = |
587 | if (T.null txt) | |
588 | then mc | |
589 | else case mc of | |
590 | Nothing -> Just (T.minimum txt) | |
591 | Just c -> Just (min c (T.minimum txt)) | |
91727d11 | 592 | {-# INLINABLE minimum #-} |
593 | ||
1677dc12 | 594 | |
91727d11 | 595 | -- | Find the first element in the stream that matches the predicate |
596 | find | |
597 | :: (Monad m) | |
598 | => (Char -> Bool) -> Producer Text m () -> m (Maybe Char) | |
599 | find predicate p = head (p >-> filter predicate) | |
600 | {-# INLINABLE find #-} | |
601 | ||
62e8521c | 602 | -- | Index into a text stream |
91727d11 | 603 | index |
604 | :: (Monad m, Integral a) | |
605 | => a-> Producer Text m () -> m (Maybe Char) | |
606 | index n p = head (p >-> drop n) | |
607 | {-# INLINABLE index #-} | |
608 | ||
63ea9ffd | 609 | |
31f41a5d | 610 | -- | Store a tally of how many segments match the given 'Text' |
611 | count :: (Monad m, Num n) => Text -> Producer Text m () -> m n | |
612 | count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c)) | |
613 | {-# INLINABLE count #-} | |
614 | ||
9e9bb0ce | 615 | |
616 | {-| Consume the first character from a stream of 'Text' | |
617 | ||
618 | 'next' either fails with a 'Left' if the 'Producer' has no more characters or | |
619 | succeeds with a 'Right' providing the next character and the remainder of the | |
620 | 'Producer'. | |
621 | -} | |
622 | nextChar | |
623 | :: (Monad m) | |
624 | => Producer Text m r | |
625 | -> m (Either r (Char, Producer Text m r)) | |
626 | nextChar = go | |
627 | where | |
628 | go p = do | |
629 | x <- next p | |
630 | case x of | |
631 | Left r -> return (Left r) | |
632 | Right (txt, p') -> case (T.uncons txt) of | |
633 | Nothing -> go p' | |
634 | Just (c, txt') -> return (Right (c, yield txt' >> p')) | |
635 | {-# INLINABLE nextChar #-} | |
636 | ||
637 | {-| Draw one 'Char' from a stream of 'Text', returning 'Left' if the | |
638 | 'Producer' is empty | |
639 | -} | |
640 | drawChar :: (Monad m) => Parser Text m (Maybe Char) | |
641 | drawChar = do | |
642 | x <- PP.draw | |
643 | case x of | |
644 | Nothing -> return Nothing | |
645 | Just txt -> case (T.uncons txt) of | |
646 | Nothing -> drawChar | |
647 | Just (c, txt') -> do | |
648 | PP.unDraw txt' | |
649 | return (Just c) | |
650 | {-# INLINABLE drawChar #-} | |
651 | ||
652 | -- | Push back a 'Char' onto the underlying 'Producer' | |
653 | unDrawChar :: (Monad m) => Char -> Parser Text m () | |
654 | unDrawChar c = modify (yield (T.singleton c) >>) | |
655 | {-# INLINABLE unDrawChar #-} | |
656 | ||
657 | {-| 'peekChar' checks the first 'Char' in the stream, but uses 'unDrawChar' to | |
658 | push the 'Char' back | |
659 | ||
660 | > peekChar = do | |
661 | > x <- drawChar | |
662 | > case x of | |
663 | > Left _ -> return () | |
664 | > Right c -> unDrawChar c | |
665 | > return x | |
666 | -} | |
667 | peekChar :: (Monad m) => Parser Text m (Maybe Char) | |
668 | peekChar = do | |
669 | x <- drawChar | |
670 | case x of | |
671 | Nothing -> return () | |
672 | Just c -> unDrawChar c | |
673 | return x | |
674 | {-# INLINABLE peekChar #-} | |
675 | ||
676 | {-| Check if the underlying 'Producer' has no more characters | |
677 | ||
678 | Note that this will skip over empty 'Text' chunks, unlike | |
679 | 'PP.isEndOfInput' from @pipes-parse@, which would consider | |
680 | an empty 'Text' a valid bit of input. | |
681 | ||
682 | > isEndOfChars = liftM isLeft peekChar | |
683 | -} | |
684 | isEndOfChars :: (Monad m) => Parser Text m Bool | |
685 | isEndOfChars = do | |
686 | x <- peekChar | |
687 | return (case x of | |
688 | Nothing -> True | |
689 | Just _-> False ) | |
690 | {-# INLINABLE isEndOfChars #-} | |
691 | ||
692 | ||
167f8805 | 693 | {- | An improper lens into a stream of 'ByteString' expected to be UTF-8 encoded; the associated |
694 | stream of Text ends by returning a stream of ByteStrings beginning at the point of failure. | |
695 | -} | |
ca6f90a0 | 696 | |
9e9bb0ce | 697 | decodeUtf8 :: Monad m => Lens' (Producer ByteString m r) |
698 | (Producer Text m (Producer ByteString m r)) | |
699 | decodeUtf8 k p0 = fmap (\p -> join (for p (yield . TE.encodeUtf8))) | |
7c9f2b8b | 700 | (k (go B.empty PI.streamDecodeUtf8 p0)) where |
ca6f90a0 | 701 | go !carry dec0 p = do |
702 | x <- lift (next p) | |
4cbc92cc | 703 | case x of Left r -> return (if B.null carry |
704 | then return r -- all bytestring input was consumed | |
705 | else (do yield carry -- a potentially valid fragment remains | |
706 | return r)) | |
ca6f90a0 | 707 | |
708 | Right (chunk, p') -> case dec0 chunk of | |
7c9f2b8b | 709 | PI.Some text carry2 dec -> do yield text |
ca6f90a0 | 710 | go carry2 dec p' |
7c9f2b8b | 711 | PI.Other text bs -> do yield text |
ca6f90a0 | 712 | return (do yield bs -- an invalid blob remains |
713 | p') | |
714 | {-# INLINABLE decodeUtf8 #-} | |
715 | ||
31f41a5d | 716 | |
717 | -- | Splits a 'Producer' after the given number of characters | |
91727d11 | 718 | splitAt |
719 | :: (Monad m, Integral n) | |
720 | => n | |
9e9bb0ce | 721 | -> Lens' (Producer Text m r) |
722 | (Producer Text m (Producer Text m r)) | |
723 | splitAt n0 k p0 = fmap join (k (go n0 p0)) | |
91727d11 | 724 | where |
725 | go 0 p = return p | |
726 | go n p = do | |
727 | x <- lift (next p) | |
728 | case x of | |
729 | Left r -> return (return r) | |
31f41a5d | 730 | Right (txt, p') -> do |
731 | let len = fromIntegral (T.length txt) | |
91727d11 | 732 | if (len <= n) |
733 | then do | |
31f41a5d | 734 | yield txt |
91727d11 | 735 | go (n - len) p' |
736 | else do | |
31f41a5d | 737 | let (prefix, suffix) = T.splitAt (fromIntegral n) txt |
91727d11 | 738 | yield prefix |
739 | return (yield suffix >> p') | |
740 | {-# INLINABLE splitAt #-} | |
741 | ||
91727d11 | 742 | |
31f41a5d | 743 | {-| Split a text stream in two, where the first text stream is the longest |
744 | consecutive group of text that satisfy the predicate | |
91727d11 | 745 | -} |
746 | span | |
747 | :: (Monad m) | |
748 | => (Char -> Bool) | |
9e9bb0ce | 749 | -> Lens' (Producer Text m r) |
750 | (Producer Text m (Producer Text m r)) | |
751 | span predicate k p0 = fmap join (k (go p0)) | |
91727d11 | 752 | where |
753 | go p = do | |
754 | x <- lift (next p) | |
755 | case x of | |
756 | Left r -> return (return r) | |
31f41a5d | 757 | Right (txt, p') -> do |
758 | let (prefix, suffix) = T.span predicate txt | |
91727d11 | 759 | if (T.null suffix) |
760 | then do | |
31f41a5d | 761 | yield txt |
91727d11 | 762 | go p' |
763 | else do | |
764 | yield prefix | |
765 | return (yield suffix >> p') | |
766 | {-# INLINABLE span #-} | |
767 | ||
62e8521c | 768 | {-| Split a text stream in two, where the first text stream is the longest |
769 | consecutive group of characters that don't satisfy the predicate | |
91727d11 | 770 | -} |
771 | break | |
772 | :: (Monad m) | |
773 | => (Char -> Bool) | |
9e9bb0ce | 774 | -> Lens' (Producer Text m r) |
775 | (Producer Text m (Producer Text m r)) | |
91727d11 | 776 | break predicate = span (not . predicate) |
777 | {-# INLINABLE break #-} | |
778 | ||
9e9bb0ce | 779 | {-| Improper lens that splits after the first group of equivalent Chars, as |
780 | defined by the given equivalence relation | |
781 | -} | |
782 | groupBy | |
783 | :: (Monad m) | |
784 | => (Char -> Char -> Bool) | |
785 | -> Lens' (Producer Text m r) | |
786 | (Producer Text m (Producer Text m r)) | |
787 | groupBy equals k p0 = fmap join (k ((go p0))) where | |
788 | go p = do | |
789 | x <- lift (next p) | |
790 | case x of | |
791 | Left r -> return (return r) | |
792 | Right (txt, p') -> case T.uncons txt of | |
793 | Nothing -> go p' | |
794 | Just (c, _) -> (yield txt >> p') ^. span (equals c) | |
795 | {-# INLINABLE groupBy #-} | |
796 | ||
797 | -- | Improper lens that splits after the first succession of identical 'Char' s | |
798 | group :: Monad m | |
799 | => Lens' (Producer Text m r) | |
800 | (Producer Text m (Producer Text m r)) | |
801 | group = groupBy (==) | |
802 | {-# INLINABLE group #-} | |
803 | ||
804 | {-| Improper lens that splits a 'Producer' after the first word | |
805 | ||
806 | Unlike 'words', this does not drop leading whitespace | |
807 | -} | |
808 | word :: (Monad m) | |
809 | => Lens' (Producer Text m r) | |
810 | (Producer Text m (Producer Text m r)) | |
811 | word k p0 = fmap join (k (to p0)) | |
812 | where | |
813 | to p = do | |
814 | p' <- p^.span isSpace | |
815 | p'^.break isSpace | |
816 | {-# INLINABLE word #-} | |
817 | ||
818 | ||
819 | line :: (Monad m) | |
820 | => Lens' (Producer Text m r) | |
821 | (Producer Text m (Producer Text m r)) | |
822 | line = break (== '\n') | |
823 | ||
824 | {-# INLINABLE line #-} | |
825 | ||
826 | ||
827 | -- | Intersperse a 'Char' in between the characters of stream of 'Text' | |
828 | intersperse | |
829 | :: (Monad m) => Char -> Producer Text m r -> Producer Text m r | |
830 | intersperse c = go0 | |
831 | where | |
832 | go0 p = do | |
833 | x <- lift (next p) | |
834 | case x of | |
835 | Left r -> return r | |
836 | Right (txt, p') -> do | |
837 | yield (T.intersperse c txt) | |
838 | go1 p' | |
839 | go1 p = do | |
840 | x <- lift (next p) | |
841 | case x of | |
842 | Left r -> return r | |
843 | Right (txt, p') -> do | |
844 | yield (T.singleton c) | |
845 | yield (T.intersperse c txt) | |
846 | go1 p' | |
847 | {-# INLINABLE intersperse #-} | |
848 | ||
849 | ||
850 | ||
851 | -- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's | |
852 | packChars :: Monad m => Iso' (Producer Char m x) (Producer Text m x) | |
853 | packChars = Data.Profunctor.dimap to (fmap from) | |
854 | where | |
855 | -- to :: Monad m => Producer Char m x -> Producer Text m x | |
7ed76745 | 856 | to p = PG.folds step id done (p^.PG.chunksOf defaultChunkSize) |
9e9bb0ce | 857 | |
858 | step diffAs c = diffAs . (c:) | |
859 | ||
860 | done diffAs = T.pack (diffAs []) | |
861 | ||
862 | -- from :: Monad m => Producer Text m x -> Producer Char m x | |
863 | from p = for p (each . T.unpack) | |
864 | {-# INLINABLE packChars #-} | |
865 | ||
0f8c6f1b | 866 | |
867 | -- | Split a text stream into 'FreeT'-delimited text streams of fixed size | |
868 | chunksOf | |
869 | :: (Monad m, Integral n) | |
870 | => n -> Lens' (Producer Text m r) | |
871 | (FreeT (Producer Text m) m r) | |
872 | chunksOf n k p0 = fmap concats (k (FreeT (go p0))) | |
873 | where | |
874 | go p = do | |
875 | x <- next p | |
876 | return $ case x of | |
7ed76745 | 877 | Left r -> Pure r |
878 | Right (txt, p') -> Free $ do | |
0f8c6f1b | 879 | p'' <- (yield txt >> p') ^. splitAt n |
7ed76745 | 880 | return $ FreeT (go p'') |
0f8c6f1b | 881 | {-# INLINABLE chunksOf #-} |
882 | ||
883 | ||
62e8521c | 884 | {-| Split a text stream into sub-streams delimited by characters that satisfy the |
91727d11 | 885 | predicate |
886 | -} | |
1677dc12 | 887 | splitsWith |
91727d11 | 888 | :: (Monad m) |
889 | => (Char -> Bool) | |
890 | -> Producer Text m r | |
7ed76745 | 891 | -> FreeT (Producer Text m) m r |
892 | splitsWith predicate p0 = FreeT (go0 p0) | |
91727d11 | 893 | where |
894 | go0 p = do | |
895 | x <- next p | |
896 | case x of | |
7ed76745 | 897 | Left r -> return (Pure r) |
31f41a5d | 898 | Right (txt, p') -> |
899 | if (T.null txt) | |
91727d11 | 900 | then go0 p' |
7ed76745 | 901 | else return $ Free $ do |
9e9bb0ce | 902 | p'' <- (yield txt >> p') ^. span (not . predicate) |
7ed76745 | 903 | return $ FreeT (go1 p'') |
91727d11 | 904 | go1 p = do |
905 | x <- nextChar p | |
906 | return $ case x of | |
7ed76745 | 907 | Left r -> Pure r |
908 | Right (_, p') -> Free $ do | |
9e9bb0ce | 909 | p'' <- p' ^. span (not . predicate) |
7ed76745 | 910 | return $ FreeT (go1 p'') |
1677dc12 | 911 | {-# INLINABLE splitsWith #-} |
91727d11 | 912 | |
31f41a5d | 913 | -- | Split a text stream using the given 'Char' as the delimiter |
0f8c6f1b | 914 | splits :: (Monad m) |
91727d11 | 915 | => Char |
0f8c6f1b | 916 | -> Lens' (Producer Text m r) |
917 | (FreeT (Producer Text m) m r) | |
918 | splits c k p = | |
7ed76745 | 919 | fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) |
0f8c6f1b | 920 | {-# INLINABLE splits #-} |
921 | ||
922 | {-| Isomorphism between a stream of 'Text' and groups of equivalent 'Char's , using the | |
923 | given equivalence relation | |
924 | -} | |
925 | groupsBy | |
926 | :: Monad m | |
927 | => (Char -> Char -> Bool) | |
928 | -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x) | |
7ed76745 | 929 | groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where |
0f8c6f1b | 930 | go p = do x <- next p |
7ed76745 | 931 | case x of Left r -> return (Pure r) |
0f8c6f1b | 932 | Right (bs, p') -> case T.uncons bs of |
933 | Nothing -> go p' | |
7ed76745 | 934 | Just (c, _) -> do return $ Free $ do |
0f8c6f1b | 935 | p'' <- (yield bs >> p')^.span (equals c) |
7ed76745 | 936 | return $ FreeT (go p'') |
0f8c6f1b | 937 | {-# INLINABLE groupsBy #-} |
938 | ||
939 | ||
940 | -- | Like 'groupsBy', where the equality predicate is ('==') | |
941 | groups | |
942 | :: Monad m | |
943 | => Lens' (Producer Text m x) (FreeT (Producer Text m) m x) | |
944 | groups = groupsBy (==) | |
945 | {-# INLINABLE groups #-} | |
946 | ||
91727d11 | 947 | |
91727d11 | 948 | |
62e8521c | 949 | {-| Split a text stream into 'FreeT'-delimited lines |
91727d11 | 950 | -} |
951 | lines | |
0f8c6f1b | 952 | :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) |
953 | lines = Data.Profunctor.dimap _lines (fmap _unlines) | |
91727d11 | 954 | where |
7ed76745 | 955 | _lines p0 = FreeT (go0 p0) |
0f8c6f1b | 956 | where |
957 | go0 p = do | |
958 | x <- next p | |
959 | case x of | |
7ed76745 | 960 | Left r -> return (Pure r) |
0f8c6f1b | 961 | Right (txt, p') -> |
962 | if (T.null txt) | |
963 | then go0 p' | |
7ed76745 | 964 | else return $ Free $ go1 (yield txt >> p') |
0f8c6f1b | 965 | go1 p = do |
966 | p' <- p ^. break ('\n' ==) | |
7ed76745 | 967 | return $ FreeT $ do |
0f8c6f1b | 968 | x <- nextChar p' |
969 | case x of | |
7ed76745 | 970 | Left r -> return $ Pure r |
0f8c6f1b | 971 | Right (_, p'') -> go0 p'' |
972 | -- _unlines | |
973 | -- :: Monad m | |
974 | -- => FreeT (Producer Text m) m x -> Producer Text m x | |
7fc48f7c | 975 | _unlines = concats . PG.maps (<* yield (T.singleton '\n')) |
976 | ||
0f8c6f1b | 977 | |
91727d11 | 978 | {-# INLINABLE lines #-} |
91727d11 | 979 | |
31f41a5d | 980 | |
31f41a5d | 981 | -- | Split a text stream into 'FreeT'-delimited words |
91727d11 | 982 | words |
0f8c6f1b | 983 | :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) |
984 | words = Data.Profunctor.dimap go (fmap _unwords) | |
91727d11 | 985 | where |
7ed76745 | 986 | go p = FreeT $ do |
cf10d6f1 | 987 | x <- next (p >-> dropWhile isSpace) |
988 | return $ case x of | |
7ed76745 | 989 | Left r -> Pure r |
990 | Right (bs, p') -> Free $ do | |
9e9bb0ce | 991 | p'' <- (yield bs >> p') ^. break isSpace |
cf10d6f1 | 992 | return (go p'') |
7ed76745 | 993 | _unwords = PG.intercalates (yield $ T.singleton ' ') |
0f8c6f1b | 994 | |
91727d11 | 995 | {-# INLINABLE words #-} |
996 | ||
cf10d6f1 | 997 | |
31f41a5d | 998 | {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after |
999 | interspersing a text stream in between them | |
91727d11 | 1000 | -} |
1001 | intercalate | |
1002 | :: (Monad m) | |
1003 | => Producer Text m () | |
1004 | -> FreeT (Producer Text m) m r | |
1005 | -> Producer Text m r | |
1006 | intercalate p0 = go0 | |
1007 | where | |
1008 | go0 f = do | |
7ed76745 | 1009 | x <- lift (runFreeT f) |
91727d11 | 1010 | case x of |
7ed76745 | 1011 | Pure r -> return r |
1012 | Free p -> do | |
91727d11 | 1013 | f' <- p |
1014 | go1 f' | |
1015 | go1 f = do | |
7ed76745 | 1016 | x <- lift (runFreeT f) |
91727d11 | 1017 | case x of |
7ed76745 | 1018 | Pure r -> return r |
1019 | Free p -> do | |
91727d11 | 1020 | p0 |
1021 | f' <- p | |
1022 | go1 f' | |
1023 | {-# INLINABLE intercalate #-} | |
1024 | ||
62e8521c | 1025 | {-| Join 'FreeT'-delimited lines into a text stream |
91727d11 | 1026 | -} |
1027 | unlines | |
1028 | :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r | |
1029 | unlines = go | |
1030 | where | |
1031 | go f = do | |
7ed76745 | 1032 | x <- lift (runFreeT f) |
91727d11 | 1033 | case x of |
7ed76745 | 1034 | Pure r -> return r |
1035 | Free p -> do | |
91727d11 | 1036 | f' <- p |
1037 | yield $ T.singleton '\n' | |
1038 | go f' | |
1039 | {-# INLINABLE unlines #-} | |
1040 | ||
31f41a5d | 1041 | {-| Join 'FreeT'-delimited words into a text stream |
91727d11 | 1042 | -} |
1043 | unwords | |
1044 | :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r | |
7fc48f7c | 1045 | unwords = intercalate (yield $ T.singleton ' ') |
91727d11 | 1046 | {-# INLINABLE unwords #-} |
1047 | ||
1048 | {- $parse | |
31f41a5d | 1049 | The following parsing utilities are single-character analogs of the ones found |
1050 | @pipes-parse@. | |
91727d11 | 1051 | -} |
1052 | ||
91727d11 | 1053 | {- $reexports |
91727d11 | 1054 | |
1055 | @Data.Text@ re-exports the 'Text' type. | |
1056 | ||
0f8c6f1b | 1057 | @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym. |
64e03122 | 1058 | -} |
1059 | ||
167f8805 | 1060 | {- | Use a 'Codec' as a pipes-style 'Lens' into a byte stream; the available 'Codec' s are |
1061 | 'utf8', 'utf16_le', 'utf16_be', 'utf32_le', 'utf32_be' . The 'Codec' concept and the | |
1062 | individual 'Codec' definitions follow the enumerator and conduit libraries. | |
1063 | ||
1064 | Utf8 is handled differently in this library -- without the use of 'unsafePerformIO' &co | |
1065 | to catch 'Text' exceptions; but the same 'mypipe ^. codec utf8' interface can be used. | |
1066 | 'mypipe ^. decodeUtf8' should be the same, but has a somewhat more direct and thus perhaps | |
1067 | better implementation. | |
1068 | ||
1069 | -} | |
90189414 | 1070 | codec :: Monad m => Codec -> Lens' (Producer ByteString m r) (Producer Text m (Producer ByteString m r)) |
1071 | codec (Codec _ enc dec) k p0 = fmap (\p -> join (for p (yield . fst . enc))) | |
1072 | (k (decoder (dec B.empty) p0) ) where | |
7c9f2b8b | 1073 | decoder :: Monad m => PI.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r) |
90189414 | 1074 | decoder !d p0 = case d of |
7c9f2b8b | 1075 | PI.Other txt bad -> do yield txt |
90189414 | 1076 | return (do yield bad |
1077 | p0) | |
7c9f2b8b | 1078 | PI.Some txt extra dec -> do yield txt |
90189414 | 1079 | x <- lift (next p0) |
1080 | case x of Left r -> return (do yield extra | |
1081 | return r) | |
1082 | Right (chunk,p1) -> decoder (dec chunk) p1 | |
1083 | ||
167f8805 | 1084 | {- | ascii and latin encodings only represent a small fragment of 'Text'; thus we cannot |
1085 | use the pipes 'Lens' style to work with them. Rather we simply define functions | |
1086 | each way. | |
90189414 | 1087 | |
167f8805 | 1088 | 'encodeAscii' : Reduce as much of your stream of 'Text' actually is ascii to a byte stream, |
1089 | returning the rest of the 'Text' at the first non-ascii 'Char' | |
1090 | -} | |
90189414 | 1091 | encodeAscii :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r) |
1092 | encodeAscii = go where | |
1093 | go p = do echunk <- lift (next p) | |
1094 | case echunk of | |
1095 | Left r -> return (return r) | |
1096 | Right (chunk, p') -> | |
1097 | if T.null chunk | |
1098 | then go p' | |
1099 | else let (safe, unsafe) = T.span (\c -> ord c <= 0x7F) chunk | |
1100 | in do yield (B8.pack (T.unpack safe)) | |
1101 | if T.null unsafe | |
1102 | then go p' | |
1103 | else return $ do yield unsafe | |
1104 | p' | |
167f8805 | 1105 | {- | Reduce as much of your stream of 'Text' actually is iso8859 or latin1 to a byte stream, |
1106 | returning the rest of the 'Text' upon hitting any non-latin 'Char' | |
1107 | -} | |
90189414 | 1108 | encodeIso8859_1 :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r) |
1109 | encodeIso8859_1 = go where | |
1110 | go p = do etxt <- lift (next p) | |
1111 | case etxt of | |
1112 | Left r -> return (return r) | |
1113 | Right (txt, p') -> | |
1114 | if T.null txt | |
1115 | then go p' | |
1116 | else let (safe, unsafe) = T.span (\c -> ord c <= 0xFF) txt | |
1117 | in do yield (B8.pack (T.unpack safe)) | |
1118 | if T.null unsafe | |
1119 | then go p' | |
1120 | else return $ do yield unsafe | |
1121 | p' | |
1122 | ||
167f8805 | 1123 | {- | Reduce a byte stream to a corresponding stream of ascii chars, returning the |
1124 | unused 'ByteString' upon hitting an un-ascii byte. | |
1125 | -} | |
90189414 | 1126 | decodeAscii :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) |
1127 | decodeAscii = go where | |
1128 | go p = do echunk <- lift (next p) | |
1129 | case echunk of | |
1130 | Left r -> return (return r) | |
1131 | Right (chunk, p') -> | |
1132 | if B.null chunk | |
1133 | then go p' | |
1134 | else let (safe, unsafe) = B.span (<= 0x7F) chunk | |
1135 | in do yield (T.pack (B8.unpack safe)) | |
1136 | if B.null unsafe | |
1137 | then go p' | |
1138 | else return $ do yield unsafe | |
1139 | p' | |
1140 | ||
167f8805 | 1141 | {- | Reduce a byte stream to a corresponding stream of ascii chars, returning the |
1142 | unused 'ByteString' upon hitting the rare un-latinizable byte. | |
1143 | -} | |
90189414 | 1144 | decodeIso8859_1 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) |
1145 | decodeIso8859_1 = go where | |
1146 | go p = do echunk <- lift (next p) | |
1147 | case echunk of | |
1148 | Left r -> return (return r) | |
1149 | Right (chunk, p') -> | |
1150 | if B.null chunk | |
1151 | then go p' | |
1152 | else let (safe, unsafe) = B.span (<= 0xFF) chunk | |
1153 | in do yield (T.pack (B8.unpack safe)) | |
1154 | if B.null unsafe | |
1155 | then go p' | |
1156 | else return $ do yield unsafe | |
1157 | p' | |
1158 | ||
1159 | ||
1160 | ||
167f8805 | 1161 | |
c8027236 | 1162 |