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