packages feed

pipes-break (empty) → 0.2.0.0

raw patch · 9 files changed

+644/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, mtl, pipes, pipes-break, pipes-group, pipes-parse, text

Files

+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2013, 2014 David McHealy+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright notice,+      this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+      this list of conditions and the following disclaimer in the documentation+      and/or other materials provided with the distribution.+    * Neither the name of Gabriel Gonzalez nor the names of other contributors+      may be used to endorse or promote products derived from this software+      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pipes-break.cabal view
@@ -0,0 +1,52 @@+name:                pipes-break+version:             0.2.0.0+synopsis:            Pipes for grouping by input by any delimiter (such as lines with carriage returns)+description:+  `pipes-break` contains utility functions for splitting bytestring or text with any delimiter you like.+  .+  These are utility functions that were omitted from pipes-bytestring, pipes-text.+homepage:            https://github.com/mindreader/pipes-break+license:             BSD3+license-file:        LICENSE+author:              David McHealy+maintainer:          david.mchealy@gmail.com+copyright:           2017 David McHealy+category:            Pipes, Control+build-type:          Simple+bug-reports:         https://github.com/mindreader/pipes-break/issues+-- extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Pipes.Break.ByteString+                       Pipes.Break.ByteString.Lens+                       Pipes.Break.Text+                       Pipes.Break.Text.Lens+  other-modules:       Pipes.Break.Internal+  build-depends:+    base >= 4.7 && < 5.0,+    pipes >= 4.0 && < 5.0,+    pipes-group >= 1.0 && < 2.0,+    pipes-parse >= 3.0 && < 4.0,+    bytestring >= 0.10 && < 0.20,+    text >= 1.2 && < 2.0+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite pipes-break-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , pipes-break+                     , bytestring >= 0.10 && < 0.12+                     , mtl >= 2.2 && < 3+                     , pipes >= 4.0 && < 5.0+                     , QuickCheck >= 2.0+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010++source-repository head+   type:     git+   location: https://github.com/mindreader/pipes-break
+ src/Pipes/Break/ByteString.hs view
@@ -0,0 +1,98 @@+-- | To learn more about pipes-group and how to use these functions with it, check out the in+--   depth tutorial at <http://hackage.haskell.org/package/pipes-group/docs/Pipes-Group-Tutorial.html>++module Pipes.Break.ByteString (+  -- * Group Producers By A Delimiter+  -- | Break any producer up into groups with the delimiter stripped out.+  --+  -- >>> unBreaksBy delim (breaksBy delim foo) ≡ foo+  -- >>> unBreakBy delim (breakBy delim foo) ≡ foo+  --+  -- with the presumption that two 'Producer's are "equivalent" if they produce the same string when drained.+  breakBy, unBreakBy, breaksBy, unBreaksBy,++  -- * Group Producers Ending By A Delimiter+  -- | These are almost equivalent to the breakBy functions, however they imply that every chunk "ends" with a delimiter,+  --   rather than just being separated by them.+  --+  --   Unfortunately it is impossible to know in a streaming fashion for sure that your next group will+  --   ever end with a delimiter (or end at all for that matter). The only way to find out is to store every line you receive until you find it.+  --   Therefore, the endsBy family of functions are not invertible.+  --+  -- >>> > mconcat $ Pipes.Prelude.toList (unEndsBy "\r\n" (endsBy "\r\n" (yield "A\r\nB\r\nC")))+  -- >>> "A\r\nB\r\nC\r\n"+  --+  -- In other words:+  --+  -- >>> unEndsBy delim (endsBy delim foo) ≠ foo+  endBy, unEndBy, endsBy, unEndsBy,++  -- * Utilities+  replace+) where++import Pipes as P+import Pipes.Group as P++import qualified Data.ByteString.Char8 as B++import Pipes.Break.Internal++-- | Yield argument until it reaches delimiter or end of stream, then return the remainder (minus the delimiter).+--+--   This is equivalent to 'breakBy'.+endBy :: (Monad m) => B.ByteString -> Producer B.ByteString m r -> Producer B.ByteString m (Producer B.ByteString m r)+endBy = breakBy++-- | Recombine a producer that had been previously broken by using a separator.  If the second stream is empty,+--   the delimiter will be added on at the end of the first producer anyways.+--+-- >>> > mconcat $ Pipes.Prelude.toList (unEndBy "\n" (yield "abc" >> return (yield "def")))+-- >>> "abc\ndef"+--+-- >>> > mconcat $ Pipes.Prelude.toList (unEndBy "\n" (yield "abc" >> return (return ())))+-- >>> "abc\n"+--+-- This is /not/ equivalent to 'unBreakBy' and is not quite an inverse of 'endBy'.+unEndBy :: (Monad m) => B.ByteString -> Producer B.ByteString m (Producer B.ByteString m r) -> Producer B.ByteString m r+unEndBy = _unEndBy++-- | The inverse of 'breakBy'.+unBreakBy :: (Monad m) => B.ByteString -> Producer B.ByteString m (Producer B.ByteString m r) -> Producer B.ByteString m r+unBreakBy = _unBreakBy+++endsBy :: (Monad m) => B.ByteString -> Producer B.ByteString m r -> FreeT (Producer B.ByteString m) m r+endsBy = _endsBy++-- | Not quite the inverse of 'endsBy'.+unEndsBy :: (Monad m) => B.ByteString -> FreeT (Producer B.ByteString m) m r -> Producer B.ByteString m r+unEndsBy = _unEndsBy++-- | The inverse of 'breaksBy'.+unBreaksBy :: (Monad m) => B.ByteString -> FreeT (Producer B.ByteString m) m r -> Producer B.ByteString m r+unBreaksBy = _unBreaksBy++-- | Group a producer on any delimiter.+breaksBy :: (Monad m) => B.ByteString -> Producer B.ByteString m r -> FreeT (Producer B.ByteString m) m r+breaksBy = _breaksBy++-- | Yield argument until it reaches delimiter or end of stream, then returns the remainder (minus the delimiter).+--+-- > > rest <- runEffect $ for (breakBy "\r\n" (yield "A\r\nB\r\nC\r\n")) (lift . Prelude.print)+-- > "A"+--+-- > > runEffect $ for rest (lift . print)+-- > "B\r\nC\r\n"+--+-- This is almost equivalent to Pipes.ByteString.line except that it works for any delimiter, not just '\n',+-- and it also consumes the delimiter.+breakBy :: (Monad m) => B.ByteString -> Producer B.ByteString m r -> Producer B.ByteString m (Producer B.ByteString m r)+breakBy = _breakBy++-- | Replace one delimiter with another in a stream.+--+-- > > fmap mconcat <$> toListM $ replace "\r\n" "\n" (yield "abc\ndef\r\nfoo\n\r\nbar")+-- > "abc\ndef\nfoo\n\nbar"+replace :: (Monad m) => B.ByteString -> B.ByteString -> Producer B.ByteString m r -> Producer B.ByteString m r+replace from to = unBreaksBy to . breaksBy from
+ src/Pipes/Break/ByteString/Lens.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE RankNTypes #-}++{- | For those who like lenses, here are Lens library versions of the functions from Pipes.Break.Text+ -+     To learn more about using lenses to manipulate pipes, check out the in depth tutorial at+     <http://hackage.haskell.org/package/pipes-group/docs/Pipes-Group-Tutorial.html>++     Due to the fact that the endsBy family of functions are non invertible, it doesn't make much sense to encourage their use+     as lenses.+     For example, if your protocol were blocks of lines delimited by a double newline at the end (such as in email or http).++> > fmap mconcat <$> P.toListM $+>     over (endsBy "\n\n" . individually) (over (endsBy "\n" . individually) id)+>        (yield "A\nB\n\nA\nB\nC\n\n")+> "A\nB\n\n\nA\nB\nC\n\n\n\n\n"++  As you can see, this would result in the wrong number of newlines being appended when reforming.+-}++module Pipes.Break.ByteString.Lens (+  -- * Grouping producers by a delimiter+  --+  -- $breakbyoverview+  breaksBy, unBreaksBy,++) where++import Pipes as P+import Pipes.Group as P++import qualified Data.ByteString as B++import Pipes.Break.Internal++type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)++{- $breakbyoverview++> > fmap mconcat <$> P.toListM $+>    over (breaksBy "\n\n" . individually) (over (breaksBy "\n" . individually) (<* yield "!"))+>      (P.each ["A\nB","\n\n","A","","\nB\nC","\n\n"])+> "A!\nB!\n\nA!\nB!\nC!\n\n"+-}+++breaksBy :: Monad m => B.ByteString -> Lens' (Producer B.ByteString m r) (FreeT (Producer B.ByteString m) m r)+breaksBy del k p' = fmap (_unBreaksBy del) (k (_breaksBy del p'))+++unBreaksBy :: Monad m => B.ByteString -> Lens' (FreeT (Producer B.ByteString m) m r) (Producer B.ByteString m r)+unBreaksBy del k p' = fmap (_breaksBy del) (k (_unBreaksBy del p'))
+ src/Pipes/Break/Internal.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE LambdaCase, OverloadedStrings, PartialTypeSignatures, NoMonomorphismRestriction, DeriveGeneric, Rank2Types #-}++module Pipes.Break.Internal (+  _breaksBy, _unBreaksBy, _breakBy,+  _endsBy, _unEndsBy,+  _unEndBy, _unBreakBy+) where+++import Data.String (IsString)++import Pipes as P+import Pipes.Group as P+import Pipes.Parse as P++import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T++-- basically a P.Parser, but it is itself a producer, thus it can yield immediately.+type ParserP a m r = forall x. StateT (Producer a m x) (Producer a m) r++yieldP :: Monad m => a -> ParserP a m ()+yieldP = lift . yield++drawP :: Monad m => ParserP a m (Maybe a)+drawP = hoist lift draw++unDrawP :: Monad m => a -> ParserP a m ()+unDrawP = hoist lift . unDraw++class (Show a, Monoid a, Eq a, IsString a) => TextLike a where+  tlNull :: a -> Bool+  tlBreakSubstring :: a -> a -> (a, a)+  tlLength :: a -> Int+  tlTake :: Int -> a -> a+  tlDrop :: Int -> a -> a+  tlIsPrefixOf :: a -> a -> Bool++instance TextLike B.ByteString where+  tlNull = B.null+  tlBreakSubstring = B.breakSubstring+  tlLength = B.length+  tlTake = B.take+  tlDrop = B.drop+  tlIsPrefixOf = B.isPrefixOf++instance TextLike T.Text where+  tlNull = T.null+  tlBreakSubstring = T.breakOn+  tlLength = T.length+  tlTake = T.take+  tlDrop = T.drop+  tlIsPrefixOf = T.isPrefixOf++_breaksBy, _endsBy :: (TextLike a, Monad m) => a -> Producer a m r -> FreeT (Producer a m) m r+_breaksBy = toFreeT . _breakBy+_endsBy = toFreeT . _breakBy++_unBreaksBy, _unEndsBy :: (TextLike a, Monad m) => a -> FreeT (Producer a m) m r -> Producer a m r+_unBreaksBy = intercalates . yield+_unEndsBy del = concats . maps (<* yield del)++_breakBy :: (TextLike a, Monad m) => a -> Producer a m r -> Producer a m (Producer a m r)+_breakBy delim p = lift (next p) >>= \case+    Left r -> return (return r)+    -- If the user supplied an empty delimiter, breakByP will infinitely loop.+    Right (bs, p') | tlNull delim -> yield bs >> _breakBy delim p'+    Right (bs, p') -> execStateT (breakByP delim) (yield bs >> p')+++_unEndBy :: (TextLike a, Monad m) => a -> Producer a m (Producer a m r) -> Producer a m r+_unEndBy delim p = p <* yield delim >>= \p' -> p'++_unBreakBy :: (TextLike a, Monad m) => a -> Producer a m (Producer a m r) -> Producer a m r+_unBreakBy delim p = p >>= lift . next >>= \case+  Left r -> return r+  Right (bs, p') -> yield delim >> (yield bs >> p')++-- | Group a producer of bytestrings into a series of producers delimited by f, where the delimiter is dropped+toFreeT :: (TextLike a, Monad m) => (Producer a m r -> Producer a m (Producer a m r)) -> Producer a m r -> FreeT (Producer a m) m r+toFreeT f = FreeT . go0+  where+    go0 p = do+      next p >>= \case+        Left r       -> return (Pure r)+        Right (bs, p') -> return $ Free (go1 (yield bs >> p'))++    go1 p = do+      p' <- f p+      return $ FreeT $ do+        next p' >>= \case+          Left r -> return (Pure r)+          Right (bs, p'') -> go0 (yield bs >> p'')++-- Yield data from underlying producer before the delimiter, while stripping the delimeter out.+breakByP :: (TextLike a, Monad m) => a -> ParserP a m ()+breakByP str = go+  where+    go = +      drawP >>= \case+        Nothing -> return ()++        Just bs | tlNull bs -> go+        Just bs -> case tlBreakSubstring str bs of+ +           -- null suff means pref has no delimeter or partial delimiter and we need to fetch more chunks to be sure+           (_, suff) | tlNull suff -> if (tlLength str <= 1)+              -- If the delimiter is only one character, we know it can't be in this chunk.+              then yieldP bs >> go++              -- Starting with one less than the length of delimiter, test the end of this chunk.+              else hoist lift (chunkEndsWith str bs (max(tlLength bs - (tlLength str - 1)) 0)) >>= \case++                -- The end of this chunk does begin with the delimiter, get more chunks, keep going.+                Nothing -> yieldP bs >> go++                -- This chunk has a delimiter at index n, yield it, and undraw beginning of delimiter+                Just n -> do+                  yieldP (tlTake n bs)+                  hoist lift (dropChars (tlLength str - (tlLength bs - n)))+++           -- non null suff means suff has delimiter.+           -- pref must be yielded if it is non null+           (pref, suff) -> do+              yieldP pref+              unDrawP (tlDrop (tlLength str) suff)+++dropChars :: (TextLike a, Monad m) => Int -> P.Parser a m ()+dropChars 0 = return ()+dropChars n = draw >>= \case+  Nothing -> return ()+  Just bs | n > tlLength bs -> dropChars (n - tlLength bs)+  Just bs -> unDraw (tlDrop n bs)++-- See if Producer with initial chunk ends with the delimiter anywhere after first n characters,+-- and if it does, return number of characters into this chunk where said delimiter began.+chunkEndsWith :: (TextLike a, Monad m) => a -> a -> Int -> P.Parser a m (Maybe Int)+chunkEndsWith str = go+  where go bs n | n >= tlLength bs = return Nothing+        go bs n = startsWith str (tlDrop n bs) >>= \case+          True -> return (Just n)+          False -> go bs $! (n + 1)++-- if Producer starts with a, return True.  Never advances the stream.+startsWith :: (TextLike a, Monad m) => a -> a -> P.Parser a m Bool+startsWith = go1+  where+    go0 str = do+      draw >>= \case+        Nothing -> return False+        Just bs | tlNull bs -> go0 str+        Just bs -> go1 str bs <* unDraw bs++    go1 str bs | tlNull bs = go0 str++    go1 str bs | str `tlIsPrefixOf` bs = return True++    go1 str bs | tlLength bs < tlLength str && tlTake bsLen str == bs =+      go0 (tlDrop bsLen str)+      where+        bsLen = tlLength bs+      +    go1 _ _ = return False
+ src/Pipes/Break/Text.hs view
@@ -0,0 +1,105 @@+-- | To learn more about pipes-group and how to use these functions with it, check out the in+--   depth tutorial at <http://hackage.haskell.org/package/pipes-group/docs/Pipes-Group-Tutorial.html>++module Pipes.Break.Text (+  -- * Group Producers By A Delimiter+  -- | Break any producer up into groups with the delimiter stripped out.+  --+  -- >>> unBreaksBy delim (breaksBy delim foo) ≡ foo+  -- >>> unBreakBy delim (breakBy delim foo) ≡ foo+  --+  -- with the presumption that two 'Producer's are "equivalent" if they produce the same string when drained.+  breakBy, unBreakBy, breaksBy, unBreaksBy,++  -- * Group Producers Ending By A Delimiter+  -- | These are almost equivalent to the breakBy functions, however they imply that every chunk "ends" with a delimiter,+  --   rather than just being separated by them.+  --+  --   Unfortunately it is impossible to know in a streaming fashion for sure that your next group will+  --   ever end with a delimiter (or end at all for that matter). The only way to find out is to store every line you receive until you find it.+  --   Therefore, the endsBy family of functions are not invertible.+  --+  -- >>> > mconcat $ Pipes.Prelude.toList (unEndsBy "\r\n" (endsBy "\r\n" (yield "A\r\nB\r\nC")))+  -- >>> "A\r\nB\r\nC\r\n"+  --+  -- In other words:+  --+  -- >>> unEndsBy delim (endsBy delim foo) ≠ foo+  endBy, unEndBy, endsBy, unEndsBy,++  -- * Utilities+  replace+) where++import Pipes as P+import Pipes.Group as P++import qualified Data.Text as T++import Pipes.Break.Internal++-- | Yield argument until it reaches delimiter or end of stream, then return the remainder (minus the delimiter).+--+--   This is equivalent to 'breakBy'.+endBy :: (Monad m) => T.Text -> Producer T.Text m r -> Producer T.Text m (Producer T.Text m r)+endBy = breakBy++-- | Recombine a producer that had been previously broken by using a separator.  If the second stream is empty+--   the delimiter will be added on at the end of the first producer anyways.+--+-- >>> > mconcat $ Pipes.Prelude.toList (unEndBy "\n" (yield "abc" >> return (yield "def")))+-- >>> "abc\ndef"+--+-- >>> > mconcat $ Pipes.Prelude.toList (unEndBy "\n" (yield "abc" >> return (return ())))+-- >>> "abc\n"+--+-- This is /not/ equivalent to 'unBreakBy' and is not quite an inverse of 'endBy'+unEndBy :: (Monad m) => T.Text -> Producer T.Text m (Producer T.Text m r) -> Producer T.Text m r+unEndBy = _unEndBy++-- | Recombine a producer that had been previously broken recombining it with the provided delimiter.+--+-- >>> > mconcat $ Pipes.Prelude.toList (unBreakBy "\n" (yield "abc" >> return (yield "def")))+-- >>> "abc\ndef"+--+-- >>> > mconcat $ Pipes.Prelude.toList (unBreakBy "\n" (yield "abc" >> return (return ())))+-- >>> "abc"+-- | The inverse of 'breakBy'+unBreakBy :: (Monad m) => T.Text -> Producer T.Text m (Producer T.Text m r) -> Producer T.Text m r+unBreakBy = _unBreakBy+++endsBy :: (Monad m) => T.Text -> Producer T.Text m r -> FreeT (Producer T.Text m) m r+endsBy = _endsBy++-- | Not quite the inverse of 'endsBy'.+unEndsBy :: (Monad m) => T.Text -> FreeT (Producer T.Text m) m r -> Producer T.Text m r+unEndsBy = _unEndsBy++-- | The inverse of 'breaksBy'.+unBreaksBy :: (Monad m) => T.Text -> FreeT (Producer T.Text m) m r -> Producer T.Text m r+unBreaksBy = _unBreaksBy++-- | Group a producer on any delimiter.+breaksBy :: (Monad m) => T.Text -> Producer T.Text m r -> FreeT (Producer T.Text m) m r+breaksBy = _breaksBy++-- | Yield argument until it reaches delimiter or end of stream, then returns the remainder (minus the delimiter).+--+-- > > rest <- runEffect $ for (breakBy "\r\n" (yield "A\r\nB\r\nC\r\n")) (lift . Prelude.print)+-- > "A"+--+-- > > runEffect $ for rest (lift . print)+-- > "B\r\nC\r\n"+--+-- This is almost equivalent to Pipes.Text.line except that it works for any delimiter, not just '\n',+-- and it also consumes the delimiter.+breakBy :: (Monad m) => T.Text -> Producer T.Text m r -> Producer T.Text m (Producer T.Text m r)+breakBy = _breakBy++-- | Replace one delimiter with another in a stream.+--+-- > > fmap mconcat <$> toListM $ replace "\r\n" "\n" (yield "abc\ndef\r\nfoo\n\r\nbar")+-- > "abc\ndef\nfoo\n\nbar"+replace :: (Monad m) => T.Text -> T.Text -> Producer T.Text m r -> Producer T.Text m r+replace from to = unBreaksBy to . breaksBy from
+ src/Pipes/Break/Text/Lens.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE RankNTypes #-}++{- | For those who like lenses, here are Lens library versions of the functions from Pipes.Break.Text++     To learn more about using lenses to manipulate pipes, check out the in depth tutorial at+     <http://hackage.haskell.org/package/pipes-group/docs/Pipes-Group-Tutorial.html>++     Due to the fact that the endsBy family of functions are non invertible, it doesn't make much sense to encourage their use+     as lenses.+     For example, if your protocol were blocks of lines delimited by a double newline at the end (such as in email or http).++> > fmap mconcat <$> P.toListM $+>     over (endsBy "\n\n" . individually) (over (endsBy "\n" . individually) id)+>        (yield "A\nB\n\nA\nB\nC\n\n")+>  "A\nB\n\n\nA\nB\nC\n\n\n\n\n"++  As you can see, this would result in the wrong number of newlines being appended when reforming.+-}++module Pipes.Break.Text.Lens (+  -- * Grouping producers by a delimiter+  --+  -- $breakbyoverview+  breaksBy, unBreaksBy,+) where++import Pipes as P+import Pipes.Group as P++import qualified Data.Text as T++import Pipes.Break.Internal++type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)++{- $breakbyoverview++> > fmap mconcat <$> P.toListM $+>    over (breaksBy "\n\n" . individually) (over (breaksBy "\n" . individually) (<* yield "!"))+>      (P.each ["A\nB","\n\n","A","","\nB\nC","\n\n"])+> "A!\nB!\n\nA!\nB!\nC!\n\n"+-}+++breaksBy :: Monad m => T.Text -> Lens' (Producer T.Text m r) (FreeT (Producer T.Text m) m r)+breaksBy del k p' = fmap (_unBreaksBy del) (k (_breaksBy del p'))+++unBreaksBy :: Monad m => T.Text -> Lens' (FreeT (Producer T.Text m) m r) (Producer T.Text m r)+unBreaksBy del k p' = fmap (_breaksBy del) (k (_unBreaksBy del p'))
+ test/Spec.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, DeriveGeneric, GeneralizedNewtypeDeriving #-}++module Main (main) where+++import Test.QuickCheck++import Control.Monad (void)++import Data.Tuple (swap)++import qualified Data.ByteString.Char8 as B++import Pipes as P+import qualified Pipes.Prelude as P++import Data.List (mapAccumL, isInfixOf)++import Pipes.Break.ByteString as PB++import Control.Monad.Identity++-- type BS = B.ByteString++-- debug :: (MonadIO m, Show a) => Producer a m (Producer a m r) -> m ()+-- debug p = do+--   (beg,rest) <- P.toListM' p+--   end <- P.toListM (void rest)+--      +--   liftIO $ putStrLn $ "beg:" <> show beg+--   liftIO $ putStrLn $ "rest:" <> show end+--   return ()++-- A string that most likely contains this delimiter or at least some parts of it in a few places+arbitraryStringWithDelimiter :: String -> Gen String+arbitraryStringWithDelimiter "" = arbitrary+arbitraryStringWithDelimiter del = do+  n <- choose (1,1000)+  mconcat <$> vectorOf n (oneof [return del, pieceOfDelim, someStr])+  where+    -- a long string where the delimiter is not contained in it+    someStr = arbitrary `suchThat` (\str -> not (del `isInfixOf` str))++    -- randomly pull out a peice of the delimiter+    pieceOfDelim = do+      beg <- choose (1,length del)+      end <- choose (0, beg - 1)+      return $ drop end $  take beg $ del++-- Split up a string into randomly sized chunks+arbitrarySplit :: String -> Gen [String]+arbitrarySplit bs = do+ offsets <- arbitrarySplits (length bs)+ let (rest, items) = mapAccumL (\str idx -> swap $ splitAt idx str) bs offsets+ return $ items ++ [rest]+ where+   arbitrarySplits :: Int -> Gen [Int]+   arbitrarySplits n = listOf (choose (0,10)) `suchThat` (\ls -> sum ls <= n)++-- For any delimiter, for any string that has pieces of that delimiter in it,+-- which has been broken up into random chunks, every call to breakBy should+-- at least be advancing the stream on each call.+prop_WillFinish :: String -> Property+prop_WillFinish delimiter =+  forAll (arbitraryStringWithDelimiter delimiter) $ \str ->+    forAll (arbitrarySplit str) $ \frags ->+      let remainder = runIdentity $ do+            rest <- runEffect $ breakBy (B.pack delimiter) (traverse (yield . B.pack) frags) >-> P.drain+            B.unpack . mconcat <$> P.toListM (void rest)+        +      in length str > 0 ==> length str > length remainder++-- Ensure invertibility of breaksBy and unBreaksBy+prop_BreaksEquiv :: String -> Property+prop_BreaksEquiv delimiter =+  forAll (arbitraryStringWithDelimiter delimiter) $ \str ->+    forAll (arbitrarySplit str) $ \frags ->+      str === B.unpack (breakByThenBackToStr (B.pack <$> frags) (B.pack delimiter))+  where+    breakByThenBackToStr :: [B.ByteString] -> B.ByteString -> B.ByteString+    breakByThenBackToStr frags br = mconcat $ P.toList (PB.unBreaksBy br $  PB.breaksBy br $ P.each frags)++-- Ensure invertibility of breakBy and unBreakBy+prop_BreakEquiv :: String -> Property+prop_BreakEquiv delimiter =+  forAll (arbitraryStringWithDelimiter delimiter) $ \str ->+    forAll (arbitrarySplit str) $ \frags ->+      str === (B.unpack $ mconcat $ P.toList $ unBreakBy (B.pack delimiter) $ breakBy (B.pack delimiter) $ P.each (B.pack <$> frags))+++return []+runTests :: IO Bool+-- runTests = $verboseCheckAll+runTests = $quickCheckAll++main :: IO ()+main = void runTests