diff --git a/DPutils.cabal b/DPutils.cabal --- a/DPutils.cabal +++ b/DPutils.cabal @@ -1,17 +1,17 @@ Name: DPutils -Version: 0.0.1.0 +Version: 0.0.2.0 License: BSD3 License-file: LICENSE Maintainer: choener@bioinf.uni-leipzig.de -author: Christian Hoener zu Siederdissen, 2016 -copyright: Christian Hoener zu Siederdissen, 2016 +author: Christian Hoener zu Siederdissen, 2016-2018 +copyright: Christian Hoener zu Siederdissen, 2016-2018 homepage: https://github.com/choener/DPutils bug-reports: https://github.com/choener/DPutils/issues Stability: Experimental Category: Data Build-type: Simple Cabal-version: >=1.10.0 -tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 8.4.4 Synopsis: utilities for DP Description: Small set of utility functions @@ -27,6 +27,8 @@ Library Exposed-modules: + Data.Attoparsec.ByteString.Streaming + Data.ByteString.Streaming.Split Data.Char.Util Data.Paired.Common Data.Paired.Foldable @@ -35,22 +37,26 @@ Math.TriangularNumbers Pipes.Parallel Pipes.Split.ByteString - build-depends: base >= 4.7 && < 5.0 + build-depends: base >= 4.7 && < 5.0 + , attoparsec >= 0.13 , bytestring , containers - , kan-extensions >= 4.0 - , parallel >= 3.0 - , pipes >= 4.0 - , QuickCheck >= 2.7 - , stringsearch >= 0.3 - , transformers >= 0.5 - , vector >= 0.10 + , kan-extensions >= 4.0 + , parallel >= 3.0 + , pipes >= 4.0 + , QuickCheck >= 2.7 + , streaming >= 0.1 + , streaming-bytestring >= 0.1 + , stringsearch >= 0.3 + , transformers >= 0.5 + , vector >= 0.10 default-extensions: BangPatterns , CPP + , FlexibleContexts , RankNTypes , ScopedTypeVariables , TypeFamilies - , FlexibleContexts + , UnicodeSyntax default-language: Haskell2010 ghc-options: @@ -77,15 +83,14 @@ build-depends: base , bytestring , containers - , kan-extensions , lens >= 4.0 , mtl - , parallel , pipes , pipes-bytestring >= 2.0 , pipes-parse >= 3.0 , QuickCheck - , quickcheck-instances >= 0.3 + , streaming + , streaming-bytestring , tasty >= 0.11 , tasty-quickcheck >= 0.8 , tasty-th >= 0.1 @@ -99,7 +104,9 @@ type: exitcode-stdio-1.0 build-depends: base - , criterion >= 1.1 + , criterion >= 1.1 + , streaming + , streaming-bytestring , vector -- , DPutils @@ -111,6 +118,33 @@ Haskell2010 ghc-options: -O2 + + + +benchmark streaming + type: + exitcode-stdio-1.0 + build-depends: base + , streaming + , streaming-bytestring + , bytestring + , timeit >= 2.0 + -- + , DPutils + hs-source-dirs: + tests + default-extensions: BangPatterns + , CPP + , RankNTypes + , ScopedTypeVariables + , TemplateHaskell + , UnicodeSyntax + main-is: + streaming.hs + default-language: + Haskell2010 + ghc-options: + -O2 -rtsopts "-with-rtsopts=-K10M -M10M" diff --git a/Data/Attoparsec/ByteString/Streaming.hs b/Data/Attoparsec/ByteString/Streaming.hs new file mode 100644 --- /dev/null +++ b/Data/Attoparsec/ByteString/Streaming.hs @@ -0,0 +1,42 @@ + +-- | Taken from Michael Thompson + +module Data.Attoparsec.ByteString.Streaming where + +import qualified Data.Attoparsec.ByteString as A +import Data.ByteString.Streaming +import Data.ByteString.Streaming.Internal +import qualified Data.ByteString as B +import Streaming.Internal (Stream (..)) +import Streaming hiding (concats, unfold) + + + +type Message = ([String], String) + +-- | The parsed function from @streaming-utils@ + +parsed + :: Monad m + => A.Parser a -- ^ Attoparsec parser + -> ByteString m r -- ^ Raw input + -> Stream (Of a) m (Either (Message, ByteString m r) r) +parsed parser = begin + where + begin p0 = case p0 of -- inspect for null chunks before + Go m -> lift m >>= begin -- feeding attoparsec + Empty r -> Return (Right r) + Chunk bs p1 | B.null bs -> begin p1 + | otherwise -> step (chunk bs >>) (A.parse parser bs) p1 + step diffP res p0 = case res of + A.Fail _ c m -> Return (Left ((c,m), diffP p0)) + A.Done bs a | B.null bs -> Step (a :> begin p0) + | otherwise -> Step (a :> begin (chunk bs >> p0)) + A.Partial k -> do + x <- lift (nextChunk p0) + case x of + Left e -> step diffP (k mempty) (return e) + Right (bs,p1) | B.null bs -> step diffP res p1 + | otherwise -> step (diffP . (chunk bs >>)) (k bs) p1 +{-# INLINABLE parsed #-} + diff --git a/Data/ByteString/Streaming/Split.hs b/Data/ByteString/Streaming/Split.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Streaming/Split.hs @@ -0,0 +1,60 @@ + +-- | Splitting functions for @ByteString m r@ into @Stream (ByteString m) m r@. +-- +-- TODO These functions need quickcheck tests. + +module Data.ByteString.Streaming.Split where + +import Data.ByteString.Streaming.Char8 as S8 +import Data.ByteString.Streaming.Internal as SI +import Streaming.Internal (Stream(..)) + + + +-- | Split a @ByteString m r@ after every @k@ characters. +-- +-- Streams in constant memory. +-- +-- BUG: Once the stream is exhausted, it will still call @splitAt@, forever +-- creating empty @ByteString@s. + +splitsByteStringAt ∷ Monad m ⇒ Int → ByteString m r → Stream (ByteString m) m r +splitsByteStringAt !k = loop where + loop (Empty r) = return r + loop p = Step $ fmap loop $ S8.splitAt (fromIntegral k) p +{- -- this version would consume all memory + loop p = SI.Effect $ do + e ← nextChunk p + return $ case e of + Left r → SI.Return r + Right (a,p') → SI.Step (fmap loop (S8.splitAt (fromIntegral k) (chunk a >> p'))) + -} +{-# Inlinable splitsByteStringAt #-} + + + +-- | For lists, this would be @sbs (f :: [a] -> ([a],[a])) -> [a] -> [[a]]@. +-- Takes a function that splits the bytestring into two elements repeatedly, +-- where the first is followed by the repeated application of the function. +-- +-- cf. +-- +-- TODO these functions should go into a helper library + +separatesByteString + ∷ Monad m + ⇒ (ByteString m r → ByteString m (ByteString m r)) + → ByteString m r + → Stream (ByteString m) m r +separatesByteString f = loop where + loop (Empty r) = return r + loop p = Step $ fmap loop $ f p +{- + loop p = SI.Effect $ do + e ← nextChunk p + return $ case e of + Left r → SI.Return r + Right (a,p') → SI.Step (fmap loop (f (chunk a >> p'))) +-} +{-# Inlinable separatesByteString #-} + diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,9 @@ +0.0.2.0 +------- + +- Data.ByteString.Streaming.Split with generic splitting operations for the + bytestring-streaming library + 0.0.1.0 ------- diff --git a/tests/properties.hs b/tests/properties.hs --- a/tests/properties.hs +++ b/tests/properties.hs @@ -16,7 +16,6 @@ import qualified Pipes.Parse as PP import qualified Pipes.Prelude as P import Test.QuickCheck -import Test.QuickCheck.Instances import Test.Tasty import Test.Tasty.QuickCheck as QC import Test.Tasty.TH @@ -207,6 +206,11 @@ skeMult :: Int skeMult = 1000 + + + +-- * Streaming tests. + main :: IO () main = $(defaultMainGenerator) diff --git a/tests/streaming.hs b/tests/streaming.hs new file mode 100644 --- /dev/null +++ b/tests/streaming.hs @@ -0,0 +1,55 @@ + +-- | Test the performance of splitting and consuming a *very long* bytestring +-- using @streaming@. + +module Main where + +import Data.Functor.Of +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy.Char8 as BSL8 +import qualified Data.ByteString.Streaming.Char8 as SB8 +import System.TimeIt +import Text.Printf + +import qualified Data.ByteString.Streaming.Split as SBS + + + +genLong + ∷ ( Monad m ) + ⇒ Int + → SB8.ByteString m () +genLong = SB8.fromLazy . BSL8.fromChunks . go + where + -- create chunks of strict char8 bytestring to concatenate. + go !k + | k <= 0 = [] + | otherwise = chunk : go (k-1) + -- the chunk to use for concatenation. + !chunk = BS8.pack $ ['A'..'Z'] ++ "\n" ++ ['a'..'z'] +{-# Inlinable genLong #-} + +-- | Generate long strings, split them after every 10 characters (which is +-- different from the chunk length), concatenate the resulting strings, and get +-- the total string length. +-- +-- This function should run in constant memory. + +longLength ∷ ( Monad m ) ⇒ Int → m (Of Int ()) +longLength = SB8.length . SB8.concat . SBS.splitsByteStringAt 10 . genLong + +otherLength ∷ ( Monad m ) ⇒ Int → m (Of Int ()) +otherLength = SB8.length . SB8.concat . SBS.separatesByteString (SB8.splitAt 10) . genLong + +benchmark ∷ (Int → IO (Of Int ())) → Int → Int → IO () +benchmark !f !k !l = do + (!seconds, !n :> ()) ← timeItT $ f l + printf "53 * 10^%2d = %10d characters in %9.6f seconds\n" k n seconds + +main = do + putStrLn "longLength" + mapM_ (uncurry (benchmark longLength)) [(k ∷ Int, 10^k) | k ← [0..7]] + putStrLn "otherLength" + mapM_ (uncurry (benchmark otherLength)) [(k ∷ Int, 10^k) | k ← [0..7]] + return () +