git.iko.soy/streamly
on 00f541e help sign in
streamly/src/Streamly/Internal/Data/Unicode/Stream.hs
743 lines 28 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE PatternSynonyms #-}
5{-# LANGUAGE RankNTypes #-}
6{-# LANGUAGE RecordWildCards #-}
8-- |
9-- Module : Streamly.Data.Internal.Unicode.Stream
10-- Copyright : (c) 2018 Composewell Technologies
11--
12-- License : BSD3
13-- Maintainer : streamly@composewell.com
14-- Stability : experimental
15-- Portability : GHC
16--
18#include "inline.hs"
20module Streamly.Internal.Data.Unicode.Stream
21 (
22 -- * Construction (Decoding)
23 decodeLatin1
24 , decodeUtf8
25 , decodeUtf8Lax
26 , DecodeError(..)
27 , DecodeState
28 , CodePoint
29 , decodeUtf8Either
30 , resumeDecodeUtf8Either
31 , decodeUtf8Arrays
32 , decodeUtf8ArraysLenient
34 -- * Elimination (Encoding)
35 , encodeLatin1
36 , encodeLatin1Lax
37 , encodeUtf8
38 {-
39 -- * Operations on character strings
40 , strip -- (dropAround isSpace)
41 , stripEnd
42 -}
44 -- * StreamD UTF8 Encoding / Decoding transformations.
45 , decodeUtf8D
46 , encodeUtf8D
47 , decodeUtf8LenientD
48 , decodeUtf8EitherD
49 , resumeDecodeUtf8EitherD
50 , decodeUtf8ArraysD
51 , decodeUtf8ArraysLenientD
53 -- * Transformation
54 , stripStart
55 , lines
56 , words
57 , unlines
58 , unwords
59 )
60where
62import Control.Monad.IO.Class (MonadIO, liftIO)
63import Data.Bits (shiftR, shiftL, (.|.), (.&.))
64import Data.Char (ord)
65import Data.Word (Word8)
66import Foreign.ForeignPtr (touchForeignPtr)
67import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
68import Foreign.Storable (Storable(..))
69import GHC.Base (assert, unsafeChr)
70import GHC.ForeignPtr (ForeignPtr (..))
71import GHC.IO.Encoding.Failure (isSurrogate)
72import GHC.Ptr (Ptr (..), plusPtr)
73import Prelude hiding (String, lines, words, unlines, unwords)
74import System.IO.Unsafe (unsafePerformIO)
76import Streamly (IsStream)
77import Streamly.Data.Fold (Fold)
78import Streamly.Memory.Array (Array)
79import Streamly.Internal.Data.Unfold (Unfold)
80import Streamly.Internal.Data.SVar (adaptState)
81import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))
82import Streamly.Internal.Data.Strict (Tuple'(..))
84#if __GLASGOW_HASKELL__ < 800
85import Streamly.Internal.Data.Stream.StreamD (pattern Stream)
86#endif
88import qualified Streamly.Internal.Memory.Array.Types as A
89import qualified Streamly.Internal.Prelude as S
90import qualified Streamly.Internal.Data.Stream.StreamD as D
92-------------------------------------------------------------------------------
93-- Encoding/Decoding Unicode (UTF-8) Characters
94-------------------------------------------------------------------------------
96-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
98data WList = WCons !Word8 !WList | WNil
100{-# INLINE ord2 #-}
101ord2 :: Char -> WList
102ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
103 where
104 n = ord c
105 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
106 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
108{-# INLINE ord3 #-}
109ord3 :: Char -> WList
110ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
111 where
112 n = ord c
113 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
114 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
115 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
117{-# INLINE ord4 #-}
118ord4 :: Char -> WList
119ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
120 where
121 n = ord c
122 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
123 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
124 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
125 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
127data CodingFailureMode
128 = TransliterateCodingFailure
129 | ErrorOnCodingFailure
130 deriving (Show)
132{-# INLINE replacementChar #-}
133replacementChar :: Char
134replacementChar = '\xFFFD'
136-- Int helps in cheaper conversion from Int to Char
137type CodePoint = Int
138type DecodeState = Word8
140-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
142-- XXX Use names decodeSuccess = 0, decodeFailure = 12
144decodeTable :: [Word8]
145decodeTable = [
146 -- The first part of the table maps bytes to character classes that
147 -- to reduce the size of the transition table and create bitmasks.
148 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,
149 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,
150 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,
151 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,
152 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,
153 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,
154 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,
155 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,
157 -- The second part is a transition table that maps a combination
158 -- of a state of the automaton and a character class to a state.
159 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
160 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
161 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
162 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
163 12,36,12,12,12,12,12,12,12,12,12,12
164 ]
166utf8d :: A.Array Word8
167utf8d =
168 unsafePerformIO
169 -- Aligning to cacheline makes a barely noticeable difference
170 -- XXX currently alignment is not implemented for unmanaged allocation
171 $ D.runFold (A.writeNAlignedUnmanaged 64 (length decodeTable))
172 (D.fromList decodeTable)
174-- | Return element at the specified index without checking the bounds.
175-- and without touching the foreign ptr.
176{-# INLINE_NORMAL unsafePeekElemOff #-}
177unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
178unsafePeekElemOff p i = let !x = A.unsafeInlineIO $ peekElemOff p i in x
180-- decode is split into two separate cases to avoid branching instructions.
181-- From the higher level flow we already know which case we are in so we can
182-- call the appropriate decode function.
183--
184-- When the state is 0
185{-# INLINE decode0 #-}
186decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
187decode0 table byte =
188 let !t = table `unsafePeekElemOff` fromIntegral byte
189 !codep' = (0xff `shiftR` (fromIntegral t)) .&. fromIntegral byte
190 !state' = table `unsafePeekElemOff` (256 + fromIntegral t)
191 in assert ((byte > 0x7f || error showByte)
192 && (state' /= 0 || error (showByte ++ showTable)))
193 (Tuple' state' codep')
195 where
197 utf8table =
198 let !(Ptr addr) = table
199 end = table `plusPtr` 364
200 in A.Array (ForeignPtr addr undefined) end end :: A.Array Word8
201 showByte = "Streamly: decode0: byte: " ++ show byte
202 showTable = " table: " ++ show utf8table
204-- When the state is not 0
205{-# INLINE decode1 #-}
206decode1
207 :: Ptr Word8
208 -> DecodeState
209 -> CodePoint
210 -> Word8
211 -> Tuple' DecodeState CodePoint
212decode1 table state codep byte =
213 -- Remember codep is Int type!
214 -- Can it be unsafe to convert the resulting Int to Char?
215 let !t = table `unsafePeekElemOff` fromIntegral byte
216 !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
217 !state' = table `unsafePeekElemOff`
218 (256 + fromIntegral state + fromIntegral t)
219 in assert (codep' <= 0x10FFFF
220 || error (showByte ++ showState state codep))
221 (Tuple' state' codep')
222 where
224 utf8table =
225 let !(Ptr addr) = table
226 end = table `plusPtr` 364
227 in A.Array (ForeignPtr addr undefined) end end :: A.Array Word8
228 showByte = "Streamly: decode1: byte: " ++ show byte
229 showState st cp =
230 " state: " ++ show st ++
231 " codepoint: " ++ show cp ++
232 " table: " ++ show utf8table
234-- We can divide the errors in three general categories:
235-- * A non-starter was encountered in a begin state
236-- * A starter was encountered without completing a codepoint
237-- * The last codepoint was not complete (input underflow)
238--
239data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
241data FreshPoint s a
242 = FreshPointDecodeInit s
243 | FreshPointDecodeInit1 s Word8
244 | FreshPointDecodeFirst s Word8
245 | FreshPointDecoding s !DecodeState !CodePoint
246 | YieldAndContinue a (FreshPoint s a)
247 | Done
249-- XXX Add proper error messages
250-- XXX Implement this in terms of decodeUtf8Either
251{-# INLINE_NORMAL decodeUtf8WithD #-}
252decodeUtf8WithD :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char
253decodeUtf8WithD cfm (Stream step state) =
254 let A.Array p _ _ = utf8d
255 !ptr = (unsafeForeignPtrToPtr p)
256 in Stream (step' ptr) (FreshPointDecodeInit state)
257 where
258 {-# INLINE transliterateOrError #-}
259 transliterateOrError e s =
260 case cfm of
261 ErrorOnCodingFailure -> error e
262 TransliterateCodingFailure -> YieldAndContinue replacementChar s
263 {-# INLINE inputUnderflow #-}
264 inputUnderflow =
265 case cfm of
266 ErrorOnCodingFailure ->
267 error "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Input Underflow"
268 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
269 {-# INLINE_LATE step' #-}
270 step' _ gst (FreshPointDecodeInit st) = do
271 r <- step (adaptState gst) st
272 return $ case r of
273 Yield x s -> Skip (FreshPointDecodeInit1 s x)
274 Skip s -> Skip (FreshPointDecodeInit s)
275 Stop -> Skip Done
277 step' _ _ (FreshPointDecodeInit1 st x) = do
278 -- Note: It is important to use a ">" instead of a "<=" test
279 -- here for GHC to generate code layout for default branch
280 -- prediction for the common case. This is fragile and might
281 -- change with the compiler versions, we need a more reliable
282 -- "likely" primitive to control branch predication.
283 case x > 0x7f of
284 False ->
285 return $ Skip $ YieldAndContinue
286 (unsafeChr (fromIntegral x))
287 (FreshPointDecodeInit st)
288 -- Using a separate state here generates a jump to a
289 -- separate code block in the core which seems to perform
290 -- slightly better for the non-ascii case.
291 True -> return $ Skip $ FreshPointDecodeFirst st x
293 -- XXX should we merge it with FreshPointDecodeInit1?
294 step' table _ (FreshPointDecodeFirst st x) = do
295 let (Tuple' sv cp) = decode0 table x
296 return $
297 case sv of
298 12 ->
299 Skip $
300 transliterateOrError
301 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"
302 (FreshPointDecodeInit st)
303 0 -> error "unreachable state"
304 _ -> Skip (FreshPointDecoding st sv cp)
306 -- We recover by trying the new byte x a starter of a new codepoint.
307 -- XXX need to use the same recovery in array decoding routine as well
308 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
309 r <- step (adaptState gst) st
310 case r of
311 Yield x s -> do
312 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
313 return $
314 case sv of
315 0 -> Skip $ YieldAndContinue (unsafeChr cp)
316 (FreshPointDecodeInit s)
317 12 ->
318 Skip $
319 transliterateOrError
320 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"
321 (FreshPointDecodeInit1 s x)
322 _ -> Skip (FreshPointDecoding s sv cp)
323 Skip s -> return $ Skip (FreshPointDecoding s statePtr codepointPtr)
324 Stop -> return $ Skip inputUnderflow
326 step' _ _ (YieldAndContinue c s) = return $ Yield c s
327 step' _ _ Done = return Stop
329{-# INLINE decodeUtf8D #-}
330decodeUtf8D :: Monad m => Stream m Word8 -> Stream m Char
331decodeUtf8D = decodeUtf8WithD ErrorOnCodingFailure
333{-# INLINE decodeUtf8LenientD #-}
334decodeUtf8LenientD :: Monad m => Stream m Word8 -> Stream m Char
335decodeUtf8LenientD = decodeUtf8WithD TransliterateCodingFailure
337{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
338resumeDecodeUtf8EitherD
339 :: Monad m
340 => DecodeState
341 -> CodePoint
342 -> Stream m Word8
343 -> Stream m (Either DecodeError Char)
344resumeDecodeUtf8EitherD dst codep (Stream step state) =
345 let A.Array p _ _ = utf8d
346 !ptr = (unsafeForeignPtrToPtr p)
347 stt =
348 if dst == 0
349 then FreshPointDecodeInit state
350 else FreshPointDecoding state dst codep
351 in Stream (step' ptr) stt
352 where
353 {-# INLINE_LATE step' #-}
354 step' _ gst (FreshPointDecodeInit st) = do
355 r <- step (adaptState gst) st
356 return $ case r of
357 Yield x s -> Skip (FreshPointDecodeInit1 s x)
358 Skip s -> Skip (FreshPointDecodeInit s)
359 Stop -> Skip Done
361 step' _ _ (FreshPointDecodeInit1 st x) = do
362 -- Note: It is important to use a ">" instead of a "<=" test
363 -- here for GHC to generate code layout for default branch
364 -- prediction for the common case. This is fragile and might
365 -- change with the compiler versions, we need a more reliable
366 -- "likely" primitive to control branch predication.
367 case x > 0x7f of
368 False ->
369 return $ Skip $ YieldAndContinue
370 (Right $ unsafeChr (fromIntegral x))
371 (FreshPointDecodeInit st)
372 -- Using a separate state here generates a jump to a
373 -- separate code block in the core which seems to perform
374 -- slightly better for the non-ascii case.
375 True -> return $ Skip $ FreshPointDecodeFirst st x
377 -- XXX should we merge it with FreshPointDecodeInit1?
378 step' table _ (FreshPointDecodeFirst st x) = do
379 let (Tuple' sv cp) = decode0 table x
380 return $
381 case sv of
382 12 ->
383 Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))
384 (FreshPointDecodeInit st)
385 0 -> error "unreachable state"
386 _ -> Skip (FreshPointDecoding st sv cp)
388 -- We recover by trying the new byte x a starter of a new codepoint.
389 -- XXX need to use the same recovery in array decoding routine as well
390 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
391 r <- step (adaptState gst) st
392 case r of
393 Yield x s -> do
394 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
395 return $
396 case sv of
397 0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)
398 (FreshPointDecodeInit s)
399 12 ->
400 Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)
401 (FreshPointDecodeInit1 s x)
402 _ -> Skip (FreshPointDecoding s sv cp)
403 Skip s -> return $ Skip (FreshPointDecoding s statePtr codepointPtr)
404 Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done
406 step' _ _ (YieldAndContinue c s) = return $ Yield c s
407 step' _ _ Done = return Stop
409{-# INLINE_NORMAL decodeUtf8EitherD #-}
410decodeUtf8EitherD :: Monad m
411 => Stream m Word8 -> Stream m (Either DecodeError Char)
412decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0
414data FlattenState s a
415 = OuterLoop s !(Maybe (DecodeState, CodePoint))
416 | InnerLoopDecodeInit s (ForeignPtr a) !(Ptr a) !(Ptr a)
417 | InnerLoopDecodeFirst s (ForeignPtr a) !(Ptr a) !(Ptr a) Word8
418 | InnerLoopDecoding s (ForeignPtr a) !(Ptr a) !(Ptr a)
419 !DecodeState !CodePoint
420 | YAndC !Char (FlattenState s a) -- These constructors can be
421 -- encoded in the FreshPoint
422 -- type, I prefer to keep these
423 -- flat even though that means
424 -- coming up with new names
425 | D
427-- The normal decodeUtf8 above should fuse with flattenArrays
428-- to create this exact code but it doesn't for some reason, as of now this
429-- remains the fastest way I could figure out to decodeUtf8.
430--
431-- XXX Add Proper error messages
432{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
433decodeUtf8ArraysWithD ::
434 MonadIO m
435 => CodingFailureMode
436 -> Stream m (A.Array Word8)
437 -> Stream m Char
438decodeUtf8ArraysWithD cfm (Stream step state) =
439 let A.Array p _ _ = utf8d
440 !ptr = (unsafeForeignPtrToPtr p)
441 in Stream (step' ptr) (OuterLoop state Nothing)
442 where
443 {-# INLINE transliterateOrError #-}
444 transliterateOrError e s =
445 case cfm of
446 ErrorOnCodingFailure -> error e
447 TransliterateCodingFailure -> YAndC replacementChar s
448 {-# INLINE inputUnderflow #-}
449 inputUnderflow =
450 case cfm of
451 ErrorOnCodingFailure ->
452 error
453 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Input Underflow"
454 TransliterateCodingFailure -> YAndC replacementChar D
455 {-# INLINE_LATE step' #-}
456 step' _ gst (OuterLoop st Nothing) = do
457 r <- step (adaptState gst) st
458 return $
459 case r of
460 Yield A.Array {..} s ->
461 let p = unsafeForeignPtrToPtr aStart
462 in Skip (InnerLoopDecodeInit s aStart p aEnd)
463 Skip s -> Skip (OuterLoop s Nothing)
464 Stop -> Skip D
465 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do
466 r <- step (adaptState gst) st
467 return $
468 case r of
469 Yield A.Array {..} s ->
470 let p = unsafeForeignPtrToPtr aStart
471 in Skip (InnerLoopDecoding s aStart p aEnd ds cp)
472 Skip s -> Skip (OuterLoop s dst)
473 Stop -> Skip inputUnderflow
474 step' _ _ (InnerLoopDecodeInit st startf p end)
475 | p == end = do
476 liftIO $ touchForeignPtr startf
477 return $ Skip $ OuterLoop st Nothing
478 step' _ _ (InnerLoopDecodeInit st startf p end) = do
479 x <- liftIO $ peek p
480 -- Note: It is important to use a ">" instead of a "<=" test here for
481 -- GHC to generate code layout for default branch prediction for the
482 -- common case. This is fragile and might change with the compiler
483 -- versions, we need a more reliable "likely" primitive to control
484 -- branch predication.
485 case x > 0x7f of
486 False ->
487 return $ Skip $ YAndC
488 (unsafeChr (fromIntegral x))
489 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
490 -- Using a separate state here generates a jump to a separate code
491 -- block in the core which seems to perform slightly better for the
492 -- non-ascii case.
493 True -> return $ Skip $ InnerLoopDecodeFirst st startf p end x
495 step' table _ (InnerLoopDecodeFirst st startf p end x) = do
496 let (Tuple' sv cp) = decode0 table x
497 return $
498 case sv of
499 12 ->
500 Skip $
501 transliterateOrError
502 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
503 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
504 0 -> error "unreachable state"
505 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
506 step' _ _ (InnerLoopDecoding st startf p end sv cp)
507 | p == end = do
508 liftIO $ touchForeignPtr startf
509 return $ Skip $ OuterLoop st (Just (sv, cp))
510 step' table _ (InnerLoopDecoding st startf p end statePtr codepointPtr) = do
511 x <- liftIO $ peek p
512 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
513 return $
514 case sv of
515 0 ->
516 Skip $
517 YAndC
518 (unsafeChr cp)
519 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
520 12 ->
521 Skip $
522 transliterateOrError
523 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
524 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
525 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
526 step' _ _ (YAndC c s) = return $ Yield c s
527 step' _ _ D = return Stop
529{-# INLINE decodeUtf8ArraysD #-}
530decodeUtf8ArraysD ::
531 MonadIO m
532 => Stream m (A.Array Word8)
533 -> Stream m Char
534decodeUtf8ArraysD = decodeUtf8ArraysWithD ErrorOnCodingFailure
536{-# INLINE decodeUtf8ArraysLenientD #-}
537decodeUtf8ArraysLenientD ::
538 MonadIO m
539 => Stream m (A.Array Word8)
540 -> Stream m Char
541decodeUtf8ArraysLenientD = decodeUtf8ArraysWithD TransliterateCodingFailure
543data EncodeState s = EncodeState s !WList
545-- More yield points improve performance, but I am not sure if they can cause
546-- too much code bloat or some trouble with fusion. So keeping only two yield
547-- points for now, one for the ascii chars (fast path) and one for all other
548-- paths (slow path).
549{-# INLINE_NORMAL encodeUtf8D #-}
550encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
551encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)
552 where
553 {-# INLINE_LATE step' #-}
554 step' gst (EncodeState st WNil) = do
555 r <- step (adaptState gst) st
556 return $
557 case r of
558 Yield c s ->
559 case ord c of
560 x
561 | x <= 0x7F ->
562 Yield (fromIntegral x) (EncodeState s WNil)
563 | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
564 | x <= 0xFFFF ->
565 if isSurrogate c
566 then error
567 "Streamly.Internal.Data.Stream.StreamD.encodeUtf8: Encountered a surrogate"
568 else Skip (EncodeState s (ord3 c))
569 | otherwise -> Skip (EncodeState s (ord4 c))
570 Skip s -> Skip (EncodeState s WNil)
571 Stop -> Stop
572 step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
575-- | Decode a stream of bytes to Unicode characters by mapping each byte to a
576-- corresponding Unicode 'Char' in 0-255 range.
577--
578-- /Since: 0.7.0/
579{-# INLINE decodeLatin1 #-}
580decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char
581decodeLatin1 = S.map (unsafeChr . fromIntegral)
583-- | Encode a stream of Unicode characters to bytes by mapping each character
584-- to a byte in 0-255 range. Throws an error if the input stream contains
585-- characters beyond 255.
586--
587-- /Since: 0.7.0/
588{-# INLINE encodeLatin1 #-}
589encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8
590encodeLatin1 = S.map convert
591 where
592 convert c =
593 let codepoint = ord c
594 in if codepoint > 255
595 then error $ "Streamly.String.encodeLatin1 invalid " ++
596 "input char codepoint " ++ show codepoint
597 else fromIntegral codepoint
599-- | Like 'encodeLatin1' but silently truncates and maps input characters beyond
600-- 255 to (incorrect) chars in 0-255 range. No error or exception is thrown
601-- when such truncation occurs.
602--
603-- /Since: 0.7.0/
604{-# INLINE encodeLatin1Lax #-}
605encodeLatin1Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
606encodeLatin1Lax = S.map (fromIntegral . ord)
608-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
609-- The incoming stream is truncated if an invalid codepoint is encountered.
610--
611-- /Since: 0.7.0/
612{-# INLINE decodeUtf8 #-}
613decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char
614decodeUtf8 = D.fromStreamD . decodeUtf8D . D.toStreamD
616-- |
617--
618-- /Internal/
619{-# INLINE decodeUtf8Arrays #-}
620decodeUtf8Arrays :: (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
621decodeUtf8Arrays = D.fromStreamD . decodeUtf8ArraysD . D.toStreamD
623-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
624-- Any invalid codepoint encountered is replaced with the unicode replacement
625-- character.
626--
627-- /Since: 0.7.0/
628{-# INLINE decodeUtf8Lax #-}
629decodeUtf8Lax :: (Monad m, IsStream t) => t m Word8 -> t m Char
630decodeUtf8Lax = D.fromStreamD . decodeUtf8LenientD . D.toStreamD
632-- |
633--
634-- /Internal/
635{-# INLINE decodeUtf8Either #-}
636decodeUtf8Either :: (Monad m, IsStream t)
637 => t m Word8 -> t m (Either DecodeError Char)
638decodeUtf8Either = D.fromStreamD . decodeUtf8EitherD . D.toStreamD
640-- |
641--
642-- /Internal/
643{-# INLINE resumeDecodeUtf8Either #-}
644resumeDecodeUtf8Either
645 :: (Monad m, IsStream t)
646 => DecodeState
647 -> CodePoint
648 -> t m Word8
649 -> t m (Either DecodeError Char)
650resumeDecodeUtf8Either st cp =
651 D.fromStreamD . resumeDecodeUtf8EitherD st cp . D.toStreamD
653-- |
654--
655-- /Internal/
656{-# INLINE decodeUtf8ArraysLenient #-}
657decodeUtf8ArraysLenient ::
658 (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
659decodeUtf8ArraysLenient =
660 D.fromStreamD . decodeUtf8ArraysLenientD . D.toStreamD
662-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.
663--
664-- /Since: 0.7.0/
665{-# INLINE encodeUtf8 #-}
666encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
667encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD
669{-
670-------------------------------------------------------------------------------
671-- Utility operations on strings
672-------------------------------------------------------------------------------
674strip :: IsStream t => t m Char -> t m Char
675strip = undefined
677stripEnd :: IsStream t => t m Char -> t m Char
678stripEnd = undefined
679-}
681-- | Remove leading whitespace from a string.
682--
683-- > stripStart = S.dropWhile isSpace
684--
685-- /Internal/
686{-# INLINE stripStart #-}
687stripStart :: (Monad m, IsStream t) => t m Char -> t m Char
688stripStart = S.dropWhile isSpace
690-- | Fold each line of the stream using the supplied 'Fold'
691-- and stream the result.
692--
693-- >>> S.toList $ lines FL.toList (S.fromList "lines\nthis\nstring\n\n\n")
694-- ["lines", "this", "string", "", ""]
695--
696-- > lines = S.splitOnSuffix (== '\n')
697--
698-- /Internal/
699{-# INLINE lines #-}
700lines :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
701lines = S.splitOnSuffix (== '\n')
703foreign import ccall unsafe "u_iswspace"
704 iswspace :: Int -> Int
706-- | Code copied from base/Data.Char to INLINE it
707{-# INLINE isSpace #-}
708isSpace :: Char -> Bool
709isSpace c
710 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
711 | otherwise = iswspace (ord c) /= 0
712 where
713 uc = fromIntegral (ord c) :: Word
715-- | Fold each word of the stream using the supplied 'Fold'
716-- and stream the result.
717--
718-- >>> S.toList $ words FL.toList (S.fromList "fold these words")
719-- ["fold", "these", "words"]
720--
721-- > words = S.wordsBy isSpace
722--
723-- /Internal/
724{-# INLINE words #-}
725words :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
726words = S.wordsBy isSpace
728-- | Unfold a stream to character streams using the supplied 'Unfold'
729-- and concat the results suffixing a newline character @\\n@ to each stream.
730--
731-- /Internal/
732{-# INLINE unlines #-}
733unlines :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
734unlines = S.interposeSuffix '\n'
736-- | Unfold the elements of a stream to character streams using the supplied
737-- 'Unfold' and concat the results with a whitespace character infixed between
738-- the streams.
739--
740-- /Internal/
741{-# INLINE unwords #-}
742unwords :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
743unwords = S.interpose ' '