a3196b3 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add String transformation and UTF8 encoding/decoding operations.

a3196b3Pranay Sashank7 years ago

src/Streamly/Streams/StreamD.hs+248−1

compare with master

unifiedsplit

@@ -10,6 +10,7 @@

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE ViewPatterns #-}

12{-# LANGUAGE RankNTypes #-}

13+{-# LANGUAGE MagicHash #-}

14#include "inline.hs"

15#include "inline.hs"

@@ -235,6 +236,10 @@ module Streamly.Streams.StreamD

235 , onException

236 , onException

236 , finally

237 , finally

237 , handle

238 , handle

239+

240+ -- * UTF8 Encoding / Decoding transformations.

241+ , decodeUtf8

242+ , encodeUtf8

238 )

243 )

239where

244where

240

245

@@ -242,12 +247,16 @@ import Control.Exception (Exception)

242import Control.Monad.Catch (MonadCatch)

247import Control.Monad.Catch (MonadCatch)

243import Control.Monad.IO.Class (MonadIO(..))

248import Control.Monad.IO.Class (MonadIO(..))

244import Control.Monad.Trans (MonadTrans(lift))

249import Control.Monad.Trans (MonadTrans(lift))

245−import Data.Word (Word32)

246import Data.Bits (shiftR, shiftL, (.|.), (.&.))

250import Data.Bits (shiftR, shiftL, (.|.), (.&.))

247import Data.Maybe (fromJust, isJust)

251import Data.Maybe (fromJust, isJust)

252+import Data.Word (Word32)

248import Foreign.Ptr (Ptr)

253import Foreign.Ptr (Ptr)

249import Foreign.Storable (Storable(..))

254import Foreign.Storable (Storable(..))

255+import GHC.Base (assert, Char(..), unsafeChr, (-#), (+#), uncheckedIShiftL#,

256+ word2Int#, chr#, ord)

257+import GHC.IO.Encoding.Failure (isSurrogate)

250import GHC.Types (SPEC(..))

258import GHC.Types (SPEC(..))

259+import GHC.Word (Word8(..))

251import Prelude

260import Prelude

252 hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,

261 hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,

253 takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,

262 takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,

@@ -2355,3 +2364,241 @@ the (Stream step state) = go state

2355 | otherwise -> return Nothing

2364 | otherwise -> return Nothing

2356 Skip s -> go' n s

2365 Skip s -> go' n s

2357 Stop -> return (Just n)

2366 Stop -> return (Just n)

2367+

2368+--------------------------------------------------------------------------------

2369+-- UTF8 Encoding / Decoding

2370+--------------------------------------------------------------------------------

2371+

2372+-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.

2373+

2374+ord2 :: Char -> [Word8]

2375+ord2 c = assert (n >= 0x80 && n <= 0x07ff) [x1, x2]

2376+ where

2377+ n = ord c

2378+ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0

2379+ x2 = fromIntegral $ (n .&. 0x3F) + 0x80

2380+

2381+ord3 :: Char -> [Word8]

2382+ord3 c = assert (n >= 0x0800 && n <= 0xffff) [x1, x2, x3]

2383+ where

2384+ n = ord c

2385+ x1 = fromIntegral $ (n `shiftR` 12) + 0xE0

2386+ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

2387+ x3 = fromIntegral $ (n .&. 0x3F) + 0x80

2388+

2389+ord4 :: Char -> [Word8]

2390+ord4 c = assert (n >= 0x10000) [x1, x2, x3, x4]

2391+ where

2392+ n = ord c

2393+ x1 = fromIntegral $ (n `shiftR` 18) + 0xF0

2394+ x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80

2395+ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

2396+ x4 = fromIntegral $ (n .&. 0x3F) + 0x80

2397+

2398+{-# INLINE chr2 #-}

2399+chr2 :: Word8 -> Word8 -> Char

2400+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

2401+ where

2402+ !y1# = word2Int# x1#

2403+ !y2# = word2Int# x2#

2404+ !z1# = uncheckedIShiftL# (y1# -# 192#) 6#

2405+ !z2# = y2# -# 128#

2406+

2407+{-# INLINE chr3 #-}

2408+chr3 :: Word8 -> Word8 -> Word8 -> Char

2409+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))

2410+ where

2411+ !y1# = word2Int# x1#

2412+ !y2# = word2Int# x2#

2413+ !y3# = word2Int# x3#

2414+ !z1# = uncheckedIShiftL# (y1# -# 224#) 12#

2415+ !z2# = uncheckedIShiftL# (y2# -# 128#) 6#

2416+ !z3# = y3# -# 128#

2417+

2418+{-# INLINE chr4 #-}

2419+chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char

2420+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =

2421+ C# (chr# (z1# +# z2# +# z3# +# z4#))

2422+ where

2423+ !y1# = word2Int# x1#

2424+ !y2# = word2Int# x2#

2425+ !y3# = word2Int# x3#

2426+ !y4# = word2Int# x4#

2427+ !z1# = uncheckedIShiftL# (y1# -# 240#) 18#

2428+ !z2# = uncheckedIShiftL# (y2# -# 128#) 12#

2429+ !z3# = uncheckedIShiftL# (y3# -# 128#) 6#

2430+ !z4# = y4# -# 128#

2431+

2432+{-# INLINE between #-}

2433+between ::

2434+ Word8 -- ^ byte to check

2435+ -> Word8 -- ^ lower bound

2436+ -> Word8 -- ^ upper bound

2437+ -> Bool

2438+between x y z = x >= y && x <= z

2439+

2440+{-# INLINE validate3 #-}

2441+validate3 :: Word8 -> Word8 -> Word8 -> Bool

2442+validate3 x1 x2 x3 = validate3_1 ||

2443+ validate3_2 ||

2444+ validate3_3 ||

2445+ validate3_4

2446+ where

2447+ validate3_1 = (x1 == 0xE0) &&

2448+ between x2 0xA0 0xBF &&

2449+ between x3 0x80 0xBF

2450+ validate3_2 = between x1 0xE1 0xEC &&

2451+ between x2 0x80 0xBF &&

2452+ between x3 0x80 0xBF

2453+ validate3_3 = x1 == 0xED &&

2454+ between x2 0x80 0x9F &&

2455+ between x3 0x80 0xBF

2456+ validate3_4 = between x1 0xEE 0xEF &&

2457+ between x2 0x80 0xBF &&

2458+ between x3 0x80 0xBF

2459+

2460+{-# INLINE validate4 #-}

2461+validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

2462+validate4 x1 x2 x3 x4 = validate4_1 ||

2463+ validate4_2 ||

2464+ validate4_3

2465+ where

2466+ validate4_1 = x1 == 0xF0 &&

2467+ between x2 0x90 0xBF &&

2468+ between x3 0x80 0xBF &&

2469+ between x4 0x80 0xBF

2470+ validate4_2 = between x1 0xF1 0xF3 &&

2471+ between x2 0x80 0xBF &&

2472+ between x3 0x80 0xBF &&

2473+ between x4 0x80 0xBF

2474+ validate4_3 = x1 == 0xF4 &&

2475+ between x2 0x80 0x8F &&

2476+ between x3 0x80 0xBF &&

2477+ between x4 0x80 0xBF

2478+

2479+data CodePoint = FreshPoint

2480+ | Two !Word8

2481+ | GoThree !Word8

2482+ | Three !Word8 !Word8

2483+ | GoFour !Word8

2484+ | Four1 !Word8 !Word8

2485+ | Four !Word8 !Word8 !Word8

2486+ | YieldPoint !Char

2487+

2488+{-# INLINE_NORMAL decodeUtf8 #-}

2489+decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char

2490+decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

2491+ where

2492+ {-# INLINE_LATE step' #-}

2493+ step' gst (st, FreshPoint) = do

2494+ r <- step (adaptState gst) st

2495+ return $

2496+ case r of

2497+ Yield c0 s

2498+ | c0 <= 0x7f ->

2499+ Skip (s, YieldPoint $ unsafeChr (fromIntegral c0))

2500+ | c0 >= 0xc0 && c0 <= 0xc1 -> error "Invalid Overlong forms"

2501+ | c0 >= 0xc2 && c0 <= 0xdf -> Skip (s, Two c0)

2502+ | c0 >= 0xe0 && c0 <= 0xef -> Skip (s, GoThree c0)

2503+ | c0 >= 0xf0 -> Skip (s, GoFour c0)

2504+ | otherwise -> error "Invalid Sequence"

2505+ Skip s -> Skip (s, FreshPoint)

2506+ Stop -> Stop

2507+

2508+ -- Decoding of a UTF8 character that spans two bytes with one byte (c0)

2509+ -- known.

2510+ step' gst (st, Two c0) = do

2511+ r <- step (adaptState gst) st

2512+ return $

2513+ case r of

2514+ Yield c1 s

2515+ | c1 < 0x80 || c1 >= 0xc0 -> error "Invalid Sequence"

2516+ | otherwise -> Skip (s, YieldPoint $ chr2 c0 c1)

2517+ Skip s -> Skip (s, Two c0)

2518+ Stop -> error "Input Underflow"

2519+

2520+ -- Decoding of a UTF8 character that spans three bytes with first byte (c0)

2521+ -- known.

2522+ step' gst (st, GoThree c0) = do

2523+ r <- step (adaptState gst) st

2524+ return $

2525+ case r of

2526+ Yield c1 s

2527+ | not (validate3 c0 c1 0x80) -> error "Invalid Sequence"

2528+ -- See #3341@ghc

2529+ | otherwise -> Skip (s, Three c0 c1)

2530+ Skip s -> Skip (s, GoThree c0)

2531+ Stop -> error "Input Underflow"

2532+

2533+ -- Two bytes known of a 3 byte UTF8 encoded unicode character.

2534+ step' gst (st, Three c0 c1) = do

2535+ r <- step (adaptState gst) st

2536+ return $

2537+ case r of

2538+ Yield c2 s

2539+ | not (validate3 c0 c1 c2) -> error "Invalid Sequence"

2540+ | otherwise -> Skip (s, YieldPoint $ chr3 c0 c1 c2)

2541+ Skip s -> Skip (s, Three c0 c1)

2542+ Stop -> error "Input Underflow"

2543+

2544+ -- One byte known of a four byte UTF8 unicode character.

2545+ step' gst (st, GoFour c0) = do

2546+ r <- step (adaptState gst) st

2547+ return $

2548+ case r of

2549+ Yield c1 s

2550+ | not (validate4 c0 c1 0x80 0x80) -> error "Invalid Sequence"

2551+ | otherwise -> Skip (s, Four1 c0 c1)

2552+ Skip s -> Skip (s, GoFour c0)

2553+ Stop -> error "Input Underflow"

2554+

2555+ -- Two bytes known of a four byte UTF8 unicode character.

2556+ step' gst (st, Four1 c0 c1) = do

2557+ r <- step (adaptState gst) st

2558+ return $

2559+ case r of

2560+ Yield c2 s

2561+ | not (validate4 c0 c1 c2 0x80) -> error "Invalid Sequence"

2562+ | otherwise -> Skip (s, Four c0 c1 c2)

2563+ Skip s -> Skip (s, Four1 c0 c1)

2564+ Stop -> error "Input Underflow"

2565+

2566+ -- Three bytes known of a three byte UTF8 unicode character.

2567+ step' gst (st, Four c0 c1 c2) = do

2568+ r <- step (adaptState gst) st

2569+ return $

2570+ case r of

2571+ Yield c3 s

2572+ | not (validate4 c0 c1 c2 c3) -> error "Invalid Sequence"

2573+ | otherwise -> Skip (s, YieldPoint $ chr4 c0 c1 c2 c3)

2574+ Skip s -> Skip (s, Four c0 c1 c2)

2575+ Stop -> error "Input Underflow"

2576+

2577+ -- This way so that we only need one Yield.

2578+ step' _ (s, YieldPoint c) = return $ Yield c (s, FreshPoint)

2579+

2580+data YieldMany x = None

2581+ | YieldMany !x

2582+

2583+{-# INLINE_NORMAL encodeUtf8 #-}

2584+encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8

2585+encodeUtf8 (Stream step state) = Stream step' (state, None)

2586+ where

2587+ {-# INLINE_LATE step' #-}

2588+ step' gst (st, None) = do

2589+ r <- step (adaptState gst) st

2590+ return $

2591+ case r of

2592+ Yield c s ->

2593+ case ord c of

2594+ x | x <= 0x7F -> Skip (s, YieldMany [fromIntegral x])

2595+ | x <= 0x7FF -> Skip (s, YieldMany (ord2 c))

2596+ | x <= 0xFFFF ->

2597+ if isSurrogate c

2598+ then error "Encountered a surrogate"

2599+ else Skip (s, YieldMany (ord3 c))

2600+ | otherwise -> Skip (s, YieldMany (ord4 c))

2601+ Skip s -> Skip (s, None)

2602+ Stop -> Stop

2603+ step' _ (s, YieldMany []) = return $ Skip (s, None)

2604+ step' _ (s, YieldMany (x:xs)) = return $ Yield x (s, YieldMany xs)

src/Streamly/String.hs+36−26

@@ -35,10 +35,10 @@ module Streamly.String

35 encodeChar8

36 , encodeChar8Unchecked

37 , decodeChar8

38−{-

38+

39 , encodeUtf8

40 , decodeUtf8

41−

41+{-

42 -- * Unicode aware operations

43 , toCaseFold

44 , toLower

@@ -47,28 +47,29 @@ module Streamly.String

48 -- * Operations on character strings

49 , strip -- (dropAround isSpace)

50+ , stripEnd-}

50 , stripStart

51 , stripStart

51− , stripEnd

52 , foldLines

53 , foldWords

54 , lines

55− , words

55+ , words{-

56 , unlines

57− , unwords

57+ , unwords-}

58−-}

59 )

58 )

60where

59where

61+import Control.Monad.IO.Class (MonadIO)

62−import Data.Char (ord)

62+import Data.Char (isSpace, ord)

63import Data.Word (Word8)

64import GHC.Base (unsafeChr)

65import Streamly (IsStream)

66−-- import Streamly.List (List)

67import Prelude hiding (String, lines, words, unlines, unwords)

66import Prelude hiding (String, lines, words, unlines, unwords)

68−-- import Streamly.Fold (Fold)

67+import Streamly.Fold (Fold)

69−-- import Streamly.Array (Array)

68+import Streamly.Mem.Array (Array, toArray)

71import qualified Streamly.Prelude as S

70import qualified Streamly.Prelude as S

71+import qualified Streamly.Fold as FL

72+import qualified Streamly.Streams.StreamD as D

73-- type String = List Char

74-- type String = List Char

@@ -110,15 +111,17 @@ encodeChar8 = S.map convert

110encodeChar8Unchecked :: (IsStream t, Monad m) => t m Char -> t m Word8

111encodeChar8Unchecked :: (IsStream t, Monad m) => t m Char -> t m Word8

111encodeChar8Unchecked = S.map (fromIntegral . ord)

112encodeChar8Unchecked = S.map (fromIntegral . ord)

112

113

113−{-

114-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.

115+{-# INLINE decodeUtf8 #-}

115−decodeUtf8 :: IsStream t => t m Word8 -> t m Char

116+decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char

116−decodeUtf8 = undefined

117+decodeUtf8 = D.fromStreamD . D.decodeUtf8 . D.toStreamD

117

118

119+{-# INLINE encodeUtf8 #-}

118-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

120-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

119−encodeUtf8 :: IsStream t => t m Char -> t m Word8

121+encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

120−encodeUtf8 = undefined

122+encodeUtf8 = D.fromStreamD . D.encodeUtf8 . D.toStreamD

121

123

124+{-

122-------------------------------------------------------------------------------

125-------------------------------------------------------------------------------

123-- Unicode aware operations on strings

126-- Unicode aware operations on strings

124-------------------------------------------------------------------------------

127-------------------------------------------------------------------------------

@@ -142,24 +145,31 @@ toTitle = undefined

142strip :: IsStream t => t m Char -> t m Char

145strip :: IsStream t => t m Char -> t m Char

143strip = undefined

146strip = undefined

144

147

145−stripStart :: IsStream t => t m Char -> t m Char

146−stripStart = undefined

147−

148stripEnd :: IsStream t => t m Char -> t m Char

149stripEnd = undefined

150+-}

150

151

152+{-# INLINE stripStart #-}

151−foldLines :: IsStream t => t m Char -> Fold m Char b -> t m b

153+stripStart :: (Monad m, IsStream t) => t m Char -> t m Char

152−foldLines = undefined

154+stripStart = S.dropWhile isSpace

153

155

156+{-# INLINE foldLines #-}

154−foldWords :: IsStream t => t m Char -> Fold m Char b -> t m b

157+foldLines :: (Monad m, IsStream t) => t m Char -> Fold m Char b -> t m b

155−foldWords = undefined

158+foldLines = flip (FL.splitSuffixBy (== '\n'))

156

159

160+{-# INLINE foldWords #-}

157−lines :: IsStream t => t m Char -> t m (Array Char)

161+foldWords :: (Monad m, IsStream t) => t m Char -> Fold m Char b -> t m b

158−lines = undefined

162+foldWords = flip (FL.wordsBy isSpace)

159

163

164+{-# INLINE lines #-}

160−words :: IsStream t => t m Char -> t m (Array Char)

165+lines :: (MonadIO m, IsStream t) => t m Char -> t m (Array Char)

161−words = undefined

166+lines = FL.splitSuffixBy (== '\n') toArray

162

167

168+{-# INLINE words #-}

169+words :: (MonadIO m, IsStream t) => t m Char -> t m (Array Char)

170+words = FL.wordsBy isSpace toArray

171+

172+{-

163unlines :: IsStream t => t m (Array Char) -> t m Char

173unlines :: IsStream t => t m (Array Char) -> t m Char

164unlines = undefined

174unlines = undefined

165

175