2-- Module : Streamly.Internal.Unicode.Stream
3-- Copyright : (c) 2018 Composewell Technologies
4-- (c) Bjoern Hoehrmann 2008-2009
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
12module Streamly.Internal.Unicode.Stream
14 -- * Construction (Decoding)
22 -- ** Resumable UTF-8 Decoding
27 , resumeDecodeUtf8Either
29 -- ** UTF-8 Array Stream Decoding
34 -- * Elimination (Encoding)
47 -- * Operations on character strings
48 , strip -- (dropAround isSpace)
59 -- * StreamD UTF8 Encoding / Decoding transformations.
67 , resumeDecodeUtf8EitherD
81import Control.Monad.IO.Class (MonadIO, liftIO)
82import Data.Bits (shiftR, shiftL, (.|.), (.&.))
83import Data.Char (chr, ord)
84import Data.Word (Word8)
85import Foreign.Storable (Storable(..))
86import Fusion.Plugin.Types (Fuse(..))
87import GHC.Base (assert, unsafeChr)
88import GHC.IO.Encoding.Failure (isSurrogate)
89import GHC.Ptr (Ptr (..), plusPtr)
90import System.IO.Unsafe (unsafePerformIO)
91import Streamly.Internal.Data.Array.Foreign (Array)
92import Streamly.Internal.Data.Array.Foreign.Mut.Type (ArrayContents, touch)
93import Streamly.Internal.Data.Fold (Fold)
94import Streamly.Internal.Data.Stream.IsStream.Type
95 (IsStream, fromStreamD, toStreamD, adapt)
96import Streamly.Internal.Data.Stream.Serial (SerialT)
97import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))
98import Streamly.Internal.Data.SVar (adaptState)
99import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
100import Streamly.Internal.Data.Unfold.Type (Unfold(..))
101import Streamly.Internal.System.IO (unsafeInlineIO)
103import qualified Streamly.Internal.Data.Unfold as Unfold
104import qualified Streamly.Internal.Data.Stream.Serial as Serial
105import qualified Streamly.Internal.Data.Array.Foreign as Array
106import qualified Streamly.Internal.Data.Array.Foreign.Type as A
107import qualified Streamly.Internal.Data.Stream.IsStream as S
108import qualified Streamly.Internal.Data.Stream.StreamD as D
110import Prelude hiding (lines, words, unlines, unwords)
114-- >>> import Prelude hiding (lines, words, unlines, unwords)
115-- >>> import qualified Streamly.Prelude as Stream
116-- >>> import qualified Streamly.Data.Fold as Fold
117-- >>> import Streamly.Internal.Unicode.Stream
119-------------------------------------------------------------------------------
121-------------------------------------------------------------------------------
123-- | Decode a stream of bytes to Unicode characters by mapping each byte to a
124-- corresponding Unicode 'Char' in 0-255 range.
126-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
129{-# INLINE decodeLatin1 #-}
130decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char
131decodeLatin1 = S.map (unsafeChr . fromIntegral)
133-------------------------------------------------------------------------------
135-------------------------------------------------------------------------------
137-- | Encode a stream of Unicode characters to bytes by mapping each character
138-- to a byte in 0-255 range. Throws an error if the input stream contains
139-- characters beyond 255.
142{-# INLINE encodeLatin1' #-}
143encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8
144encodeLatin1' = S.map convert
147 let codepoint = ord c
148 in if codepoint > 255
149 then error $ "Streamly.Unicode.encodeLatin1 invalid " ++
150 "input char codepoint " ++ show codepoint
151 else fromIntegral codepoint
153-- XXX Should we instead replace the invalid chars by NUL or whitespace or some
154-- other control char? That may affect the perf a bit but may be a better
157-- | Like 'encodeLatin1'' but silently maps input codepoints beyond 255 to
158-- arbitrary Latin1 chars in 0-255 range. No error or exception is thrown when
159-- such mapping occurs.
161-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
163-- /Since: 0.8.0 (Lenient Behaviour)/
164{-# INLINE encodeLatin1 #-}
165encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8
166encodeLatin1 = S.map (fromIntegral . ord)
168-- | Like 'encodeLatin1' but drops the input characters beyond 255.
171{-# INLINE encodeLatin1_ #-}
172encodeLatin1_ :: (IsStream t, Monad m) => t m Char -> t m Word8
173encodeLatin1_ = S.map (fromIntegral . ord) . S.filter (<= chr 255)
175-- | Same as 'encodeLatin1'
177{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}
178{-# INLINE encodeLatin1Lax #-}
179encodeLatin1Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
180encodeLatin1Lax = encodeLatin1
182-------------------------------------------------------------------------------
184-------------------------------------------------------------------------------
186-- Int helps in cheaper conversion from Int to Char
188type DecodeState = Word8
190-- We can divide the errors in three general categories:
191-- * A non-starter was encountered in a begin state
192-- * A starter was encountered without completing a codepoint
193-- * The last codepoint was not complete (input underflow)
195-- Need to separate resumable and non-resumable error. In case of non-resumable
196-- error we can also provide the failing byte. In case of resumable error the
197-- state can be opaque.
199data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
201-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
203-- XXX Use names decodeSuccess = 0, decodeFailure = 12
205decodeTable :: [Word8]
207 -- The first part of the table maps bytes to character classes that
208 -- to reduce the size of the transition table and create bitmasks.
209 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,
210 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,
211 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,
212 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,
213 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,
214 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,
215 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,
216 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,
218 -- The second part is a transition table that maps a combination
219 -- of a state of the automaton and a character class to a state.
220 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
221 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
222 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
223 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
224 12,36,12,12,12,12,12,12,12,12,12,12
227{-# NOINLINE utf8d #-}
228utf8d :: A.Array Word8
231 -- Aligning to cacheline makes a barely noticeable difference
232 -- XXX currently alignment is not implemented for unmanaged allocation
233 $ D.fold (A.writeNAlignedUnmanaged 64 (length decodeTable))
234 (D.fromList decodeTable)
236-- | Return element at the specified index without checking the bounds.
237-- and without touching the foreign ptr.
238{-# INLINE_NORMAL unsafePeekElemOff #-}
239unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
240unsafePeekElemOff p i = let !x = unsafeInlineIO $ peekElemOff p i in x
242-- decode is split into two separate cases to avoid branching instructions.
243-- From the higher level flow we already know which case we are in so we can
244-- call the appropriate decode function.
246-- When the state is 0
247{-# INLINE decode0 #-}
248decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
250 let !t = table `unsafePeekElemOff` fromIntegral byte
251 !codep' = (0xff `shiftR` fromIntegral t) .&. fromIntegral byte
252 !state' = table `unsafePeekElemOff` (256 + fromIntegral t)
253 in assert ((byte > 0x7f || error showByte)
254 && (state' /= 0 || error (showByte ++ showTable)))
255 (Tuple' state' codep')
260 let end = table `plusPtr` 364
261 in A.Array undefined table end :: A.Array Word8
262 showByte = "Streamly: decode0: byte: " ++ show byte
263 showTable = " table: " ++ show utf8table
265-- When the state is not 0
266{-# INLINE decode1 #-}
272 -> Tuple' DecodeState CodePoint
273decode1 table state codep byte =
274 -- Remember codep is Int type!
275 -- Can it be unsafe to convert the resulting Int to Char?
276 let !t = table `unsafePeekElemOff` fromIntegral byte
277 !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
278 !state' = table `unsafePeekElemOff`
279 (256 + fromIntegral state + fromIntegral t)
280 in assert (codep' <= 0x10FFFF
281 || error (showByte ++ showState state codep))
282 (Tuple' state' codep')
286 let end = table `plusPtr` 364
287 in A.Array undefined table end :: A.Array Word8
288 showByte = "Streamly: decode1: byte: " ++ show byte
290 " state: " ++ show st ++
291 " codepoint: " ++ show cp ++
292 " table: " ++ show utf8table
294-------------------------------------------------------------------------------
295-- Resumable UTF-8 decoding
296-------------------------------------------------------------------------------
298-- Strangely, GHCJS hangs linking template-haskell with this
300{-# ANN type UTF8DecodeState Fuse #-}
302data UTF8DecodeState s a
304 | UTF8DecodeInit1 s Word8
305 | UTF8DecodeFirst s Word8
306 | UTF8Decoding s !DecodeState !CodePoint
307 | YieldAndContinue a (UTF8DecodeState s a)
310{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
311resumeDecodeUtf8EitherD
316 -> Stream m (Either DecodeError Char)
317resumeDecodeUtf8EitherD dst codep (Stream step state) =
318 let A.Array _ p _ = utf8d
322 then UTF8DecodeInit state
323 else UTF8Decoding state dst codep
324 in Stream (step' ptr) stt
326 {-# INLINE_LATE step' #-}
327 step' _ gst (UTF8DecodeInit st) = do
328 r <- step (adaptState gst) st
330 Yield x s -> Skip (UTF8DecodeInit1 s x)
331 Skip s -> Skip (UTF8DecodeInit s)
334 step' _ _ (UTF8DecodeInit1 st x) = do
335 -- Note: It is important to use a ">" instead of a "<=" test
336 -- here for GHC to generate code layout for default branch
337 -- prediction for the common case. This is fragile and might
338 -- change with the compiler versions, we need a more reliable
339 -- "likely" primitive to control branch predication.
342 return $ Skip $ YieldAndContinue
343 (Right $ unsafeChr (fromIntegral x))
345 -- Using a separate state here generates a jump to a
346 -- separate code block in the core which seems to perform
347 -- slightly better for the non-ascii case.
348 True -> return $ Skip $ UTF8DecodeFirst st x
350 -- XXX should we merge it with UTF8DecodeInit1?
351 step' table _ (UTF8DecodeFirst st x) = do
352 let (Tuple' sv cp) = decode0 table x
356 Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))
358 0 -> error "unreachable state"
359 _ -> Skip (UTF8Decoding st sv cp)
361 -- We recover by trying the new byte x a starter of a new codepoint.
362 -- XXX on error need to report the next byte "x" as well.
363 -- XXX need to use the same recovery in array decoding routine as well
364 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
365 r <- step (adaptState gst) st
368 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
371 0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)
374 Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)
375 (UTF8DecodeInit1 s x)
376 _ -> Skip (UTF8Decoding s sv cp)
377 Skip s -> return $ Skip (UTF8Decoding s statePtr codepointPtr)
378 Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done
380 step' _ _ (YieldAndContinue c s) = return $ Yield c s
381 step' _ _ Done = return Stop
383-- XXX We can use just one API, and define InitState = 0 and InitCodePoint = 0
384-- to use as starting state.
386{-# INLINE_NORMAL decodeUtf8EitherD #-}
387decodeUtf8EitherD :: Monad m
388 => Stream m Word8 -> Stream m (Either DecodeError Char)
389decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0
394{-# INLINE decodeUtf8Either #-}
395decodeUtf8Either :: (Monad m, IsStream t)
396 => t m Word8 -> t m (Either DecodeError Char)
397decodeUtf8Either = fromStreamD . decodeUtf8EitherD . toStreamD
402{-# INLINE resumeDecodeUtf8Either #-}
403resumeDecodeUtf8Either
404 :: (Monad m, IsStream t)
408 -> t m (Either DecodeError Char)
409resumeDecodeUtf8Either st cp =
410 fromStreamD . resumeDecodeUtf8EitherD st cp . toStreamD
412-------------------------------------------------------------------------------
414-------------------------------------------------------------------------------
416data CodingFailureMode
417 = TransliterateCodingFailure
418 | ErrorOnCodingFailure
419 | DropOnCodingFailure
422{-# INLINE replacementChar #-}
423replacementChar :: Char
424replacementChar = '\xFFFD'
426-- XXX write it as a parser and use parseMany to decode a stream, need to check
427-- if that preserves the same performance. Or we can use a resumable parser
428-- that parses a chunk at a time.
430-- XXX Implement this in terms of decodeUtf8Either. Need to make sure that
431-- decodeUtf8Either preserves the performance characterstics.
433{-# INLINE_NORMAL decodeUtf8WithD #-}
434decodeUtf8WithD :: Monad m
435 => CodingFailureMode -> Stream m Word8 -> Stream m Char
436decodeUtf8WithD cfm (Stream step state) =
437 let A.Array _ ptr _ = utf8d
438 in Stream (step' ptr) (UTF8DecodeInit state)
442 prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "
444 {-# INLINE handleError #-}
447 ErrorOnCodingFailure -> error e
448 TransliterateCodingFailure -> YieldAndContinue replacementChar s
449 DropOnCodingFailure -> s
451 {-# INLINE handleUnderflow #-}
454 ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"
455 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
456 DropOnCodingFailure -> Done
458 {-# INLINE_LATE step' #-}
459 step' _ gst (UTF8DecodeInit st) = do
460 r <- step (adaptState gst) st
462 Yield x s -> Skip (UTF8DecodeInit1 s x)
463 Skip s -> Skip (UTF8DecodeInit s)
466 step' _ _ (UTF8DecodeInit1 st x) = do
467 -- Note: It is important to use a ">" instead of a "<=" test
468 -- here for GHC to generate code layout for default branch
469 -- prediction for the common case. This is fragile and might
470 -- change with the compiler versions, we need a more reliable
471 -- "likely" primitive to control branch predication.
474 return $ Skip $ YieldAndContinue
475 (unsafeChr (fromIntegral x))
477 -- Using a separate state here generates a jump to a
478 -- separate code block in the core which seems to perform
479 -- slightly better for the non-ascii case.
480 True -> return $ Skip $ UTF8DecodeFirst st x
482 -- XXX should we merge it with UTF8DecodeInit1?
483 step' table _ (UTF8DecodeFirst st x) = do
484 let (Tuple' sv cp) = decode0 table x
488 let msg = prefix ++ "Invalid first UTF8 byte " ++ show x
489 in Skip $ handleError msg (UTF8DecodeInit st)
490 0 -> error "unreachable state"
491 _ -> Skip (UTF8Decoding st sv cp)
493 -- We recover by trying the new byte x as a starter of a new codepoint.
494 -- XXX need to use the same recovery in array decoding routine as well
495 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
496 r <- step (adaptState gst) st
499 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
501 0 -> Skip $ YieldAndContinue
502 (unsafeChr cp) (UTF8DecodeInit s)
505 ++ "Invalid subsequent UTF8 byte "
509 ++ " accumulated value "
511 in Skip $ handleError msg (UTF8DecodeInit1 s x)
512 _ -> Skip (UTF8Decoding s sv cp)
514 Skip (UTF8Decoding s statePtr codepointPtr)
515 Stop -> return $ Skip handleUnderflow
517 step' _ _ (YieldAndContinue c s) = return $ Yield c s
518 step' _ _ Done = return Stop
520{-# INLINE decodeUtf8D #-}
521decodeUtf8D :: Monad m => Stream m Word8 -> Stream m Char
522decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure
524-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
525-- Any invalid codepoint encountered is replaced with the unicode replacement
528-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
530-- /Since: 0.8.0 (Lenient Behaviour)/
531{-# INLINE decodeUtf8 #-}
532decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char
533decodeUtf8 = fromStreamD . decodeUtf8D . toStreamD
535{-# INLINE decodeUtf8D' #-}
536decodeUtf8D' :: Monad m => Stream m Word8 -> Stream m Char
537decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure
539-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
540-- The function throws an error if an invalid codepoint is encountered.
543{-# INLINE decodeUtf8' #-}
544decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char
545decodeUtf8' = fromStreamD . decodeUtf8D' . toStreamD
547{-# INLINE decodeUtf8D_ #-}
548decodeUtf8D_ :: Monad m => Stream m Word8 -> Stream m Char
549decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure
551-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
552-- Any invalid codepoint encountered is dropped.
555{-# INLINE decodeUtf8_ #-}
556decodeUtf8_ :: (Monad m, IsStream t) => t m Word8 -> t m Char
557decodeUtf8_ = fromStreamD . decodeUtf8D_ . toStreamD
559-- | Same as 'decodeUtf8'
561{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}
562{-# INLINE decodeUtf8Lax #-}
563decodeUtf8Lax :: (IsStream t, Monad m) => t m Word8 -> t m Char
564decodeUtf8Lax = decodeUtf8
566-------------------------------------------------------------------------------
567-- Decoding Array Streams
568-------------------------------------------------------------------------------
571{-# ANN type FlattenState Fuse #-}
574 = OuterLoop s !(Maybe (DecodeState, CodePoint))
575 | InnerLoopDecodeInit s ArrayContents !(Ptr a) !(Ptr a)
576 | InnerLoopDecodeFirst s ArrayContents !(Ptr a) !(Ptr a) Word8
577 | InnerLoopDecoding s ArrayContents !(Ptr a) !(Ptr a)
578 !DecodeState !CodePoint
579 | YAndC !Char (FlattenState s a) -- These constructors can be
580 -- encoded in the UTF8DecodeState
581 -- type, I prefer to keep these
582 -- flat even though that means
583 -- coming up with new names
586-- The normal decodeUtf8 above should fuse with flattenArrays
587-- to create this exact code but it doesn't for some reason, as of now this
588-- remains the fastest way I could figure out to decodeUtf8.
590-- XXX Add Proper error messages
591{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
592decodeUtf8ArraysWithD ::
595 -> Stream m (A.Array Word8)
597decodeUtf8ArraysWithD cfm (Stream step state) =
598 let A.Array _ ptr _ = utf8d
599 in Stream (step' ptr) (OuterLoop state Nothing)
601 {-# INLINE transliterateOrError #-}
602 transliterateOrError e s =
604 ErrorOnCodingFailure -> error e
605 TransliterateCodingFailure -> YAndC replacementChar s
606 DropOnCodingFailure -> s
607 {-# INLINE inputUnderflow #-}
610 ErrorOnCodingFailure ->
612 show "Streamly.Internal.Data.Stream.StreamD."
613 ++ "decodeUtf8ArraysWith: Input Underflow"
614 TransliterateCodingFailure -> YAndC replacementChar D
615 DropOnCodingFailure -> D
616 {-# INLINE_LATE step' #-}
617 step' _ gst (OuterLoop st Nothing) = do
618 r <- step (adaptState gst) st
621 Yield A.Array {..} s ->
622 Skip (InnerLoopDecodeInit s arrContents arrStart aEnd)
623 Skip s -> Skip (OuterLoop s Nothing)
625 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do
626 r <- step (adaptState gst) st
629 Yield A.Array {..} s ->
630 Skip (InnerLoopDecoding s arrContents arrStart aEnd ds cp)
631 Skip s -> Skip (OuterLoop s dst)
632 Stop -> Skip inputUnderflow
633 step' _ _ (InnerLoopDecodeInit st startf p end)
635 liftIO $ touch startf
636 return $ Skip $ OuterLoop st Nothing
637 step' _ _ (InnerLoopDecodeInit st startf p end) = do
639 -- Note: It is important to use a ">" instead of a "<=" test here for
640 -- GHC to generate code layout for default branch prediction for the
641 -- common case. This is fragile and might change with the compiler
642 -- versions, we need a more reliable "likely" primitive to control
643 -- branch predication.
646 return $ Skip $ YAndC
647 (unsafeChr (fromIntegral x))
648 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
649 -- Using a separate state here generates a jump to a separate code
650 -- block in the core which seems to perform slightly better for the
652 True -> return $ Skip $ InnerLoopDecodeFirst st startf p end x
654 step' table _ (InnerLoopDecodeFirst st startf p end x) = do
655 let (Tuple' sv cp) = decode0 table x
662 "Streamly.Internal.Data.Stream.StreamD."
663 ++ "decodeUtf8ArraysWith: Invalid UTF8"
664 ++ " codepoint encountered"
666 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
667 0 -> error "unreachable state"
668 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
669 step' _ _ (InnerLoopDecoding st startf p end sv cp)
671 liftIO $ touch startf
672 return $ Skip $ OuterLoop st (Just (sv, cp))
673 step' table _ (InnerLoopDecoding st startf p end statePtr codepointPtr) = do
675 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
682 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
687 "Streamly.Internal.Data.Stream.StreamD."
688 ++ "decodeUtf8ArraysWith: Invalid UTF8"
689 ++ " codepoint encountered"
691 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
694 (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
695 step' _ _ (YAndC c s) = return $ Yield c s
696 step' _ _ D = return Stop
698{-# INLINE decodeUtf8ArraysD #-}
701 => Stream m (A.Array Word8)
703decodeUtf8ArraysD = decodeUtf8ArraysWithD TransliterateCodingFailure
708{-# INLINE decodeUtf8Arrays #-}
710 (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
712 fromStreamD . decodeUtf8ArraysD . toStreamD
714{-# INLINE decodeUtf8ArraysD' #-}
717 => Stream m (A.Array Word8)
719decodeUtf8ArraysD' = decodeUtf8ArraysWithD ErrorOnCodingFailure
724{-# INLINE decodeUtf8Arrays' #-}
725decodeUtf8Arrays' :: (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
726decodeUtf8Arrays' = fromStreamD . decodeUtf8ArraysD' . toStreamD
728{-# INLINE decodeUtf8ArraysD_ #-}
731 => Stream m (A.Array Word8)
733decodeUtf8ArraysD_ = decodeUtf8ArraysWithD DropOnCodingFailure
738{-# INLINE decodeUtf8Arrays_ #-}
740 (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
742 fromStreamD . decodeUtf8ArraysD_ . toStreamD
744-------------------------------------------------------------------------------
745-- Encoding Unicode (UTF-8) Characters
746-------------------------------------------------------------------------------
748data WList = WCons !Word8 !WList | WNil
750-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
754ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
757 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
758 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
762ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
765 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
766 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
767 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
771ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
774 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
775 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
776 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
777 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
779{-# INLINE_NORMAL readCharUtf8With #-}
780readCharUtf8With :: Monad m => WList -> Unfold m Char Word8
781readCharUtf8With surr = Unfold step inject
786 return $ case ord c of
787 x | x <= 0x7F -> fromIntegral x `WCons` WNil
788 | x <= 0x7FF -> ord2 c
789 | x <= 0xFFFF -> if isSurrogate c then surr else ord3 c
790 | otherwise -> ord4 c
792 {-# INLINE_LATE step #-}
793 step WNil = return Stop
794 step (WCons x xs) = return $ Yield x xs
796{-# INLINE_NORMAL readCharUtf8' #-}
797readCharUtf8' :: Monad m => Unfold m Char Word8
800 error "Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"
802-- More yield points improve performance, but I am not sure if they can cause
803-- too much code bloat or some trouble with fusion. So keeping only two yield
804-- points for now, one for the ascii chars (fast path) and one for all other
806{-# INLINE_NORMAL encodeUtf8D' #-}
807encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8
808encodeUtf8D' = D.unfoldMany readCharUtf8'
810-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
811-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
812-- function errors out.
815{-# INLINE encodeUtf8' #-}
816encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
817encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD
819{-# INLINE_NORMAL readCharUtf8 #-}
820readCharUtf8 :: Monad m => Unfold m Char Word8
821readCharUtf8 = readCharUtf8With $ WCons 239 (WCons 191 (WCons 189 WNil))
823-- | See section "3.9 Unicode Encoding Forms" in
824-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
826{-# INLINE_NORMAL encodeUtf8D #-}
827encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
828encodeUtf8D = D.unfoldMany readCharUtf8
830-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
831-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
832-- Unicode replacement character U+FFFD.
834-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
836-- /Since: 0.8.0 (Lenient Behaviour)/
837{-# INLINE encodeUtf8 #-}
838encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
839encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD
841{-# INLINE_NORMAL readCharUtf8_ #-}
842readCharUtf8_ :: Monad m => Unfold m Char Word8
843readCharUtf8_ = readCharUtf8With WNil
845{-# INLINE_NORMAL encodeUtf8D_ #-}
846encodeUtf8D_ :: Monad m => Stream m Char -> Stream m Word8
847encodeUtf8D_ = D.unfoldMany readCharUtf8_
849-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
850-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.
853{-# INLINE encodeUtf8_ #-}
854encodeUtf8_ :: (Monad m, IsStream t) => t m Char -> t m Word8
855encodeUtf8_ = fromStreamD . encodeUtf8D_ . toStreamD
857-- | Same as 'encodeUtf8'
859{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}
860{-# INLINE encodeUtf8Lax #-}
861encodeUtf8Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
862encodeUtf8Lax = encodeUtf8
864-------------------------------------------------------------------------------
865-- Encode streams of containers
866-------------------------------------------------------------------------------
868-- | Encode a container to @Array Word8@ provided an unfold to covert it to a
869-- Char stream and an encoding function.
872{-# INLINE encodeObject #-}
873encodeObject :: MonadIO m =>
874 (SerialT m Char -> SerialT m Word8)
878encodeObject encode u = S.fold Array.write . encode . S.unfold u
880-- | Encode a stream of container objects using the supplied encoding scheme.
881-- Each object is encoded as an @Array Word8@.
884{-# INLINE encodeObjects #-}
885encodeObjects :: (MonadIO m, IsStream t) =>
886 (SerialT m Char -> SerialT m Word8)
890encodeObjects encode u = adapt . Serial.mapM (encodeObject encode u) . adapt
892-- | Encode a stream of 'String' using the supplied encoding scheme. Each
893-- string is encoded as an @Array Word8@.
896{-# INLINE encodeStrings #-}
897encodeStrings :: (MonadIO m, IsStream t) =>
898 (SerialT m Char -> SerialT m Word8) -> t m String -> t m (Array Word8)
899encodeStrings encode = encodeObjects encode Unfold.fromList
902-------------------------------------------------------------------------------
903-- Utility operations on strings
904-------------------------------------------------------------------------------
906strip :: IsStream t => t m Char -> t m Char
909stripTail :: IsStream t => t m Char -> t m Char
913-- | Remove leading whitespace from a string.
915-- > stripHead = S.dropWhile isSpace
918{-# INLINE stripHead #-}
919stripHead :: (Monad m, IsStream t) => t m Char -> t m Char
920stripHead = S.dropWhile isSpace
922-- | Fold each line of the stream using the supplied 'Fold'
923-- and stream the result.
925-- >>> Stream.toList $ lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")
926-- ["lines","this","string","",""]
928-- > lines = S.splitOnSuffix (== '\n')
932lines :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
933lines = S.splitOnSuffix (== '\n')
935foreign import ccall unsafe "u_iswspace"
936 iswspace :: Int -> Int
938-- | Code copied from base/Data.Char to INLINE it
939{-# INLINE isSpace #-}
940isSpace :: Char -> Bool
942 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
943 | otherwise = iswspace (ord c) /= 0
945 uc = fromIntegral (ord c) :: Word
947-- | Fold each word of the stream using the supplied 'Fold'
948-- and stream the result.
950-- >>> Stream.toList $ words Fold.toList (Stream.fromList "fold these words")
951-- ["fold","these","words"]
953-- > words = S.wordsBy isSpace
957words :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
958words = S.wordsBy isSpace
960-- | Unfold a stream to character streams using the supplied 'Unfold'
961-- and concat the results suffixing a newline character @\\n@ to each stream.
964-- unlines = Stream.interposeSuffix '\n'
965-- unlines = Stream.intercalateSuffix Unfold.fromList "\n"
969{-# INLINE unlines #-}
970unlines :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
971unlines = S.interposeSuffix '\n'
973-- | Unfold the elements of a stream to character streams using the supplied
974-- 'Unfold' and concat the results with a whitespace character infixed between
978-- unwords = Stream.interpose ' '
979-- unwords = Stream.intercalate Unfold.fromList " "
983{-# INLINE unwords #-}
984unwords :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
985unwords = S.interpose ' '
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list