git.iko.soy/streamly
on cdccb78 help sign in
streamly/src/Streamly/Internal/Unicode/Stream.hs
920 lines 34 kB history raw
1-- |
2-- Module : Streamly.Internal.Unicode.Stream
3-- Copyright : (c) 2018 Composewell Technologies
4-- (c) Bjoern Hoehrmann 2008-2009
5--
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
9-- Portability : GHC
10--
12#include "inline.hs"
14module Streamly.Internal.Unicode.Stream
15 (
16 -- * Construction (Decoding)
17 decodeLatin1
18 , decodeUtf8
19 , decodeUtf8'
20 , decodeUtf8_
21 , DecodeError(..)
22 , DecodeState
23 , CodePoint
24 , decodeUtf8Either
25 , resumeDecodeUtf8Either
26 , decodeUtf8Arrays
27 , decodeUtf8Arrays'
28 , decodeUtf8Arrays_
30 -- * Elimination (Encoding)
31 , encodeLatin1
32 , encodeLatin1'
33 , encodeLatin1_
34 , encodeUtf8
35 , encodeUtf8'
36 , encodeUtf8_
37 {-
38 -- * Operations on character strings
39 , strip -- (dropAround isSpace)
40 , stripEnd
41 -}
43 -- * StreamD UTF8 Encoding / Decoding transformations.
44 , decodeUtf8D
45 , decodeUtf8D'
46 , decodeUtf8D_
47 , encodeUtf8D
48 , encodeUtf8D'
49 , encodeUtf8D_
50 , decodeUtf8EitherD
51 , resumeDecodeUtf8EitherD
52 , decodeUtf8ArraysD
53 , decodeUtf8ArraysD'
54 , decodeUtf8ArraysD_
56 -- * Transformation
57 , stripStart
58 , lines
59 , words
60 , unlines
61 , unwords
63 -- * Deprecations
64 , decodeUtf8Lax
65 , encodeLatin1Lax
66 , encodeUtf8Lax
67 )
68where
70import Control.Monad.IO.Class (MonadIO, liftIO)
71import Data.Bits (shiftR, shiftL, (.|.), (.&.))
72import Data.Char (chr, ord)
73import Data.Word (Word8)
74import Foreign.ForeignPtr (touchForeignPtr)
75import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
76import Foreign.Storable (Storable(..))
77import Fusion.Plugin.Types (Fuse(..))
78import GHC.Base (assert, unsafeChr)
79import GHC.ForeignPtr (ForeignPtr (..))
80import GHC.IO.Encoding.Failure (isSurrogate)
81import GHC.Ptr (Ptr (..), plusPtr)
82import System.IO.Unsafe (unsafePerformIO)
83import Streamly.Data.Fold (Fold)
84import Streamly.Data.Array.Foreign (Array)
85import Streamly.Internal.Data.Unfold (Unfold)
86import Streamly.Internal.Data.SVar (adaptState)
87import Streamly.Internal.Data.Stream.IsStream (IsStream)
88import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))
89import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
91import qualified Streamly.Internal.Data.Array.Foreign.Types as A
92import qualified Streamly.Internal.Data.Stream.IsStream as S
93import qualified Streamly.Internal.Data.Stream.StreamD as D
95import Prelude hiding (String, lines, words, unlines, unwords)
97-------------------------------------------------------------------------------
98-- Encoding/Decoding Unicode (UTF-8) Characters
99-------------------------------------------------------------------------------
101-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
103data WList = WCons !Word8 !WList | WNil
105{-# INLINE ord2 #-}
106ord2 :: Char -> WList
107ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
108 where
109 n = ord c
110 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
111 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
113{-# INLINE ord3 #-}
114ord3 :: Char -> WList
115ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
116 where
117 n = ord c
118 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
119 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
120 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
122{-# INLINE ord4 #-}
123ord4 :: Char -> WList
124ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
125 where
126 n = ord c
127 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
128 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
129 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
130 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
132data CodingFailureMode
133 = TransliterateCodingFailure
134 | ErrorOnCodingFailure
135 | DropOnCodingFailure
136 deriving (Show)
138{-# INLINE replacementChar #-}
139replacementChar :: Char
140replacementChar = '\xFFFD'
142-- Int helps in cheaper conversion from Int to Char
143type CodePoint = Int
144type DecodeState = Word8
146-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
148-- XXX Use names decodeSuccess = 0, decodeFailure = 12
150decodeTable :: [Word8]
151decodeTable = [
152 -- The first part of the table maps bytes to character classes that
153 -- to reduce the size of the transition table and create bitmasks.
154 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
155 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
156 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
157 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
158 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,
159 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
160 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
161 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,
163 -- The second part is a transition table that maps a combination
164 -- of a state of the automaton and a character class to a state.
165 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
166 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
167 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
168 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
169 12,36,12,12,12,12,12,12,12,12,12,12
170 ]
172{-# NOINLINE utf8d #-}
173utf8d :: A.Array Word8
174utf8d =
175 unsafePerformIO
176 -- Aligning to cacheline makes a barely noticeable difference
177 -- XXX currently alignment is not implemented for unmanaged allocation
178 $ D.foldOnce (A.writeNAlignedUnmanaged 64 (length decodeTable))
179 (D.fromList decodeTable)
181-- | Return element at the specified index without checking the bounds.
182-- and without touching the foreign ptr.
183{-# INLINE_NORMAL unsafePeekElemOff #-}
184unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
185unsafePeekElemOff p i = let !x = A.unsafeInlineIO $ peekElemOff p i in x
187-- decode is split into two separate cases to avoid branching instructions.
188-- From the higher level flow we already know which case we are in so we can
189-- call the appropriate decode function.
190--
191-- When the state is 0
192{-# INLINE decode0 #-}
193decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
194decode0 table byte =
195 let !t = table `unsafePeekElemOff` fromIntegral byte
196 !codep' = (0xff `shiftR` fromIntegral t) .&. fromIntegral byte
197 !state' = table `unsafePeekElemOff` (256 + fromIntegral t)
198 in assert ((byte > 0x7f || error showByte)
199 && (state' /= 0 || error (showByte ++ showTable)))
200 (Tuple' state' codep')
202 where
204 utf8table =
205 let !(Ptr addr) = table
206 end = table `plusPtr` 364
207 in A.Array (ForeignPtr addr undefined) end :: A.Array Word8
208 showByte = "Streamly: decode0: byte: " ++ show byte
209 showTable = " table: " ++ show utf8table
211-- When the state is not 0
212{-# INLINE decode1 #-}
213decode1
214 :: Ptr Word8
215 -> DecodeState
216 -> CodePoint
217 -> Word8
218 -> Tuple' DecodeState CodePoint
219decode1 table state codep byte =
220 -- Remember codep is Int type!
221 -- Can it be unsafe to convert the resulting Int to Char?
222 let !t = table `unsafePeekElemOff` fromIntegral byte
223 !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
224 !state' = table `unsafePeekElemOff`
225 (256 + fromIntegral state + fromIntegral t)
226 in assert (codep' <= 0x10FFFF
227 || error (showByte ++ showState state codep))
228 (Tuple' state' codep')
229 where
231 utf8table =
232 let !(Ptr addr) = table
233 end = table `plusPtr` 364
234 in A.Array (ForeignPtr addr undefined) end :: A.Array Word8
235 showByte = "Streamly: decode1: byte: " ++ show byte
236 showState st cp =
237 " state: " ++ show st ++
238 " codepoint: " ++ show cp ++
239 " table: " ++ show utf8table
241-- We can divide the errors in three general categories:
242-- * A non-starter was encountered in a begin state
243-- * A starter was encountered without completing a codepoint
244-- * The last codepoint was not complete (input underflow)
245--
246-- Need to separate resumable and non-resumable error. In case of non-resumable
247-- error we can also provide the failing byte. In case of resumable error the
248-- state can be opaque.
249--
250data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
252{-# ANN type FreshPoint Fuse #-}
253data FreshPoint s a
254 = FreshPointDecodeInit s
255 | FreshPointDecodeInit1 s Word8
256 | FreshPointDecodeFirst s Word8
257 | FreshPointDecoding s !DecodeState !CodePoint
258 | YieldAndContinue a (FreshPoint s a)
259 | Done
261-- XXX write it as a parser and use parseMany to decode a stream, need to check
262-- if that preserves the same performance. Or we can use a resumable parser
263-- that parses a chunk at a time.
264--
265-- XXX Implement this in terms of decodeUtf8Either. Need to make sure that
266-- decodeUtf8Either preserves the performance characterstics.
267--
268{-# INLINE_NORMAL decodeUtf8WithD #-}
269decodeUtf8WithD :: Monad m
270 => CodingFailureMode -> Stream m Word8 -> Stream m Char
271decodeUtf8WithD cfm (Stream step state) =
272 let A.Array p _ = utf8d
273 !ptr = unsafeForeignPtrToPtr p
274 in Stream (step' ptr) (FreshPointDecodeInit state)
276 where
278 prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "
280 {-# INLINE handleError #-}
281 handleError e s =
282 case cfm of
283 ErrorOnCodingFailure -> error e
284 TransliterateCodingFailure -> YieldAndContinue replacementChar s
285 DropOnCodingFailure -> s
287 {-# INLINE handleUnderflow #-}
288 handleUnderflow =
289 case cfm of
290 ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"
291 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
292 DropOnCodingFailure -> Done
294 {-# INLINE_LATE step' #-}
295 step' _ gst (FreshPointDecodeInit st) = do
296 r <- step (adaptState gst) st
297 return $ case r of
298 Yield x s -> Skip (FreshPointDecodeInit1 s x)
299 Skip s -> Skip (FreshPointDecodeInit s)
300 Stop -> Skip Done
302 step' _ _ (FreshPointDecodeInit1 st x) = do
303 -- Note: It is important to use a ">" instead of a "<=" test
304 -- here for GHC to generate code layout for default branch
305 -- prediction for the common case. This is fragile and might
306 -- change with the compiler versions, we need a more reliable
307 -- "likely" primitive to control branch predication.
308 case x > 0x7f of
309 False ->
310 return $ Skip $ YieldAndContinue
311 (unsafeChr (fromIntegral x))
312 (FreshPointDecodeInit st)
313 -- Using a separate state here generates a jump to a
314 -- separate code block in the core which seems to perform
315 -- slightly better for the non-ascii case.
316 True -> return $ Skip $ FreshPointDecodeFirst st x
318 -- XXX should we merge it with FreshPointDecodeInit1?
319 step' table _ (FreshPointDecodeFirst st x) = do
320 let (Tuple' sv cp) = decode0 table x
321 return $
322 case sv of
323 12 ->
324 let msg = prefix ++ "Invalid first UTF8 byte " ++ show x
325 in Skip $ handleError msg (FreshPointDecodeInit st)
326 0 -> error "unreachable state"
327 _ -> Skip (FreshPointDecoding st sv cp)
329 -- We recover by trying the new byte x as a starter of a new codepoint.
330 -- XXX need to use the same recovery in array decoding routine as well
331 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
332 r <- step (adaptState gst) st
333 case r of
334 Yield x s -> do
335 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
336 return $ case sv of
337 0 -> Skip $ YieldAndContinue
338 (unsafeChr cp) (FreshPointDecodeInit s)
339 12 ->
340 let msg = prefix
341 ++ "Invalid subsequent UTF8 byte "
342 ++ show x
343 ++ " in state "
344 ++ show statePtr
345 ++ " accumulated value "
346 ++ show codepointPtr
347 in Skip $ handleError msg (FreshPointDecodeInit1 s x)
348 _ -> Skip (FreshPointDecoding s sv cp)
349 Skip s -> return $
350 Skip (FreshPointDecoding s statePtr codepointPtr)
351 Stop -> return $ Skip handleUnderflow
353 step' _ _ (YieldAndContinue c s) = return $ Yield c s
354 step' _ _ Done = return Stop
356{-# INLINE decodeUtf8D #-}
357decodeUtf8D :: Monad m => Stream m Word8 -> Stream m Char
358decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure
360{-# INLINE decodeUtf8D' #-}
361decodeUtf8D' :: Monad m => Stream m Word8 -> Stream m Char
362decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure
364{-# INLINE decodeUtf8D_ #-}
365decodeUtf8D_ :: Monad m => Stream m Word8 -> Stream m Char
366decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure
368{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
369resumeDecodeUtf8EitherD
370 :: Monad m
371 => DecodeState
372 -> CodePoint
373 -> Stream m Word8
374 -> Stream m (Either DecodeError Char)
375resumeDecodeUtf8EitherD dst codep (Stream step state) =
376 let A.Array p _ = utf8d
377 !ptr = unsafeForeignPtrToPtr p
378 stt =
379 if dst == 0
380 then FreshPointDecodeInit state
381 else FreshPointDecoding state dst codep
382 in Stream (step' ptr) stt
383 where
384 {-# INLINE_LATE step' #-}
385 step' _ gst (FreshPointDecodeInit st) = do
386 r <- step (adaptState gst) st
387 return $ case r of
388 Yield x s -> Skip (FreshPointDecodeInit1 s x)
389 Skip s -> Skip (FreshPointDecodeInit s)
390 Stop -> Skip Done
392 step' _ _ (FreshPointDecodeInit1 st x) = do
393 -- Note: It is important to use a ">" instead of a "<=" test
394 -- here for GHC to generate code layout for default branch
395 -- prediction for the common case. This is fragile and might
396 -- change with the compiler versions, we need a more reliable
397 -- "likely" primitive to control branch predication.
398 case x > 0x7f of
399 False ->
400 return $ Skip $ YieldAndContinue
401 (Right $ unsafeChr (fromIntegral x))
402 (FreshPointDecodeInit st)
403 -- Using a separate state here generates a jump to a
404 -- separate code block in the core which seems to perform
405 -- slightly better for the non-ascii case.
406 True -> return $ Skip $ FreshPointDecodeFirst st x
408 -- XXX should we merge it with FreshPointDecodeInit1?
409 step' table _ (FreshPointDecodeFirst st x) = do
410 let (Tuple' sv cp) = decode0 table x
411 return $
412 case sv of
413 12 ->
414 Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))
415 (FreshPointDecodeInit st)
416 0 -> error "unreachable state"
417 _ -> Skip (FreshPointDecoding st sv cp)
419 -- We recover by trying the new byte x a starter of a new codepoint.
420 -- XXX on error need to report the next byte "x" as well.
421 -- XXX need to use the same recovery in array decoding routine as well
422 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
423 r <- step (adaptState gst) st
424 case r of
425 Yield x s -> do
426 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
427 return $
428 case sv of
429 0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)
430 (FreshPointDecodeInit s)
431 12 ->
432 Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)
433 (FreshPointDecodeInit1 s x)
434 _ -> Skip (FreshPointDecoding s sv cp)
435 Skip s -> return $ Skip (FreshPointDecoding s statePtr codepointPtr)
436 Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done
438 step' _ _ (YieldAndContinue c s) = return $ Yield c s
439 step' _ _ Done = return Stop
441{-# INLINE_NORMAL decodeUtf8EitherD #-}
442decodeUtf8EitherD :: Monad m
443 => Stream m Word8 -> Stream m (Either DecodeError Char)
444decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0
446{-# ANN type FlattenState Fuse #-}
447data FlattenState s a
448 = OuterLoop s !(Maybe (DecodeState, CodePoint))
449 | InnerLoopDecodeInit s (ForeignPtr a) !(Ptr a) !(Ptr a)
450 | InnerLoopDecodeFirst s (ForeignPtr a) !(Ptr a) !(Ptr a) Word8
451 | InnerLoopDecoding s (ForeignPtr a) !(Ptr a) !(Ptr a)
452 !DecodeState !CodePoint
453 | YAndC !Char (FlattenState s a) -- These constructors can be
454 -- encoded in the FreshPoint
455 -- type, I prefer to keep these
456 -- flat even though that means
457 -- coming up with new names
458 | D
460-- The normal decodeUtf8 above should fuse with flattenArrays
461-- to create this exact code but it doesn't for some reason, as of now this
462-- remains the fastest way I could figure out to decodeUtf8.
463--
464-- XXX Add Proper error messages
465{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
466decodeUtf8ArraysWithD ::
467 MonadIO m
468 => CodingFailureMode
469 -> Stream m (A.Array Word8)
470 -> Stream m Char
471decodeUtf8ArraysWithD cfm (Stream step state) =
472 let A.Array p _ = utf8d
473 !ptr = unsafeForeignPtrToPtr p
474 in Stream (step' ptr) (OuterLoop state Nothing)
475 where
476 {-# INLINE transliterateOrError #-}
477 transliterateOrError e s =
478 case cfm of
479 ErrorOnCodingFailure -> error e
480 TransliterateCodingFailure -> YAndC replacementChar s
481 DropOnCodingFailure -> s
482 {-# INLINE inputUnderflow #-}
483 inputUnderflow =
484 case cfm of
485 ErrorOnCodingFailure ->
486 error
487 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Input Underflow"
488 TransliterateCodingFailure -> YAndC replacementChar D
489 DropOnCodingFailure -> D
490 {-# INLINE_LATE step' #-}
491 step' _ gst (OuterLoop st Nothing) = do
492 r <- step (adaptState gst) st
493 return $
494 case r of
495 Yield A.Array {..} s ->
496 let p = unsafeForeignPtrToPtr aStart
497 in Skip (InnerLoopDecodeInit s aStart p aEnd)
498 Skip s -> Skip (OuterLoop s Nothing)
499 Stop -> Skip D
500 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do
501 r <- step (adaptState gst) st
502 return $
503 case r of
504 Yield A.Array {..} s ->
505 let p = unsafeForeignPtrToPtr aStart
506 in Skip (InnerLoopDecoding s aStart p aEnd ds cp)
507 Skip s -> Skip (OuterLoop s dst)
508 Stop -> Skip inputUnderflow
509 step' _ _ (InnerLoopDecodeInit st startf p end)
510 | p == end = do
511 liftIO $ touchForeignPtr startf
512 return $ Skip $ OuterLoop st Nothing
513 step' _ _ (InnerLoopDecodeInit st startf p end) = do
514 x <- liftIO $ peek p
515 -- Note: It is important to use a ">" instead of a "<=" test here for
516 -- GHC to generate code layout for default branch prediction for the
517 -- common case. This is fragile and might change with the compiler
518 -- versions, we need a more reliable "likely" primitive to control
519 -- branch predication.
520 case x > 0x7f of
521 False ->
522 return $ Skip $ YAndC
523 (unsafeChr (fromIntegral x))
524 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
525 -- Using a separate state here generates a jump to a separate code
526 -- block in the core which seems to perform slightly better for the
527 -- non-ascii case.
528 True -> return $ Skip $ InnerLoopDecodeFirst st startf p end x
530 step' table _ (InnerLoopDecodeFirst st startf p end x) = do
531 let (Tuple' sv cp) = decode0 table x
532 return $
533 case sv of
534 12 ->
535 Skip $
536 transliterateOrError
537 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
538 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
539 0 -> error "unreachable state"
540 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
541 step' _ _ (InnerLoopDecoding st startf p end sv cp)
542 | p == end = do
543 liftIO $ touchForeignPtr startf
544 return $ Skip $ OuterLoop st (Just (sv, cp))
545 step' table _ (InnerLoopDecoding st startf p end statePtr codepointPtr) = do
546 x <- liftIO $ peek p
547 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
548 return $
549 case sv of
550 0 ->
551 Skip $
552 YAndC
553 (unsafeChr cp)
554 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
555 12 ->
556 Skip $
557 transliterateOrError
558 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
559 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
560 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
561 step' _ _ (YAndC c s) = return $ Yield c s
562 step' _ _ D = return Stop
564{-# INLINE decodeUtf8ArraysD #-}
565decodeUtf8ArraysD ::
566 MonadIO m
567 => Stream m (A.Array Word8)
568 -> Stream m Char
569decodeUtf8ArraysD = decodeUtf8ArraysWithD TransliterateCodingFailure
571{-# INLINE decodeUtf8ArraysD' #-}
572decodeUtf8ArraysD' ::
573 MonadIO m
574 => Stream m (A.Array Word8)
575 -> Stream m Char
576decodeUtf8ArraysD' = decodeUtf8ArraysWithD ErrorOnCodingFailure
578{-# INLINE decodeUtf8ArraysD_ #-}
579decodeUtf8ArraysD_ ::
580 MonadIO m
581 => Stream m (A.Array Word8)
582 -> Stream m Char
583decodeUtf8ArraysD_ = decodeUtf8ArraysWithD DropOnCodingFailure
585{-# ANN type EncodeState Fuse #-}
586data EncodeState s = EncodeState s !WList
588-- More yield points improve performance, but I am not sure if they can cause
589-- too much code bloat or some trouble with fusion. So keeping only two yield
590-- points for now, one for the ascii chars (fast path) and one for all other
591-- paths (slow path).
592{-# INLINE_NORMAL encodeUtf8D' #-}
593encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8
594encodeUtf8D' (Stream step state) = Stream step' (EncodeState state WNil)
595 where
596 {-# INLINE_LATE step' #-}
597 step' gst (EncodeState st WNil) = do
598 r <- step (adaptState gst) st
599 return $
600 case r of
601 Yield c s ->
602 case ord c of
603 x
604 | x <= 0x7F ->
605 Yield (fromIntegral x) (EncodeState s WNil)
606 | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
607 | x <= 0xFFFF ->
608 if isSurrogate c
609 then error
610 "Streamly.Internal.Data.Stream.StreamD.encodeUtf8: Encountered a surrogate"
611 else Skip (EncodeState s (ord3 c))
612 | otherwise -> Skip (EncodeState s (ord4 c))
613 Skip s -> Skip (EncodeState s WNil)
614 Stop -> Stop
615 step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
618-- | Decode a stream of bytes to Unicode characters by mapping each byte to a
619-- corresponding Unicode 'Char' in 0-255 range.
620--
621-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
622--
623-- @since 0.8.0
624{-# INLINE decodeLatin1 #-}
625decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char
626decodeLatin1 = S.map (unsafeChr . fromIntegral)
628-- | Encode a stream of Unicode characters to bytes by mapping each character
629-- to a byte in 0-255 range. Throws an error if the input stream contains
630-- characters beyond 255.
631--
632-- @since 0.8.0
633{-# INLINE encodeLatin1' #-}
634encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8
635encodeLatin1' = S.map convert
636 where
637 convert c =
638 let codepoint = ord c
639 in if codepoint > 255
640 then error $ "Streamly.String.encodeLatin1 invalid " ++
641 "input char codepoint " ++ show codepoint
642 else fromIntegral codepoint
644-- | Like 'encodeLatin1'' but silently truncates and maps input characters beyond
645-- 255 to (incorrect) chars in 0-255 range. No error or exception is thrown
646-- when such truncation occurs.
647--
648-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
649--
650-- /Since: 0.8.0 (Lenient Behaviour)/
651{-# INLINE encodeLatin1 #-}
652encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8
653encodeLatin1 = S.map (fromIntegral . ord)
655-- | Like 'encodeLatin1' but drops the input characters beyond 255.
656--
657-- @since 0.8.0
658{-# INLINE encodeLatin1_ #-}
659encodeLatin1_ :: (IsStream t, Monad m) => t m Char -> t m Word8
660encodeLatin1_ = S.map (fromIntegral . ord) . S.filter (<= chr (255))
662-- | Same as 'encodeLatin1'
663--
664{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}
665{-# INLINE encodeLatin1Lax #-}
666encodeLatin1Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
667encodeLatin1Lax = encodeLatin1
669-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
670-- The function throws an error if an invalid codepoint is encountered.
671--
672-- @since 0.8.0
673{-# INLINE decodeUtf8' #-}
674decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char
675decodeUtf8' = D.fromStreamD . decodeUtf8D' . D.toStreamD
677-- |
678--
679-- /Internal/
680{-# INLINE decodeUtf8Arrays' #-}
681decodeUtf8Arrays' :: (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
682decodeUtf8Arrays' = D.fromStreamD . decodeUtf8ArraysD' . D.toStreamD
684-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
685-- Any invalid codepoint encountered is replaced with the unicode replacement
686-- character.
687--
688-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
689--
690-- /Since: 0.8.0 (Lenient Behaviour)/
691{-# INLINE decodeUtf8 #-}
692decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char
693decodeUtf8 = D.fromStreamD . decodeUtf8D . D.toStreamD
695-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
696-- Any invalid codepoint encountered is dropped.
697--
698-- @since 0.8.0
699{-# INLINE decodeUtf8_ #-}
700decodeUtf8_ :: (Monad m, IsStream t) => t m Word8 -> t m Char
701decodeUtf8_ = D.fromStreamD . decodeUtf8D_ . D.toStreamD
703-- | Same as 'decodeUtf8'
704--
705{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}
706{-# INLINE decodeUtf8Lax #-}
707decodeUtf8Lax :: (IsStream t, Monad m) => t m Word8 -> t m Char
708decodeUtf8Lax = decodeUtf8
710-- |
711--
712-- /Internal/
713{-# INLINE decodeUtf8Either #-}
714decodeUtf8Either :: (Monad m, IsStream t)
715 => t m Word8 -> t m (Either DecodeError Char)
716decodeUtf8Either = D.fromStreamD . decodeUtf8EitherD . D.toStreamD
718-- |
719--
720-- /Internal/
721{-# INLINE resumeDecodeUtf8Either #-}
722resumeDecodeUtf8Either
723 :: (Monad m, IsStream t)
724 => DecodeState
725 -> CodePoint
726 -> t m Word8
727 -> t m (Either DecodeError Char)
728resumeDecodeUtf8Either st cp =
729 D.fromStreamD . resumeDecodeUtf8EitherD st cp . D.toStreamD
731-- |
732--
733-- /Internal/
734{-# INLINE decodeUtf8Arrays #-}
735decodeUtf8Arrays ::
736 (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
737decodeUtf8Arrays =
738 D.fromStreamD . decodeUtf8ArraysD . D.toStreamD
740-- |
741--
742-- /Internal/
743{-# INLINE decodeUtf8Arrays_ #-}
744decodeUtf8Arrays_ ::
745 (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
746decodeUtf8Arrays_ =
747 D.fromStreamD . decodeUtf8ArraysD_ . D.toStreamD
749-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
750-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
751-- function errors out.
752--
753-- @since 0.8.0
754{-# INLINE encodeUtf8' #-}
755encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
756encodeUtf8' = D.fromStreamD . encodeUtf8D' . D.toStreamD
758-- | See section "3.9 Unicode Encoding Forms" in
759-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
760--
761{-# INLINE_NORMAL encodeUtf8D #-}
762encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
763encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)
764 where
765 {-# INLINE_LATE step' #-}
766 step' gst (EncodeState st WNil) = do
767 r <- step (adaptState gst) st
768 return $
769 case r of
770 Yield c s ->
771 case ord c of
772 x | x <= 0x7F ->
773 Yield (fromIntegral x) (EncodeState s WNil)
774 | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
775 | x <= 0xFFFF ->
776 if isSurrogate c
777 then Skip $
778 EncodeState
779 s
780 (WCons 239 (WCons 191 (WCons 189 WNil)))
781 else Skip (EncodeState s (ord3 c))
782 | otherwise -> Skip (EncodeState s (ord4 c))
783 Skip s -> Skip (EncodeState s WNil)
784 Stop -> Stop
785 step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
788-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
789-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
790-- Unicode replacement character U+FFFD.
791--
792-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
793--
794-- /Since: 0.8.0 (Lenient Behaviour)/
795{-# INLINE encodeUtf8 #-}
796encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
797encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD
799{-# INLINE_NORMAL encodeUtf8D_ #-}
800encodeUtf8D_ :: Monad m => Stream m Char -> Stream m Word8
801encodeUtf8D_ (Stream step state) = Stream step' (EncodeState state WNil)
802 where
803 {-# INLINE_LATE step' #-}
804 step' gst (EncodeState st WNil) = do
805 r <- step (adaptState gst) st
806 return $
807 case r of
808 Yield c s ->
809 case ord c of
810 x | x <= 0x7F ->
811 Yield (fromIntegral x) (EncodeState s WNil)
812 | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
813 | x <= 0xFFFF ->
814 if isSurrogate c
815 then Skip $
816 EncodeState s WNil
817 else Skip (EncodeState s (ord3 c))
818 | otherwise -> Skip (EncodeState s (ord4 c))
819 Skip s -> Skip (EncodeState s WNil)
820 Stop -> Stop
821 step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
823-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
824-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.
825--
826-- @since 0.8.0
827{-# INLINE encodeUtf8_ #-}
828encodeUtf8_ :: (Monad m, IsStream t) => t m Char -> t m Word8
829encodeUtf8_ = D.fromStreamD . encodeUtf8D_ . D.toStreamD
831-- | Same as 'encodeUtf8'
832--
833{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}
834{-# INLINE encodeUtf8Lax #-}
835encodeUtf8Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
836encodeUtf8Lax = encodeUtf8
838{-
839-------------------------------------------------------------------------------
840-- Utility operations on strings
841-------------------------------------------------------------------------------
843strip :: IsStream t => t m Char -> t m Char
844strip = undefined
846stripEnd :: IsStream t => t m Char -> t m Char
847stripEnd = undefined
848-}
850-- | Remove leading whitespace from a string.
851--
852-- > stripStart = S.dropWhile isSpace
853--
854-- /Internal/
855{-# INLINE stripStart #-}
856stripStart :: (Monad m, IsStream t) => t m Char -> t m Char
857stripStart = S.dropWhile isSpace
859-- | Fold each line of the stream using the supplied 'Fold'
860-- and stream the result.
861--
862-- >>> S.toList $ lines FL.toList (S.fromList "lines\nthis\nstring\n\n\n")
863-- ["lines", "this", "string", "", ""]
864--
865-- > lines = S.splitOnSuffix (== '\n')
866--
867-- /Internal/
868{-# INLINE lines #-}
869lines :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
870lines = S.splitOnSuffix (== '\n')
872foreign import ccall unsafe "u_iswspace"
873 iswspace :: Int -> Int
875-- | Code copied from base/Data.Char to INLINE it
876{-# INLINE isSpace #-}
877isSpace :: Char -> Bool
878isSpace c
879 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
880 | otherwise = iswspace (ord c) /= 0
881 where
882 uc = fromIntegral (ord c) :: Word
884-- | Fold each word of the stream using the supplied 'Fold'
885-- and stream the result.
886--
887-- >>> S.toList $ words FL.toList (S.fromList "fold these words")
888-- ["fold", "these", "words"]
889--
890-- > words = S.wordsBy isSpace
891--
892-- /Internal/
893{-# INLINE words #-}
894words :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
895words = S.wordsBy isSpace
897-- | Unfold a stream to character streams using the supplied 'Unfold'
898-- and concat the results suffixing a newline character @\\n@ to each stream.
899--
900-- @
901-- unlines = Stream.interposeSuffix '\n'
902-- @
903--
904-- /Internal/
905{-# INLINE unlines #-}
906unlines :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
907unlines = S.interposeSuffix '\n'
909-- | Unfold the elements of a stream to character streams using the supplied
910-- 'Unfold' and concat the results with a whitespace character infixed between
911-- the streams.
912--
913-- @
914-- unwords = Stream.interpose ' '
915-- @
916--
917-- /Internal/
918{-# INLINE unwords #-}
919unwords :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
920unwords = S.interpose ' '