254f27f · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add unlines, unwords, tests for lines/unlines and words/unwords.

254f27fPranay Sashank7 years ago

examples/HandleIO.hs+3−1

compare with master

unifiedsplit

@@ -2,6 +2,7 @@ import qualified Streamly.Prelude as S

2import qualified Streamly.Fold as FL

3import qualified Streamly.Mem.Array as A

4import qualified Streamly.FileSystem.Handle as FH

5+import qualified Streamly.String as SS

6import Data.Char (ord)

7import Data.Char (ord)

7import System.Environment (getArgs)

8import System.Environment (getArgs)

@@ -18,7 +19,8 @@ ord' = (fromIntegral . ord)

19wcl :: Handle -> IO ()

20wcl :: Handle -> IO ()

20wcl src = print =<< (S.length

21wcl src = print =<< (S.length

21− $ FL.splitSuffixBy (== ord' '\n') FL.drain

22+ $ flip SS.foldLines FL.drain

23+ $ SS.decodeChar8

22 $ FH.read src)

24 $ FH.read src)

24grepc :: String -> Handle -> IO ()

26grepc :: String -> Handle -> IO ()

src/Streamly/FileSystem/Handle.hs+16−3

@@ -114,6 +114,7 @@ import Streamly.Streams.StreamK.Type (IsStream, mkStream)

114import qualified Streamly.Mem.Array as A

115import qualified Streamly.Mem.Array.Types as A hiding (flattenArrays)

116import qualified Streamly.Prelude as S

117+import qualified Streamly.Streams.StreamD.Type as D

117

118

118-------------------------------------------------------------------------------

119-------------------------------------------------------------------------------

119-- References

120-- References

@@ -174,10 +175,10 @@ writeArray h Array{..} = withForeignPtr aStart $ \p -> hPutBuf h p aLen

174-- | @readArraysUpto size h@ reads a stream of arrays from file handle @h@.

175-- | @readArraysUpto size h@ reads a stream of arrays from file handle @h@.

175-- The maximum size of a single array is specified by @size@. The actual size

176-- The maximum size of a single array is specified by @size@. The actual size

176-- read may be less than or equal to @size@.

177-- read may be less than or equal to @size@.

177−{-# INLINABLE readArraysUpto #-}

178+{-# INLINABLE _readArraysUpto #-}

178−readArraysUpto :: (IsStream t, MonadIO m)

179+_readArraysUpto :: (IsStream t, MonadIO m)

179 => Int -> Handle -> t m (Array Word8)

180 => Int -> Handle -> t m (Array Word8)

180−readArraysUpto size h = go

181+_readArraysUpto size h = go

181 where

182 where

182 -- XXX use cons/nil instead

183 -- XXX use cons/nil instead

183 go = mkStream $ \_ yld _ stp -> do

184 go = mkStream $ \_ yld _ stp -> do

@@ -186,6 +187,18 @@ readArraysUpto size h = go

186 then stp

187 then stp

187 else yld arr go

188 else yld arr go

188

189

190+{-# INLINE_NORMAL readArraysUpto #-}

191+readArraysUpto :: (IsStream t, MonadIO m) => Int -> Handle -> t m (Array Word8)

192+readArraysUpto size h = D.fromStreamD (D.Stream step ())

193+ where

194+ {-# INLINE_LATE step #-}

195+ step _ _ = do

196+ arr <- liftIO $ readArrayUpto size h

197+ return $

198+ case A.length arr of

199+ 0 -> D.Stop

200+ _ -> D.Yield arr ()

201+

189-- XXX read 'Array a' instead of Word8

202-- XXX read 'Array a' instead of Word8

190--

203--

191-- | @readArrays h@ reads a stream of arrays from file handle @h@.

204-- | @readArrays h@ reads a stream of arrays from file handle @h@.

src/Streamly/Mem/Array/Types.hs+45−2

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

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TypeFamilies #-}

8{-# LANGUAGE UnboxedTuples #-}

9−

9+{-# LANGUAGE FlexibleContexts #-}

10#include "inline.hs"

12-- |

@@ -57,6 +57,8 @@ module Streamly.Mem.Array.Types

57 , mkChunkSize

58 , mkChunkSizeKB

59 , reallocDouble

60+

61+ , unlines

60 )

62 )

61where

63where

@@ -73,7 +75,7 @@ import Foreign.ForeignPtr

73import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

75import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

74import Foreign.Ptr (plusPtr, minusPtr, castPtr)

76import Foreign.Ptr (plusPtr, minusPtr, castPtr)

75import Foreign.Storable (Storable(..))

77import Foreign.Storable (Storable(..))

76−import Prelude hiding (length, foldr, read)

78+import Prelude hiding (length, foldr, read, unlines, unwords)

77import Text.Read (readPrec, readListPrec, readListPrecDefault)

79import Text.Read (readPrec, readListPrec, readListPrecDefault)

79import GHC.Base (Addr#, realWorld#)

81import GHC.Base (Addr#, realWorld#)

@@ -344,6 +346,22 @@ toStreamD Array{..} =

344 return r

346 return r

345 return $ D.Yield x (p `plusPtr` (sizeOf (undefined :: a)))

347 return $ D.Yield x (p `plusPtr` (sizeOf (undefined :: a)))

346

348

349+

350+{-# INLINE toStreamK #-}

351+toStreamK :: forall t m a. (K.IsStream t, Monad m, Storable a) => Array a -> t m a

352+toStreamK Array{..} =

353+ let p = unsafeForeignPtrToPtr aStart

354+ in go p

355+ where

356+ go p | p == aEnd = K.nil

357+ | otherwise =

358+ -- See Note in toStreamD.

359+ let !x = unsafeInlineIO $ do

360+ r <- peek p

361+ touchForeignPtr aStart

362+ return r

363+ in x `K.cons` go (p `plusPtr` (sizeOf (undefined :: a)))

364+

347{-# INLINE_NORMAL toStreamDRev #-}

365{-# INLINE_NORMAL toStreamDRev #-}

348toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

366toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

349toStreamDRev Array{..} =

367toStreamDRev Array{..} =

@@ -665,3 +683,28 @@ mkChunkSizeKB n = mkChunkSize (n * k)

665-- bytes, so that the actual allocation is 32KB.

683-- bytes, so that the actual allocation is 32KB.

666defaultChunkSize :: Int

684defaultChunkSize :: Int

667defaultChunkSize = mkChunkSizeKB 32

685defaultChunkSize = mkChunkSizeKB 32

686+

687+{-# INLINE_NORMAL unlines #-}

688+unlines :: MonadIO m => D.Stream m (Array Char) -> D.Stream m Char

689+unlines (D.Stream step state) = D.Stream step' (OuterLoop state)

690+ where

691+ {-# INLINE_LATE step' #-}

692+ step' gst (OuterLoop st) = do

693+ r <- step (adaptState gst) st

694+ return $ case r of

695+ D.Yield Array{..} s ->

696+ let p = unsafeForeignPtrToPtr aStart

697+ in D.Skip (InnerLoop s aStart p aEnd)

698+ D.Skip s -> D.Skip (OuterLoop s)

699+ D.Stop -> D.Stop

700+

701+ step' _ (InnerLoop st _ p end) | p == end =

702+ return $ D.Yield '\n' $ OuterLoop st

703+

704+ step' _ (InnerLoop st startf p end) = do

705+ x <- liftIO $ do

706+ r <- peek p

707+ touchForeignPtr startf

708+ return r

709+ return $ D.Yield x (InnerLoop st startf

710+ (p `plusPtr` (sizeOf (undefined :: Char))) end)

src/Streamly/String.hs+27−11

@@ -1,3 +1,4 @@

1+{-# LANGUAGE FlexibleContexts #-}

1-- |

2-- |

2-- Module : Streamly.String

3-- Module : Streamly.String

@@ -52,23 +53,25 @@ module Streamly.String

52 , foldLines

53 , foldLines

53 , foldWords

54 , foldWords

54 , lines

55 , lines

55− , words{-

56+ , words

56 , unlines

57 , unlines

57− , unwords-}

58+ , unwords

58 )

59 )

59where

60where

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

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

62−import Data.Char (isSpace, ord)

63+import Data.Char (ord)

63import Data.Word (Word8)

64import Data.Word (Word8)

64import GHC.Base (unsafeChr)

65import GHC.Base (unsafeChr)

65−import Streamly (IsStream)

66+import Streamly (IsStream, MonadAsync)

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

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

67import Streamly.Fold (Fold)

68import Streamly.Fold (Fold)

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

69import Streamly.Mem.Array (Array, toArray)

70import qualified Streamly.Prelude as S

71import qualified Streamly.Prelude as S

71import qualified Streamly.Fold as FL

72import qualified Streamly.Fold as FL

73+import qualified Streamly.Mem.Array.Types as A (unlines)

74+import qualified Streamly.Mem.Array as A

72import qualified Streamly.Streams.StreamD as D

75import qualified Streamly.Streams.StreamD as D

74-- type String = List Char

77-- type String = List Char

@@ -112,12 +115,13 @@ encodeChar8Unchecked :: (IsStream t, Monad m) => t m Char -> t m Word8

112encodeChar8Unchecked = S.map (fromIntegral . ord)

115encodeChar8Unchecked = S.map (fromIntegral . ord)

113

116

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

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

118+-- The incoming stream is truncated if an invalid codepoint is encountered.

115{-# INLINE decodeUtf8 #-}

119{-# INLINE decodeUtf8 #-}

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

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

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

121decodeUtf8 = D.fromStreamD . D.decodeUtf8 . D.toStreamD

118

122

119−{-# INLINE encodeUtf8 #-}

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

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

124+{-# INLINE encodeUtf8 #-}

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

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

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

126encodeUtf8 = D.fromStreamD . D.encodeUtf8 . D.toStreamD

123

127

@@ -161,6 +165,18 @@ foldLines = flip (FL.splitSuffixBy (== '\n'))

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

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

162foldWords = flip (FL.wordsBy isSpace)

166foldWords = flip (FL.wordsBy isSpace)

163

167

168+foreign import ccall unsafe "u_iswspace"

169+ iswspace :: Int -> Int

170+

171+-- Code copied from base/Data.Char to INLINE it

172+{-# INLINE isSpace #-}

173+isSpace :: Char -> Bool

174+isSpace c

175+ | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0

176+ | otherwise = iswspace (ord c) /= 0

177+ where

178+ uc = fromIntegral (ord c) :: Word

179+

164{-# INLINE lines #-}

180{-# INLINE lines #-}

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

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

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

182lines = FL.splitSuffixBy (== '\n') toArray

@@ -169,10 +185,10 @@ lines = FL.splitSuffixBy (== '\n') toArray

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

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

170words = FL.wordsBy isSpace toArray

186words = FL.wordsBy isSpace toArray

171

187

172−{-

188+{-# INLINE unlines #-}

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

189+unlines :: (MonadIO m, IsStream t) => t m (Array Char) -> t m Char

174−unlines = undefined

190+unlines = D.fromStreamD . A.unlines . D.toStreamD

175

191

192+{-# INLINE unwords #-}

176−unwords :: IsStream t => t m (Array Char) -> t m Char

193+unwords :: (MonadAsync m, IsStream t) => t m (Array Char) -> t m Char

177−unwords = undefined

194+unwords = A.flattenArrays . (S.intersperseM (return $ A.fromList " "))

178−-}

test/String.hs+56−6

@@ -3,14 +3,15 @@

4module Main (main) where

6−import Test.Hspec.QuickCheck

6+import Test.Hspec.QuickCheck

7−import Test.QuickCheck (Property, forAll, Gen, listOf, arbitraryUnicodeChar)

7+import Test.QuickCheck (Property, forAll, Gen, listOf, arbitraryUnicodeChar)

8−import Test.QuickCheck.Monadic (monadicIO, assert)

8+import Test.QuickCheck.Monadic (run, monadicIO, assert)

10−import Test.Hspec as H

10+import Test.Hspec as H

12−import qualified Streamly.String as SS

12+import qualified Streamly.Mem.Array as A

13import qualified Streamly.Prelude as S

14+import qualified Streamly.String as SS

15-- Coverage build takes too long with default number of tests

16-- Coverage build takes too long with default number of tests

16maxTestCount :: Int

17maxTestCount :: Int

@@ -32,10 +33,59 @@ propDecodeEncodeId =

32 chrs <- S.toList $ SS.decodeUtf8 wrds

33 chrs <- S.toList $ SS.decodeUtf8 wrds

33 assert (chrs == list)

34 assert (chrs == list)

36+testLines :: Property

37+testLines =

38+ forAll genUnicode $ \list ->

39+ monadicIO $ do

40+ xs <- S.toList

41+ $ S.map A.toList

42+ $ SS.lines

43+ $ S.fromList list

44+ assert (xs == lines list)

45+

46+testWords :: Property

47+testWords =

48+ forAll genUnicode $ \list ->

49+ monadicIO $ do

50+ xs <- S.toList

51+ $ S.map A.toList

52+ $ SS.words

53+ $ S.fromList list

54+ assert (xs == words list)

55+

56+testUnlines :: Property

57+testUnlines =

58+ forAll genUnicode $ \list ->

59+ monadicIO $ do

60+ xs <- S.toList

61+ $ SS.unlines

62+ $ SS.lines

63+ $ S.fromList list

64+ assert (xs == unlines (lines list))

65+

66+testUnwords :: Property

67+testUnwords =

68+ forAll genUnicode $ \list ->

69+ monadicIO $ do

70+ xs <- run

71+ $ S.toList

72+ $ SS.unwords

73+ $ SS.words

74+ $ S.fromList list

75+ assert (xs == unwords (words list))

76+

35main :: IO ()

77main :: IO ()

36main = hspec

78main = hspec

37 $ H.parallel

79 $ H.parallel

38− $ modifyMaxSuccess (const maxTestCount)

80+ $ modifyMaxSuccess (const 1000)

39 $ do

81 $ do

40 describe "UTF8 - Encoding / Decoding" $ do

82 describe "UTF8 - Encoding / Decoding" $ do

41 prop "decodeUtf8 . encodeUtf8 == id" $ propDecodeEncodeId

83 prop "decodeUtf8 . encodeUtf8 == id" $ propDecodeEncodeId

84+ prop "Streamly.String.lines == Prelude.lines" $ testLines

85+ prop "Streamly.String.words == Prelude.words" $ testWords

86+ prop

87+ "Streamly.String.unlines . Streamly.String.lines == unlines . lines"

88+ $ testUnlines

89+ prop

90+ "Streamly.String.unwords . Streamly.String.words == unwords . words"

91+ $ testUnwords