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