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)
18 , CodingFailureMode(..)
25 -- ** Resumable UTF-8 Decoding
30 , resumeDecodeUtf8Either
32 -- ** UTF-8 Array Stream Decoding
37 -- * Elimination (Encoding)
52 -- * Operations on character strings
53 , strip -- (dropAround isSpace)
64 -- * StreamD UTF8 Encoding / Decoding transformations.
72 , resumeDecodeUtf8EitherD
74 -- * Decoding String Literals
86import Control.Monad (void)
87import Control.Monad.IO.Class (MonadIO, liftIO)
88import Data.Bits (shiftR, shiftL, (.|.), (.&.))
89import Data.Char (chr, ord)
90#if MIN_VERSION_base(4,17,0)
91import Data.Char (generalCategory, GeneralCategory(Space))
93import Data.Word (Word8)
94import Foreign.Marshal.Alloc (mallocBytes)
95import Foreign.Storable (Storable(..))
97import Fusion.Plugin.Types (Fuse(..))
99import GHC.Base (assert, unsafeChr)
100import GHC.Exts (Addr#)
101import GHC.IO.Encoding.Failure (isSurrogate)
102import GHC.Ptr (Ptr (..), plusPtr)
103import System.IO.Unsafe (unsafePerformIO)
104import Streamly.Internal.Data.Array.Type (Array(..))
105import Streamly.Internal.Data.Array.Mut.Type (MutableByteArray)
106import Streamly.Internal.Data.Fold (Fold)
107import Streamly.Internal.Data.Stream (Stream)
108import Streamly.Internal.Data.Stream (Step (..))
109import Streamly.Internal.Data.SVar.Type (adaptState)
110import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
111import Streamly.Internal.Data.Unbox (Unbox(peekByteIndex))
112import Streamly.Internal.Data.Unfold.Type (Unfold(..))
113import Streamly.Internal.System.IO (unsafeInlineIO)
115import qualified Streamly.Data.Fold as Fold
116import qualified Streamly.Data.Unfold as Unfold
117import qualified Streamly.Internal.Data.Array.Type as Array
118import qualified Streamly.Internal.Data.Parser as Parser (Parser)
119import qualified Streamly.Internal.Data.Parser as ParserD
120import qualified Streamly.Internal.Data.Stream as Stream
121import qualified Streamly.Internal.Data.Stream as D
123import Prelude hiding (lines, words, unlines, unwords)
127-- >>> :set -XMagicHash
128-- >>> import Prelude hiding (lines, words, unlines, unwords)
129-- >>> import qualified Streamly.Data.Stream as Stream
130-- >>> import qualified Streamly.Data.Fold as Fold
131-- >>> import qualified Streamly.Internal.Unicode.Stream as Unicode
132-- >>> import Streamly.Internal.Unicode.Stream
134-------------------------------------------------------------------------------
136-------------------------------------------------------------------------------
138-- | Decode a stream of bytes to Unicode characters by mapping each byte to a
139-- corresponding Unicode 'Char' in 0-255 range.
141{-# INLINE decodeLatin1 #-}
142decodeLatin1 :: Monad m => Stream m Word8 -> Stream m Char
143decodeLatin1 = fmap (unsafeChr . fromIntegral)
145-------------------------------------------------------------------------------
147-------------------------------------------------------------------------------
149-- | Encode a stream of Unicode characters to bytes by mapping each character
150-- to a byte in 0-255 range. Throws an error if the input stream contains
151-- characters beyond 255.
153{-# INLINE encodeLatin1' #-}
154encodeLatin1' :: Monad m => Stream m Char -> Stream m Word8
155encodeLatin1' = fmap convert
158 let codepoint = ord c
159 in if codepoint > 255
160 then error $ "Streamly.Unicode.encodeLatin1 invalid " ++
161 "input char codepoint " ++ show codepoint
162 else fromIntegral codepoint
164-- XXX Should we instead replace the invalid chars by NUL or whitespace or some
165-- other control char? That may affect the perf a bit but may be a better
168-- | Like 'encodeLatin1'' but silently maps input codepoints beyond 255 to
169-- arbitrary Latin1 chars in 0-255 range. No error or exception is thrown when
170-- such mapping occurs.
172{-# INLINE encodeLatin1 #-}
173encodeLatin1 :: Monad m => Stream m Char -> Stream m Word8
174encodeLatin1 = fmap (fromIntegral . ord)
176-- | Like 'encodeLatin1' but drops the input characters beyond 255.
178{-# INLINE encodeLatin1_ #-}
179encodeLatin1_ :: Monad m => Stream m Char -> Stream m Word8
180encodeLatin1_ = fmap (fromIntegral . ord) . Stream.filter (<= chr 255)
182-- | Same as 'encodeLatin1'
184{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}
185{-# INLINE encodeLatin1Lax #-}
186encodeLatin1Lax :: Monad m => Stream m Char -> Stream m Word8
187encodeLatin1Lax = encodeLatin1
189-------------------------------------------------------------------------------
191-------------------------------------------------------------------------------
193-- Int helps in cheaper conversion from Int to Char
195type DecodeState = Word8
197-- We can divide the errors in three general categories:
198-- * A non-starter was encountered in a begin state
199-- * A starter was encountered without completing a codepoint
200-- * The last codepoint was not complete (input underflow)
202-- Need to separate resumable and non-resumable error. In case of non-resumable
203-- error we can also provide the failing byte. In case of resumable error the
204-- state can be opaque.
206data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
208-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
210-- XXX Use names decodeSuccess = 0, decodeFailure = 12
212decodeTable :: [Word8]
214 -- The first part of the table maps bytes to character classes that
215 -- to reduce the size of the transition table and create bitmasks.
216 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,
217 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,
218 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,
219 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,
220 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,
221 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,
222 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,
223 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,
225 -- The second part is a transition table that maps a combination
226 -- of a state of the automaton and a character class to a state.
227 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
228 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
229 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
230 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
231 12,36,12,12,12,12,12,12,12,12,12,12
234{-# INLINE utf8dLength #-}
236utf8dLength = length decodeTable
238-- | We do not want to garbage collect this and free the memory, we want to
239-- keep this persistent. We don't know how to do that with GHC without having a
240-- reference in some global structure. So we use a hack, use mallocBytes so
241-- that the GC has no way to free it.
242{-# NOINLINE utf8d #-}
244utf8d = unsafePerformIO $ do
245 let size = utf8dLength
246 p <- liftIO $ mallocBytes size
248 (Fold.foldlM' (\b a -> poke b a >> return (b `plusPtr` 1)) (return p))
249 (D.fromList decodeTable)
252-- | Return element at the specified index without checking the bounds.
253-- and without touching the foreign ptr.
254{-# INLINE_NORMAL unsafePeekElemOff #-}
255unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
256unsafePeekElemOff p i =
257 let !x = unsafeInlineIO $ peekElemOff p i
260-- XXX We can use a fromPtr stream to implement it.
261{-# INLINE showMemory #-}
263 forall a. (Show a, Storable a) => Ptr a -> Ptr a -> String
266 let cur1 = cur `plusPtr` sizeOf (undefined :: a)
267 in show (unsafeInlineIO $ peek cur) ++ " " ++ showMemory cur1 end
270-- decode is split into two separate cases to avoid branching instructions.
271-- From the higher level flow we already know which case we are in so we can
272-- call the appropriate decode function.
274-- When the state is 0
275{-# INLINE decode0 #-}
276decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
278 let !t = table `unsafePeekElemOff` fromIntegral byte
279 !codep' = (0xff `shiftR` fromIntegral t) .&. fromIntegral byte
280 !state' = table `unsafePeekElemOff` (256 + fromIntegral t)
281 in assert ((byte > 0x7f || error showByte)
282 && (state' /= 0 || error (showByte ++ showTable)))
283 (Tuple' state' codep')
287 utf8tableEnd = table `plusPtr` 364
288 showByte = "Streamly: decode0: byte: " ++ show byte
289 showTable = " table: " ++ showMemory table utf8tableEnd
291-- When the state is not 0
292{-# INLINE decode1 #-}
298 -> Tuple' DecodeState CodePoint
299decode1 table state codep byte =
300 -- Remember codep is Int type!
301 -- Can it be unsafe to convert the resulting Int to Char?
302 let !t = table `unsafePeekElemOff` fromIntegral byte
303 !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
304 !state' = table `unsafePeekElemOff`
305 (256 + fromIntegral state + fromIntegral t)
306 in assert (codep' <= 0x10FFFF
307 || error (showByte ++ showState state codep))
308 (Tuple' state' codep')
311 utf8tableEnd = table `plusPtr` 364
312 showByte = "Streamly: decode1: byte: " ++ show byte
314 " state: " ++ show st ++
315 " codepoint: " ++ show cp ++
316 " table: " ++ showMemory table utf8tableEnd
318-------------------------------------------------------------------------------
319-- Resumable UTF-8 decoding
320-------------------------------------------------------------------------------
322-- Strangely, GHCJS hangs linking template-haskell with this
324{-# ANN type UTF8DecodeState Fuse #-}
326data UTF8DecodeState s a
328 | UTF8DecodeInit1 s Word8
329 | UTF8DecodeFirst s Word8
330 | UTF8Decoding s !DecodeState !CodePoint
331 | YieldAndContinue a (UTF8DecodeState s a)
334{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
335resumeDecodeUtf8EitherD
340 -> D.Stream m (Either DecodeError Char)
341resumeDecodeUtf8EitherD dst codep (D.Stream step state) =
344 then UTF8DecodeInit state
345 else UTF8Decoding state dst codep
346 in D.Stream (step' utf8d) stt
348 {-# INLINE_LATE step' #-}
349 step' _ gst (UTF8DecodeInit st) = do
350 r <- step (adaptState gst) st
352 Yield x s -> Skip (UTF8DecodeInit1 s x)
353 Skip s -> Skip (UTF8DecodeInit s)
356 step' _ _ (UTF8DecodeInit1 st x) = do
357 -- Note: It is important to use a ">" instead of a "<=" test
358 -- here for GHC to generate code layout for default branch
359 -- prediction for the common case. This is fragile and might
360 -- change with the compiler versions, we need a more reliable
361 -- "likely" primitive to control branch predication.
364 return $ Skip $ YieldAndContinue
365 (Right $ unsafeChr (fromIntegral x))
367 -- Using a separate state here generates a jump to a
368 -- separate code block in the core which seems to perform
369 -- slightly better for the non-ascii case.
370 True -> return $ Skip $ UTF8DecodeFirst st x
372 -- XXX should we merge it with UTF8DecodeInit1?
373 step' table _ (UTF8DecodeFirst st x) = do
374 let (Tuple' sv cp) = decode0 table x
378 Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))
380 0 -> error "unreachable state"
381 _ -> Skip (UTF8Decoding st sv cp)
383 -- We recover by trying the new byte x a starter of a new codepoint.
384 -- XXX on error need to report the next byte "x" as well.
385 -- XXX need to use the same recovery in array decoding routine as well
386 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
387 r <- step (adaptState gst) st
390 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
393 0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)
396 Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)
397 (UTF8DecodeInit1 s x)
398 _ -> Skip (UTF8Decoding s sv cp)
399 Skip s -> return $ Skip (UTF8Decoding s statePtr codepointPtr)
400 Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done
402 step' _ _ (YieldAndContinue c s) = return $ Yield c s
403 step' _ _ Done = return Stop
405-- XXX We can use just one API, and define InitState = 0 and InitCodePoint = 0
406-- to use as starting state.
408{-# INLINE_NORMAL decodeUtf8EitherD #-}
409decodeUtf8EitherD :: Monad m
410 => D.Stream m Word8 -> D.Stream m (Either DecodeError Char)
411decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0
416{-# INLINE decodeUtf8Either #-}
417decodeUtf8Either :: Monad m
418 => Stream m Word8 -> Stream m (Either DecodeError Char)
419decodeUtf8Either = decodeUtf8EitherD
424{-# INLINE resumeDecodeUtf8Either #-}
425resumeDecodeUtf8Either
430 -> Stream m (Either DecodeError Char)
431resumeDecodeUtf8Either = resumeDecodeUtf8EitherD
433-------------------------------------------------------------------------------
435-------------------------------------------------------------------------------
437data CodingFailureMode
438 = TransliterateCodingFailure
439 | ErrorOnCodingFailure
440 | DropOnCodingFailure
443{-# INLINE replacementChar #-}
444replacementChar :: Char
445replacementChar = '\xFFFD'
447data UTF8CharDecodeState a
449 | UTF8CharDecoding !DecodeState !CodePoint
451{-# INLINE parseCharUtf8WithD #-}
453 Monad m => CodingFailureMode -> ParserD.Parser Word8 m Char
454parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract
458 prefix = "Streamly.Internal.Data.Stream.parseCharUtf8WithD:"
460 {-# INLINE initial #-}
461 initial = return $ ParserD.IPartial UTF8CharDecodeInit
463 handleError err souldBackTrack =
465 ErrorOnCodingFailure -> ParserD.Error err
466 TransliterateCodingFailure ->
467 case souldBackTrack of
468 True -> ParserD.Done 1 replacementChar
469 False -> ParserD.Done 0 replacementChar
470 DropOnCodingFailure ->
471 case souldBackTrack of
472 True -> ParserD.Continue 1 UTF8CharDecodeInit
473 False -> ParserD.Continue 0 UTF8CharDecodeInit
476 step' table UTF8CharDecodeInit x =
477 -- Note: It is important to use a ">" instead of a "<=" test
478 -- here for GHC to generate code layout for default branch
479 -- prediction for the common case. This is fragile and might
480 -- change with the compiler versions, we need a more reliable
481 -- "likely" primitive to control branch predication.
482 return $ case x > 0x7f of
483 False -> ParserD.Done 0 $ unsafeChr $ fromIntegral x
485 let (Tuple' sv cp) = decode0 table x
489 ++ "Invalid first UTF8 byte" ++ show x
490 in handleError msg False
491 0 -> error $ prefix ++ "unreachable state"
492 _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)
494 step' table (UTF8CharDecoding statePtr codepointPtr) x = return $
495 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
497 0 -> ParserD.Done 0 $ unsafeChr cp
500 ++ "Invalid subsequent UTF8 byte"
504 ++ "accumulated value"
506 in handleError msg True
507 _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)
509 {-# INLINE extract #-}
510 extract UTF8CharDecodeInit = error $ prefix ++ "Not enough input"
511 extract (UTF8CharDecoding _ _) =
513 ErrorOnCodingFailure ->
514 return $ ParserD.Error $ prefix ++ "Not enough input"
515 TransliterateCodingFailure ->
516 return (ParserD.Done 0 replacementChar)
517 -- XXX We shouldn't error out here. There is no way to represent an
518 -- empty parser result unless we return a "Maybe" type.
519 DropOnCodingFailure -> error $ prefix ++ "Not enough input"
521-- XXX This should ideally accept a "CodingFailureMode" and perform appropriate
522-- error handling. This isn't possible now as "TransliterateCodingFailure"'s
523-- workflow requires backtracking 1 element. This can be revisited once "Fold"
524-- supports backtracking.
525{-# INLINE writeCharUtf8' #-}
526writeCharUtf8' :: Monad m => Fold m Word8 Char
527writeCharUtf8' = ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)
529-- XXX The initial idea was to have "parseCharUtf8" and offload the error
530-- handling to another parser. So, say we had "parseCharUtf8'",
532-- >>> parseCharUtf8Smart = parseCharUtf8' <|> Parser.fromPure replacementChar
534-- But unfortunately parseCharUtf8Smart used in conjunction with "parseMany" -
535-- that is "parseMany parseCharUtf8Smart" on a stream causes the heap to
536-- overflow. Even a heap size of 500 MB was not sufficient.
538-- This needs to be investigated futher.
539{-# INLINE parseCharUtf8With #-}
541 Monad m => CodingFailureMode -> Parser.Parser Word8 m Char
542parseCharUtf8With = parseCharUtf8WithD
544-- XXX write it as a parser and use parseMany to decode a stream, need to check
545-- if that preserves the same performance. Or we can use a resumable parser
546-- that parses a chunk at a time.
548-- XXX Implement this in terms of decodeUtf8Either. Need to make sure that
549-- decodeUtf8Either preserves the performance characterstics.
551{-# INLINE_NORMAL decodeUtf8WithD #-}
552decodeUtf8WithD :: Monad m
553 => CodingFailureMode -> D.Stream m Word8 -> D.Stream m Char
554decodeUtf8WithD cfm (D.Stream step state) =
555 D.Stream (step' utf8d) (UTF8DecodeInit state)
559 prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "
561 {-# INLINE handleError #-}
564 ErrorOnCodingFailure -> error e
565 TransliterateCodingFailure -> YieldAndContinue replacementChar s
566 DropOnCodingFailure -> s
568 {-# INLINE handleUnderflow #-}
571 ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"
572 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
573 DropOnCodingFailure -> Done
575 {-# INLINE_LATE step' #-}
576 step' _ gst (UTF8DecodeInit st) = do
577 r <- step (adaptState gst) st
579 Yield x s -> Skip (UTF8DecodeInit1 s x)
580 Skip s -> Skip (UTF8DecodeInit s)
583 step' _ _ (UTF8DecodeInit1 st x) = do
584 -- Note: It is important to use a ">" instead of a "<=" test
585 -- here for GHC to generate code layout for default branch
586 -- prediction for the common case. This is fragile and might
587 -- change with the compiler versions, we need a more reliable
588 -- "likely" primitive to control branch predication.
591 return $ Skip $ YieldAndContinue
592 (unsafeChr (fromIntegral x))
594 -- Using a separate state here generates a jump to a
595 -- separate code block in the core which seems to perform
596 -- slightly better for the non-ascii case.
597 True -> return $ Skip $ UTF8DecodeFirst st x
599 -- XXX should we merge it with UTF8DecodeInit1?
600 step' table _ (UTF8DecodeFirst st x) = do
601 let (Tuple' sv cp) = decode0 table x
605 let msg = prefix ++ "Invalid first UTF8 byte " ++ show x
606 in Skip $ handleError msg (UTF8DecodeInit st)
607 0 -> error "unreachable state"
608 _ -> Skip (UTF8Decoding st sv cp)
610 -- We recover by trying the new byte x as a starter of a new codepoint.
611 -- XXX need to use the same recovery in array decoding routine as well
612 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
613 r <- step (adaptState gst) st
616 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
618 0 -> Skip $ YieldAndContinue
619 (unsafeChr cp) (UTF8DecodeInit s)
622 ++ "Invalid subsequent UTF8 byte "
626 ++ " accumulated value "
628 in Skip $ handleError msg (UTF8DecodeInit1 s x)
629 _ -> Skip (UTF8Decoding s sv cp)
631 Skip (UTF8Decoding s statePtr codepointPtr)
632 Stop -> return $ Skip handleUnderflow
634 step' _ _ (YieldAndContinue c s) = return $ Yield c s
635 step' _ _ Done = return Stop
637{-# INLINE decodeUtf8D #-}
638decodeUtf8D :: Monad m => D.Stream m Word8 -> D.Stream m Char
639decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure
641-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
642-- Any invalid codepoint encountered is replaced with the unicode replacement
645{-# INLINE decodeUtf8 #-}
646decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
647decodeUtf8 = decodeUtf8D
649{-# INLINE decodeUtf8D' #-}
650decodeUtf8D' :: Monad m => D.Stream m Word8 -> D.Stream m Char
651decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure
653-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
654-- The function throws an error if an invalid codepoint is encountered.
656{-# INLINE decodeUtf8' #-}
657decodeUtf8' :: Monad m => Stream m Word8 -> Stream m Char
658decodeUtf8' = decodeUtf8D'
660{-# INLINE decodeUtf8D_ #-}
661decodeUtf8D_ :: Monad m => D.Stream m Word8 -> D.Stream m Char
662decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure
664-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
665-- Any invalid codepoint encountered is dropped.
667{-# INLINE decodeUtf8_ #-}
668decodeUtf8_ :: Monad m => Stream m Word8 -> Stream m Char
669decodeUtf8_ = decodeUtf8D_
671-- | Same as 'decodeUtf8'
673{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}
674{-# INLINE decodeUtf8Lax #-}
675decodeUtf8Lax :: Monad m => Stream m Word8 -> Stream m Char
676decodeUtf8Lax = decodeUtf8
678-------------------------------------------------------------------------------
679-- Decoding Array Streams
680-------------------------------------------------------------------------------
683{-# ANN type FlattenState Fuse #-}
686 = OuterLoop s !(Maybe (DecodeState, CodePoint))
687 | InnerLoopDecodeInit s MutableByteArray !Int !Int
688 | InnerLoopDecodeFirst s MutableByteArray !Int !Int Word8
689 | InnerLoopDecoding s MutableByteArray !Int !Int
690 !DecodeState !CodePoint
691 | YAndC !Char (FlattenState s) -- These constructors can be
692 -- encoded in the UTF8DecodeState
693 -- type, I prefer to keep these
694 -- flat even though that means
695 -- coming up with new names
698-- The normal decodeUtf8 above should fuse with flattenArrays
699-- to create this exact code but it doesn't for some reason, as of now this
700-- remains the fastest way I could figure out to decodeUtf8.
702-- XXX Add Proper error messages
703{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
704decodeUtf8ArraysWithD ::
707 -> D.Stream m (Array Word8)
709decodeUtf8ArraysWithD cfm (D.Stream step state) =
710 D.Stream (step' utf8d) (OuterLoop state Nothing)
712 {-# INLINE transliterateOrError #-}
713 transliterateOrError e s =
715 ErrorOnCodingFailure -> error e
716 TransliterateCodingFailure -> YAndC replacementChar s
717 DropOnCodingFailure -> s
718 {-# INLINE inputUnderflow #-}
721 ErrorOnCodingFailure ->
723 show "Streamly.Internal.Data.Stream.StreamD."
724 ++ "decodeUtf8ArraysWith: Input Underflow"
725 TransliterateCodingFailure -> YAndC replacementChar D
726 DropOnCodingFailure -> D
727 {-# INLINE_LATE step' #-}
728 step' _ gst (OuterLoop st Nothing) = do
729 r <- step (adaptState gst) st
732 Yield Array {..} s ->
733 Skip (InnerLoopDecodeInit s arrContents arrStart arrEnd)
734 Skip s -> Skip (OuterLoop s Nothing)
736 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do
737 r <- step (adaptState gst) st
740 Yield Array {..} s ->
741 Skip (InnerLoopDecoding s arrContents arrStart arrEnd ds cp)
742 Skip s -> Skip (OuterLoop s dst)
743 Stop -> Skip inputUnderflow
744 step' _ _ (InnerLoopDecodeInit st _ p end)
746 return $ Skip $ OuterLoop st Nothing
747 step' _ _ (InnerLoopDecodeInit st contents p end) = do
748 x <- liftIO $ peekByteIndex p contents
749 -- Note: It is important to use a ">" instead of a "<=" test here for
750 -- GHC to generate code layout for default branch prediction for the
751 -- common case. This is fragile and might change with the compiler
752 -- versions, we need a more reliable "likely" primitive to control
753 -- branch predication.
756 return $ Skip $ YAndC
757 (unsafeChr (fromIntegral x))
758 (InnerLoopDecodeInit st contents (p + 1) end)
759 -- Using a separate state here generates a jump to a separate code
760 -- block in the core which seems to perform slightly better for the
762 True -> return $ Skip $ InnerLoopDecodeFirst st contents p end x
764 step' table _ (InnerLoopDecodeFirst st contents p end x) = do
765 let (Tuple' sv cp) = decode0 table x
772 "Streamly.Internal.Data.Stream.StreamD."
773 ++ "decodeUtf8ArraysWith: Invalid UTF8"
774 ++ " codepoint encountered"
776 (InnerLoopDecodeInit st contents (p + 1) end)
777 0 -> error "unreachable state"
778 _ -> Skip (InnerLoopDecoding st contents (p + 1) end sv cp)
779 step' _ _ (InnerLoopDecoding st _ p end sv cp)
780 | p == end = return $ Skip $ OuterLoop st (Just (sv, cp))
781 step' table _ (InnerLoopDecoding st contents p end statePtr codepointPtr) = do
782 x <- liftIO $ peekByteIndex p contents
783 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
790 (InnerLoopDecodeInit st contents (p + 1) end)
795 "Streamly.Internal.Data.Stream.StreamD."
796 ++ "decodeUtf8ArraysWith: Invalid UTF8"
797 ++ " codepoint encountered"
799 (InnerLoopDecodeInit st contents (p + 1) end)
802 (InnerLoopDecoding st contents (p + 1) end sv cp)
803 step' _ _ (YAndC c s) = return $ Yield c s
804 step' _ _ D = return Stop
806-- | Like 'decodeUtf8' but for a chunked stream. It may be slightly faster than
807-- flattening the stream and then decoding with 'decodeUtf8'.
808{-# INLINE decodeUtf8Chunks #-}
811 => D.Stream m (Array Word8)
813decodeUtf8Chunks = decodeUtf8ArraysWithD TransliterateCodingFailure
815-- | Like 'decodeUtf8\'' but for a chunked stream. It may be slightly faster
816-- than flattening the stream and then decoding with 'decodeUtf8\''.
817{-# INLINE decodeUtf8Chunks' #-}
820 => D.Stream m (Array Word8)
822decodeUtf8Chunks' = decodeUtf8ArraysWithD ErrorOnCodingFailure
824-- | Like 'decodeUtf8_' but for a chunked stream. It may be slightly faster
825-- than flattening the stream and then decoding with 'decodeUtf8_'.
826{-# INLINE decodeUtf8Chunks_ #-}
829 => D.Stream m (Array Word8)
831decodeUtf8Chunks_ = decodeUtf8ArraysWithD DropOnCodingFailure
833-------------------------------------------------------------------------------
834-- Encoding Unicode (UTF-8) Characters
835-------------------------------------------------------------------------------
837data WList = WCons !Word8 !WList | WNil
839-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
843ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
846 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
847 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
851ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
854 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
855 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
856 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
860ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
863 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
864 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
865 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
866 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
868{-# INLINE_NORMAL readCharUtf8With #-}
869readCharUtf8With :: Monad m => WList -> Unfold m Char Word8
870readCharUtf8With surr = Unfold step inject
875 return $ case ord c of
876 x | x <= 0x7F -> fromIntegral x `WCons` WNil
877 | x <= 0x7FF -> ord2 c
878 | x <= 0xFFFF -> if isSurrogate c then surr else ord3 c
879 | otherwise -> ord4 c
881 {-# INLINE_LATE step #-}
882 step WNil = return Stop
883 step (WCons x xs) = return $ Yield x xs
885{-# INLINE_NORMAL readCharUtf8' #-}
886readCharUtf8' :: Monad m => Unfold m Char Word8
889 error "Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"
891-- More yield points improve performance, but I am not sure if they can cause
892-- too much code bloat or some trouble with fusion. So keeping only two yield
893-- points for now, one for the ascii chars (fast path) and one for all other
895{-# INLINE_NORMAL encodeUtf8D' #-}
896encodeUtf8D' :: Monad m => D.Stream m Char -> D.Stream m Word8
897encodeUtf8D' = D.unfoldMany readCharUtf8'
899-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
900-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
901-- function errors out.
903{-# INLINE encodeUtf8' #-}
904encodeUtf8' :: Monad m => Stream m Char -> Stream m Word8
905encodeUtf8' = encodeUtf8D'
907{-# INLINE_NORMAL readCharUtf8 #-}
908readCharUtf8 :: Monad m => Unfold m Char Word8
909readCharUtf8 = readCharUtf8With $ WCons 239 (WCons 191 (WCons 189 WNil))
911-- | See section "3.9 Unicode Encoding Forms" in
912-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
914{-# INLINE_NORMAL encodeUtf8D #-}
915encodeUtf8D :: Monad m => D.Stream m Char -> D.Stream m Word8
916encodeUtf8D = D.unfoldMany readCharUtf8
918-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
919-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
920-- Unicode replacement character U+FFFD.
922{-# INLINE encodeUtf8 #-}
923encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8
924encodeUtf8 = encodeUtf8D
926{-# INLINE_NORMAL readCharUtf8_ #-}
927readCharUtf8_ :: Monad m => Unfold m Char Word8
928readCharUtf8_ = readCharUtf8With WNil
930{-# INLINE_NORMAL encodeUtf8D_ #-}
931encodeUtf8D_ :: Monad m => D.Stream m Char -> D.Stream m Word8
932encodeUtf8D_ = D.unfoldMany readCharUtf8_
934-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
935-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.
937{-# INLINE encodeUtf8_ #-}
938encodeUtf8_ :: Monad m => Stream m Char -> Stream m Word8
939encodeUtf8_ = encodeUtf8D_
941-- | Same as 'encodeUtf8'
943{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}
944{-# INLINE encodeUtf8Lax #-}
945encodeUtf8Lax :: Monad m => Stream m Char -> Stream m Word8
946encodeUtf8Lax = encodeUtf8
948-------------------------------------------------------------------------------
949-- Decoding string literals
950-------------------------------------------------------------------------------
952-- | Read UTF-8 encoded bytes as chars from an 'Addr#' until a 0 byte is
953-- encountered, the 0 byte is not included in the stream.
955-- /Unsafe:/ The caller is responsible for safe addressing.
957-- Note that this is completely safe when reading from Haskell string
958-- literals because they are guaranteed to be NULL terminated:
960-- >>> Stream.fold Fold.toList (Unicode.fromStr# "Haskell"#)
963{-# INLINE fromStr# #-}
964fromStr# :: MonadIO m => Addr# -> Stream m Char
965fromStr# addr = decodeUtf8 $ Stream.fromByteStr# addr
967-------------------------------------------------------------------------------
968-- Encode streams of containers
969-------------------------------------------------------------------------------
971-- | Encode a container to @Array Word8@ provided an unfold to covert it to a
972-- Char stream and an encoding function.
975{-# INLINE encodeObject #-}
976encodeObject :: MonadIO m =>
977 (Stream m Char -> Stream m Word8)
981encodeObject encode u = Stream.fold Array.write . encode . Stream.unfold u
983-- | Encode a stream of container objects using the supplied encoding scheme.
984-- Each object is encoded as an @Array Word8@.
987{-# INLINE encodeObjects #-}
988encodeObjects :: MonadIO m =>
989 (Stream m Char -> Stream m Word8)
992 -> Stream m (Array Word8)
993encodeObjects encode u = Stream.mapM (encodeObject encode u)
995-- | Encode a stream of 'String' using the supplied encoding scheme. Each
996-- string is encoded as an @Array Word8@.
998{-# INLINE encodeStrings #-}
999encodeStrings :: MonadIO m =>
1000 (Stream m Char -> Stream m Word8)
1002 -> Stream m (Array Word8)
1003encodeStrings encode = encodeObjects encode Unfold.fromList
1006-------------------------------------------------------------------------------
1007-- Utility operations on strings
1008-------------------------------------------------------------------------------
1010strip :: IsStream t => Stream m Char -> Stream m Char
1013stripTail :: IsStream t => Stream m Char -> Stream m Char
1014stripTail = undefined
1017-- | Remove leading whitespace from a string.
1019-- > stripHead = Stream.dropWhile isSpace
1022{-# INLINE stripHead #-}
1023stripHead :: Monad m => Stream m Char -> Stream m Char
1024stripHead = Stream.dropWhile isSpace
1026-- | Fold each line of the stream using the supplied 'Fold'
1027-- and stream the result.
1029-- >>> Stream.fold Fold.toList $ lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")
1030-- ["lines","this","string","",""]
1032-- > lines = Stream.splitOnSuffix (== '\n')
1036lines :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
1037lines f = Stream.foldMany (Fold.takeEndBy_ (== '\n') f)
1039#if !MIN_VERSION_base(4,17,0)
1040foreign import ccall unsafe "u_iswspace"
1041 iswspace :: Int -> Int
1044-- | Code copied from base/Data.Char to INLINE it
1045{-# INLINE isSpace #-}
1046isSpace :: Char -> Bool
1048 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
1049#if MIN_VERSION_base(4,17,0)
1050 | otherwise = generalCategory c == Space
1052 | otherwise = iswspace (ord c) /= 0
1055 uc = fromIntegral (ord c) :: Word
1057-- | Fold each word of the stream using the supplied 'Fold'
1058-- and stream the result.
1060-- >>> Stream.fold Fold.toList $ words Fold.toList (Stream.fromList "fold these words")
1061-- ["fold","these","words"]
1063-- > words = Stream.wordsBy isSpace
1067words :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
1068words f = D.wordsBy isSpace f
1070-- | Unfold a stream to character streams using the supplied 'Unfold'
1071-- and concat the results suffixing a newline character @\\n@ to each stream.
1074-- unlines = Stream.interposeSuffix '\n'
1075-- unlines = Stream.intercalateSuffix Unfold.fromList "\n"
1079{-# INLINE unlines #-}
1080unlines :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
1081unlines = Stream.interposeSuffix '\n'
1083-- | Unfold the elements of a stream to character streams using the supplied
1084-- 'Unfold' and concat the results with a whitespace character infixed between
1088-- unwords = Stream.interpose ' '
1089-- unwords = Stream.intercalate Unfold.fromList " "
1093{-# INLINE unwords #-}
1094unwords :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
1095unwords = Stream.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