diff --git a/Data/Conduit/Text.hs b/Data/Conduit/Text.hs --- a/Data/Conduit/Text.hs +++ b/Data/Conduit/Text.hs @@ -49,7 +49,7 @@ import qualified Data.Conduit.List as CL import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadThrow, monadThrow) -import Control.Monad (unless,when) +import Control.Monad (unless) import Data.Streaming.Text -- | A specific character encoding. @@ -80,25 +80,22 @@ -- Since 0.4.1 lines :: Monad m => Conduit T.Text m T.Text lines = - loop id + awaitText T.empty where - loop front = await >>= maybe (finish front) (go front) + awaitText buf = await >>= maybe (finish buf) (process buf) - finish front = - let final = front T.empty - in unless (T.null final) (yield final) + finish buf = unless (T.null buf) (yield buf) - go sofar more = - case T.uncons second of - Just (_, second') -> yield (sofar first') >> go id second' - Nothing -> - let rest = sofar more - in loop $ T.append rest - where - (first', second) = T.break (== '\n') more + process buf text = yieldLines $ buf `T.append` text + yieldLines buf = + let (line, rest) = T.break (== '\n') buf + in case T.uncons rest of + Just (_, rest') -> yield line >> yieldLines rest' + _ -> awaitText line + -- | Variant of the lines function with an integer parameter. -- The text length of any emitted line -- never exceeds the value of the paramater. Whenever @@ -110,30 +107,22 @@ -- require large amounts of memory if consumed. linesBounded :: MonadThrow m => Int -> Conduit T.Text m T.Text linesBounded maxLineLen = - loop 0 id + awaitText 0 T.empty where - loop len front = await >>= maybe (finish front) (go len front) + awaitText len buf = await >>= maybe (finish buf) (process len buf) - finish front = - let final = front T.empty - in unless (T.null final) (yield final) - go len sofar more = - case T.uncons second of - Just (_, second') -> do - let toYield = sofar first' - len' = len + T.length first' - when (len' > maxLineLen) - (lift $ monadThrow (LengthExceeded maxLineLen)) - yield toYield - go 0 id second' - Nothing -> do - let len' = len + T.length more - when (len' > maxLineLen) $ - (lift $ monadThrow (LengthExceeded maxLineLen)) - let rest = sofar more - loop len' $ T.append rest - where - (first', second) = T.break (== '\n') more + finish buf = unless (T.null buf) (yield buf) + + process len buf text = + let (line, rest) = T.break (== '\n') text + len' = len + T.length line + in if len' > maxLineLen + then lift $ monadThrow (LengthExceeded maxLineLen) + else case T.uncons rest of + Just (_, rest') -> + yield (buf `T.append` line) >> process 0 T.empty rest' + _ -> + awaitText len' $ buf `T.append` text diff --git a/conduit-extra.cabal b/conduit-extra.cabal --- a/conduit-extra.cabal +++ b/conduit-extra.cabal @@ -1,5 +1,5 @@ Name: conduit-extra -Version: 1.1.0 +Version: 1.1.0.1 Synopsis: Batteries included conduit: adapters for common libraries. Description: The conduit package itself maintains relative small dependencies. The purpose of this package is to collect commonly used utility functions wrapping other library dependencies, without depending on heavier-weight dependencies. The basic idea is that this package should only depend on haskell-platform packages and conduit. @@ -44,7 +44,7 @@ , blaze-builder >= 0.3 && < 0.4 , directory , filepath - , network >= 2.3 && < 2.5 + , network >= 2.3 , primitive >= 0.5 && < 0.6 , resourcet >= 1.1 && < 1.2 , streaming-commons >= 0.1 && < 0.2 diff --git a/test/Data/Conduit/TextSpec.hs b/test/Data/Conduit/TextSpec.hs --- a/test/Data/Conduit/TextSpec.hs +++ b/test/Data/Conduit/TextSpec.hs @@ -151,41 +151,68 @@ ) describe "text lines" $ do + it "yields nothing given nothing" $ + (CL.sourceList [] C.$= CT.lines C.$$ CL.consume) == + [[]] + it "yields nothing given only empty text" $ + (CL.sourceList [""] C.$= CT.lines C.$$ CL.consume) == + [[]] it "works across split lines" $ - (CL.sourceList [T.pack "abc", T.pack "d\nef"] C.$= CT.lines C.$$ CL.consume) == - [[T.pack "abcd", T.pack "ef"]] + (CL.sourceList ["abc", "d\nef"] C.$= CT.lines C.$$ CL.consume) == + [["abcd", "ef"]] it "works with multiple lines in an item" $ - (CL.sourceList [T.pack "ab\ncd\ne"] C.$= CT.lines C.$$ CL.consume) == - [[T.pack "ab", T.pack "cd", T.pack "e"]] + (CL.sourceList ["ab\ncd\ne"] C.$= CT.lines C.$$ CL.consume) == + [["ab", "cd", "e"]] it "works with ending on a newline" $ - (CL.sourceList [T.pack "ab\n"] C.$= CT.lines C.$$ CL.consume) == - [[T.pack "ab"]] + (CL.sourceList ["ab\n"] C.$= CT.lines C.$$ CL.consume) == + [["ab"]] it "works with ending a middle item on a newline" $ - (CL.sourceList [T.pack "ab\n", T.pack "cd\ne"] C.$= CT.lines C.$$ CL.consume) == - [[T.pack "ab", T.pack "cd", T.pack "e"]] + (CL.sourceList ["ab\n", "cd\ne"] C.$= CT.lines C.$$ CL.consume) == + [["ab", "cd", "e"]] + it "works with empty text" $ + (CL.sourceList ["ab", "", "cd"] C.$= CT.lines C.$$ CL.consume) == + [["abcd"]] + it "works with empty lines" $ + (CL.sourceList ["\n\n"] C.$= CT.lines C.$$ CL.consume) == + [["", ""]] it "is not too eager" $ do x <- CL.sourceList ["foobarbaz", error "ignore me"] C.$$ CT.decode CT.utf8 C.=$ CL.head x `shouldBe` Just "foobarbaz" describe "text lines bounded" $ do + it "yields nothing given nothing" $ + (CL.sourceList [] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [[]] + it "yields nothing given only empty text" $ + (CL.sourceList [""] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [[]] it "works across split lines" $ - (CL.sourceList [T.pack "abc", T.pack "d\nef"] C.$= CT.linesBounded 80 C.$$ CL.consume) == - [[T.pack "abcd", T.pack "ef"]] + (CL.sourceList ["abc", "d\nef"] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [["abcd", "ef"]] it "works with multiple lines in an item" $ - (CL.sourceList [T.pack "ab\ncd\ne"] C.$= CT.linesBounded 80 C.$$ CL.consume) == - [[T.pack "ab", T.pack "cd", T.pack "e"]] + (CL.sourceList ["ab\ncd\ne"] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [["ab", "cd", "e"]] it "works with ending on a newline" $ - (CL.sourceList [T.pack "ab\n"] C.$= CT.linesBounded 80 C.$$ CL.consume) == - [[T.pack "ab"]] + (CL.sourceList ["ab\n"] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [["ab"]] it "works with ending a middle item on a newline" $ - (CL.sourceList [T.pack "ab\n", T.pack "cd\ne"] C.$= CT.linesBounded 80 C.$$ CL.consume) == - [[T.pack "ab", T.pack "cd", T.pack "e"]] + (CL.sourceList ["ab\n", "cd\ne"] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [["ab", "cd", "e"]] + it "works with empty text" $ + (CL.sourceList ["ab", "", "cd"] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [["abcd"]] + it "works with empty lines" $ + (CL.sourceList ["\n\n"] C.$= CT.linesBounded 80 C.$$ CL.consume) == + [["", ""]] it "is not too eager" $ do x <- CL.sourceList ["foobarbaz", error "ignore me"] C.$$ CT.decode CT.utf8 C.=$ CL.head x `shouldBe` Just "foobarbaz" it "throws an exception when lines are too long" $ do x <- runExceptionT $ CL.sourceList ["hello\nworld"] C.$$ CT.linesBounded 4 C.=$ CL.consume show x `shouldBe` show (Left $ CT.LengthExceeded 4 :: Either CT.TextException ()) + it "works with infinite input" $ do + x <- runExceptionT $ CL.sourceList (cycle ["hello"]) C.$$ CT.linesBounded 256 C.=$ CL.consume + show x `shouldBe` show (Left $ CT.LengthExceeded 256 :: Either CT.TextException ()) describe "text decode" $ do it' "doesn't throw runtime exceptions" $ do let x = runIdentity $ runExceptionT $ C.yield "\x89\x243" C.$$ CT.decode CT.utf8 C.=$ CL.consume