DPutils 0.0.0.2 → 0.0.1.0

raw patch · 6 files changed

+307/−22 lines, 6 filesdep +bytestringdep +lensdep +mtldep ~kan-extensionsdep ~paralleldep ~pipesPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, lens, mtl, pipes-bytestring, pipes-parse, quickcheck-instances, stringsearch, transformers

Dependency ranges changed: kan-extensions, parallel, pipes, vector

API changes (from Hackage documentation)

Files

• DPutils.cabal +28/−10
• Data/Char/Util.hs +16/−0
• Data/Vector/Generic/Unstream.hs +36/−0
• Pipes/Split/ByteString.hs +140/−0
• changelog.md +6/−0
• tests/properties.hs +81/−12

@@ -1,5 +1,5 @@ Name:           DPutils-Version:        0.0.0.2+Version:        0.0.1.0 License:        BSD3 License-file:   LICENSE Maintainer:     choener@bioinf.uni-leipzig.de@@ -27,21 +27,29 @@  Library   Exposed-modules:+    Data.Char.Util     Data.Paired.Common     Data.Paired.Foldable     Data.Paired.Vector+    Data.Vector.Generic.Unstream     Math.TriangularNumbers     Pipes.Parallel+    Pipes.Split.ByteString   build-depends: base             >= 4.7    &&  < 5.0+               , bytestring                , containers-               , kan-extensions   >= 4.0    &&  < 6.0-               , parallel         >= 3.0    &&  < 4.0-               , pipes            >= 4.0    &&  < 4.3+               , kan-extensions   >= 4.0+               , parallel         >= 3.0+               , pipes            >= 4.0                , QuickCheck       >= 2.7-               , vector           >= 0.10   &&  < 0.12+               , stringsearch     >= 0.3+               , transformers     >= 0.5+               , vector           >= 0.10   default-extensions: BangPatterns                     , CPP+                    , RankNTypes                     , ScopedTypeVariables+                    , TypeFamilies                     , FlexibleContexts   default-language:     Haskell2010@@ -63,18 +71,27 @@   default-language:     Haskell2010   default-extensions: CPP+                    , RankNTypes+                    , ScopedTypeVariables                     , TemplateHaskell   build-depends: base+               , bytestring                , containers-               , DPutils                , kan-extensions+               , lens                 >= 4.0+               , mtl                , parallel                , pipes+               , pipes-bytestring     >= 2.0+               , pipes-parse          >= 3.0                , QuickCheck-               , tasty              >= 0.11-               , tasty-quickcheck   >= 0.8-               , tasty-th           >= 0.1+               , quickcheck-instances >= 0.3+               , tasty                >= 0.11+               , tasty-quickcheck     >= 0.8+               , tasty-th             >= 0.1                , vector+               --+               , DPutils   @@ -83,8 +100,9 @@     exitcode-stdio-1.0   build-depends: base                , criterion  >= 1.1-               , DPutils                , vector+               --+               , DPutils   hs-source-dirs:     tests   main-is:

@@ -0,0 +1,16 @@++-- | Convert between @Word8@ and @Char@. Mostly for attoparsec's bytestring+-- module.++module Data.Char.Util where++import Data.Word (Word8)++c2w8 :: Char -> Word8+c2w8 = fromIntegral . fromEnum+{-# Inline c2w8 #-}++w82c :: Word8 -> Char+w82c = toEnum . fromIntegral+{-# Inline w82c #-}+

@@ -0,0 +1,36 @@++-- | Helper functions for turnings streams into vectors.+--+-- Mostly very similar to bundle conversion functions from the @vector@+-- package.++module Data.Vector.Generic.Unstream where++import           Control.Monad.ST+import           GHC.Conc (pseq)+import qualified Data.Vector.Fusion.Stream.Monadic as SM+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Generic.Mutable as VGM+import           System.IO.Unsafe (unsafePerformIO)++-- for testing++import qualified Data.Vector.Unboxed as VU++++-- | Turns a stream into a vector.+--+-- TODO insert index checks? Generalized @flag devel@++streamToVectorM :: forall m v a . (Monad m, VG.Vector v a) => SM.Stream m a -> m (v a)+streamToVectorM s = do+  let mv' = unsafePerformIO $ VGM.unsafeNew 1+  let put (v',i) x =+        do let v = unsafePerformIO $ if (i < VGM.length v') then return v' else VGM.unsafeGrow v' (max 1 $ VGM.length v')+           seq (unsafePerformIO $ VGM.unsafeWrite v i x) (return (v,i+1))+      {-# Inline [0] put #-}+  (mv,written) <- SM.foldlM' put (mv',0) s+  mv `pseq` return . unsafePerformIO . VG.freeze $ VGM.unsafeSlice 0 written mv+{-# Inline streamToVectorM #-}+

@@ -0,0 +1,140 @@++-- | Split incombing bytestrings based on bytestrings.++module Pipes.Split.ByteString where++import           Control.Monad (join,unless)+import           Control.Monad.Trans.Class (lift)+import           Data.ByteString (ByteString)+import           Data.ByteString.Search (indices)+import           Data.Monoid ((<>))+import           Debug.Trace+import           Pipes (Producer,next,yield)+import qualified Data.ByteString as BS++++type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)++-- | Splits bytestrings after each pattern @pat@. Tries to minimize the+-- number of intermediate bytestring constructors.+--+-- The following function @ske@ expects a string @str@ and a pattern @pat@+-- and then returns a tuple with the splitted bytestrings in @fst@ and the+-- return value in @snd@.+--+-- The inner parser @parse@ uses @zoom@ to draw the full inner producer,+-- which should contain just one bytestring, namely one of the split off+-- ones. @parse@ doesn't do anything with the inner producer, except+-- returning the contained bytestring.+--+-- @parse@ returns @Right $ concat xs@ on a correct parse, and @Left []@+-- once the input has been exhausted.+--+-- @+-- ske :: ByteString -> ByteString -> ([ByteString],[ByteString],[ByteString])+-- ske pat str | BS.null pat || BS.null str = ([],[],[])+-- ske pat str =+--   let parse = do+--         xs <- zoom (splitKeepEnd pat) PP.drawAll+--         case xs of+--           [] -> return $ Left []+--           xs -> return $ Right $ BS.concat xs+--       (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PP.yield str+--   in (a,b, fst . runIdentity . P.toListM' $ p)+-- @++splitKeepEnd :: Monad m => ByteString -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))+splitKeepEnd pat k p0 = fmap join (k (go BS.empty p0)) where+  go pre p = do+    x <- lift (next p)+    case x of+      Left r -> return $ return r+      Right (bs, p') -> do+        case fnd (pre <> bs) of+          -- no hit yet, send the bs down, keep some suffix+          [] -> do+            unless (BS.null bs) (yield bs)+            let pfx = BS.drop (BS.length bs - l + 1) bs+            go pfx p'+          -- at least one hit, split off the correct part, remainder goes+          -- back.+          (k:_) -> do+            let (y,suf) = BS.splitAt (k - BS.length pre + l) bs+            yield y+            return (yield suf >> p')+  l = BS.length pat+  fnd = indices pat+{-# Inlineable splitKeepEnd #-}++++-- | Split a string into substrings, where each substring starts with @pat@+-- and continues until just before the next @pat@ (or until there is no+-- more input).+--+-- Any prefix that does not start with the substring is /kept/!+--+-- Since each substring is supposed to start with @pat@, there is a small+-- problem. What about a header that prefixes the string we are interested+-- in?++splitKeepStart :: Monad m => ByteString -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))+splitKeepStart = splitGeneric (\bs k p l -> BS.splitAt (k - p) bs)+{-# Inlineable splitKeepStart #-}++++-- | Generic splitting function. Takes a bytestring @[a,b,c]@ (where+-- @a,b,c@ are substrings of the bytestring!) and performs the split.+--++splitGeneric+  :: Monad m+  => (ByteString -> Int -> Int -> Int -> (ByteString,ByteString))+  -- ^ splitter function+  -> ByteString+  -- ^ pattern to split on+  -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))+  -- ^ lens into the individual split off bytestrings+splitGeneric splt pat k p0 = fmap join (k (go BS.empty p0)) where+  go pre p = do+    x <- lift (next p)+    case x of+      Left r -> do+        -- yield final split off string+        unless (BS.null pre) (yield pre)+        return $ return r+      Right (bs, p') -> do+        -- will not search in the part of the prefix that *can not contain*+        -- the @pat@tern.+        case fnd ((BS.drop (BS.length pre - l) pre) <> bs) of+          -- no hit yet, send the prefix down completely, make bs new+          -- prefix if possible. If either @pre@ or @bs@ are too short, we+          -- keep @pre <> bs@ for the next round. This should not happen if+          -- the pattern is reasonably short compared to the size of the+          -- bytestring chunks.+          [] -> do+            if (BS.length bs >= l)+            then yield pre >> go bs p'+            else go (pre <> bs) p'+          -- at least one hit, split off the correct part, remainder goes+          -- back.+          (k:_) -> do+            let (y,suf) = splt bs k (BS.length pre) l+            yield y+            return (yield suf >> p')+  l = BS.length pat+  fnd = indices pat+{-# Inline splitGeneric #-}++++-- manual splitting, for @splitKeepEnd@++referenceByteStringTokenizer pat str | BS.null pat || BS.null str = []+referenceByteStringTokenizer pat str+  = (h `BS.append` BS.take (BS.length pat) t)+  : if BS.null t then [] else referenceByteStringTokenizer pat (BS.drop (BS.length pat) t)+    where (h,t) = BS.breakSubstring pat str+

@@ -1,3 +1,9 @@+0.0.1.0+-------++- Pipes.Split.ByteString splits a bytestring based on a given pattern (example+  usage in tests/properties.hs)+ 0.0.0.2 ------- 

@@ -1,19 +1,30 @@  module Main where -import Data.List as L-import Data.Map.Strict as M-import Data.Tuple (swap)-import Data.Vector as V-import Debug.Trace-import Test.QuickCheck-import Test.Tasty-import Test.Tasty.QuickCheck as QC-import Test.Tasty.TH+import           Control.Lens+import           Control.Monad.Identity+import           Data.ByteString (ByteString)+import           Data.List as L+import           Data.Map.Strict as M+import           Data.Tuple (swap)+import           Data.Vector as V+import           Debug.Trace+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Pipes as P+import qualified Pipes.ByteString as PB+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 -import Data.Paired.Vector as DPV-import Data.Paired.Foldable as DPF-import Math.TriangularNumbers+import           Data.Paired.Foldable as DPF+import           Data.Paired.Vector as DPV+import           Math.TriangularNumbers+import           Pipes.Split.ByteString   @@ -138,6 +149,64 @@              | (k,(i,j)) <- ls ]  --++-- | Check if both splitKeepEnd and simple tokenization provide the same+-- result.++prop_splitKeepEndStrict :: String -> Small Int -> Small Int -> Bool+prop_splitKeepEndStrict str' (Small k) (Small l)+  | tt == ss  = True+  | otherwise = traceShow ("ske",pat,str,k,l,tt,ss,ee) False+  where str = BS.concat . L.replicate skeMult $ BS.pack str'+        -- make a small pattern with a chance that it repeats+        pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str+        -- what ske thinks is a good split+        (ss,ee,_) = ske pat str+        -- manual splitting+        tt = referenceByteStringTokenizer pat str++-- | Check if both splitKeepEnd and simple tokenization provide the same+-- result.++prop_splitKeepEndLazy :: String -> Small Int -> Small Int -> Bool+prop_splitKeepEndLazy str' (Small k) (Small l)+  | tt == ll  = True+  | otherwise = traceShow ("ske'",pat,str',str,strL,k,l,tt,ll,ee,rr) False+  where str = BS.concat . L.replicate skeMult $ BS.pack str'+        strL = BSL.fromChunks $ L.replicate skeMult $ BS.pack str'+        -- make a small pattern with a chance that it repeats+        pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str+        -- what we get with the lazy version+        (ll,ee,rr) = ske' pat strL+        -- manual splitting+        tt = referenceByteStringTokenizer pat str++-- The actual splitting system++ske :: ByteString -> ByteString -> ([ByteString],[ByteString],[ByteString])+ske pat str | BS.null pat || BS.null str = ([],[],[])+ske pat str =+  let parse = do+        xs <- zoom (splitKeepEnd pat) PP.drawAll+        case xs of+          [] -> return $ Left []+          xs -> return $ Right $ BS.concat xs+      (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PP.yield str+  in (a,b, fst . runIdentity . P.toListM' $ p)++ske' :: ByteString -> BSL.ByteString -> ([ByteString],[ByteString],[ByteString])+ske' pat _ | BS.null pat = ([],[],[])+ske' pat str =+  let parse = do+        xs <- zoom (splitKeepEnd pat) PP.drawAll+        case xs of+          [] -> return $ Left []+          xs -> return $ Right $ BS.concat xs+      (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PB.fromLazy str+  in (a,b, fst . runIdentity . P.toListM' $ p)++skeMult :: Int+skeMult = 1000  main :: IO () main = $(defaultMainGenerator)