DPutils 0.1.0.0 → 0.1.1.0

raw patch · 29 files changed

+822/−736 lines, 29 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• DP/Backtraced/Core.hs +0/−78
• DPutils.cabal +22/−13
• Data/Attoparsec/ByteString/Streaming.hs +0/−42
• Data/ByteString/Streaming/Split.hs +0/−60
• Data/Char/Util.hs +0/−16
• Data/Paired/Common.hs +0/−29
• Data/Paired/Foldable.hs +0/−121
• Data/Paired/Vector.hs +0/−46
• Data/Vector/Generic/Unstream.hs +0/−36
• Math/TriangularNumbers.hs +0/−78
• Pipes/Parallel.hs +0/−60
• Pipes/Split/ByteString.hs +0/−140
• README.md +1/−1
• Streaming/Primitive.hs +0/−16
• changelog.md +7/−0
• lib/DP/Backtraced/Core.hs +78/−0
• lib/Data/Attoparsec/ByteString/Streaming.hs +42/−0
• lib/Data/ByteString/Streaming/Split.hs +60/−0
• lib/Data/Char/Util.hs +16/−0
• lib/Data/Info.hs +24/−0
• lib/Data/Ord/Fast.hs +46/−0
• lib/Data/Paired/Common.hs +29/−0
• lib/Data/Paired/Foldable.hs +121/−0
• lib/Data/Paired/Vector.hs +46/−0
• lib/Data/Vector/Generic/Unstream.hs +36/−0
• lib/Math/TriangularNumbers.hs +78/−0
• lib/Pipes/Parallel.hs +60/−0
• lib/Pipes/Split/ByteString.hs +140/−0
• lib/Streaming/Primitive.hs +16/−0

@@ -1,78 +0,0 @@---- | The base constructors for generic backtracing.------ NOTE this currently can capture dot-bracket notation, but not deep--- semantics.--module DP.Backtraced.Core where--import           Control.Lens-import           Data.Foldable-import           GHC.Generics (Generic)-import qualified Data.Sequence as Seq-import qualified Test.QuickCheck as QC-import qualified Test.SmallCheck.Series as SC---- | This is a bit like a lazy "Data.Sequence" in terms of constructors. We can--- not be spine-strict, otherwise we'd use @Data.Sequence@ and enjoy the better--- performance.--data Backtraced ty where-  -- | This backtrace is done-  Epsilon ∷ Backtraced ty-  -- | Expand a backtrace to the left. This is lazy, since backtracing relies-  -- on laziness.-  Cons ∷ ty → Backtraced ty → Backtraced ty-  -- | Expand lazily to the right.-  Snoc ∷ Backtraced ty → ty → Backtraced ty-  -- | concatenate two structures-  Append ∷ Backtraced ty → Backtraced ty → Backtraced ty-  deriving (Eq,Ord,Show,Read,Generic,Functor,Foldable,Traversable)---- | This is somewhat tricky, since we might have to walk down the structure--- quite a bit and shuffle constructors without changing the actual leaf order.--instance Cons (Backtraced ty) (Backtraced ty') ty ty' where-  {-# Inlinable _Cons #-}-  _Cons =-    let go1 Epsilon = Left Epsilon-        go1 (Cons x xs)    = Right (x,xs)-        go1 (Snoc xs x)    = go2 xs (Left x)-        go1 (Append xs ys) = go2 xs (Right ys)-        go2 Epsilon        (Left y)   = Right (y,Epsilon)-        go2 Epsilon        (Right ys) = go1 ys-        go2 (Cons x xs)    (Left y)   = Right (x,Snoc xs y)-        go2 (Cons x xs)    (Right ys) = Right (x, Append xs ys)-        go2 (Snoc xs x)    (Left y)   = go2 xs (Right $ x `Cons` Epsilon `Snoc` y)-        go2 (Snoc xs x)    (Right ys) = go2 xs (Right $ x `Cons` ys)-        go2 (Append xs ys) (Left z)   = go2 xs (Right $ ys `Snoc` z)-        go2 (Append xs ys) (Right zs) = go2 xs (Right $ ys `Append` zs)-    in  prism (uncurry Cons) go1--instance Snoc (Backtraced ty) (Backtraced ty') ty ty' where-  {-# Inlinable _Snoc #-}-  _Snoc =-    let go1 Epsilon = Left Epsilon-        go1 (Cons x xs)    = go2 (Left x) xs-        go1 (Snoc xs x)    = Right (xs,x)-        go1 (Append xs ys) = go2 (Right xs) ys-        go2 (Left x)   Epsilon        = Right (Epsilon,x)-        go2 (Right xs) Epsilon        = go1 xs-        go2 (Left x)   (Cons y ys)    = go2 (Right $ x `Cons` (y `Cons` Epsilon)) ys-        go2 (Right xs) (Cons y ys)    = go2 (Right $ xs `Snoc` y) ys-        go2 (Left x)   (Snoc ys y)    = Right (x `Cons` ys, y)-        go2 (Right xs) (Snoc ys y)    = Right (xs `Append` ys, y)-        go2 (Left x)   (Append ys zs) = go2 (Right $ x `Cons` ys) zs-        go2 (Right xs) (Append ys zs) = go2 (Right $ xs `Append` ys) zs-    in  prism (uncurry Snoc) go1--(<|) = Cons-(|>) = Snoc-(><) = Append--infixr 5 <|-infixr 5 ><-infixl 5 |>--instance SC.Serial m a ⇒ SC.Serial m (Backtraced a)-

@@ -1,17 +1,17 @@ Cabal-version:  2.2 Name:           DPutils-Version:        0.1.0.0+Version:        0.1.1.0 License:        BSD-3-Clause License-file:   LICENSE Maintainer:     choener@bioinf.uni-leipzig.de-author:         Christian Hoener zu Siederdissen, 2016-2019-copyright:      Christian Hoener zu Siederdissen, 2016-2019+author:         Christian Hoener zu Siederdissen, 2016-2021+copyright:      Christian Hoener zu Siederdissen, 2016-2021 homepage:       https://github.com/choener/DPutils bug-reports:    https://github.com/choener/DPutils/issues Stability:      Experimental Category:       Data Build-type:     Simple-tested-with:    GHC == 8.4.4+tested-with:    GHC == 8.8, GHC == 8.10, GHC == 9.0 Synopsis:       utilities for DP Description:                 Small set of utility functions, as well as the base types for@@ -31,7 +31,6 @@                , attoparsec           >= 0.13                , bytestring                , containers-               , criterion            >= 1.1                , kan-extensions       >= 4.0                , lens                 >= 4.0                , mtl@@ -41,14 +40,10 @@                , pipes-parse          >= 3.0                , primitive            >= 0.6                , QuickCheck           >= 2.7+               , smallcheck           >= 1.1                , streaming            >= 0.1                , streaming-bytestring >= 0.1                , stringsearch         >= 0.3-               , smallcheck           >= 1.1-               , tasty                >= 0.11-               , tasty-quickcheck     >= 0.8-               , tasty-smallcheck     >= 0.8-               , tasty-th             >= 0.1                , transformers         >= 0.5                , vector               >= 0.10   default-extensions: BangPatterns@@ -82,6 +77,8 @@     Data.Attoparsec.ByteString.Streaming     Data.ByteString.Streaming.Split     Data.Char.Util+    Data.Info+    Data.Ord.Fast     Data.Paired.Common     Data.Paired.Foldable     Data.Paired.Vector@@ -91,14 +88,21 @@     Pipes.Parallel     Pipes.Split.ByteString     Streaming.Primitive+  hs-source-dirs:+    lib    test-suite properties   import:     deps-  build-depends:-    DPutils+  build-depends: base+               , tasty                >= 0.11+               , tasty-quickcheck     >= 0.8+               , tasty-smallcheck     >= 0.8+               , tasty-th             >= 0.1+               --+               , DPutils   type:     exitcode-stdio-1.0   main-is:@@ -115,8 +119,12 @@  benchmark benchmark   import: deps+  build-depends: base+               , criterion            >= 1.1   type:     exitcode-stdio-1.0+  build-depends:+    DPutils   hs-source-dirs:     tests   main-is:@@ -128,7 +136,8 @@   import: deps   type:     exitcode-stdio-1.0-  build-depends: timeit               >= 2.0+  build-depends: DPutils+               , timeit               >= 2.0   hs-source-dirs:     tests   main-is:

@@ -1,42 +0,0 @@---- | Taken from Michael Thompson <http://hackage.haskell.org/package/streaming-utils>--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 #-}-

@@ -1,60 +0,0 @@---- | 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. <http://hackage.haskell.org/package/streaming-utils-0.1.4.7/docs/src/Streaming-Pipes.html#chunksOf>------ 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 #-}-

@@ -1,16 +0,0 @@---- | 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 #-}-

@@ -1,29 +0,0 @@--module Data.Paired.Common where------ | Shall we combine elements on the main diagonal as well?------ If we choose @NoDiag@, we deal with upper triangular matrices that are--- effectively one element smaller.--data OnDiag = OnDiag | NoDiag-  deriving (Eq)---- | Select only a subset of the possible enumerations.--data Enumerate-  -- | Enumerate all elements-  = All-  -- | Enumerate from a value and at most @N@ elements-  | FromN Int Int-  deriving (Eq)---- | If the size of the input is known before-hand or not.--data SizeHint-  = UnknownSize-  | KnownSize Int-  deriving (Eq)-

@@ -1,121 +0,0 @@---- | Efficient enumeration of subsets of triangular elements. Given a list--- @[1..n]@ we want to enumerate a subset @[(i,j)]@ of ordered pairs in--- such a way that we only have to hold the elements necessary for this--- subset in memory.--module Data.Paired.Foldable where--import Data.IntMap as IM-import Data.Foldable as F-import Data.List as L-import Control.Arrow ((***))-import Data.Vector as V-import Data.Vector.Generic as VG-import Debug.Trace (traceShow)-import Text.Printf--import Data.Paired.Common-import Math.TriangularNumbers------ | Generalized upper triangular elements. Given a list of elements--- @[e_1,...,e_k]@, we want to return pairs @(e_i,e_j)@ such that we have--- all ordered pairs with @i<j@ (if @NoDiag@onal elements), or @i<=j@ (if--- @OnDiag@onal elements).------ @upperTri@ will force the spine of @t a@ but is consumed linearly with--- a strict @Data.Foldable.foldl'@. Internally we keep a @Data.IntMap@ of--- the retained elements.------ This is important if the @Enumerate@ type is set to @FromN k n@. We--- start at the @k@th element, and produce @n@ elements.------ TODO compare @IntMap@ and @HashMap@.------ TODO inRange is broken.--upperTri-  :: (Foldable t)-  => SizeHint-  -- ^ If the size of @t a@ is known beforehand, give the appropriate-  -- @KnownSize n@, otherwise give @UnknownSize@. Using @UnknownSize@ will-  -- force the complete spine of @t a@.-  -> OnDiag-  -- ^ The enumeration will include the pairs on the main diagonal with-  -- @OnDiag@, meaning @(i,i)@ will be included for all @i@. Otherwise,-  -- @NoDiag@ will exclude these elements.-  -> Enumerate-  -- ^ Either enumerate @All@ elements or enumerate the @s@ elements-  -- starting at @k@ with @FromN k s@.-  -> t a-  -- ^ The foldable data structure to enumerate over.-  -> Either String (IntMap a, Int, [((Int,Int),(a,a))])-  -- ^ If there is any error then return @Left errorMsg@. Otherwise we have-  -- @Right (imap, numElems, list)@. The @imap@ structure holds the subset-  -- of elements with which we actually generate elements. @numElems@ is-  -- the total number of elements that will be generated. This is-  -- calculated without touch @list@. Finally, @list@ is the lazy list of-  -- elements to be generated.-upperTri sz d e xs-  | szLen /= readLen = Left $ printf "Expected SizeHint %d elements, but processed only %d elements!" szLen readLen-  | otherwise        = Right (imp, numElems, ys)-  where ys   = case e of {All -> id ; FromN _ s -> L.take s}-             . L.unfoldr go $ initEnum e d-        -- how many elements we will emit depends on enumeration and on-        -- diagonal element counting-        numElems-          | All <- e       = allSize-          | FromN s k <- e = if s+k > allSize then max 0 (allSize - s) else k-        -- The length of the input. With a given size hint, @xs :: t a@-        -- will only be touched once.-#if MIN_VERSION_base(4,8,0)-        szLen = case sz of { UnknownSize -> F.length xs ; KnownSize z -> z }-#else-        szLen = case sz of { UnknownSize -> L.length . F.toList $ xs ; KnownSize z -> z }-#endif-        szLn' = case d of { OnDiag -> szLen - 1 ; NoDiag -> szLen - 2 }-        -- Construct an intmap @imp@ of all elements in the accepted range.-        -- At the same time, return the length or size of the foldable-        -- container we gave as input. @xs@ is touched only once and can-        -- be efficiently consumed.-        (!imp,!readLen) = F.foldl' (\(!i,!l) x -> (if inRange l then IM.insert l x i else i,l+1)) (IM.empty, 0) xs-        allSize = szLen * (szLen + if d == OnDiag then 1 else -1) `div` 2-        -- we need three ranges. @cMin@ and @cMax@ are the range for the-        -- slow-moving first element in the tuple. @rMin@ and @rMax@ are-        -- the first and last element of the range starting at @cMin@ (we-        -- can actually start at @cMax@ but it doesn't matter).-        -- Finally, @lMin@ and @lMax@ are the range to the left of @cMin@.-        (lMin,lMax,cMin,cMax,rMin,rMax) = case e of-          All -> (0, szLen-1, 0, szLen-1, 0, szLen-1)-          FromN s k ->-            let (cmin,rmin) = fromLinear szLn' s-                (cmax,_   ) = fromLinear szLn' (s+k)-                rmax = rmin+k -- if this is @>= len@ we are safe anyway.-                lmin = if rmin+k >= szLen then 0 else cmin-                lmax = if rmin+k >= szLen then lmin + toLinear szLn' (cmin+1,cmin+1+rmin+k-szLn') else cmax-            in  (lmin, lmax, cmin, cmax, rmin, rmax)-        -- Determine if an element at linear index @z@ is in the range to-        -- be consumed.-        inRange z =  lMin <= z && z <= lMax-                  || cMin <= z && z <= cMax-                  || rMin <= z && z <= rMax-        -- index into the generated vector @xs@ when generating elements-        -- via @go@-        go (k,l)-          | k >= szLen  = Nothing-          | l >= szLen  = go (k+1,k+1 + if d == OnDiag then 0 else 1)-          | otherwise = Just (((k,l),(imp IM.! k, imp IM.! l)), (k,l+1))-        -- Initialize the enumeration at the correct pair @(i,j)@. From-        -- then on we can @take@ the correct number of elements, or stream-        -- all of them.-        initEnum All OnDiag = (0,0)-        initEnum All NoDiag = (0,1)-        initEnum (FromN s k) OnDiag-          | s >= allSize = (szLen,szLen)-          | otherwise    = fromLinear szLn' s-        initEnum (FromN s k) NoDiag-          | s >= allSize = (szLen,szLen)-          | otherwise    = id *** (+1) $ fromLinear szLn' s-

@@ -1,46 +0,0 @@--module Data.Paired.Vector-  ( module Data.Paired.Vector-  , module Data.Paired.Common-  ) where--import Data.Vector.Generic as VG--import Data.Paired.Common------ | Upper triangular elements.--upperTriVG-  :: (Vector v a, Vector w (a,a))-  => OnDiag-  -> v a-  -> (Int, w (a,a))-upperTriVG d as = (z, unfoldrN z go (0,if d == OnDiag then 0 else 1))-  where la = VG.length as-        z  = la * (la + if d == OnDiag then 1 else 0) `div` 2-        go (k,l)-          | k >= la   = Nothing-          | l >= la   = go (k+1,k+1 + if d == OnDiag then 0 else 1)-          | otherwise = Just ((as `VG.unsafeIndex` k, as `VG.unsafeIndex` l), (k,l+1))-{-# Inline upperTriVG #-}---- | Outer pairing of all @as@ with all @bs@. This one is quasi-trivial,--- but here for completeness.--rectangularVG-  :: (Vector va a, Vector vb b, Vector w (a,b))-  => va a-  -> vb b-  -> (Int, w (a,b))-rectangularVG as bs = (z, unfoldrN z go (0,0))-  where la = VG.length as-        lb = VG.length bs-        z  = la * lb-        go (k,l)-          | k >= la   = Nothing-          | l >= lb   = go (k+1,0)-          | otherwise = Just ((as `VG.unsafeIndex` k, bs `VG.unsafeIndex` l), (k,l+1))-{-# Inline rectangularVG #-}-

@@ -1,36 +0,0 @@---- | 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 #-}-

@@ -1,78 +0,0 @@---- | Triangular numbers and various helper functions.------ Main use is for linearization of triangular array indexing.--- --- Triangular numbers:--- @--- T_n = Σ_{k=1)^n k = 1 + 2 + 3 + ... + n =------ n * (n+1) / 2 = (n+1) `choose` 2--- @--------module Math.TriangularNumbers where------ | Triangular numbers.------ https://oeis.org/A000217--triangularNumber :: Int -> Int-triangularNumber x = (x * (x+1)) `quot` 2-{-# INLINE triangularNumber #-}---- | Size of an upper triangle starting at 'i' and ending at 'j'. "(0,N)" what--- be the normal thing to use.--linearizeUppertri :: (Int,Int) -> Int-linearizeUppertri (i,j) = triangularNumber $ j-i+1-{-# INLINE linearizeUppertri #-}---- | Subword indexing. Given the longest subword and the current subword,--- calculate a linear index "[0,..]". "(l,n)" in this case means "l"ower bound,--- length "n". And "(i,j)" is the normal index.------ @--- 0 1 2 3    <- j = ...------ 0 1 2 3    i=0--- _ 4 5 6    i=1--- _ _ 7 8    i=2---       9    i=3------ i=2, j=3  -> (4+1) * i - tri i + j------ _--- _ _  the triangular number to subtract.--- @--toLinear :: Int -> (Int,Int) -> Int-toLinear n (i,j) = adr n (i,j)-  where-    adr n (i,j) = (n+1)*i - triangularNumber i + j-    {-# Inline adr #-}-{-# INLINE toLinear #-}------ | Linear index to paired.------ We have indices in @[0,N]@, and linear index @k@.------ @--- (N+1)*i - (i*(i+1)/2) + j == K--- @--fromLinear :: Int -> Int -> (Int,Int)-fromLinear n' k' = (i,j)-  where ll = (2*n+1) / 2-        rr = sqrt $ ((2*(n+1)+1) / 2)^2 - 2*k-        n  = fromIntegral n'-        k  = fromIntegral k'-        i  = floor $ ll - rr + 1-        j  = k' - toLinear n' (i,0)-{-# Inline fromLinear #-}-

@@ -1,60 +0,0 @@---- | Pipes that introduce parallelism on different levels.--module Pipes.Parallel where--import Control.Monad.Codensity (lowerCodensity)-import Control.Monad (replicateM)-import Control.Parallel.Strategies (Strategy, parMap)-import Pipes------ | Evaluates chunks of pipes elements in parallel with a pure function.--pipePar-  :: (Monad m)-  => Int-  -- ^ number of elements to evaluate in parallel-  -> Strategy b-  -- ^ with which strategy-  -> (a -> b)-  -- ^ function to be mapped in parallel-  -> Pipe a b m ()-pipePar n strat f = pipeParBA n strat f (\as -> return ((),as)) (\() bs -> return bs)-{--  where-  go = do-    xs <- lowerCodensity . replicateM n $ lift await-    let ys = parMap strat f xs-    lowerCodensity $ mapM_ (lift . yield) ys-    go--}---- | Evaluates chunks of pipes elements in parallel with a pure function.--- Before and after each parallel step, a monadic function is run. This--- allows generation of certain statistics or information during runs.--pipeParBA-  :: (Monad m)-  => Int-  -- ^ number of elements to evaluate in parallel-  -> Strategy b-  -- ^ with which strategy-  -> (a -> b)-  -- ^ pure function to run in parallel-  -> ([a] -> m (x,[a]))-  -- ^ function to run before-  -> (x -> [b] -> m [b])-  -- ^ function to run after-  -> Pipe a b m ()-pipeParBA n strat f bef aft = go-  where-  go = do-    as' <- lowerCodensity . replicateM n $ lift await-    (x,as) <- lift $ bef as'-    let bs' = parMap strat f as-    bs <- lift $ aft x bs'-    lowerCodensity $ mapM_ (lift . yield) bs-    go-

@@ -1,140 +0,0 @@---- | 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,4 +1,4 @@-[![Build Status](https://travis-ci.org/choener/DPutils.svg?branch=master)](https://travis-ci.org/choener/DPutils)+![github action: master](https://github.com/choener/DPutils/actions/workflows/action.yml/badge.svg)  # DPutils 

@@ -1,16 +0,0 @@--module Streaming.Primitive where--import Control.Monad.Primitive-import Streaming------ | Orphan instance providing a primitive monad instance for streams. Allows--- impurely folds into mutable vectors from streams.--instance (Monad m, PrimMonad m, Functor f) ⇒ PrimMonad (Stream f m) where-  type PrimState (Stream f m) = PrimState m-  {-# Inline primitive #-}-  primitive = lift . primitive-

@@ -1,3 +1,10 @@+0.1.1.0+-------++- Data.Ord.Fast provides fast versions of min/max (until GHC catches up)+- Data.Info for "hand-written" Show-like instances to be used in an interactive environment. The+  info might, for example, return the length, beginning, and end of a string.+ 0.1.0.0 ------- 

@@ -0,0 +1,78 @@++-- | The base constructors for generic backtracing.+--+-- NOTE this currently can capture dot-bracket notation, but not deep+-- semantics.++module DP.Backtraced.Core where++import           Control.Lens+import           Data.Foldable+import           GHC.Generics (Generic)+import qualified Data.Sequence as Seq+import qualified Test.QuickCheck as QC+import qualified Test.SmallCheck.Series as SC++-- | This is a bit like a lazy "Data.Sequence" in terms of constructors. We can+-- not be spine-strict, otherwise we'd use @Data.Sequence@ and enjoy the better+-- performance.++data Backtraced ty where+  -- | This backtrace is done+  Epsilon ∷ Backtraced ty+  -- | Expand a backtrace to the left. This is lazy, since backtracing relies+  -- on laziness.+  Cons ∷ ty → Backtraced ty → Backtraced ty+  -- | Expand lazily to the right.+  Snoc ∷ Backtraced ty → ty → Backtraced ty+  -- | concatenate two structures+  Append ∷ Backtraced ty → Backtraced ty → Backtraced ty+  deriving (Eq,Ord,Show,Read,Generic,Functor,Foldable,Traversable)++-- | This is somewhat tricky, since we might have to walk down the structure+-- quite a bit and shuffle constructors without changing the actual leaf order.++instance Cons (Backtraced ty) (Backtraced ty') ty ty' where+  {-# Inlinable _Cons #-}+  _Cons =+    let go1 Epsilon = Left Epsilon+        go1 (Cons x xs)    = Right (x,xs)+        go1 (Snoc xs x)    = go2 xs (Left x)+        go1 (Append xs ys) = go2 xs (Right ys)+        go2 Epsilon        (Left y)   = Right (y,Epsilon)+        go2 Epsilon        (Right ys) = go1 ys+        go2 (Cons x xs)    (Left y)   = Right (x,Snoc xs y)+        go2 (Cons x xs)    (Right ys) = Right (x, Append xs ys)+        go2 (Snoc xs x)    (Left y)   = go2 xs (Right $ x `Cons` Epsilon `Snoc` y)+        go2 (Snoc xs x)    (Right ys) = go2 xs (Right $ x `Cons` ys)+        go2 (Append xs ys) (Left z)   = go2 xs (Right $ ys `Snoc` z)+        go2 (Append xs ys) (Right zs) = go2 xs (Right $ ys `Append` zs)+    in  prism (uncurry Cons) go1++instance Snoc (Backtraced ty) (Backtraced ty') ty ty' where+  {-# Inlinable _Snoc #-}+  _Snoc =+    let go1 Epsilon = Left Epsilon+        go1 (Cons x xs)    = go2 (Left x) xs+        go1 (Snoc xs x)    = Right (xs,x)+        go1 (Append xs ys) = go2 (Right xs) ys+        go2 (Left x)   Epsilon        = Right (Epsilon,x)+        go2 (Right xs) Epsilon        = go1 xs+        go2 (Left x)   (Cons y ys)    = go2 (Right $ x `Cons` (y `Cons` Epsilon)) ys+        go2 (Right xs) (Cons y ys)    = go2 (Right $ xs `Snoc` y) ys+        go2 (Left x)   (Snoc ys y)    = Right (x `Cons` ys, y)+        go2 (Right xs) (Snoc ys y)    = Right (xs `Append` ys, y)+        go2 (Left x)   (Append ys zs) = go2 (Right $ x `Cons` ys) zs+        go2 (Right xs) (Append ys zs) = go2 (Right $ xs `Append` ys) zs+    in  prism (uncurry Snoc) go1++(<|) = Cons+(|>) = Snoc+(><) = Append++infixr 5 <|+infixr 5 ><+infixl 5 |>++instance SC.Serial m a ⇒ SC.Serial m (Backtraced a)+

@@ -0,0 +1,42 @@++-- | Taken from Michael Thompson <http://hackage.haskell.org/package/streaming-utils>++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 #-}+

@@ -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. <http://hackage.haskell.org/package/streaming-utils-0.1.4.7/docs/src/Streaming-Pipes.html#chunksOf>+--+-- 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 #-}+

@@ -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,24 @@++-- | Similar to @Show@, this module provides a string via @info@. This string gives convenient+-- user-information on objects.++module Data.Info where++import Data.List (concat,intersperse)+import qualified Data.Vector.Unboxed as VU++++class Info c where+  -- | The string returned by 'info' should be around 60 chars per line, and one line if possible.+  info :: c -> String++instance (Info a, Info b, Info c) => Info (a,b,c) where+  info (a,b,c) = concat $ intersperse " " [info a, info b, info c]++instance (VU.Unbox a, Info a) => Info (VU.Vector a) where+  info = concatMap info . VU.toList++instance Info Int where+  info = show+

@@ -0,0 +1,46 @@++{-# Language MagicHash #-}+{-# Language ForeignFunctionInterface #-}+{-# Language UnliftedFFITypes #-}+{-# Language GHCForeignImportPrim #-}+{-# Language UnboxedTuples #-}+{-# Language CPP #-}++-- | This module provides a small set of function for extremely fast @max@ and+-- @min@ operations that are branchless.+--+-- This should be temporary, since GHC is supposed to get the branchless variants.+--+-- NOTE these do not seem to be faster anyway.++module Data.Ord.Fast where++import GHC.Exts++++class FastMinMax x where+  fastmin :: x -> x -> x+  fastmax :: x -> x -> x+  -- | Clamp values to @>=0@.+  clamp :: x -> x++instance FastMinMax Int where+  fastmin (I# x) (I# y) =+    let !xmy = x -# y+        res  = I# ( y +# ( xmy `andI#` uncheckedIShiftRA# xmy 63# ) )+    in  res+  {-# Inline fastmin #-}+  fastmax (I# x) (I# y) =+    let !xmy  = x -# y+        res  = I# ( x -# ( xmy `andI#` uncheckedIShiftRA# xmy 63# ) )+    in  res+  -- FROM: https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-bignum-1.0/src/GHC-Num-Primitives.html#maxI%23+  -- NOTE: slightly slower than the above version+  --fastmax (I# x) (I# y)+  --  | isTrue# (x >=# y) = I# x+  --  | True              = I# y+  {-# Inline fastmax #-}+  clamp (I# x) = I# (andI# x (notI# (uncheckedIShiftRA# x 63#)))+  {-# Inline clamp #-}+

@@ -0,0 +1,29 @@++module Data.Paired.Common where++++-- | Shall we combine elements on the main diagonal as well?+--+-- If we choose @NoDiag@, we deal with upper triangular matrices that are+-- effectively one element smaller.++data OnDiag = OnDiag | NoDiag+  deriving (Eq)++-- | Select only a subset of the possible enumerations.++data Enumerate+  -- | Enumerate all elements+  = All+  -- | Enumerate from a value and at most @N@ elements+  | FromN Int Int+  deriving (Eq)++-- | If the size of the input is known before-hand or not.++data SizeHint+  = UnknownSize+  | KnownSize Int+  deriving (Eq)+

@@ -0,0 +1,121 @@++-- | Efficient enumeration of subsets of triangular elements. Given a list+-- @[1..n]@ we want to enumerate a subset @[(i,j)]@ of ordered pairs in+-- such a way that we only have to hold the elements necessary for this+-- subset in memory.++module Data.Paired.Foldable where++import Data.IntMap as IM+import Data.Foldable as F+import Data.List as L+import Control.Arrow ((***))+import Data.Vector as V+import Data.Vector.Generic as VG+import Debug.Trace (traceShow)+import Text.Printf++import Data.Paired.Common+import Math.TriangularNumbers++++-- | Generalized upper triangular elements. Given a list of elements+-- @[e_1,...,e_k]@, we want to return pairs @(e_i,e_j)@ such that we have+-- all ordered pairs with @i<j@ (if @NoDiag@onal elements), or @i<=j@ (if+-- @OnDiag@onal elements).+--+-- @upperTri@ will force the spine of @t a@ but is consumed linearly with+-- a strict @Data.Foldable.foldl'@. Internally we keep a @Data.IntMap@ of+-- the retained elements.+--+-- This is important if the @Enumerate@ type is set to @FromN k n@. We+-- start at the @k@th element, and produce @n@ elements.+--+-- TODO compare @IntMap@ and @HashMap@.+--+-- TODO inRange is broken.++upperTri+  :: (Foldable t)+  => SizeHint+  -- ^ If the size of @t a@ is known beforehand, give the appropriate+  -- @KnownSize n@, otherwise give @UnknownSize@. Using @UnknownSize@ will+  -- force the complete spine of @t a@.+  -> OnDiag+  -- ^ The enumeration will include the pairs on the main diagonal with+  -- @OnDiag@, meaning @(i,i)@ will be included for all @i@. Otherwise,+  -- @NoDiag@ will exclude these elements.+  -> Enumerate+  -- ^ Either enumerate @All@ elements or enumerate the @s@ elements+  -- starting at @k@ with @FromN k s@.+  -> t a+  -- ^ The foldable data structure to enumerate over.+  -> Either String (IntMap a, Int, [((Int,Int),(a,a))])+  -- ^ If there is any error then return @Left errorMsg@. Otherwise we have+  -- @Right (imap, numElems, list)@. The @imap@ structure holds the subset+  -- of elements with which we actually generate elements. @numElems@ is+  -- the total number of elements that will be generated. This is+  -- calculated without touch @list@. Finally, @list@ is the lazy list of+  -- elements to be generated.+upperTri sz d e xs+  | szLen /= readLen = Left $ printf "Expected SizeHint %d elements, but processed only %d elements!" szLen readLen+  | otherwise        = Right (imp, numElems, ys)+  where ys   = case e of {All -> id ; FromN _ s -> L.take s}+             . L.unfoldr go $ initEnum e d+        -- how many elements we will emit depends on enumeration and on+        -- diagonal element counting+        numElems+          | All <- e       = allSize+          | FromN s k <- e = if s+k > allSize then max 0 (allSize - s) else k+        -- The length of the input. With a given size hint, @xs :: t a@+        -- will only be touched once.+#if MIN_VERSION_base(4,8,0)+        szLen = case sz of { UnknownSize -> F.length xs ; KnownSize z -> z }+#else+        szLen = case sz of { UnknownSize -> L.length . F.toList $ xs ; KnownSize z -> z }+#endif+        szLn' = case d of { OnDiag -> szLen - 1 ; NoDiag -> szLen - 2 }+        -- Construct an intmap @imp@ of all elements in the accepted range.+        -- At the same time, return the length or size of the foldable+        -- container we gave as input. @xs@ is touched only once and can+        -- be efficiently consumed.+        (!imp,!readLen) = F.foldl' (\(!i,!l) x -> (if inRange l then IM.insert l x i else i,l+1)) (IM.empty, 0) xs+        allSize = szLen * (szLen + if d == OnDiag then 1 else -1) `div` 2+        -- we need three ranges. @cMin@ and @cMax@ are the range for the+        -- slow-moving first element in the tuple. @rMin@ and @rMax@ are+        -- the first and last element of the range starting at @cMin@ (we+        -- can actually start at @cMax@ but it doesn't matter).+        -- Finally, @lMin@ and @lMax@ are the range to the left of @cMin@.+        (lMin,lMax,cMin,cMax,rMin,rMax) = case e of+          All -> (0, szLen-1, 0, szLen-1, 0, szLen-1)+          FromN s k ->+            let (cmin,rmin) = fromLinear szLn' s+                (cmax,_   ) = fromLinear szLn' (s+k)+                rmax = rmin+k -- if this is @>= len@ we are safe anyway.+                lmin = if rmin+k >= szLen then 0 else cmin+                lmax = if rmin+k >= szLen then lmin + toLinear szLn' (cmin+1,cmin+1+rmin+k-szLn') else cmax+            in  (lmin, lmax, cmin, cmax, rmin, rmax)+        -- Determine if an element at linear index @z@ is in the range to+        -- be consumed.+        inRange z =  lMin <= z && z <= lMax+                  || cMin <= z && z <= cMax+                  || rMin <= z && z <= rMax+        -- index into the generated vector @xs@ when generating elements+        -- via @go@+        go (k,l)+          | k >= szLen  = Nothing+          | l >= szLen  = go (k+1,k+1 + if d == OnDiag then 0 else 1)+          | otherwise = Just (((k,l),(imp IM.! k, imp IM.! l)), (k,l+1))+        -- Initialize the enumeration at the correct pair @(i,j)@. From+        -- then on we can @take@ the correct number of elements, or stream+        -- all of them.+        initEnum All OnDiag = (0,0)+        initEnum All NoDiag = (0,1)+        initEnum (FromN s k) OnDiag+          | s >= allSize = (szLen,szLen)+          | otherwise    = fromLinear szLn' s+        initEnum (FromN s k) NoDiag+          | s >= allSize = (szLen,szLen)+          | otherwise    = id *** (+1) $ fromLinear szLn' s+

@@ -0,0 +1,46 @@++module Data.Paired.Vector+  ( module Data.Paired.Vector+  , module Data.Paired.Common+  ) where++import Data.Vector.Generic as VG++import Data.Paired.Common++++-- | Upper triangular elements.++upperTriVG+  :: (Vector v a, Vector w (a,a))+  => OnDiag+  -> v a+  -> (Int, w (a,a))+upperTriVG d as = (z, unfoldrN z go (0,if d == OnDiag then 0 else 1))+  where la = VG.length as+        z  = la * (la + if d == OnDiag then 1 else 0) `div` 2+        go (k,l)+          | k >= la   = Nothing+          | l >= la   = go (k+1,k+1 + if d == OnDiag then 0 else 1)+          | otherwise = Just ((as `VG.unsafeIndex` k, as `VG.unsafeIndex` l), (k,l+1))+{-# Inline upperTriVG #-}++-- | Outer pairing of all @as@ with all @bs@. This one is quasi-trivial,+-- but here for completeness.++rectangularVG+  :: (Vector va a, Vector vb b, Vector w (a,b))+  => va a+  -> vb b+  -> (Int, w (a,b))+rectangularVG as bs = (z, unfoldrN z go (0,0))+  where la = VG.length as+        lb = VG.length bs+        z  = la * lb+        go (k,l)+          | k >= la   = Nothing+          | l >= lb   = go (k+1,0)+          | otherwise = Just ((as `VG.unsafeIndex` k, bs `VG.unsafeIndex` l), (k,l+1))+{-# Inline rectangularVG #-}+

@@ -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,78 @@++-- | Triangular numbers and various helper functions.+--+-- Main use is for linearization of triangular array indexing.+-- +-- Triangular numbers:+-- @+-- T_n = Σ_{k=1)^n k = 1 + 2 + 3 + ... + n =+--+-- n * (n+1) / 2 = (n+1) `choose` 2+-- @+--+--++module Math.TriangularNumbers where++++-- | Triangular numbers.+--+-- https://oeis.org/A000217++triangularNumber :: Int -> Int+triangularNumber x = (x * (x+1)) `quot` 2+{-# INLINE triangularNumber #-}++-- | Size of an upper triangle starting at 'i' and ending at 'j'. "(0,N)" what+-- be the normal thing to use.++linearizeUppertri :: (Int,Int) -> Int+linearizeUppertri (i,j) = triangularNumber $ j-i+1+{-# INLINE linearizeUppertri #-}++-- | Subword indexing. Given the longest subword and the current subword,+-- calculate a linear index "[0,..]". "(l,n)" in this case means "l"ower bound,+-- length "n". And "(i,j)" is the normal index.+--+-- @+-- 0 1 2 3    <- j = ...+--+-- 0 1 2 3    i=0+-- _ 4 5 6    i=1+-- _ _ 7 8    i=2+--       9    i=3+--+-- i=2, j=3  -> (4+1) * i - tri i + j+--+-- _+-- _ _  the triangular number to subtract.+-- @++toLinear :: Int -> (Int,Int) -> Int+toLinear n (i,j) = adr n (i,j)+  where+    adr n (i,j) = (n+1)*i - triangularNumber i + j+    {-# Inline adr #-}+{-# INLINE toLinear #-}++++-- | Linear index to paired.+--+-- We have indices in @[0,N]@, and linear index @k@.+--+-- @+-- (N+1)*i - (i*(i+1)/2) + j == K+-- @++fromLinear :: Int -> Int -> (Int,Int)+fromLinear n' k' = (i,j)+  where ll = (2*n+1) / 2+        rr = sqrt $ ((2*(n+1)+1) / 2)^2 - 2*k+        n  = fromIntegral n'+        k  = fromIntegral k'+        i  = floor $ ll - rr + 1+        j  = k' - toLinear n' (i,0)+{-# Inline fromLinear #-}+

@@ -0,0 +1,60 @@++-- | Pipes that introduce parallelism on different levels.++module Pipes.Parallel where++import Control.Monad.Codensity (lowerCodensity)+import Control.Monad (replicateM)+import Control.Parallel.Strategies (Strategy, parMap)+import Pipes++++-- | Evaluates chunks of pipes elements in parallel with a pure function.++pipePar+  :: (Monad m)+  => Int+  -- ^ number of elements to evaluate in parallel+  -> Strategy b+  -- ^ with which strategy+  -> (a -> b)+  -- ^ function to be mapped in parallel+  -> Pipe a b m ()+pipePar n strat f = pipeParBA n strat f (\as -> return ((),as)) (\() bs -> return bs)+{-+  where+  go = do+    xs <- lowerCodensity . replicateM n $ lift await+    let ys = parMap strat f xs+    lowerCodensity $ mapM_ (lift . yield) ys+    go+-}++-- | Evaluates chunks of pipes elements in parallel with a pure function.+-- Before and after each parallel step, a monadic function is run. This+-- allows generation of certain statistics or information during runs.++pipeParBA+  :: (Monad m)+  => Int+  -- ^ number of elements to evaluate in parallel+  -> Strategy b+  -- ^ with which strategy+  -> (a -> b)+  -- ^ pure function to run in parallel+  -> ([a] -> m (x,[a]))+  -- ^ function to run before+  -> (x -> [b] -> m [b])+  -- ^ function to run after+  -> Pipe a b m ()+pipeParBA n strat f bef aft = go+  where+  go = do+    as' <- lowerCodensity . replicateM n $ lift await+    (x,as) <- lift $ bef as'+    let bs' = parMap strat f as+    bs <- lift $ aft x bs'+    lowerCodensity $ mapM_ (lift . yield) bs+    go+

@@ -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+

@@ -0,0 +1,16 @@++module Streaming.Primitive where++import Control.Monad.Primitive+import Streaming++++-- | Orphan instance providing a primitive monad instance for streams. Allows+-- impurely folds into mutable vectors from streams.++instance (Monad m, PrimMonad m, Functor f) ⇒ PrimMonad (Stream f m) where+  type PrimState (Stream f m) = PrimState m+  {-# Inline primitive #-}+  primitive = lift . primitive+