packages feed

pipes-lines (empty) → 1.0.0.0

raw patch · 7 files changed

+362/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, lens, mtl, pipes, pipes-group, pipes-lines, 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-lines.cabal view
@@ -0,0 +1,47 @@+name:                pipes-lines+version:             1.0.0.0+synopsis:            pipes-group like functions for lines delimited by \r\n+description:         These are utility functions that were omitted from pipes-bytestring and pipes-text for grouping or splitting lines by \r\n.+homepage:            https://github.com/mindreader/pipes-lines+license:             BSD3+license-file:        LICENSE+author:              David McHealy+maintainer:          david.mchealy@gmail.com+copyright:           2017 Author name here+category:            Web+build-type:          Simple+-- extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Pipes.ByteString.Lines,+                       Pipes.Text.Lines+  other-modules:       Pipes.Lines+  build-depends:+    base >= 4.7 && < 5,+    pipes >= 4 && < 5,+    pipes-group >= 1.0 && < 2.0,+    bytestring >= 0.10 && < 0.12,+    text >= 1.2 && < 2.0+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite pipes-lines-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , pipes-lines+                     , bytestring >= 0.10 && < 0.12+                     , mtl >= 2.2 && < 3+                     , pipes >= 4 && < 5+                     , pipes-group >= 1.0 && < 2.0+                     , lens+                     , QuickCheck+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010++source-repository head+   type:     git+   location: https://github.com/mindreader/pipes-lines
+ src/Pipes/ByteString/Lines.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, PartialTypeSignatures, NoMonomorphismRestriction, DeriveGeneric, Rank2Types #-}++-- | This is equivalent to the <http://hackage.haskell.org/package/pipes-bytestring/docs/Pipes-ByteString.html#v:lines> except it works for lines delimited with "\\r\\n"+--+-- Warning: Since this works on bytestrings, it assumes a particular encoding.  You should use "Pipes.Text.Split" if possible++module Pipes.ByteString.Lines (+  Pipes.ByteString.Lines.lines,+  Pipes.ByteString.Lines.unlines, line+) where++import Pipes as P+import Pipes.Group as P++import qualified Data.ByteString.Char8 as B++import Pipes.Lines++type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)++-- | Producer of strict 'Data.ByteString.Char8.ByteString's is delimited by "\\r\\n"+--+-- >>> runEffect $ for (over (lines . individually) (<* yield "!") (yield "asdf\r\nqwerty\r\n")) (lift . print)+-- "asdf"+-- "!"+-- "\r\n"+-- "qwerty"+-- "!"+-- "\r\n"+-- +lines :: Monad m => Lens' (Producer B.ByteString m r) (FreeT (Producer B.ByteString m) m r)+lines k p' = fmap _unLinesRn (k (_linesRn p'))++unlines :: Monad m => Lens' (FreeT (Producer B.ByteString m) m r) (Producer B.ByteString m r)+unlines k p' = fmap _linesRn (k (_unLinesRn p'))++-- | Producer which consumes a single line, then returns a producer with rest of input.+--+-- >>> rest <- runEffect $ for (line (yield "foo\r\nbar\r\nbaz\r\n")) (lift . print)+-- "foo"+-- >>> runEffect $ for rest (lift . print)+-- "bar\r\nbaz\r\n"+line :: (Monad m) => Producer B.ByteString m r -> Producer B.ByteString m (Producer B.ByteString m r)+line = _lineRn++
+ src/Pipes/Lines.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE LambdaCase, OverloadedStrings, PartialTypeSignatures, NoMonomorphismRestriction, DeriveGeneric, Rank2Types #-}++module Pipes.Lines (+  _unLinesRn, _linesRn, _lineRn+) where++import Data.String (IsString)++import Pipes as P+import Pipes.Group as P++import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T++import Control.Monad (when, (>=>))+++class (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+  tlHead :: a -> Char+  tlLast :: a -> Char+  tlIsPrefixOf :: a -> a -> Bool++instance TextLike B.ByteString where+  tlNull = B.null+  tlBreakSubstring = B.breakSubstring+  tlLength = B.length+  tlTake = B.take+  tlDrop = B.drop+  tlHead = B.head+  tlLast = B.last+  tlIsPrefixOf = B.isPrefixOf++instance TextLike T.Text where+  tlNull = T.null+  tlBreakSubstring = T.breakOn+  tlLength = T.length+  tlTake = T.take+  tlDrop = T.drop+  tlHead = T.head+  tlLast = T.last+  tlIsPrefixOf = T.isPrefixOf+++_unLinesRn ::(TextLike a, Monad m) => FreeT (Producer a m) m r -> Producer a m r+_unLinesRn = concats . maps (<* yield "\r\n")++-- | Group a producer of bytestrings into a series of producers delimited by "\r\n"+--   The \r\n are dropped.+_linesRn :: (TextLike a, Monad m) => Producer a m r -> FreeT (Producer a m) m r+_linesRn p = FreeT $ do+  next p >>= return . \case+    Left r       -> Pure r+    Right (bs, p') -> Free (go1 (yield bs >> p'))++  where+    go1 = _lineRn >=> return . _linesRn+++_lineRn :: (TextLike a, Monad m) => Producer a m r -> Producer a m (Producer a m r)+_lineRn p = do+  nextNonNull p >>= \case+    Left r -> return (return r)+    Right ("\r\n", p') -> return p'+    Right (bs, p') -> do+      case tlBreakSubstring "\r\n" bs of+        (pref,suff) | tlNull pref && tlIsPrefixOf "\r\n" suff -> return (yield (tlDrop 2 suff) >> p')+        (pref,suff) | tlNull pref -> return (yield suff >> p')+        (pref,suff) | suff == "\r\n" -> yield pref >> return p'+        (pref,suff) | tlIsPrefixOf "\r\n" suff -> yield pref >> return (yield (tlDrop 2 suff) >> p')++        (pref,_) | tlLast pref == '\r' -> nextNonNull p' >>= \case+          Left r -> yield pref >> return (return r)+          Right (bs', p'') | tlNull bs' -> yield "\r" >> return p''+          Right (bs', p'') | tlHead bs' == '\n' ->+            yield (tlTake ((tlLength pref) - 1) pref) >> return (when (tlLength bs' > 1) (yield $ tlDrop 1 bs') >> p'')+          Right (bs', p'') -> yield bs >> _lineRn (yield bs' >> p'')++        (pref, suff) | tlNull suff -> nextNonNull p' >>= \case+          Left r -> yield pref >> return (return r)+          Right (bs', p'') | tlIsPrefixOf "\r\n" bs' -> yield bs >> return (when (tlLength bs' > 2) (yield (tlDrop 2 bs')) >> p'')++          Right (bs', p'') | tlLength bs' == 1 && tlHead bs' == '\r' -> nextNonNull p'' >>= \case+            Left r -> yield bs >> yield bs' >> return (return r)+            Right (bs'', p''') | tlHead bs'' == '\n'-> yield bs >> return (when (tlLength bs'' > 1) (yield (tlDrop 1 bs'')) >> p''')+            Right (bs'', p''') -> yield bs >> yield "\r" >> _lineRn (yield bs'' >> p''')++          Right (bs', p'') -> yield bs >> _lineRn (yield bs' >> p'')++        (pref,suff) -> yield pref >> return (yield (tlDrop 2 suff) >> p')++  where+    dropNulls :: (TextLike a, Monad m) => Producer a m r -> Producer a m (Producer a m r)+    dropNulls = lift . next >=> \case+      Left r -> return (return r)+      Right (bs,p') | tlNull bs -> dropNulls p'+      Right (bs,p') -> return (yield bs >> p')++    nextNonNull :: (TextLike a, Monad m) => Producer a m r -> Producer a m (Either r (a, Producer a m r))+    nextNonNull = dropNulls >=> lift . next
+ src/Pipes/Text/Lines.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, PartialTypeSignatures, NoMonomorphismRestriction, DeriveGeneric, Rank2Types #-}++-- | This is equivalent to the <http://hackage.haskell.org/package/pipes-text/docs/Pipes-Text.html#v:lines> except it works for lines delimited with "\\r\\n"++module Pipes.Text.Lines (+  Pipes.Text.Lines.lines,+  Pipes.Text.Lines.unlines, line+) where++import Pipes as P+import Pipes.Group as P++import qualified Data.Text as T++import Pipes.Lines++type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)++-- | Producer of strict 'Data.Text.Text's is delimited by "\\r\\n"+--+-- >>> runEffect $ for (over (lines . individually) (<* yield "!") (yield "asdf\r\nqwerty\r\n")) (lift . print)+-- "asdf"+-- "!"+-- "\r\n"+-- "qwerty"+-- "!"+-- "\r\n"+lines :: Monad m => Lens' (Producer T.Text m r) (FreeT (Producer T.Text m) m r)+lines k p' = fmap _unLinesRn (k (_linesRn p'))++unlines :: Monad m => Lens' (FreeT (Producer T.Text m) m r) (Producer T.Text m r)+unlines k p' = fmap _linesRn (k (_unLinesRn p'))++-- | Producer which consumes a single line, then returns a producer with rest of input.+--+-- >>> rest <- runEffect $ for (line (yield "foo\r\nbar\r\nbaz\r\n")) (lift . print)+-- "foo"+-- >>> runEffect $ for rest (lift . print)+-- "bar\r\nbaz\r\n"+line :: (Monad m) => Producer T.Text m r -> Producer T.Text m (Producer T.Text m r)+line = _lineRn++
+ test/Spec.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Main (main) where++import Test.QuickCheck+import Test.QuickCheck.Monadic++import Control.Lens (view, over)++import Control.Monad (replicateM, void)+import Control.Monad.Identity++import Data.Tuple (swap)++import Data.Monoid++import qualified Data.ByteString.Char8 as B++import Pipes as P+import qualified Pipes.Prelude as P+import qualified Pipes.Group as P++import Data.List (mapAccumL, isSubsequenceOf)++import Pipes.ByteString.Lines as PL++-- | Make up some words, combine them into a network stream, break network stream up randomly into chunks,+--   parse them back into words, ensure final words matches initial words+prop_splitrn :: SomeWords -> Property+prop_splitrn (SomeWords wds) = monadic runIdentity $ do+   frags <- pick $ splitString sentence+   let res = map B.unpack $ P.toList (P.folds mappend mempty id $ view PL.lines $ P.each frags)+   -- monitor $ collect (show $ length frags)+   assert (wds == res)+   where+     sentence = B.intercalate "\r\n" (map B.pack wds) <> "\r\n"++-- | Ensure identity property.+prop_ident :: SomeNetworkString -> Property+prop_ident (SomeNetworkString str) = monadic runIdentity $ do+  let prod = P.yield str :: Producer B.ByteString Identity ()+  assert (mconcat (P.toList $ over PL.lines id prod) == mconcat (P.toList prod))++-- | Ensure identity property even if stream is split up randomly into chunks.+prop_ident_split :: SomeNetworkString -> Property+prop_ident_split (SomeNetworkString str) = monadic runIdentity $ do+  str' <- pick $ splitString str+  assert (mconcat (P.toList $ over PL.lines id (P.each str')) == mconcat (P.toList (P.yield str)))++newtype SomeNetworkString = SomeNetworkString B.ByteString deriving Show++instance Arbitrary SomeNetworkString where+  arbitrary = SomeNetworkString . B.pack <$> arbitraryNetworkString+  shrink (SomeNetworkString "") = []+  shrink (SomeNetworkString bs) = [SomeNetworkString (B.drop 1 bs)]++arbitraryNetworkString :: Gen String+arbitraryNetworkString = do+  n <- choose (1,1500)+  (<> "\r\n") . concat <$> vectorOf n (frequency [(15, arbitrary), (1, return "\r\n")])++newtype SomeWords = SomeWords [String] deriving Show++instance Arbitrary SomeWords where+  arbitrary = arbitrarySomeWords+  shrink (SomeWords []) = []+  shrink (SomeWords [word]) = [SomeWords [(tail word)], SomeWords [(take (length word - 1) word)]]+  shrink (SomeWords wds) = [SomeWords (take (length wds - 1) wds), SomeWords (tail wds)]++arbitrarySomeWords :: Gen SomeWords+arbitrarySomeWords = do+    numWords <- choose (1,100)+    SomeWords <$> replicateM numWords arbitraryWord+  where+    arbitraryWord :: Gen String+    arbitraryWord = do+        len <- choose (0,300)+        str <- vector len `suchThat` (not . isSubsequenceOf "\r\n")+        return str++splitString :: B.ByteString -> Gen [B.ByteString]+splitString bs = do+ offsets <- arbitrarySplits (B.length bs - 1)+ let (rest, items) = mapAccumL (\str idx -> swap $ B.splitAt idx str) bs offsets+ return $ items ++ [rest]+ where+   arbitrarySplits :: Int -> Gen [Int]+   arbitrarySplits n = listOf (choose (1,10)) `suchThat` (\ls -> sum ls <= n)+++return []+runTests :: IO Bool+runTests = $quickCheckAll++main :: IO ()+main = void runTests