biohazard 0.6.13 → 0.6.15

raw patch · 26 files changed

+1412/−1702 lines, 26 filesdep −ListLikedep ~base-preludedep ~vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: ListLike

Dependency ranges changed: base-prelude, vector

API changes (from Hackage documentation)

Files

• biohazard.cabal +5/−9
• src/Bio/Adna.hs +4/−3
• src/Bio/Bam/Fastq.hs +2/−2
• src/Bio/Bam/Header.hs +22/−19
• src/Bio/Bam/Index.hs +1/−1
• src/Bio/Bam/Reader.hs +7/−5
• src/Bio/Bam/Rec.hs +12/−10
• src/Bio/Bam/Rmdup.hs +26/−26
• src/Bio/Bam/Trim.hs +105/−72
• src/Bio/Bam/Writer.hs +5/−5
• src/Bio/Iteratee.hs +21/−26
• src/Bio/Iteratee/Bgzf.hsc +14/−12
• src/Bio/Iteratee/Binary.hs +0/−199
• src/Bio/Iteratee/Builder.hs +8/−4
• src/Bio/Iteratee/Bytes.hs +269/−0
• src/Bio/Iteratee/Char.hs +0/−151
• src/Bio/Iteratee/IO.hs +13/−15
• src/Bio/Iteratee/IO/Fd.hs +27/−33
• src/Bio/Iteratee/IO/Handle.hs +29/−34
• src/Bio/Iteratee/List.hs +815/−0
• src/Bio/Iteratee/ListLike.hs +0/−883
• src/Bio/Iteratee/ReadableChunk.hs +0/−49
• src/Bio/Iteratee/ZLib.hsc +1/−1
• src/Bio/Prelude.hs +14/−1
• src/Bio/PriorityQueue.hs +0/−142
• src/cbits/loops.c +12/−0

@@ -1,5 +1,5 @@ Name:                biohazard-Version:             0.6.13+Version:             0.6.15 Synopsis:            bioinformatics support library Description:         This is a collection of modules I separated from                      various bioinformatics tools.  The hope is to make@@ -49,20 +49,17 @@                        Bio.Iteratee,                        Bio.Iteratee.Base,                        Bio.Iteratee.Bgzf,-                       Bio.Iteratee.Binary,                        Bio.Iteratee.Builder,-                       Bio.Iteratee.Char,+                       Bio.Iteratee.Bytes,                        Bio.Iteratee.Exception,                        Bio.Iteratee.IO,                        Bio.Iteratee.IO.Base,                        Bio.Iteratee.IO.Fd,                        Bio.Iteratee.IO.Handle,                        Bio.Iteratee.Iteratee,-                       Bio.Iteratee.ListLike,-                       Bio.Iteratee.ReadableChunk,+                       Bio.Iteratee.List,                        Bio.Iteratee.ZLib,                        Bio.Prelude,-                       Bio.PriorityQueue,                        Bio.TwoBit,                        Bio.Util.Numeric,                        Bio.Util.Zlib@@ -71,7 +68,7 @@                        async                    >= 2.0 && < 2.2,                        attoparsec               >= 0.10 && < 0.14,                        base                     >= 4.6 && < 4.10,-                       base-prelude             == 1.0.*,+                       base-prelude             >= 1.0 && < 1.3,                        binary                   >= 0.7 && < 0.9,                        bytestring               >= 0.10.2 && < 0.11,                        bytestring-mmap          >= 0.2 && < 1.0,@@ -80,7 +77,6 @@                        exceptions               >= 0.6 && < 0.9,                        filepath                 >= 1.3 && < 2.0,                        hashable                 >= 1.0 && < 1.3,-                       ListLike                 >= 3.0 && < 5.0,                        monad-control            == 1.0.*,                        primitive                >= 0.5 && < 0.7,                        random                   >= 1.0 && < 1.2,@@ -91,7 +87,7 @@                        transformers-base        >= 0.4 && < 0.6,                        unix                     >= 2.5 && < 2.8,                        unordered-containers     >= 0.2.3 && < 0.3,-                       vector                   == 0.11.*,+                       vector                   >= 0.11 && < 0.13,                        vector-algorithms        >= 0.3 && < 1.0,                        vector-th-unbox          == 0.2.*,                        zlib                     == 0.6.*

@@ -7,6 +7,7 @@     damagePatternsIter,     damagePatternsIterMD,     damagePatternsIter2Bit,+    alnFromMd,      DamageParameters(..),     NewDamageParameters(..),@@ -361,7 +362,7 @@         let b@BamRec{..} = unpackBam br         guard (not $ isUnmapped b)         md <- getMd b-        let pps = aln_from_md b_seq b_cigar md+        let pps = alnFromMd b_seq b_cigar md             ref = U.map fromN $ U.filter ((/=) gap . fst) pps         return (b, ft, ref, pps)) =$     damagePatternsIter 0 rng it@@ -581,8 +582,8 @@  -- | Reconstructs the alignment from query, cigar, and md.  Only -- positions where the query is not gapped are produced.-aln_from_md :: Vector_Nucs_half Nucleotides -> VS.Vector Cigar -> [MdOp] -> U.Vector NPair-aln_from_md qry0 cig0 md0 = U.fromList $ step qry0 cig0 md0+alnFromMd :: Vector_Nucs_half Nucleotides -> VS.Vector Cigar -> [MdOp] -> U.Vector NPair+alnFromMd qry0 cig0 md0 = U.fromList $ step qry0 cig0 md0   where     step qry cig1 md         | G.null qry || G.null cig1 || null md = []

@@ -99,9 +99,9 @@              | otherwise = Just (i-1)  skipJunk :: Monad m => Iteratee Bytes m ()-skipJunk = peekStream >>= check+skipJunk = peekStreamBS >>= check   where-    check (Just c) | bad c = dropWhileStream (c2w '\n' /=) >> dropStream 1 >> skipJunk+    check (Just c) | bad c = dropWhileStreamBS (c2w '\n' /=) >> dropStreamBS 1 >> skipJunk     check _                = return ()     bad c = c /= c2w '>' && c /= c2w '@' 

@@ -38,7 +38,8 @@         flagDuplicate,         eflagTrimmed,         eflagMerged,-        eflagVestigial,+        eflagAlternative,+        eflagExactIndex,          distinctBin, @@ -288,29 +289,31 @@  getRef :: Refs -> Refseq -> BamSQ getRef refs (Refseq i)-    | 0 <= i && fromIntegral i < Z.length refs = Z.index refs (fromIntegral i)-    | otherwise                                = BamSQ "*" 0 []+    | i < fromIntegral (Z.length refs) = Z.index refs (fromIntegral i)+    | otherwise                        = BamSQ "*" 0 []  -flagPaired, flagProperlyPaired, flagUnmapped, flagMateUnmapped, flagReversed, flagMateReversed, flagFirstMate, flagSecondMate,+flagPaired, flagProperlyPaired, flagUnmapped, flagMateUnmapped,+ flagReversed, flagMateReversed, flagFirstMate, flagSecondMate,  flagAuxillary, flagFailsQC, flagDuplicate :: Int -flagPaired = 0x1-flagProperlyPaired = 0x2-flagUnmapped = 0x4-flagMateUnmapped = 0x8-flagReversed = 0x10-flagMateReversed = 0x20-flagFirstMate = 0x40-flagSecondMate = 0x80-flagAuxillary = 0x100-flagFailsQC = 0x200-flagDuplicate = 0x400+flagPaired         =   0x1+flagProperlyPaired =   0x2+flagUnmapped       =   0x4+flagMateUnmapped   =   0x8+flagReversed       =  0x10+flagMateReversed   =  0x20+flagFirstMate      =  0x40+flagSecondMate     =  0x80+flagAuxillary      = 0x100+flagFailsQC        = 0x200+flagDuplicate      = 0x400 -eflagTrimmed, eflagMerged, eflagVestigial :: Int-eflagTrimmed       = 0x1-eflagMerged        = 0x2-eflagVestigial     = 0x4+eflagTrimmed, eflagMerged, eflagAlternative, eflagExactIndex :: Int+eflagTrimmed     = 0x1+eflagMerged      = 0x2+eflagAlternative = 0x4+eflagExactIndex  = 0x8   -- | Compares two sequence names the way samtools does.

@@ -175,7 +175,7 @@      switch "CSI\1" = do minshift <- fromIntegral `liftM` endianRead4 LSB                         depth <- fromIntegral `liftM` endianRead4 LSB-                        endianRead4 LSB >>= dropStream . fromIntegral -- aux data+                        endianRead4 LSB >>= dropStreamBS . fromIntegral -- aux data                         nref <- fromIntegral `liftM` endianRead4 LSB                         getIndexArrays nref minshift depth (addOneCheckpoint minshift depth) return 

@@ -173,7 +173,8 @@  isEmptyBam = (\e -> if e then Just (\k -> return $ k mempty) else Nothing) `liftM` isFinished -isPlainBam = (\n -> if n == 4 then Just (joinI . decompressPlain . decodeBam) else Nothing) `liftM` heads "BAM\SOH"+isPlainBam = (\n -> if n == "BAM\SOH" then Just (joinI . decompressPlain . decodeBam) else Nothing)+             `liftM` iGetString 4  -- Interesting... iLookAhead interacts badly with the parallel -- decompression of BGZF.  (The chosen interface doesn't allow the EOF@@ -257,11 +258,12 @@                      refs <- liftBlock get_ref_array                      convStream getBamRaw $ inner $! mmerge meta refs   where-    get_bam_header  = do magic <- heads "BAM\SOH"-                         when (magic /= 4) $ do s <- iGetString 10-                                                fail $ "BAM signature not found: " ++ show magic ++ " " ++ show s+    get_bam_header  = do magic <- iGetString 4 +                         when (magic /= "BAM\SOH") $ do+                                s <- iGetString 10+                                fail $ "BAM signature not found: " ++ show magic ++ " " ++ show s                          hdr_len <- endianRead4 LSB-                         joinI $ takeStream (fromIntegral hdr_len) $ parserToIteratee parseBamMeta+                         joinI $ takeStreamBS (fromIntegral hdr_len) $ parserToIteratee parseBamMeta      get_ref_array = do nref <- endianRead4 LSB                        foldM (\acc _ -> do

@@ -46,7 +46,8 @@     isDuplicate,     isTrimmed,     isMerged,-    isVestigial,+    isAlternative,+    isExactIndex,     type_mask,      progressBam,@@ -59,10 +60,7 @@  import Control.Monad.Primitive      ( unsafePrimToPrim, unsafeInlineIO ) import Foreign.C.Types              ( CInt(..), CSize(..) )-import Foreign.ForeignPtr import Foreign.Marshal.Alloc        ( alloca )-import Foreign.Ptr                  ( Ptr, plusPtr )-import Foreign.Storable             ( peek, poke, peekByteOff, pokeByteOff, Storable(..) )  import qualified Data.ByteString                    as B import qualified Data.ByteString.Char8              as S@@ -278,11 +276,14 @@                      fromIntegral (B.unsafeIndex (raw_data br) $ o+1) `shiftL`  8          getInt32 :: (Num a, Bits a) => Int -> a-        getInt32 o = fromIntegral (B.unsafeIndex (raw_data br) $ o+0)             .|.-                     fromIntegral (B.unsafeIndex (raw_data br) $ o+1) `shiftL`  8 .|.-                     fromIntegral (B.unsafeIndex (raw_data br) $ o+2) `shiftL` 16 .|.-                     fromIntegral (B.unsafeIndex (raw_data br) $ o+3) `shiftL` 24+        getInt32 o = fromIntegral (        B.unsafeIndex (raw_data br) $ o+0 )             .|.+                     fromIntegral (        B.unsafeIndex (raw_data br) $ o+1 ) `shiftL`  8 .|.+                     fromIntegral (        B.unsafeIndex (raw_data br) $ o+2 ) `shiftL` 16 .|.+                     fromIntegral (signed (B.unsafeIndex (raw_data br) $ o+3)) `shiftL` 24 +        signed :: Word8 -> Int8+        signed = fromIntegral+ -- | A collection of extension fields.  The key is actually only two @Char@s, but that proved impractical. -- (Hmm... we could introduce a Key type that is a 16 bit int, then give -- it an @instance IsString@... practical?)@@ -361,7 +362,7 @@  isPaired, isProperlyPaired, isUnmapped, isMateUnmapped, isReversed,     isMateReversed, isFirstMate, isSecondMate, isAuxillary, isFailsQC,-    isDuplicate, isTrimmed, isMerged, isVestigial :: BamRec -> Bool+    isDuplicate, isTrimmed, isMerged, isAlternative, isExactIndex :: BamRec -> Bool  isPaired         = flip testBit  0 . b_flag isProperlyPaired = flip testBit  1 . b_flag@@ -377,7 +378,8 @@  isTrimmed        = flip testBit 0 . extAsInt 0 "FF" isMerged         = flip testBit 1 . extAsInt 0 "FF"-isVestigial      = flip testBit 2 . extAsInt 0 "FF"+isAlternative    = flip testBit 2 . extAsInt 0 "FF"+isExactIndex     = flip testBit 3 . extAsInt 0 "FF"  type_mask :: Int type_mask = flagFirstMate .|. flagSecondMate .|. flagPaired

@@ -102,20 +102,20 @@ -- duplicates of each other.  The typical label function would extract -- read groups, libraries or samples. -rmdup :: (Monad m, Ord l) => (BamRec -> l) -> Bool -> Collapse -> Enumeratee [BamRec] [BamRec] m r+rmdup :: (Monad m, Ord l) => (BamRec -> l) -> Bool -> Collapse -> Enumeratee [BamRec] [(Int,BamRec)] m r rmdup label strand_preserved collapse_cfg =     -- Easiest way to go about this:  We simply collect everything that     -- starts at some specific coordinate and group it appropriately.     -- Treat the groups separately, output, go on.-    check_sort "input must be sorted for rmdup to work" ><>+    check_sort id "input must be sorted for rmdup to work" ><>     mapGroups rmdup_group ><>-    check_sort "internal error, output isn't sorted anymore"+    check_sort snd "internal error, output isn't sorted anymore"   where     rmdup_group = nice_sort . do_rmdup label strand_preserved collapse_cfg     same_pos u v = b_cpos u == b_cpos v     b_cpos u = (b_rname u, b_pos u) -    nice_sort x = sortBy (comparing (V.length . b_seq)) x+    nice_sort x = sortBy (comparing (V.length . b_seq . snd)) x      mapGroups f o = tryHead >>= maybe (return o) (\a -> eneeCheckIfDone (mg1 f a []) o)     mg1 f a acc k = tryHead >>= \mb -> case mb of@@ -123,11 +123,11 @@                         Just b | same_pos a b -> mg1 f a (b:acc) k                                | otherwise -> eneeCheckIfDone (mg1 f b []) . k . Chunk . f $ a:acc -check_sort :: Monad m => String -> Enumeratee [BamRec] [BamRec] m a-check_sort msg out = tryHead >>= maybe (return out) (\a -> eneeCheckIfDone (step a) out)+check_sort :: Monad m => (a -> BamRec) -> String -> Enumeratee [a] [a] m b+check_sort f msg out = tryHead >>= maybe (return out) (\a -> eneeCheckIfDone (step a) out)   where     step a k = tryHead >>= maybe (return . k $ Chunk [a]) (step' a k)-    step' a k b | (b_rname a, b_pos a) > (b_rname b, b_pos b) = fail $ "rmdup: " ++ msg+    step' a k b | (b_rname (f a), b_pos (f a)) > (b_rname (f b), b_pos (f b)) = fail $ "rmdup: " ++ msg                 | otherwise = eneeCheckIfDone (step b) . k $ Chunk [a]  @@ -192,15 +192,15 @@    (4) See 'merge_singles' for how it's actually done. -} -do_rmdup :: Ord l => (BamRec -> l) -> Bool -> Collapse -> [BamRec] -> [BamRec]+do_rmdup :: Ord l => (BamRec -> l) -> Bool -> Collapse -> [BamRec] -> [(Int,BamRec)] do_rmdup label strand_preserved Collapse{..} =     concatMap do_rmdup1 . M.elems . accumMap label id   where-    do_rmdup1 rds = results ++ originals (leftovers ++ r1 ++ r2 ++ r3)+    do_rmdup1 rds = results ++ map ((,) 0) (originals (leftovers ++ r1 ++ r2 ++ r3))       where         (results, leftovers) = merge_singles singles' unaligned' $-                [ (str, fromDecision b) | ((_,str  ),b) <- M.toList merged' ] ++-                [ (str, fromDecision b) | ((_,str,_),b) <- M.toList pairs' ]+                [ (str, second fromDecision b) | ((_,str  ),b) <- M.toList merged' ] +++                [ (str, second fromDecision b) | ((_,str,_),b) <- M.toList pairs' ]          (raw_pairs, raw_singles)       = partition isPaired rds         (merged, true_singles)         = partition (liftA2 (||) isMerged isTrimmed) raw_singles@@ -208,8 +208,9 @@         (pairs, raw_half_pairs)        = partition b_totally_aligned raw_pairs         (half_unaligned, half_aligned) = partition isUnmapped raw_half_pairs -        mkMap f x = let m1 = M.map collapse $ accumMap f id x-                    in (M.map fst m1, concatMap snd $ M.elems m1)+        mkMap :: Ord a => (BamRec -> a) -> [BamRec] -> (M.Map a (Int,Decision), [BamRec])+        mkMap f x = let m1 = M.map (\xs -> (length xs, collapse xs)) $ accumMap f id x+                    in (M.map (second fst) m1, concatMap (snd.snd) $ M.elems m1)          (pairs',r1)   = mkMap (\b -> (b_mate_pos b,   b_strand b, b_mate b)) pairs         (merged',r2)  = mkMap (\b -> (alignedLength (b_cigar b), b_strand b))           merged@@ -237,10 +238,10 @@ -- everything(?).  Then we don't have a mate for the consensus... though -- we could decide to duplicate one mate read to get it. -merge_singles :: M.Map Bool Decision                    -- strand --> true singles & half aligned+merge_singles :: M.Map Bool (Int,Decision)              -- strand --> true singles & half aligned               -> M.Map Bool [BamRec]                    -- strand --> half unaligned-              -> [ (Bool, BamRec) ]                     -- strand --> paireds & mergeds-              -> ([BamRec],[BamRec])                    -- results, leftovers+              -> [ (Bool, (Int, BamRec)) ]              -- strand --> paireds & mergeds+              -> ([(Int,BamRec)],[BamRec])              -- results, leftovers  merge_singles singles unaligneds = go   where@@ -250,14 +251,14 @@     -- representative, we add in its XP field and put it into the     -- leftovers.  If there is unaligned stuff here that has the same     -- strand, it goes to the leftovers.-    go ( (str, v) : paireds) =+    go ( (str, (m,v)) : paireds) =         let (r,l) = merge_singles (M.delete str singles) (M.delete str unaligneds) paireds             unal  = M.findWithDefault [] str unaligneds ++ l          in case M.lookup str singles of-            Nothing                 -> (             v : r,     unal )-            Just (Consensus      w) -> ( add_xp_of w v : r,     unal )      -- XXX do we need this w?!-            Just (Representative w) -> ( add_xp_of w v : r, w : unal )+            Nothing                    -> (              (m,v) : r,     unal )+            Just (n, Consensus      w) -> ( (n, add_xp_of w v) : r,     unal )      -- XXX do we need this w?!+            Just (n, Representative w) -> ( (n, add_xp_of w v) : r, w : unal )      -- No more pairs, delegate the problem     go [] = merge_halves unaligneds (M.toList singles)@@ -280,17 +281,16 @@ -- singleton.  merge_halves :: M.Map Bool [BamRec]                     -- strand --> half unaligned-             -> [(Bool, Decision)]                      -- strand --> true singles & half aligned-             -> ([BamRec],[BamRec])                     -- results, leftovers+             -> [(Bool, (Int,Decision))]                -- strand --> true singles & half aligned+             -> ([(Int,BamRec)],[BamRec])               -- results, leftovers  -- Emitting a consensus: make it a single.  Nothing goes to leftovers; -- we may still need it for something else to be emitted.  (While that -- would be strange, making sure the BAM file stays completely valid is -- probably better.)-merge_halves unaligneds ((_, Consensus v) : singles) =-    case merge_halves unaligneds singles of-        (l,r) -> ( v { b_flag = b_flag v .&. complement pflags } : r, l )+merge_halves unaligneds ((_, (n, Consensus v)) : singles) = ( (n, v { b_flag = b_flag v .&. complement pflags }) : r, l )   where+    (r,l)  = merge_halves unaligneds singles     pflags = flagPaired .|. flagProperlyPaired .|. flagMateUnmapped .|. flagMateReversed .|. flagFirstMate .|. flagSecondMate  @@ -299,7 +299,7 @@ -- result.  Everything else goes to leftovers.  If the representative -- happens to be unpaired, no mate is found and that case therefore is -- handled smoothly.-merge_halves unaligneds ((str, Representative v) : singles) = (v : take 1 same ++ r, drop 1 same ++ diff ++ l)+merge_halves unaligneds ((str, (n, Representative v)) : singles) = ((n,v) : map ((,)1) (take 1 same) ++ r, drop 1 same ++ diff ++ l)   where     (r,l)          = merge_halves (M.delete str unaligneds) singles     (same,diff)    = partition (is_mate_of v) $ M.findWithDefault [] str unaligneds

@@ -1,7 +1,21 @@ -- | Trimming of reads as found in BAM files.  Implements trimming low -- quality sequence from the 3' end. -module Bio.Bam.Trim where+module Bio.Bam.Trim+        ( trim_3+        , trim_3'+        , trim_low_quality+        , default_fwd_adapters+        , default_rev_adapters+        , find_merge+        , mergeBam+        , find_trim+        , trimBam+        , mergeTrimBam+        , twoMins+        , merged_seq+        , merged_qual+        ) where  import Bio.Bam.Header import Bio.Bam.Rec@@ -10,7 +24,6 @@ import Bio.Prelude  import Foreign.C.Types      ( CInt(..) )-import Foreign.Ptr          ( Ptr )  import qualified Data.ByteString                        as B import qualified Data.Vector.Generic                    as V@@ -145,6 +158,19 @@ trim_low_quality q = const $ all (< q)  +-- | Finds the merge point.  Input is list of forward adapters, list of+-- reverse adapters, sequence1, quality1, sequence2, quality2; output is+-- merge point and two qualities (YM, YN).+find_merge :: [W.Vector Nucleotides] -> [W.Vector Nucleotides]+           -> W.Vector Nucleotides -> W.Vector Qual+           -> W.Vector Nucleotides -> W.Vector Qual+           -> (Int, Int, Int)+find_merge ads1 ads2 r1 q1 r2 q2 = (mlen, score2 - score1, plain_score - score1)+  where+    plain_score = 6 * fromIntegral (V.length r1 + V.length r2)+    (score1, mlen, score2) = twoMins plain_score (V.length r1 + V.length r2) $+                             merge_score ads1 ads2 r1 q1 r2 q2+ -- | Overlap-merging of read pairs.  We shall compute the likelihood -- for every possible overlap, then select the most likely one (unless it -- looks completely random), compute a quality from the second best@@ -164,16 +190,15 @@ -- would further limit the returned quality!  (In practice, map quality -- later imposes a limit anyway, so no worries...) -merge_overlap :: BamRec -> [ W.Vector Nucleotides ]-              -> BamRec -> [ W.Vector Nucleotides ]-              -> Maybe ( BamRec, BamRec, BamRec, Int, Int )-merge_overlap r1 ads1 r2 ads2-    | V.null (b_seq r1) && V.null (b_seq r2) = Nothing-    | otherwise                              = result mlen score1 score2+mergeBam :: Int -> Int -> [W.Vector Nucleotides] -> [W.Vector Nucleotides] -> BamRec -> BamRec -> [BamRec]+mergeBam lowq highq ads1 ads2 r1 r2+    | V.null (b_seq r1) && V.null (b_seq r2) = [ r1', r2'     ]+    | qual1 < lowq                           = [ r1', r2'     ]+    | qual1 >= highq && mlen == 0            = [              ]+    | qual1 >= highq                         = [           rm ]+    | mlen < len_r1-20 || mlen < len_r2-20   = [           rm ]+    | otherwise         = map flag_alternative [ r1', r2', rm ]   where-    -- the "merge" score if there is no overlap-    plain_score = 6 * fromIntegral (len_r1 + len_r2)-     len_r1    = V.length  $ b_seq  r1     len_r2    = V.length  $ b_seq  r2 @@ -182,84 +207,96 @@     b_qual_r1 = V.convert $ b_qual r1     b_qual_r2 = V.convert $ b_qual r2 -    (score1, mlen, score2) = twoMins plain_score (len_r1 + len_r2) $-                             merge_score ads1 ads2 b_seq_r1 b_qual_r1 b_seq_r2 b_qual_r2+    (mlen, qual1, qual2) = find_merge ads1 ads2 b_seq_r1 b_qual_r1 b_seq_r2 b_qual_r2 -    flag_vestigial    br = br { b_exts = updateE "FF" (Int $ extAsInt 0 "FF" br .|. eflagVestigial) $ b_exts br }-    store_quals s1 s2 br = br { b_exts = updateE "YM" (Int $ s2          - s1) $-                                         updateE "YN" (Int $ plain_score - s1) $ b_exts br }+    flag_alternative br = br { b_exts = updateE "FF" (Int $ extAsInt 0 "FF" br .|. eflagAlternative) $ b_exts br }+    store_quals      br = br { b_exts = updateE "YM" (Int qual1) $ updateE "YN" (Int qual2) $ b_exts br }+    pair_flags = flagPaired.|.flagProperlyPaired.|.flagMateUnmapped.|.flagMateReversed.|.flagFirstMate.|.flagSecondMate -    result l s1 s2 = Just ( store_quals s1 s2 $ flag_vestigial r1-                          , store_quals s1 s2 $ flag_vestigial r2-                          , store_quals s1 s2 $ merged_read l (fromIntegral . min 63 $ s2-s1)-                          , s2 - s1, plain_score - s1 )+    r1' = store_quals r1+    r2' = store_quals r2+    rm  = store_quals $ merged_read mlen (fromIntegral $ min 63 qual1) -    merged_read l qmax-        | V.length merged_seq /= l = error $ "Logic error in merged_read: " ++ show (V.length merged_seq, l)-        | otherwise = nullBamRec {+    merged_read l qmax = nullBamRec {                 b_qname = b_qname r1,                 b_flag  = flagUnmapped .|. complement pair_flags .&. b_flag r1,-                b_seq   = merged_seq,-                b_qual  = merged_qual,+                b_seq   = V.convert $ merged_seq l b_seq_r1 b_qual_r1 b_seq_r2 b_qual_r2,+                b_qual  = V.convert $ merged_qual qmax l b_seq_r1 b_qual_r1 b_seq_r2 b_qual_r2,                 b_exts  = let ff = if l < len_r1 then eflagTrimmed else 0                           in updateE "FF" (Int $ extAsInt 0 "FF" r1 .|. eflagMerged .|. ff) $ b_exts r1 }-      where-        merged_seq = V.convert $ V.concat-                [ V.take (l - len_r2) (b_seq_r1)-                , merge_seqs             (V.take l $ V.drop (l - len_r2) b_seq_r1)-                                         (V.take l $ V.drop (l - len_r2) b_qual_r1)-                             (V.reverse $ V.take l $ V.drop (l - len_r1) b_seq_r2)-                             (V.reverse $ V.take l $ V.drop (l - len_r1) b_qual_r2)-                , V.reverse $ V.take (l - len_r1) b_seq_r2 ] -        merged_qual = V.convert $ V.concat-                [ V.take (l - len_r2) (b_qual_r1)-                , merge_quals qmax        (V.take l $ V.drop (l - len_r2) b_seq_r1)-                                          (V.take l $ V.drop (l - len_r2) b_qual_r1)-                              (V.reverse $ V.take l $ V.drop (l - len_r1) b_seq_r2)-                              (V.reverse $ V.take l $ V.drop (l - len_r1) b_qual_r2)-                , V.reverse $ V.take (l - len_r1) b_qual_r2 ]+{-# INLINE merged_seq #-}+merged_seq :: (V.Vector v Nucleotides, V.Vector v Qual)+           => Int -> v Nucleotides -> v Qual -> v Nucleotides -> v Qual -> v Nucleotides+merged_seq l b_seq_r1 b_qual_r1 b_seq_r2 b_qual_r2 = V.concat+        [ V.take (l - len_r2) (b_seq_r1)+        , V.zipWith4 zz          (V.take l $ V.drop (l - len_r2) b_seq_r1)+                                 (V.take l $ V.drop (l - len_r2) b_qual_r1)+                     (V.reverse $ V.take l $ V.drop (l - len_r1) b_seq_r2)+                     (V.reverse $ V.take l $ V.drop (l - len_r1) b_qual_r2)+        , V.reverse $ V.take (l - len_r1) b_seq_r2 ]+  where+    len_r1 = V.length b_qual_r1+    len_r2 = V.length b_qual_r2+    zz !n1 (Q !q1) !n2 (Q !q2) | n1 == compls n2 =        n1+                               | q1 > q2         =        n1+                               | otherwise       = compls n2 -    pair_flags = flagPaired.|.flagProperlyPaired.|.flagMateUnmapped.|.flagMateReversed.|.flagFirstMate.|.flagSecondMate+{-# INLINE merged_qual #-}+merged_qual :: (V.Vector v Nucleotides, V.Vector v Qual)+            => Word8 -> Int -> v Nucleotides -> v Qual -> v Nucleotides -> v Qual -> v Qual+merged_qual qmax l b_seq_r1 b_qual_r1 b_seq_r2 b_qual_r2 = V.concat+        [ V.take (l - len_r2) (b_qual_r1)+        , V.zipWith4 zz           (V.take l $ V.drop (l - len_r2) b_seq_r1)+                                  (V.take l $ V.drop (l - len_r2) b_qual_r1)+                      (V.reverse $ V.take l $ V.drop (l - len_r1) b_seq_r2)+                      (V.reverse $ V.take l $ V.drop (l - len_r1) b_qual_r2)+        , V.reverse $ V.take (l - len_r1) b_qual_r2 ]+  where+    len_r1 = V.length b_qual_r1+    len_r2 = V.length b_qual_r2+    zz !n1 (Q !q1) !n2 (Q !q2) | n1 == compls n2 = Q $ min qmax (q1 + q2)+                               | q1 > q2         = Q $           q1 - q2+                               | otherwise       = Q $           q2 - q1 -    merge_seqs v1 v2 v3 v4 = V.zipWith4 zz v1 v2 v3 v4-      where-        zz !n1 (Q !q1) !n2 (Q !q2) | n1 == compls n2 =        n1-                                   | q1 > q2         =        n1-                                   | otherwise       = compls n2 -    merge_quals qmax v1 v2 v3 v4 = V.zipWith4 zz v1 v2 v3 v4-      where-        zz !n1 (Q !q1) !n2 (Q !q2) | n1 == compls n2 = Q $ min qmax (q1 + q2)-                                   | q1 > q2         = Q $           q1 - q2-                                   | otherwise       = Q $           q2 - q1 +-- | Finds the trimming point.  Input is list of forward adapters,+-- sequence, quality; output is trim point and two qualities (YM, YN).+find_trim :: [W.Vector Nucleotides]+          -> W.Vector Nucleotides -> W.Vector Qual+          -> (Int, Int, Int)+find_trim ads1 r1 q1 = (mlen, score2 - score1, plain_score - score1)+  where+    plain_score = 6 * fromIntegral (V.length r1)+    (score1, mlen, score2) = twoMins plain_score (V.length r1) $+                             merge_score ads1 [V.empty] r1 q1 V.empty V.empty+ -- | Trimming for a single read:  we need one adapter only (the one coming -- /after/ the read), here provided as a list of options, and then we -- merge with an empty second read.  Results in up to two reads (the -- original, possibly flagged, and the trimmed one, definitely flagged, -- and two qualities).-trim_adapter :: BamRec -> [ W.Vector Nucleotides ] -> Maybe ( BamRec, BamRec, Int, Int )-trim_adapter r1 ads1-    | V.null (b_seq r1) = Nothing-    | otherwise         = result mlen score1 score2+trimBam :: Int -> Int -> [W.Vector Nucleotides] -> BamRec -> [BamRec]+trimBam lowq highq ads1 r1+    | V.null (b_seq r1)              = [ r1'      ]+    | mlen == 0 && qual1 >= highq    = [          ]+    | qual1 < lowq                   = [ r1'      ]+    | qual1 >= highq                 = [      r1t ]+    | otherwise = map flag_alternative [ r1', r1t ]   where     -- the "merge" score if there is no trimming-    plain_score = 6 * fromIntegral (V.length (b_seq r1))      b_seq_r1 = V.convert $ b_seq r1     b_qual_r1 = V.convert $ b_qual r1 -    (score1, mlen, score2) = twoMins plain_score (V.length (b_seq r1)) $-                             merge_score ads1 [V.empty] b_seq_r1 b_qual_r1 V.empty V.empty+    (mlen, qual1, qual2) = find_trim ads1 b_seq_r1 b_qual_r1 -    flag_vestigial    br = br { b_exts = updateE "FF" (Int $ extAsInt 0 "FF" br .|. eflagVestigial) $ b_exts br }-    store_quals s1 s2 br = br { b_exts = updateE "YM" (Int $ s2          - s1) $-                                         updateE "YN" (Int $ plain_score - s1) $ b_exts br }+    flag_alternative br = br { b_exts = updateE "FF" (Int $ extAsInt 0 "FF" br .|. eflagAlternative) $ b_exts br }+    store_quals      br = br { b_exts = updateE "YM" (Int qual1) $ updateE "YN" (Int qual2) $ b_exts br } -    result l s1 s2 = Just ( store_quals s1 s2 $ flag_vestigial r1-                          , store_quals s1 s2 $ trimmed_read l-                          , s2 - s1, plain_score - s1 )+    r1'  = store_quals r1+    r1t  = store_quals $ trimmed_read mlen      trimmed_read l = nullBamRec {             b_qname = b_qname r1,@@ -391,18 +428,14 @@                   | otherwise -> go m1 i1 m2 i2 (i+1)  -mergeTrimBam :: Monad m => [W.Vector Nucleotides] -> [W.Vector Nucleotides] -> Enumeratee [BamRec] [BamRec] m a-mergeTrimBam fwd_ads rev_ads = convStream go+mergeTrimBam :: Monad m => Int -> Int -> [W.Vector Nucleotides] -> [W.Vector Nucleotides] -> Enumeratee [BamRec] [BamRec] m a+mergeTrimBam lowq highq fwd_ads rev_ads = convStream go   where     go = do r1 <- headStream             if isPaired r1               then tryHead >>= go2 r1-              else case trim_adapter r1 fwd_ads of-                    Nothing                -> return [r1]-                    Just (r1',r1t,_q1,_q2) -> return [r1t,r1']+              else return $ trimBam lowq highq fwd_ads r1      go2 r1  Nothing  = error $ "Lone mate found: " ++ show (b_qname r1)-    go2 r1 (Just r2) = case merge_overlap r1 fwd_ads r2 rev_ads of-                    Nothing                   -> return [r1,r2]-                    Just (r1',r2',rm,_q1,_q2) -> return [rm,r1',r2']+    go2 r1 (Just r2) = return $ mergeBam lowq highq fwd_ads rev_ads r1 r2 

@@ -19,7 +19,6 @@ import Data.ByteString.Internal     ( ByteString(..) ) import Data.ByteString.Lazy         ( foldrChunks ) import Foreign.Marshal.Alloc        ( alloca )-import Foreign.Storable             ( pokeByteOff, peek ) import System.IO                    ( openBinaryFile, IOMode(..) )  import qualified Control.Monad.Catch                as C@@ -50,11 +49,12 @@     shows (b_flag b .&. 0xffff),     unpck (sq_name $ getRef refs $ b_rname b),     shows (b_pos b + 1),-    shows (b_mapq b),-    shows (b_cigar b),-    unpck (sq_name $ getRef refs $ b_mrnm b),+    shows (unQ $ b_mapq b),+    V.foldr ((.) . shows) id (b_cigar b),+    if isValidRefseq (b_mrnm b) && b_mrnm b == b_rname b+      then (:) '=' else unpck (sq_name $ getRef refs $ b_mrnm b),     shows (b_mpos b + 1),-    shows (b_isize b + 1),+    shows (b_isize b),     shows (V.toList $ b_seq b),     (++)  (V.toList . V.map (chr . (+33) . fromIntegral . unQ) $ b_qual b) ] .     foldr (\(k,v) f -> (:) '\t' . shows k . (:) ':' . extToSam v . f) id (b_exts b)

@@ -15,7 +15,6 @@     progressPos,      ($==),-    ListLike,     MonadIO, MonadMask,     lift, liftIO,     stdin, stdout, stderr,@@ -46,20 +45,18 @@     Fd,     withFileFd, -    module Bio.Iteratee.Binary,-    module Bio.Iteratee.Char,+    module Bio.Iteratee.Bytes,     module Bio.Iteratee.IO,     module Bio.Iteratee.Iteratee,-    module Bio.Iteratee.ListLike+    module Bio.Iteratee.List         ) where  import Bio.Bam.Header import Bio.Iteratee.Base-import Bio.Iteratee.Binary-import Bio.Iteratee.Char+import Bio.Iteratee.Bytes import Bio.Iteratee.IO import Bio.Iteratee.Iteratee-import Bio.Iteratee.ListLike+import Bio.Iteratee.List import Bio.Prelude import Bio.Util.Numeric                     ( showNum ) import Control.Concurrent.Async             ( Async, async, wait, cancel )@@ -67,13 +64,11 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class import Data.Binary.Get-import Data.ListLike                        ( ListLike ) import System.IO                            ( hIsTerminalDevice )  import qualified Control.Monad.Catch            as CMC import qualified Data.Attoparsec.ByteString     as A import qualified Data.ByteString.Char8          as S-import qualified Data.ListLike                  as LL import qualified Data.Vector.Generic            as VG import qualified Data.Vector.Generic.Mutable    as VM @@ -166,17 +161,17 @@  data Ordering' a = Less | Equal a | NotLess -mergeSortStreams :: (Monad m, ListLike s a, Nullable s) => (a -> a -> Ordering' a) -> Enumeratee s s (Iteratee s m) b+mergeSortStreams :: Monad m => (a -> a -> Ordering' a) -> Enumeratee [a] [a] (Iteratee [a] m) b mergeSortStreams comp = eneeCheckIfDone step   where     step out = peekStream >>= \mx -> lift peekStream >>= \my -> case (mx, my) of         (Just x, Just y) -> case x `comp` y of-            Less    -> do dropStream 1 ;                       eneeCheckIfDone step . out . Chunk $ LL.singleton x-            NotLess -> do                lift (dropStream 1) ; eneeCheckIfDone step . out . Chunk $ LL.singleton y-            Equal z -> do dropStream 1 ; lift (dropStream 1) ; eneeCheckIfDone step . out . Chunk $ LL.singleton z+            Less    -> do dropStream 1 ;                       eneeCheckIfDone step . out $ Chunk [x]+            NotLess -> do                lift (dropStream 1) ; eneeCheckIfDone step . out $ Chunk [y]+            Equal z -> do dropStream 1 ; lift (dropStream 1) ; eneeCheckIfDone step . out $ Chunk [z] -        (Just  x, Nothing) -> do       dropStream 1  ; eneeCheckIfDone step . out . Chunk $ LL.singleton x-        (Nothing, Just  y) -> do lift (dropStream 1) ; eneeCheckIfDone step . out . Chunk $ LL.singleton y+        (Just  x, Nothing) -> do       dropStream 1  ; eneeCheckIfDone step . out $ Chunk [x]+        (Nothing, Just  y) -> do lift (dropStream 1) ; eneeCheckIfDone step . out $ Chunk [y]         (Nothing, Nothing) -> idone (liftI out) $ EOF Nothing  @@ -239,28 +234,28 @@  -- | A general progress indicator that prints some message after a set -- number of records have passed through.-progressGen :: (MonadIO m, NullPoint s, ListLike s a)-            => (Int -> a -> String) -> Int -> (String -> IO ()) -> Enumeratee s s m b+progressGen :: MonadIO m+            => (Int -> a -> String) -> Int -> (String -> IO ()) -> Enumeratee [a] [a] m b progressGen msg sz put = eneeCheckIfDonePass (icont . go 0)   where     go !_ k (EOF   mx) = idone (liftI k) (EOF mx)     go !n k (Chunk as)-        | LL.null as = liftI $ go n k-        | otherwise  = let !n' = n + LL.length as+        | null as    = liftI $ go n k+        | otherwise  = let !n' = n + length as                        in when (n' `div` sz /= n `div` sz) (liftIO . put $-                                "\27[K" ++ msg n' (LL.head as) ++ "\r")+                                "\27[K" ++ msg n' (head as) ++ "\r")                           `ioBind_` eneeCheckIfDonePass (icont . go n') (k $ Chunk as)  -- | A simple progress indicator that prints the number of records.-progressNum :: (MonadIO m, NullPoint s, ListLike s a)-            => String -> Int -> (String -> IO ()) -> Enumeratee s s m b+progressNum :: MonadIO m+            => String -> Int -> (String -> IO ()) -> Enumeratee [a] [a] m b progressNum msg = progressGen (\n _ -> msg ++ " " ++ showNum n)  -- | A simple progress indicator that prints a position every set number -- of passed records.-progressPos :: (MonadIO m, ListLike s a, NullPoint s)+progressPos :: MonadIO m             => (a -> (Refseq, Int)) -> String -> Refs-            -> Int -> (String -> IO ()) -> Enumeratee s s m b+            -> Int -> (String -> IO ()) -> Enumeratee [a] [a] m b progressPos f msg refs =     progressGen $ \_ a -> let (!rs1, !po1) = f a                               !nm = unpack . sq_name $ getRef refs rs1@@ -317,7 +312,7 @@  -- | Equivalent to @joinI $ takeStream n $ stream2vector@, but more -- efficient.-stream2vectorN :: (MonadIO m, ListLike s a, Nullable s, VG.Vector v a) => Int -> Iteratee s m (v a)+stream2vectorN :: (MonadIO m, VG.Vector v a) => Int -> Iteratee [a] m (v a) stream2vectorN n = do     mv <- liftIO $ VM.new n     l <- go mv 0@@ -331,7 +326,7 @@                 Just  a -> liftIO (VM.write mv i a) >> go mv (i+1)  -- | Reads the whole stream into a 'VG.Vector'.-stream2vector :: (MonadIO m, ListLike s a, Nullable s, VG.Vector v a) => Iteratee s m (v a)+stream2vector :: (MonadIO m, VG.Vector v a) => Iteratee [a] m (v a) stream2vector = liftIO (VM.new 1024) >>= go 0   where     go !i !mv = tryHead >>= \x -> case x of

@@ -122,24 +122,25 @@ -- | Decodes a BGZF block header and returns the block size if -- successful. get_bgzf_header :: Monad m => Iteratee Bytes m (Word16, Word16)-get_bgzf_header = do n <- heads "\31\139"-                     _cm <- headStream-                     flg <- headStream+get_bgzf_header = do x   <- headStreamBS+                     y   <- headStreamBS+                     _cm <- headStreamBS+                     flg <- headStreamBS                      if flg `testBit` 2 then do-                         dropStream 6+                         dropStreamBS 6                          xlen <- endianRead2 LSB-                         it <- takeStream (fromIntegral xlen) get_bsize >>= lift . tryRun+                         it <- takeStreamBS (fromIntegral xlen) get_bsize >>= lift . tryRun                          case it of Left e -> throwErr e-                                    Right s | n == 2 -> return (s,xlen)+                                    Right s | x == 31 && y == 139 -> return (s,xlen)                                     _ -> throwErr $ iterStrExc "No BGZF"                       else throwErr $ iterStrExc "No BGZF"   where-    get_bsize = do i1 <- headStream-                   i2 <- headStream+    get_bsize = do i1 <- headStreamBS+                   i2 <- headStreamBS                    len <- endianRead2 LSB                    if i1 == 66 && i2 == 67 && len == 2                       then endianRead2 LSB-                      else dropStream (fromIntegral len) >> get_bsize+                      else dropStreamBS (fromIntegral len) >> get_bsize  -- | Tests whether a stream is in BGZF format.  Does not consume any -- input.@@ -151,10 +152,11 @@ isGzip :: Monad m => Iteratee Bytes m Bool isGzip = liftM (either (const False) id) $ checkErr $ iLookAhead $ test   where-    test = do n <- heads "\31\139"-              dropStream 24+    test = do x   <- headStreamBS+              y   <- headStreamBS+              dropStreamBS 24               b <- isFinished-              return $ not b && n == 2+              return $ not b && x == 31 && y == 139  -- ------------------------------------------------------------------------- Output 

@@ -1,199 +0,0 @@-{-# LANGUAGE FlexibleContexts, BangPatterns #-}---- |Monadic Iteratees:--- incremental input parsers, processors, and transformers------ Iteratees for parsing binary data.--module Bio.Iteratee.Binary (-  -- * Types-  Endian (..)-  -- * Endian multi-byte iteratees-  ,endianRead2-  ,endianRead3-  ,endianRead3i-  ,endianRead4-  ,endianRead8-  -- ** bytestring specializations-  -- | In current versions of @iteratee@ there is no difference between the-  -- bytestring specializations and polymorphic functions.  They exist-  -- for compatibility.-  ,readWord16be_bs-  ,readWord16le_bs-  ,readWord32be_bs-  ,readWord32le_bs-  ,readWord64be_bs-  ,readWord64le_bs-)-where--import Bio.Iteratee.Base-import Data.Bits-import Data.Int-import Data.Word-import Prelude--import qualified Bio.Iteratee.ListLike as I-import qualified Data.ByteString       as B-import qualified Data.ListLike         as LL---- --------------------------------------------------------------------------- Binary Random IO Iteratees---- Iteratees to read unsigned integers written in Big- or Little-endian ways---- | Indicate endian-ness.-data Endian = MSB -- ^ Most Significant Byte is first (big-endian)-  | LSB           -- ^ Least Significan Byte is first (little-endian)-  deriving (Eq, Ord, Show, Enum)--endianRead2-  :: LL.ListLike s Word8-  => Endian-  -> Iteratee s m Word16-endianRead2 e = endianReadN e 2 word16'-{-# INLINE endianRead2 #-}--endianRead3-  :: LL.ListLike s Word8-  => Endian-  -> Iteratee s m Word32-endianRead3 e = endianReadN e 3 (word32' . (0:))-{-# INLINE endianRead3 #-}---- |Read 3 bytes in an endian manner.  If the first bit is set (negative),--- set the entire first byte so the Int32 will be negative as--- well.-endianRead3i-  :: (Nullable s, LL.ListLike s Word8, Monad m)-  => Endian-  -> Iteratee s m Int32-endianRead3i e = do-  c1 <- I.headStream-  c2 <- I.headStream-  c3 <- I.headStream-  case e of-    MSB -> return $ (((fromIntegral c1-                        `shiftL` 8) .|. fromIntegral c2)-                        `shiftL` 8) .|. fromIntegral c3-    LSB ->-     let m :: Int32-         m = shiftR (shiftL (fromIntegral c3) 24) 8-     in return $ (((fromIntegral c3-                        `shiftL` 8) .|. fromIntegral c2)-                        `shiftL` 8) .|. fromIntegral m-{-# INLINE endianRead3i #-}--endianRead4-  :: LL.ListLike s Word8-  => Endian-  -> Iteratee s m Word32-endianRead4 e = endianReadN e 4 word32'-{-# INLINE endianRead4 #-}--endianRead8-  :: LL.ListLike s Word8-  => Endian-  -> Iteratee s m Word64-endianRead8 e = endianReadN e 8 word64'-{-# INLINE endianRead8 #-}---- This function does all the parsing work, depending upon provided arguments-endianReadN ::-  LL.ListLike s Word8-  => Endian-  -> Int-  -> ([Word8] -> b)-  -> Iteratee s m b-endianReadN MSB n0 cnct = liftI (step n0 [])- where-  step !n acc (Chunk c)-    | LL.null c        = liftI (step n acc)-    | LL.length c >= n = let (this,next) = LL.splitAt n c-                             !result     = cnct $ acc ++ LL.toList this-                         in idone result (Chunk next)-    | otherwise        = liftI (step (n - LL.length c) (acc ++ LL.toList c))-  step !n acc (EOF Nothing)  = icont (step n acc) (Just $ toException EofException)-  step !n acc (EOF (Just e)) = icont (step n acc) (Just e)-endianReadN LSB n0 cnct = liftI (step n0 [])- where-  step !n acc (Chunk c)-    | LL.null c        = liftI (step n acc)-    | LL.length c >= n = let (this,next) = LL.splitAt n c-                             !result = cnct $ reverse (LL.toList this) ++ acc-                         in idone result (Chunk next)-    | otherwise        = liftI (step (n - LL.length c)-                                     (reverse (LL.toList c) ++ acc))-  step !n acc (EOF Nothing)  = icont (step n acc)-                                    (Just $ toException EofException)-  step !n acc (EOF (Just e)) = icont (step n acc) (Just e)-{-# INLINE endianReadN #-}---- As of now, the polymorphic code is as fast as the best specializations--- I have found, so these just call out.  They may be improved in the--- future, or possibly deprecated.--- JWL, 2012-01-16--readWord16be_bs :: Iteratee B.ByteString m Word16-readWord16be_bs = endianRead2 MSB-{-# INLINE readWord16be_bs  #-}--readWord16le_bs :: Iteratee B.ByteString m Word16-readWord16le_bs = endianRead2 LSB-{-# INLINE readWord16le_bs  #-}--readWord32be_bs :: Iteratee B.ByteString m Word32-readWord32be_bs = endianRead4 MSB-{-# INLINE readWord32be_bs  #-}--readWord32le_bs :: Iteratee B.ByteString m Word32-readWord32le_bs = endianRead4 LSB-{-# INLINE readWord32le_bs  #-}--readWord64be_bs :: Iteratee B.ByteString m Word64-readWord64be_bs = endianRead8 MSB-{-# INLINE readWord64be_bs  #-}--readWord64le_bs :: Iteratee B.ByteString m Word64-readWord64le_bs = endianRead8 LSB-{-# INLINE readWord64le_bs  #-}--word16' :: [Word8] -> Word16-word16' [c1,c2] = word16 c1 c2-word16' _ = error "iteratee: internal error in word16'"--word16 :: Word8 -> Word8 -> Word16-word16 c1 c2 = (fromIntegral c1 `shiftL`  8) .|.  fromIntegral c2-{-# INLINE word16 #-}--word32' :: [Word8] -> Word32-word32' [c1,c2,c3,c4] = word32 c1 c2 c3 c4-word32' _ = error "iteratee: internal error in word32'"--word32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-word32 c1 c2 c3 c4 =-  (fromIntegral c1 `shiftL` 24) .|.-  (fromIntegral c2 `shiftL` 16) .|.-  (fromIntegral c3 `shiftL`  8) .|.-   fromIntegral c4-{-# INLINE word32 #-}--word64' :: [Word8] -> Word64-word64' [c1,c2,c3,c4,c5,c6,c7,c8] = word64 c1 c2 c3 c4 c5 c6 c7 c8-word64' _ = error "iteratee: internal error in word64'"-{-# INLINE word64' #-}--word64-  :: Word8 -> Word8 -> Word8 -> Word8-  -> Word8 -> Word8 -> Word8 -> Word8-  -> Word64-word64 c1 c2 c3 c4 c5 c6 c7 c8 =-  (fromIntegral c1 `shiftL` 56) .|.-  (fromIntegral c2 `shiftL` 48) .|.-  (fromIntegral c3 `shiftL` 40) .|.-  (fromIntegral c4 `shiftL` 32) .|.-  (fromIntegral c5 `shiftL` 24) .|.-  (fromIntegral c6 `shiftL` 16) .|.-  (fromIntegral c7 `shiftL`  8) .|.-   fromIntegral c8-{-# INLINE word64 #-}

@@ -24,10 +24,7 @@ import Bio.Iteratee import Bio.Iteratee.Bgzf                   ( compressChunk, maxBlockSize, bgzfEofMarker ) import Bio.Prelude-import Foreign.ForeignPtr                  ( ForeignPtr, withForeignPtr, mallocForeignPtrBytes ) import Foreign.Marshal.Utils               ( copyBytes )-import Foreign.Ptr                         ( Ptr, plusPtr )-import Foreign.Storable                    ( pokeByteOff )  import qualified Data.ByteString            as B import qualified Data.ByteString.Unsafe     as B@@ -75,7 +72,7 @@                 | TkBclSpecial !BclArgs                   BgzfTokens                 | TkLowLevel {-# UNPACK #-} !Int (BB -> IO BB) BgzfTokens -data BclSpecialType = BclNucsBin | BclNucsAsc | BclNucsAscRev | BclQualsBin | BclQualsAsc | BclQualsAscRev+data BclSpecialType = BclNucsBin | BclNucsWide | BclNucsAsc | BclNucsAscRev | BclQualsBin | BclQualsAsc | BclQualsAscRev  data BclArgs = BclArgs BclSpecialType                        {-# UNPACK #-} !(VS.Vector Word8)  -- bcl matrix@@ -238,6 +235,10 @@             nuc_loop p stride (plusPtr q i) u v             return $ (v - u + 2) `div` 2 +        BclNucsWide -> do+            nuc_loop_wide p stride (plusPtr q i) u v+            return $ v - u + 1+         BclNucsAsc -> do             nuc_loop_asc p stride (plusPtr q i) u v             return $ v - u + 1@@ -260,6 +261,9 @@  foreign import ccall unsafe "nuc_loop"     nuc_loop :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> Int -> IO ()++foreign import ccall unsafe "nuc_loop_wide"+    nuc_loop_wide :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> Int -> IO ()  foreign import ccall unsafe "nuc_loop_asc"     nuc_loop_asc :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> Int -> IO ()

@@ -0,0 +1,269 @@+{-# LANGUAGE FlexibleContexts, BangPatterns #-}++-- |Monadic Iteratees:+-- incremental input parsers, processors, and transformers+--+-- Iteratees for parsing binary data.++module Bio.Iteratee.Bytes (+  -- * Types+  Endian (..)+  -- * Endian multi-byte iteratees+  ,endianRead2+  ,endianRead3+  ,endianRead3i+  ,endianRead4+  ,endianRead8++  -- * Iteratees treating Bytes as list of Word8+  ,headStreamBS+  ,tryHeadBS+  ,peekStreamBS+  ,takeStreamBS+  ,dropStreamBS+  ,dropWhileStreamBS++  -- * Iteratees treating Bytes as list of Char+  ,enumLinesBS+  ,enumWordsBS+)+where++import Bio.Iteratee.Base+import Bio.Iteratee.Iteratee+import Bio.Prelude++import qualified Data.ByteString              as B+import qualified Data.ByteString.Char8        as C+import qualified Data.ByteString.Unsafe       as B++-- ------------------------------------------------------------------------+-- Binary Random IO Iteratees++-- Iteratees to read unsigned integers written in Big- or Little-endian ways++-- | Indicate endian-ness.+data Endian = MSB -- ^ Most Significant Byte is first (big-endian)+  | LSB           -- ^ Least Significan Byte is first (little-endian)+  deriving (Eq, Ord, Show, Enum)++endianRead2 :: Endian -> Iteratee Bytes m Word16+endianRead2 e = endianReadN e 2 word16'+{-# INLINE endianRead2 #-}++endianRead3 :: Endian -> Iteratee Bytes m Word32+endianRead3 e = endianReadN e 3 (word32' . (0:))+{-# INLINE endianRead3 #-}++-- |Read 3 bytes in an endian manner.  If the first bit is set (negative),+-- set the entire first byte so the Int32 will be negative as+-- well.+endianRead3i :: Monad m => Endian -> Iteratee Bytes m Int32+endianRead3i e = do+  c1 <- headStreamBS+  c2 <- headStreamBS+  c3 <- headStreamBS+  case e of+    MSB -> return $ (((fromIntegral c1+                        `shiftL` 8) .|. fromIntegral c2)+                        `shiftL` 8) .|. fromIntegral c3+    LSB ->+     let m :: Int32+         m = shiftR (shiftL (fromIntegral c3) 24) 8+     in return $ (((fromIntegral c3+                        `shiftL` 8) .|. fromIntegral c2)+                        `shiftL` 8) .|. fromIntegral m+{-# INLINE endianRead3i #-}++endianRead4 :: Endian -> Iteratee Bytes m Word32+endianRead4 e = endianReadN e 4 word32'+{-# INLINE endianRead4 #-}++endianRead8 :: Endian -> Iteratee Bytes m Word64+endianRead8 e = endianReadN e 8 word64'+{-# INLINE endianRead8 #-}++-- This function does all the parsing work, depending upon provided arguments+endianReadN ::+  Endian+  -> Int+  -> ([Word8] -> b)+  -> Iteratee Bytes m b+endianReadN MSB n0 cnct = liftI (step n0 [])+ where+  step !n acc (Chunk c)+    | B.null c        = liftI (step n acc)+    | B.length c >= n = let (this,next) = B.splitAt n c+                            !result     = cnct $ acc ++ B.unpack this+                        in idone result (Chunk next)+    | otherwise        = liftI (step (n - B.length c) (acc ++ B.unpack c))+  step !n acc (EOF Nothing)  = icont (step n acc) (Just $ toException EofException)+  step !n acc (EOF (Just e)) = icont (step n acc) (Just e)+endianReadN LSB n0 cnct = liftI (step n0 [])+ where+  step !n acc (Chunk c)+    | B.null c        = liftI (step n acc)+    | B.length c >= n = let (this,next) = B.splitAt n c+                            !result = cnct $ B.unpack (B.reverse this) ++ acc+                        in idone result (Chunk next)+    | otherwise        = liftI (step (n - B.length c)+                                     (B.unpack (B.reverse c) ++ acc))+  step !n acc (EOF Nothing)  = icont (step n acc)+                                    (Just $ toException EofException)+  step !n acc (EOF (Just e)) = icont (step n acc) (Just e)+{-# INLINE endianReadN #-}+++word16' :: [Word8] -> Word16+word16' [c1,c2] = word16 c1 c2+word16' _ = error "iteratee: internal error in word16'"++word16 :: Word8 -> Word8 -> Word16+word16 c1 c2 = (fromIntegral c1 `shiftL`  8) .|.  fromIntegral c2+{-# INLINE word16 #-}++word32' :: [Word8] -> Word32+word32' [c1,c2,c3,c4] = word32 c1 c2 c3 c4+word32' _ = error "iteratee: internal error in word32'"++word32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+word32 c1 c2 c3 c4 =+  (fromIntegral c1 `shiftL` 24) .|.+  (fromIntegral c2 `shiftL` 16) .|.+  (fromIntegral c3 `shiftL`  8) .|.+   fromIntegral c4+{-# INLINE word32 #-}++word64' :: [Word8] -> Word64+word64' [c1,c2,c3,c4,c5,c6,c7,c8] = word64 c1 c2 c3 c4 c5 c6 c7 c8+word64' _ = error "iteratee: internal error in word64'"+{-# INLINE word64' #-}++word64+  :: Word8 -> Word8 -> Word8 -> Word8+  -> Word8 -> Word8 -> Word8 -> Word8+  -> Word64+word64 c1 c2 c3 c4 c5 c6 c7 c8 =+  (fromIntegral c1 `shiftL` 56) .|.+  (fromIntegral c2 `shiftL` 48) .|.+  (fromIntegral c3 `shiftL` 40) .|.+  (fromIntegral c4 `shiftL` 32) .|.+  (fromIntegral c5 `shiftL` 24) .|.+  (fromIntegral c6 `shiftL` 16) .|.+  (fromIntegral c7 `shiftL`  8) .|.+   fromIntegral c8+{-# INLINE word64 #-}++headStreamBS :: Iteratee Bytes m Word8+headStreamBS = liftI step+  where+  step (Chunk c)+    | B.null c = icont step Nothing+    | otherwise  = idone (B.unsafeHead c) (Chunk (B.unsafeTail c))+  step stream          = icont step (Just (setEOF stream))+{-# INLINE headStreamBS #-}++peekStreamBS :: Iteratee Bytes m (Maybe Word8)+peekStreamBS = liftI step+  where+    step s@(Chunk vec)+      | B.null vec = liftI step+      | otherwise   = idone (Just $ B.unsafeHead vec) s+    step stream     = idone Nothing stream+{-# INLINE peekStreamBS #-}++tryHeadBS :: Iteratee Bytes m (Maybe Word8)+tryHeadBS = liftI step+  where+  step (Chunk vec)+    | B.null vec = liftI step+    | otherwise  = idone (Just (B.unsafeHead vec)) (Chunk (B.unsafeTail vec))+  step stream          = idone Nothing stream+{-# INLINE tryHeadBS #-}++dropStreamBS :: Int -> Iteratee Bytes m ()+dropStreamBS 0  = idone () (Chunk emptyP)+dropStreamBS n' = liftI (step n')+  where+    step n (Chunk str)+      | B.length str < n = liftI (step (n - B.length str))+      | otherwise        = idone () (Chunk (B.drop n str))+    step _ stream        = idone () stream+{-# INLINE dropStreamBS #-}++dropWhileStreamBS :: (Word8 -> Bool) -> Iteratee Bytes m ()+dropWhileStreamBS p = liftI step+  where+    step (Chunk str)+      | B.null rest  = liftI step+      | otherwise    = idone () (Chunk rest)+      where+        rest = B.dropWhile p str+    step stream      = idone () stream+{-# INLINE dropWhileStreamBS #-}++takeStreamBS ::+  Monad m+  => Int   -- ^ number of elements to consume+  -> Enumeratee Bytes Bytes m a+takeStreamBS n' iter+ | n' <= 0   = return iter+ | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)+  where+    on_done od oc x _ = runIter (dropStreamBS n' >> return (return x)) od oc+    on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step n' k)) od oc+    on_cont od oc _ (Just e) = runIter (dropStreamBS n' >> throwErr e) od oc+    step n k (Chunk str)+      | B.null str        = liftI (step n k)+      | B.length str <= n = takeStreamBS (n - B.length str) $ k (Chunk str)+      | otherwise          = idone (k (Chunk s1)) (Chunk s2)+      where (s1, s2) = B.splitAt n str+    step _n k stream       = idone (liftI k) stream+{-# INLINE takeStreamBS #-}++-- Like enumWords, but operates on ByteStrings.+-- This is provided as a higher-performance alternative to enumWords, and+-- is equivalent to treating the stream as a Data.ByteString.Char8.ByteString.+enumWordsBS :: Monad m => Enumeratee Bytes [Bytes] m a+enumWordsBS iter = convStream getter iter+  where+    getter = liftI step+    lChar = isSpace . C.last+    step (Chunk xs)+      | C.null xs  = getter+      | lChar xs   = idone (C.words xs) (Chunk C.empty)+      | otherwise  = icont (step' xs) Nothing+    step str       = idone mempty str+    step' xs (Chunk ys)+      | C.null ys  = icont (step' xs) Nothing+      | lChar ys   = idone (C.words . C.append xs $ ys) mempty+      | otherwise  = let w' = C.words . C.append xs $ ys+                         ws = init w'+                         ck = last w'+                     in idone ws (Chunk ck)+    step' xs str   = idone (C.words xs) str+{-# INLINE enumWordsBS #-}++-- Like enumLines, but operates on ByteStrings.+-- This is provided as a higher-performance alternative to enumLines, and+-- is equivalent to treating the stream as a Data.ByteString.Char8.ByteString.+enumLinesBS :: Monad m => Enumeratee Bytes [Bytes] m a+enumLinesBS = convStream getter+  where+    getter = icont step Nothing+    lChar = (== '\n') . C.last+    step (Chunk xs)+      | C.null xs  = getter+      | lChar xs   = idone (C.lines xs) (Chunk C.empty)+      | otherwise  = icont (step' xs) Nothing+    step str       = idone mempty str+    step' xs (Chunk ys)+      | C.null ys  = icont (step' xs) Nothing+      | lChar ys   = idone (C.lines . C.append xs $ ys) mempty+      | otherwise  = let w' = C.lines $ C.append xs ys+                         ws = init w'+                         ck = last w'+                     in idone ws (Chunk ck)+    step' xs str   = idone (C.lines xs) str+{-# INLINE enumLinesBS #-}

@@ -1,151 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}---- | Utilities for Char-based iteratee processing.--module Bio.Iteratee.Char (-  -- * Word and Line processors-  printLines-  ,printLinesUnterminated-  ,enumLines-  ,enumLinesBS-  ,enumWords-  ,enumWordsBS-)--where--import           Bio.Iteratee.Iteratee-import           Bio.Iteratee.ListLike-import           Data.Char-import           Data.Monoid-import qualified Data.ListLike as LL-import           Control.Monad (liftM)-import           Control.Monad.IO.Class-import qualified Data.ByteString.Char8 as BC-import           Prelude----- |Print lines as they are received. This is the first `impure' iteratee--- with non-trivial actions during chunk processing------  Only lines ending with a newline are printed,---  data terminated with EOF is not printed.-printLines :: Iteratee String IO ()-printLines = lines'- where-  lines' = breakStream (\c -> c == '\r' || c == '\n') >>= \l -> terminators >>= check l-  check _  0 = return ()-  check "" _ = return ()-  check l  _ = liftIO (putStrLn l) >> lines'---- |Print lines as they are received.------  All lines are printed, including a line with a terminating EOF.---  If the final line is terminated by EOF without a newline,---  no newline is printed.---  this function should be used in preference to printLines when possible,---  as it is more efficient with long lines.-printLinesUnterminated :: forall s el.-                       (Eq el, Nullable s, LL.StringLike s, LL.ListLike s el)-                       => Iteratee s IO ()-printLinesUnterminated = lines'- where-  lines' = do-    joinI $ breakE (`LL.elem` t1) (mapChunksM_ (putStr . LL.toString))-    terminators >>= check-  check 0 = return ()-  check _ = liftIO (putStrLn "") >> lines'-  t1 :: s-  t1 = LL.fromString "\r\n"--terminators :: (Eq el, Nullable s, LL.StringLike s, LL.ListLike s el)-            => Iteratee s IO Int-terminators = do-  l <- heads (LL.fromString "\r\n")-  if l == 0 then heads (LL.fromString "\n") else return l----- |Convert the stream of characters to the stream of lines, and--- apply the given iteratee to enumerate the latter.--- The stream of lines is normally terminated by the empty line.--- When the stream of characters is terminated, the stream of lines--- is also terminated.--- This is the first proper iteratee-enumerator: it is the iteratee of the--- character stream and the enumerator of the line stream.--enumLines-  :: (LL.ListLike s el, LL.StringLike s, Nullable s, Monad m) =>-     Enumeratee s [s] m a-enumLines = convStream getter-  where-    getter = icont step Nothing-    lChar = (== '\n') . last . LL.toString-    step (Chunk xs)-      | LL.null xs = getter-      | lChar xs   = idone (LL.lines xs) mempty-      | otherwise  = icont (step' xs) Nothing-    step _str      = getter-    step' xs (Chunk ys)-      | LL.null ys = icont (step' xs) Nothing-      | lChar ys   = idone (LL.lines . mappend xs $ ys) mempty-      | otherwise  = let w' = LL.lines $ mappend xs ys-                         ws = init w'-                         ck = last w'-                     in idone ws (Chunk ck)-    step' xs str   = idone (LL.lines xs) str---- |Convert the stream of characters to the stream of words, and--- apply the given iteratee to enumerate the latter.--- Words are delimited by white space.--- This is the analogue of List.words-enumWords :: (LL.ListLike s Char, Nullable s, Monad m) => Enumeratee s [s] m a-enumWords = convStream $ dropWhileStream isSpace >> liftM (:[]) (breakStream isSpace)-{-# INLINE enumWords #-}---- Like enumWords, but operates on ByteStrings.--- This is provided as a higher-performance alternative to enumWords, and--- is equivalent to treating the stream as a Data.ByteString.Char8.ByteString.-enumWordsBS-  :: (Monad m) => Enumeratee BC.ByteString [BC.ByteString] m a-enumWordsBS iter = convStream getter iter-  where-    getter = liftI step-    lChar = isSpace . BC.last-    step (Chunk xs)-      | BC.null xs = getter-      | lChar xs   = idone (BC.words xs) (Chunk BC.empty)-      | otherwise  = icont (step' xs) Nothing-    step str       = idone mempty str-    step' xs (Chunk ys)-      | BC.null ys = icont (step' xs) Nothing-      | lChar ys   = idone (BC.words . BC.append xs $ ys) mempty-      | otherwise  = let w' = BC.words . BC.append xs $ ys-                         ws = init w'-                         ck = last w'-                     in idone ws (Chunk ck)-    step' xs str   = idone (BC.words xs) str--{-# INLINE enumWordsBS #-}---- Like enumLines, but operates on ByteStrings.--- This is provided as a higher-performance alternative to enumLines, and--- is equivalent to treating the stream as a Data.ByteString.Char8.ByteString.-enumLinesBS :: (Monad m) => Enumeratee BC.ByteString [BC.ByteString] m a-enumLinesBS = convStream getter-  where-    getter = icont step Nothing-    lChar = (== '\n') . BC.last-    step (Chunk xs)-      | BC.null xs = getter-      | lChar xs   = idone (BC.lines xs) (Chunk BC.empty)-      | otherwise  = icont (step' xs) Nothing-    step str       = idone mempty str-    step' xs (Chunk ys)-      | BC.null ys = icont (step' xs) Nothing-      | lChar ys   = idone (BC.lines . BC.append xs $ ys) mempty-      | otherwise  = let w' = BC.lines $ BC.append xs ys-                         ws = init w'-                         ck = last w'-                     in idone ws (Chunk ck)-    step' xs str   = idone (BC.lines xs) str-

@@ -26,12 +26,10 @@  where -import Bio.Iteratee.ReadableChunk import Bio.Iteratee.Iteratee-import Bio.Iteratee.Binary ()+import Bio.Prelude import Control.Monad.Catch import Control.Monad.IO.Class-import Prelude  import qualified Bio.Iteratee.IO.Handle as H import qualified Bio.Iteratee.IO.Fd as FD@@ -47,33 +45,33 @@  -- If Posix is available, use the fileDriverRandomFd as fileDriverRandom.  Otherwise, use a handle-based variant. enumFile-  :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int      -> FilePath-     -> Enumerator s m a+     -> Enumerator Bytes m a enumFile = FD.enumFile  enumFileRandom-  :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int      -> FilePath-     -> Enumerator s m a+     -> Enumerator Bytes m a enumFileRandom = FD.enumFileRandom  -- |Process a file using the given Iteratee.  This function wraps -- enumFd as a convenience. fileDriver-  :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>-     Iteratee s m a+  :: (MonadIO m, MonadMask m) =>+     Iteratee Bytes m a      -> FilePath      -> m a fileDriver = FD.fileDriverFd defaultBufSize  -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf-  :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int-     -> Iteratee s m a+     -> Iteratee Bytes m a      -> FilePath      -> m a fileDriverVBuf = FD.fileDriverFd@@ -81,16 +79,16 @@ -- |Process a file using the given Iteratee.  This function wraps -- enumFdRandom as a convenience. fileDriverRandom-  :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>-     Iteratee s m a+  :: (MonadIO m, MonadMask m) =>+     Iteratee Bytes m a      -> FilePath      -> m a fileDriverRandom = FD.fileDriverRandomFd defaultBufSize  fileDriverRandomVBuf-  :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int-     -> Iteratee s m a+     -> Iteratee Bytes m a      -> FilePath      -> m a fileDriverRandomVBuf = FD.fileDriverRandomFd

@@ -1,6 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ConstraintKinds #-}- -- |Random and Binary IO with generic Iteratees, using File Descriptors for IO. -- when available, these are the preferred functions for performing IO as they -- run in constant space and function properly with sockets, pipes, etc.@@ -20,16 +17,13 @@  where -import Bio.Iteratee.Binary () import Bio.Iteratee.IO.Base import Bio.Iteratee.Iteratee-import Bio.Iteratee.ReadableChunk import Bio.Prelude import Control.Monad.Catch as CIO import Control.Monad.IO.Class+import Data.ByteString (packCStringLen) import Foreign.Marshal.Alloc-import Foreign.Ptr-import Foreign.Storable import System.IO (SeekMode(..))  @@ -37,12 +31,12 @@ -- Binary Random IO enumerators  makefdCallback ::-  (MonadIO m, NullPoint s, ReadableChunk s el) =>+  MonadIO m =>   Ptr el   -> ByteCount   -> Fd   -> st-  -> m (Either SomeException ((Bool, st), s))+  -> m (Either SomeException ((Bool, st), Bytes)) makefdCallback p bufsize fd st = do   n <- liftIO $ myfdRead fd (castPtr p) bufsize   case n of@@ -50,42 +44,42 @@     Right 0  -> liftIO yield >> return (Right ((False, st), emptyP))     Right n' -> liftM (\s -> Right ((True, st), s)) $                   readFromPtr p (fromIntegral n')+  where+    readFromPtr buf l = liftIO $ packCStringLen (castPtr buf, l)  -- |The enumerator of a POSIX File Descriptor.  This version enumerates -- over the entire contents of a file, in order, unless stopped by -- the iteratee.  In particular, seeking is not supported. enumFd-  :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) =>+  :: (MonadIO m, MonadMask m) =>      Int      -> Fd-     -> Enumerator s m a-enumFd bs fd iter =-  let bufsize = bs * (sizeOf (undefined :: el))-  in CIO.bracket (liftIO $ mallocBytes bufsize)-                 (liftIO . free)-                 (\p -> enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) () iter)+     -> Enumerator Bytes m a+enumFd bufsize fd iter =+  CIO.bracket (liftIO $ mallocBytes bufsize)+              (liftIO . free)+              (\p -> enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) () iter)  -- |A variant of enumFd that catches exceptions raised by the @Iteratee@. enumFdCatch- :: forall e s el m a.(IException e, NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m)+ :: (IException e, MonadIO m, MonadMask m)     => Int     -> Fd     -> (e -> m (Maybe EnumException))-    -> Enumerator s m a-enumFdCatch bs fd handler iter =-  let bufsize = bs * (sizeOf (undefined :: el))-  in CIO.bracket (liftIO $ mallocBytes bufsize)-                 (liftIO . free)-                 (\p -> enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd) handler () iter)+    -> Enumerator Bytes m a+enumFdCatch bufsize fd handler iter =+  CIO.bracket (liftIO $ mallocBytes bufsize)+              (liftIO . free)+              (\p -> enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd) handler () iter)   -- |The enumerator of a POSIX File Descriptor: a variation of @enumFd@ that -- supports RandomIO (seek requests). enumFdRandom- :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) =>+ :: (MonadIO m, MonadMask m) =>     Int     -> Fd-    -> Enumerator s m a+    -> Enumerator Bytes m a enumFdRandom bs fd iter = enumFdCatch bs fd handler iter   where     handler (SeekException off) =@@ -108,18 +102,18 @@  -- |Process a file using the given @Iteratee@. fileDriverFd-  :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int -- ^Buffer size (number of elements)-     -> Iteratee s m a+     -> Iteratee Bytes m a      -> FilePath      -> m a fileDriverFd = fileDriver enumFd  -- |A version of fileDriverFd that supports seeking. fileDriverRandomFd-  :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int-     -> Iteratee s m a+     -> Iteratee Bytes m a      -> FilePath      -> m a fileDriverRandomFd = fileDriver enumFdRandom@@ -135,17 +129,17 @@   (flip (enumf bufsize) iter)  enumFile ::-  (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+  (MonadIO m, MonadMask m)   => Int                 -- ^Buffer size   -> FilePath-  -> Enumerator s m a+  -> Enumerator Bytes m a enumFile = enumFile' enumFd  enumFileRandom ::-  (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+  (MonadIO m, MonadMask m)   => Int                 -- ^Buffer size   -> FilePath-  -> Enumerator s m a+  -> Enumerator Bytes m a enumFileRandom = enumFile' enumFdRandom  

@@ -20,27 +20,24 @@  where -import Bio.Iteratee.Binary () import Bio.Iteratee.Iteratee-import Bio.Iteratee.ReadableChunk import Bio.Prelude import Control.Monad.Catch as CIO import Control.Monad.IO.Class+import Data.ByteString (packCStringLen) import Foreign.Marshal.Alloc-import Foreign.Ptr-import Foreign.Storable import System.IO  -- ------------------------------------------------------------------------ -- Binary Random IO enumerators  makeHandleCallback ::-  (MonadIO m, NullPoint s, ReadableChunk s el) =>-  Ptr el+  MonadIO m =>+  Ptr Word8   -> Int   -> Handle   -> st-  -> m (Either SomeException ((Bool, st), s))+  -> m (Either SomeException ((Bool, st), Bytes)) makeHandleCallback p bsize h st = do   n' <- liftIO (CIO.try $ hGetBuf h p bsize :: IO (Either SomeException Int))   case n' of@@ -48,6 +45,8 @@     Right 0 -> return $ Right ((False, st), emptyP)     Right n -> liftM (\s -> Right ((True, st), s)) $                  readFromPtr p (fromIntegral n)+  where+    readFromPtr buf l = liftIO $ packCStringLen (castPtr buf, l)   -- |The (monadic) enumerator of a file Handle.  This version enumerates@@ -55,43 +54,39 @@ -- the iteratee.  In particular, seeking is not supported. -- Data is read into a buffer of the specified size. enumHandle ::- forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) =>+  (MonadIO m, MonadMask m) =>   Int -- ^Buffer size (number of elements per read)   -> Handle-  -> Enumerator s m a-enumHandle bs h i =-  let bufsize = bs * sizeOf (undefined :: el)-  in CIO.bracket (liftIO $ mallocBytes bufsize)-                 (liftIO . free)-                 (\p -> enumFromCallback (makeHandleCallback p bufsize h) () i)+  -> Enumerator Bytes m a+enumHandle bufsize h i =+  CIO.bracket (liftIO $ mallocBytes bufsize)+              (liftIO . free)+              (\p -> enumFromCallback (makeHandleCallback p bufsize h) () i)  -- |An enumerator of a file handle that catches exceptions raised by -- the Iteratee. enumHandleCatch  ::- forall e s el m a.(IException e,-                    NullPoint s,-                    ReadableChunk s el,-                    MonadIO m, MonadMask m) =>+ forall e m a.(IException e,+               MonadIO m, MonadMask m) =>   Int -- ^Buffer size (number of elements per read)   -> Handle   -> (e -> m (Maybe EnumException))-  -> Enumerator s m a-enumHandleCatch bs h handler i =-  let bufsize = bs * sizeOf (undefined :: el)-  in CIO.bracket (liftIO $ mallocBytes bufsize)-                 (liftIO . free)-                 (\p -> enumFromCallbackCatch (makeHandleCallback p bufsize h) handler () i)+  -> Enumerator Bytes m a+enumHandleCatch bufsize h handler i =+  CIO.bracket (liftIO $ mallocBytes bufsize)+              (liftIO . free)+              (\p -> enumFromCallbackCatch (makeHandleCallback p bufsize h) handler () i)   -- |The enumerator of a Handle: a variation of enumHandle that -- supports RandomIO (seek requests). -- Data is read into a buffer of the specified size. enumHandleRandom ::- forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) =>+ forall m a.(MonadIO m, MonadMask m) =>   Int -- ^ Buffer size (number of elements per read)   -> Handle-  -> Enumerator s m a+  -> Enumerator Bytes m a enumHandleRandom bs h i = enumHandleCatch bs h handler i   where     handler (SeekException off) =@@ -114,25 +109,25 @@   (flip (enumf bufsize) iter)  enumFile ::-  (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+  (MonadIO m, MonadMask m)   => Int                 -- ^Buffer size   -> FilePath-  -> Enumerator s m a+  -> Enumerator Bytes m a enumFile = enumFile' enumHandle  enumFileRandom ::-  (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+  (MonadIO m, MonadMask m)   => Int                 -- ^Buffer size   -> FilePath-  -> Enumerator s m a+  -> Enumerator Bytes m a enumFileRandom = enumFile' enumHandleRandom  -- |Process a file using the given @Iteratee@.  This function wraps -- @enumHandle@ as a convenience. fileDriverHandle-  :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int                      -- ^Buffer size (number of elements)-     -> Iteratee s m a+     -> Iteratee Bytes m a      -> FilePath      -> m a fileDriverHandle bufsize iter filepath =@@ -140,9 +135,9 @@  -- |A version of @fileDriverHandle@ that supports seeking. fileDriverRandomHandle-  :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) =>+  :: (MonadIO m, MonadMask m) =>      Int                      -- ^ Buffer size (number of elements)-     -> Iteratee s m a+     -> Iteratee Bytes m a      -> FilePath      -> m a fileDriverRandomHandle bufsize iter filepath =

@@ -0,0 +1,815 @@+{-# LANGUAGE TupleSections, ScopedTypeVariables #-}++-- |Monadic Iteratees:+-- incremental input parsers, processors and transformers+--+-- This module provides many basic iteratees from which more complicated+-- iteratees can be built.  In general these iteratees parallel those in+-- @Data.List@, with some additions.++module Bio.Iteratee.List (+  -- * Iteratees+  -- ** Iteratee Utilities+  isFinished+  ,stream2list+  ,stream2stream+  -- ** Basic Iteratees+  ,dropWhileStream+  ,dropStream+  ,headStream+  ,tryHead+  ,lastStream+  ,heads+  ,peekStream+  ,roll+  ,lengthStream+  ,chunkLength+  ,takeFromChunk+  -- ** Nested iteratee combinators+  ,breakStream+  ,breakE+  ,takeStream+  ,takeUpTo+  ,takeWhileE+  ,mapStream+  ,concatMapStream+  ,concatMapStreamM+  ,mapMaybeStream+  ,filterStream+  ,filterStreamM+  ,groupStreamBy+  ,groupStreamOn+  ,mergeStreams+  ,mergeByChunks+  -- ** Folds+  ,foldStream+  -- * Enumerators+  -- ** Basic enumerators+  ,enumPureNChunk+  -- ** Enumerator Combinators+  ,enumWith+  ,zipStreams+  ,zipStreams3+  ,zipStreams4+  ,zipStreams5+  ,sequenceStreams_+  ,countConsumed+  -- ** Monadic functions+  ,mapStreamM+  ,mapStreamM_+  ,foldStreamM+  -- * Re-exported modules+  ,module Bio.Iteratee.Iteratee+)+where++import Bio.Iteratee.Iteratee+import Bio.Prelude+import Control.Monad.Trans.Class++-- import qualified Data.ByteString          as B+++-- Useful combinators for implementing iteratees and enumerators++-- | Check if a stream has received 'EOF'.+isFinished :: Nullable s => Iteratee s m Bool+isFinished = liftI check+  where+  check c@(Chunk xs)+    | nullC xs    = liftI check+    | otherwise   = idone False c+  check s@(EOF _) = idone True s+{-# INLINE isFinished #-}++-- ------------------------------------------------------------------------+-- Primitive iteratees++-- |Read a stream to the end and return all of its elements as a list.+-- This iteratee returns all data from the stream *strictly*.+stream2list :: Monad m => Iteratee [el] m [el]+stream2list = liftM concat getChunks+{-# INLINE stream2list #-}++-- |Read a stream to the end and return all of its elements as a stream.+-- This iteratee returns all data from the stream *strictly*.+stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s+stream2stream = liftM mconcat getChunks+{-# INLINE stream2stream #-}+++-- ------------------------------------------------------------------------+-- Parser combinators++-- |Attempt to read the next element of the stream and return it+-- Raise a (recoverable) error if the stream is terminated.+--+-- The analogue of @List.head@+--+-- Because @head@ can raise an error, it shouldn't be used when constructing+-- iteratees for @convStream@.  Use @tryHead@ instead.+headStream :: Iteratee [el] m el+headStream = liftI step+  where+  step (Chunk [     ]) = icont step Nothing+  step (Chunk (hd:tl)) = idone hd (Chunk tl)+  step stream          = icont step (Just (setEOF stream))+{-# INLINE headStream #-}++-- | Similar to @headStream@, except it returns @Nothing@ if the stream+-- is terminated.+tryHead :: Iteratee [el] m (Maybe el)+tryHead = liftI step+  where+  step (Chunk [     ]) = liftI step+  step (Chunk (hd:tl)) = idone (Just hd) (Chunk tl)+  step stream          = idone Nothing stream+{-# INLINE tryHead #-}++-- |Attempt to read the last element of the stream and return it+-- Raise a (recoverable) error if the stream is terminated+--+-- The analogue of @List.last@+lastStream :: Iteratee [el] m el+lastStream = liftI (step Nothing)+  where+  step l (Chunk xs)+    | nullC xs     = liftI (step l)+    | otherwise    = liftI $ step (Just $ last xs)+  step l s@(EOF _) = case l of+    Nothing -> icont (step l) . Just . setEOF $ s+    Just x  -> idone x s+{-# INLINE lastStream #-}+++-- |Given a sequence of characters, attempt to match them against+-- the characters on the stream.  Return the count of how many+-- characters matched.  The matched characters are removed from the+-- stream.+-- For example, if the stream contains 'abd', then (heads 'abc')+-- will remove the characters 'ab' and return 2.+heads :: (Monad m, Eq el) => [el] -> Iteratee [el] m Int+heads st | nullC st = return 0+heads st = loopE 0 st+  where+  loopE cnt xs+    | nullC xs  = return cnt+    | otherwise = liftI (step cnt xs)+  step cnt str (Chunk [])          = liftI (step cnt str)+  step cnt [ ] stream              = idone cnt stream+  step cnt (y:ys) s@(Chunk (x:xs))+    | y == x    = step (succ cnt) ys (Chunk xs)+    | otherwise = idone cnt s+  step cnt _ stream         = idone cnt stream+{-# INLINE heads #-}+++-- |Look ahead at the next element of the stream, without removing+-- it from the stream.+-- Return @Just c@ if successful, return @Nothing@ if the stream is+-- terminated by 'EOF'.+peekStream :: Iteratee [el] m (Maybe el)+peekStream = liftI step+  where+    step   (Chunk [   ]) = liftI step+    step s@(Chunk (x:_)) = idone (Just x) s+    step stream          = idone Nothing stream+{-# INLINE peekStream #-}++-- | Return a chunk of @t@ elements length while consuming @d@ elements+--   from the stream.  Useful for creating a 'rolling average' with+--  'convStream'.+roll+  :: Monad m+  => Int  -- ^ length of chunk (t)+  -> Int  -- ^ amount to consume (d)+  -> Iteratee [el] m [[el]]+roll t d | t > d  = liftI step+  where+    step (Chunk vec)+      | length vec >= t =+          idone [take t vec] (Chunk $ drop d vec)+      | null vec        = liftI step+      | otherwise          = liftI (step' vec)+    step stream            = idone empty stream+    step' v1 (Chunk vec)   = step . Chunk $ v1 `mappend` vec+    step' v1 stream        = idone [v1] stream+roll t d = do r <- joinI (takeStream t stream2stream)+              dropStream (d-t)+              return [r]+  -- d is >= t, so this version works+{-# INLINE roll #-}+++-- |Drop n elements of the stream, if there are that many.+--+-- The analogue of @List.drop@+dropStream :: Int -> Iteratee [el] m ()+dropStream 0  = idone () (Chunk emptyP)+dropStream n' = liftI (step n')+  where+    step n (Chunk str)+      | length str < n = liftI (step (n - length str))+      | otherwise         = idone () (Chunk (drop n str))+    step _ stream         = idone () stream+{-# INLINE dropStream #-}++-- |Skip all elements while the predicate is true.+--+-- The analogue of @List.dropWhile@+dropWhileStream :: (el -> Bool) -> Iteratee [el] m ()+dropWhileStream p = liftI step+  where+    step (Chunk str)+      | null rest = liftI step+      | otherwise    = idone () (Chunk rest)+      where+        rest = dropWhile p str+    step stream      = idone () stream+{-# INLINE dropWhileStream #-}+++-- | Return the total length of the remaining part of the stream.+--+-- This forces evaluation of the entire stream.+--+-- The analogue of @List.length@+lengthStream :: Num a => Iteratee [el] m a+lengthStream = liftI (step 0)+  where+    step !i (Chunk xs) = liftI (step $ i + fromIntegral (length xs))+    step !i stream     = idone i stream+{-# INLINE lengthStream #-}++-- | Get the length of the current chunk, or @Nothing@ if 'EOF'.+--+-- This function consumes no input.+chunkLength :: Iteratee [el] m (Maybe Int)+chunkLength = liftI step+ where+  step s@(Chunk xs) = idone (Just $ length xs) s+  step stream       = idone Nothing stream+{-# INLINE chunkLength #-}++-- | Take @n@ elements from the current chunk, or the whole chunk if+-- @n@ is greater.+takeFromChunk :: Int -> Iteratee [el] m [el]+takeFromChunk n | n <= 0 = idone emptyP (Chunk emptyP)+takeFromChunk n = liftI step+ where+  step (Chunk xs) = let (h,t) = splitAt n xs in idone h $ Chunk t+  step stream     = idone emptyP stream+{-# INLINE takeFromChunk #-}++-- |Takes an element predicate and returns the (possibly empty) prefix of+-- the stream.  None of the characters in the string satisfy the character+-- predicate.+-- If the stream is not terminated, the first character of the remaining stream+-- satisfies the predicate.+--+-- N.B. 'breakE' should be used in preference to @breakStream@.+-- @breakStream@ will retain all data until the predicate is met, which may+-- result in a space leak.+--+-- The analogue of @List.break@++breakStream :: (el -> Bool) -> Iteratee [el] m [el]+breakStream cpred = icont (step mempty) Nothing+  where+    step bfr (Chunk str)+      | null str          =  icont (step bfr) Nothing+      | otherwise         =  case break cpred str of+        (str', tail')+          | null tail'    -> icont (step (bfr `mappend` str)) Nothing+          | otherwise     -> idone (bfr `mappend` str') (Chunk tail')+    step bfr stream       =  idone bfr stream+{-# INLINE breakStream #-}++-- ---------------------------------------------------+-- The converters show a different way of composing two iteratees:+-- `vertical' rather than `horizontal'++-- |Takes an element predicate and an iteratee, running the iteratee+-- on all elements of the stream until the predicate is met.+--+-- the following rule relates @break@ to @breakE@+-- @break@ pred === @joinI@ (@breakE@ pred stream2stream)+--+-- @breakE@ should be used in preference to @break@ whenever possible.+breakE :: (el -> Bool) -> Enumeratee [el] [el] m a+breakE cpred = eneeCheckIfDonePass (icont . step)+ where+  step k (Chunk s)+      | null s  = liftI (step k)+      | otherwise  = case break cpred s of+        (str', tail')+          | null tail'    -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'+          | otherwise     -> idone (k $ Chunk str') (Chunk tail')+  step k stream           =  idone (liftI k) stream+{-# INLINE breakE #-}++-- |Read n elements from a stream and apply the given iteratee to the+-- stream of the read elements. Unless the stream is terminated early, we+-- read exactly n elements, even if the iteratee has accepted fewer.+--+-- The analogue of @List.take@+takeStream ::+  Monad m+  => Int   -- ^ number of elements to consume+  -> Enumeratee [el] [el] m a+takeStream n' iter+ | n' <= 0   = return iter+ | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)+  where+    on_done od oc x _ = runIter (dropStream n' >> return (return x)) od oc+    on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step n' k)) od oc+    on_cont od oc _ (Just e) = runIter (dropStream n' >> throwErr e) od oc+    step n k (Chunk str)+      | null str           = liftI (step n k)+      | length str <= n    = takeStream (n - length str) $ k (Chunk str)+      | otherwise          = idone (k (Chunk s1)) (Chunk s2)+      where (s1, s2) = splitAt n str+    step _n k stream       = idone (liftI k) stream+{-# INLINE takeStream #-}++-- |Read n elements from a stream and apply the given iteratee to the+-- stream of the read elements. If the given iteratee accepted fewer+-- elements, we stop.+-- This is the variation of 'takeStream' with the early termination+-- of processing of the outer stream once the processing of the inner stream+-- finished early.+--+-- Iteratees composed with 'takeUpTo' will consume only enough elements to+-- reach a done state.  Any remaining data will be available in the outer+-- stream.+--+-- > > let iter = do+-- > h <- joinI $ takeUpTo 5 I.head+-- > t <- stream2list+-- > return (h,t)+-- >+-- > > enumPureNChunk [1..10::Int] 3 iter >>= run >>= print+-- > (1,[2,3,4,5,6,7,8,9,10])+-- >+-- > > enumPureNChunk [1..10::Int] 7 iter >>= run >>= print+-- > (1,[2,3,4,5,6,7,8,9,10])+--+-- in each case, @I.head@ consumes only one element, returning the remaining+-- 4 elements to the outer stream+takeUpTo :: Monad m => Int -> Enumeratee [el] [el] m a+takeUpTo i iter+ | i <= 0    = idone iter (Chunk emptyP)+ | otherwise = Iteratee $ \od oc ->+    runIter iter (onDone od oc) (onCont od oc)+  where+    onDone od oc x str      = runIter (idone (return x) str) od oc+    onCont od oc k Nothing  = if i == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step i k)) od oc+    onCont od oc _ (Just e) = runIter (throwErr e) od oc+    step n k (Chunk str)+      | null str       = liftI (step n k)+      | length str < n = takeUpTo (n - length str) $ k (Chunk str)+      | otherwise      =+         -- check to see if the inner iteratee has completed, and if so,+         -- grab any remaining stream to put it in the outer iteratee.+         -- the outer iteratee is always complete at this stage, although+         -- the inner may not be.+         let (s1, s2) = splitAt n str+         in Iteratee $ \od' _ -> do+              res <- runIter (k (Chunk s1)) (\a s  -> return $ Left  (a, s))+                                            (\k' e -> return $ Right (k',e))+              case res of+                Left (a,Chunk s1') -> od' (return a)+                                          (Chunk $ s1' ++ s2)+                Left  (a,s')       -> od' (idone a s') (Chunk s2)+                Right (k',e)       -> od' (icont k' e) (Chunk s2)+    step _ k stream       = idone (liftI k) stream+{-# INLINE takeUpTo #-}+++-- |Takes an element predicate and an iteratee, running the iteratee+-- on all elements of the stream while the predicate is met.+--+-- This is preferred to @takeWhile@.+takeWhileE :: (el -> Bool) -> Enumeratee [el] [el] m a+takeWhileE = breakE . (not .)+{-# INLINEABLE takeWhileE #-}++-- | Map a function over an 'Iteratee'.+-- This one is reimplemented and differs from the the one in+-- "Data.Iteratee.ListLike" in so far that it doesn't pass on an 'EOF'+-- received in the input, which is the expected behavior.+mapStream :: (el -> el') -> Enumeratee [el] [el'] m a+mapStream = mapChunks . map+{-# INLINE mapStream #-}++-- | Apply a function to the elements of a stream, concatenate the+-- results into a stream.  No giant intermediate list is produced.+concatMapStream :: Monoid t => (a -> t) -> Enumeratee [a] t m r+concatMapStream = mapChunks . foldMap+{-# INLINE concatMapStream #-}++-- | Apply a monadic function to the elements of a stream, concatenate+-- the results into a stream.  No giant intermediate list is produced.+concatMapStreamM :: Monad m => (a -> m t) -> Enumeratee [a] t m r+concatMapStreamM f = eneeCheckIfDone (liftI . go)+  where+    go k (EOF   mx)              = idone (liftI k) (EOF mx)+    go k (Chunk xs) | null xs    = liftI (go k)+                    | otherwise  = f (head xs) `mBind`+                                   eneeCheckIfDone (flip go (Chunk (tail xs))) . k . Chunk+{-# INLINE concatMapStreamM #-}++mapMaybeStream :: (a -> Maybe b) -> Enumeratee [a] [b] m r+mapMaybeStream = mapChunks . mapMaybe+{-# INLINE mapMaybeStream #-}++-- |Creates an 'enumeratee' with only elements from the stream that+-- satisfy the predicate function.  The outer stream is completely consumed.+--+-- The analogue of @List.filter@+filterStream :: (el -> Bool) -> Enumeratee [el] [el] m a+filterStream p = mapChunks (filter p)+{-# INLINE filterStream #-}++-- | Apply a monadic filter predicate to an 'Iteratee'.+filterStreamM :: Monad m => (a -> m Bool) -> Enumeratee [a] [a] m r+filterStreamM k = mapChunksM (go id)+  where+    go acc [   ] = return $! acc empty+    go acc (h:t) = do p <- k h+                      let acc' = if p then (:) h . acc else acc+                      go acc' t+{-# INLINE filterStreamM #-}++-- | Grouping on 'Iteratee's.  @groupStreamOn proj inner outer@ executes+-- @inner (proj e)@, where @e@ is the first input element, to obtain an+-- 'Iteratee' @i@, then passes elements @e@ to @i@ as long as @proj e@+-- produces the same result.  If @proj e@ changes or the input ends, the+-- pair of @proj e@ and the result of @run i@ is passed to @outer@.  At+-- end of input, the resulting @outer@ is returned.+groupStreamOn :: (Monad m, Eq t1)+              => (e -> t1)+              -> (t1 -> m (Iteratee [e] m t2))+              -> Enumeratee [e] [(t1, t2)] m a+groupStreamOn proj inner = eneeCheckIfDonePass (icont . step)+  where+    step outer   (EOF      mx) = idone (liftI outer) $ EOF mx+    step outer   (Chunk [   ]) = liftI $ step outer+    step outer c@(Chunk (h:_)) = let x = proj h+                                 in lift (inner x) >>= \i -> step' x i outer c++    -- We want to feed a 'Chunk' to the inner 'Iteratee', which might be+    -- finished.  In that case, we would want to abort, but we cannot,+    -- since the outer iteration is still going on.  So instead we+    -- discard data we would have fed to the inner 'Iteratee'.  (Use of+    -- 'enumPure1Chunk' is not appropriate, it would accumulate the+    -- data, just to have it discarded by the 'run' that eventually+    -- happens.++    step' c it outer (Chunk as)+        | null as = liftI $ step' c it outer+        | (l,r) <- span ((==) c . proj) as, not (null l) =+            let od a    _str = idoneM a $ EOF Nothing+                oc k Nothing = return $ k (Chunk l)+                oc k       m = icontM k m+            in lift (runIter it od oc) >>= \it' -> step' c it' outer (Chunk r)++    step' c it outer str =+        lift (run it) >>= \b -> eneeCheckIfDone (`step` str) . outer $ Chunk [(c,b)]+++-- | Grouping on 'Iteratee's.  @groupStreamBy cmp inner outer@ executes+-- @inner@ to obtain an 'Iteratee' @i@, then passes elements @e@ to @i@+-- as long as @cmp e0 e@, where @e0@ is some preceeding element, is+-- true.  Else, the result of @run i@ is passed to @outer@ and+-- 'groupStreamBy' restarts.  At end of input, the resulting @outer@ is+-- returned.+groupStreamBy :: Monad m+              => (t -> t -> Bool)+              -> m (Iteratee [t] m t2)+              -> Enumeratee [t] [t2] m a+groupStreamBy cmp inner = eneeCheckIfDonePass (icont . step)+  where+    step outer   (EOF      mx) = idone (liftI outer) $ EOF mx+    step outer   (Chunk [   ]) = liftI $ step outer+    step outer c@(Chunk (h:_)) = lift inner >>= \i -> step' h i outer c++    step' c it outer (Chunk as)+        | null as = liftI $ step' c it outer+        | (l,r) <- span (cmp c) as, not (null l) =+            let od a    _str = idoneM a $ EOF Nothing+                oc k Nothing = return $ k (Chunk l)+                oc k       m = icontM k m+            in lift (runIter it od oc) >>= \it' -> step' (head l) it' outer (Chunk r)++    step' _ it outer str =+        lift (run it) >>= \b -> eneeCheckIfDone (`step` str) . outer $ Chunk [b]+++-- | @mergeStreams@ offers another way to nest iteratees: as a monad stack.+-- This allows for the possibility of interleaving data from multiple+-- streams.+--+-- > -- print each element from a stream of lines.+-- > logger :: (MonadIO m) => Iteratee [ByteString] m ()+-- > logger = mapStreamM_ (liftIO . putStrLn . B.unpack)+-- >+-- > -- combine alternating lines from two sources+-- > -- To see how this was derived, follow the types from+-- > -- 'ileaveLines logger' and work outwards.+-- > run =<< enumFile 10 "file1" (joinI $ enumLinesBS $+-- >           ( enumFile 10 "file2" . joinI . enumLinesBS $ joinI+-- >                 (ileaveLines logger)) >>= run)+-- >+-- > ileaveLines :: (Functor m, Monad m)+-- >   => Enumeratee [ByteString] [ByteString] (Iteratee [ByteString] m)+-- >        [ByteString]+-- > ileaveLines = mergeStreams (\l1 l2 ->+-- >    [B.pack "f1:\n\t" ,l1 ,B.pack "f2:\n\t" ,l2 ]+-- >+-- >+--+mergeStreams :: Monad m => (el1 -> el2 -> b) -> Enumeratee [el2] b (Iteratee [el1] m) a+mergeStreams f = convStream $ liftM2 f (lift headStream) headStream+{-# INLINE mergeStreams #-}++-- | A version of mergeStreams which operates on chunks instead of+-- elements.+--+-- mergeByChunks offers more control than 'mergeStreams'.+-- 'mergeStreams' terminates when the first stream terminates, however+-- mergeByChunks will continue until both streams are exhausted.+--+-- 'mergeByChunks' guarantees that both chunks passed to the merge+-- function will have the same number of elements, although that number+-- may vary between calls.+mergeByChunks ::+  Monad m+  => ([el1] -> [el2] -> c3)  -- ^ merge function+  -> ([el1] -> c3)+  -> ([el2] -> c3)+  -> Enumeratee [el2] c3 (Iteratee [el1] m) a+mergeByChunks f f1 f2 = unfoldConvStream iter (0 :: Int)+ where+  iter 1 = (\x -> (1,f1 x)) `liftM` lift getChunk+  iter 2 = (\x -> (2,f2 x)) `liftM` getChunk+  iter _ = do+    ml1 <- lift chunkLength+    ml2 <- chunkLength+    case (ml1, ml2) of+      (Just l1, Just l2) -> do+        let tval = min l1 l2+        c1 <- lift $ takeFromChunk tval+        c2 <- takeFromChunk tval+        return (0, f c1 c2)+      (Just _, Nothing) -> iter 1+      (Nothing, _)      -> iter 2+{-# INLINE mergeByChunks #-}++-- ------------------------------------------------------------------------+-- Folds++-- | Left-associative fold that is strict in the accumulator.+-- This function should be used in preference to 'foldl' whenever possible.+--+-- The analogue of @List.foldl'@.+foldStream :: (a -> el -> a) -> a -> Iteratee [el] m a+foldStream f i = liftI (step i)+  where+    step acc (Chunk xs)+      | null xs = liftI (step acc)+      | otherwise  = liftI (step $! foldl' f acc xs)+    step acc stream = idone acc stream+{-# INLINE foldStream #-}++-- ------------------------------------------------------------------------+-- Zips++-- |Enumerate two iteratees over a single stream simultaneously.+--+-- Compare to @List.zip@.+zipStreams+  :: Monad m+  => Iteratee [el] m a+  -> Iteratee [el] m b+  -> Iteratee [el] m (a, b)+zipStreams x0 y0 = do+    -- need to check if both iteratees are initially finished.  If so,+    -- we don't want to push a chunk which will be dropped+    (a', x') <- lift $ runIter x0 od oc+    (b', y') <- lift $ runIter y0 od oc+    case checkDone a' b' of+      Just (Right (a,b,s))  -> idone (a,b) s  -- 's' may be EOF, needs to stay+      Just (Left (Left a))  -> liftM (a,) y'+      Just (Left (Right b)) -> liftM (,b) x'+      Nothing               -> liftI (step x' y')+  where+    step x y (Chunk xs) | nullC xs = liftI (step x y)+    step x y (Chunk xs) = do+      (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x+      (b', y') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs y+      case checkDone a' b' of+        Just (Right (a,b,s))  -> idone (a,b) s+        Just (Left (Left a))  -> liftM (a,) y'+        Just (Left (Right b)) -> liftM (,b) x'+        Nothing               -> liftI (step x' y')+    step x y (EOF err) = joinIM $ case err of+      Nothing -> (liftM2.liftM2) (,) (enumEof   x) (enumEof   y)+      Just e  -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)++    od a s = return (Just (a, s), idone a s)+    oc k e = return (Nothing    , icont k e)++    checkDone r1 r2 = case (r1, r2) of+      (Just (a, s1), Just (b,s2)) -> Just $ Right (a, b, shorter s1 s2)+      (Just (a, _), Nothing)      -> Just . Left $ Left a+      (Nothing, Just (b, _))      -> Just . Left $ Right b+      (Nothing, Nothing)          -> Nothing++    shorter c1@(Chunk xs) c2@(Chunk ys)+      | length xs < length ys = c1+      | otherwise                   = c2+    shorter e@(EOF _)  _         = e+    shorter _          e@(EOF _) = e+{-# INLINE zipStreams #-}++zipStreams3+  :: Monad m+  => Iteratee [el] m a -> Iteratee [el] m b+  -> Iteratee [el] m c -> Iteratee [el] m (a, b, c)+zipStreams3 a b c = zipStreams a (zipStreams b c) >>=+  \(r1, (r2, r3)) -> return (r1, r2, r3)+{-# INLINE zipStreams3 #-}++zipStreams4+  :: Monad m+  => Iteratee [el] m a -> Iteratee [el] m b+  -> Iteratee [el] m c -> Iteratee [el] m d+  -> Iteratee [el] m (a, b, c, d)+zipStreams4 a b c d = zipStreams a (zipStreams3 b c d) >>=+  \(r1, (r2, r3, r4)) -> return (r1, r2, r3, r4)+{-# INLINE zipStreams4 #-}++zipStreams5+  :: Monad m+  => Iteratee [el] m a -> Iteratee [el] m b+  -> Iteratee [el] m c -> Iteratee [el] m d+  -> Iteratee [el] m e -> Iteratee [el] m (a, b, c, d, e)+zipStreams5 a b c d e = zipStreams a (zipStreams4 b c d e) >>=+  \(r1, (r2, r3, r4, r5)) -> return (r1, r2, r3, r4, r5)+{-# INLINE zipStreams5 #-}++-- | Enumerate over two iteratees in parallel as long as the first iteratee+-- is still consuming input.  The second iteratee will be terminated with EOF+-- when the first iteratee has completed.  An example use is to determine+-- how many elements an iteratee has consumed:+--+-- > snd <$> enumWith (dropWhile (<5)) length+--+-- Compare to @zipStreams@+enumWith+  :: Monad m+  => Iteratee [el] m a+  -> Iteratee [el] m b+  -> Iteratee [el] m (a, b)+enumWith i1 i2 = do+    -- as with zipStreams, first check to see if the initial iteratee is complete,+    -- otherwise data would be dropped.+    -- running the second iteratee as well to prevent a monadic effect mismatch+    -- although I think that would be highly unlikely to happen in common+    -- code+    (a', x') <- lift $ runIter i1 od oc+    (_,  y') <- lift $ runIter i2 od oc+    case a' of+      Just (a, s) -> flip idone s =<< lift (liftM (a,) $ run i2)+      Nothing     -> go x' y'+  where+    od a s = return (Just (a, s), idone a s)+    oc k e = return (Nothing    , icont k e)++    getUsed xs (Chunk ys) = take (length xs - length ys) xs+    getUsed xs (EOF _)    = xs++    go x y = liftI step+      where+        step (Chunk xs) | nullC xs = liftI step+        step (Chunk xs) = do+          (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x+          case a' of+            Just (a, s) -> do+              b <- lift $ run =<< enumPure1Chunk (getUsed xs s) y+              idone (a, b) s+            Nothing        -> lift (enumPure1Chunk xs y) >>= go x'+        step (EOF err) = joinIM $ case err of+          Nothing -> (liftM2.liftM2) (,) (enumEof   x) (enumEof   y)+          Just e  -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)+{-# INLINE enumWith #-}++-- |Enumerate a list of iteratees over a single stream simultaneously+-- and discard the results. This is a different behavior than Prelude's+-- sequence_ which runs iteratees in the list one after the other.+--+-- Compare to @Prelude.sequence_@.+sequenceStreams_+  :: Monad m+  => [Iteratee [el] m a]+  -> Iteratee [el] m ()+sequenceStreams_ = self+  where+    self is = liftI step+      where+        step (Chunk xs) | null xs = liftI step+        step s@(Chunk _) = do+          -- give a chunk to each iteratee+          is'  <- lift $ mapM (enumChunk s) is+          -- filter done iteratees+          (done, notDone) <- lift $ partition fst `liftM` mapM enumCheckIfDone is'+          if null notDone+            then idone () <=< remainingStream $ map snd done+            else self $ map snd notDone+        step s@(EOF _) = do+          s' <- remainingStream <=< lift $ mapM (enumChunk s) is+          case s' of+            EOF (Just e) -> throwErr e+            _            -> idone () s'++    -- returns the unconsumed part of the stream; "sequenceStreams_ is" consumes as+    -- much of the stream as the iteratee in is that consumes the most; e.g.+    -- sequenceStreams_ [I.head, I.last] consumes whole stream+    remainingStream :: Monad m => [Iteratee [el] m a] -> Iteratee [el] m (Stream [el])+    remainingStream is = lift $+      return . foldl1 shorter <=< mapM (\i -> runIter i od oc) $ is+      where+        od _ s = return s+        oc _ e = return $ case e of+          Nothing -> mempty+          _       -> EOF e++    -- return the shorter one of two streams; errors are propagated with the+    -- priority given to the "left"+    shorter c1@(Chunk xs) c2@(Chunk ys)+      | length xs < length ys = c1+      | otherwise                   = c2+    shorter (EOF e1 ) (EOF e2 ) = EOF (e1 `mplus` e2)+    shorter e@(EOF _) _         = e+    shorter _         e@(EOF _) = e++-- |Transform an iteratee into one that keeps track of how much data it+-- consumes.+countConsumed :: (Monad m, Integral n) => Iteratee [el] m a -> Iteratee [el] m (a, n)+countConsumed i = go 0 (const i) (Chunk emptyP)+  where+    go !n f str@(EOF _) = (, n) `liftM` f str+    go !n f str@(Chunk c) = Iteratee rI+      where+        newLen = n + fromIntegral (length c)+        rI od oc = runIter (f str) onDone onCont+          where+            onDone a str'@(Chunk c') =+                od (a, newLen - fromIntegral (length c')) str'+            onDone a str'@(EOF _) = od (a, n) str'+            onCont f' mExc = oc (go newLen f') mExc+{-# INLINE countConsumed #-}++-- ------------------------------------------------------------------------+-- Enumerators++-- |The pure n-chunk enumerator+-- It passes a given stream of elements to the iteratee in @n@-sized chunks.+enumPureNChunk :: Monad m => [el] -> Int -> Enumerator [el] m a+enumPureNChunk str n iter+  | null str = return iter+  | n > 0       = enum' str iter+  | otherwise   = error $ "enumPureNChunk called with n==" ++ show n+  where+    enum' str' iter'+      | null str' = return iter'+      | otherwise    = let (s1, s2) = splitAt n str'+                           on_cont k Nothing = enum' s2 . k $ Chunk s1+                           on_cont k e = return $ icont k e+                       in runIter iter' idoneM on_cont+{-# INLINE enumPureNChunk #-}++-- ------------------------------------------------------------------------+-- Monadic functions++-- | Maps a monadic function over the elements of the stream and ignores+-- the result.+mapStreamM_ :: Monad m => (el -> m b) -> Iteratee [el] m ()+mapStreamM_ = mapChunksM_ . mapM_+{-# INLINE mapStreamM_ #-}++-- | Maps a monadic function over an 'Iteratee'.+mapStreamM :: Monad m => (el -> m el') -> Enumeratee [el] [el'] m a+mapStreamM = mapChunksM . mapM+{-# INLINE mapStreamM #-}++-- | Folds a monadic function over an 'Iteratee'.+foldStreamM :: Monad m => (b -> a -> m b) -> b -> Iteratee [a] m b+foldStreamM k = foldChunksM go+  where+    go b [   ] = return b+    go b (h:t) = k b h >>= \b' -> go b' t+{-# INLINE foldStreamM #-}

@@ -1,883 +0,0 @@-{-# LANGUAGE TupleSections, ScopedTypeVariables #-}---- |Monadic Iteratees:--- incremental input parsers, processors and transformers------ This module provides many basic iteratees from which more complicated--- iteratees can be built.  In general these iteratees parallel those in--- @Data.List@, with some additions.--module Bio.Iteratee.ListLike (-  -- * Iteratees-  -- ** Iteratee Utilities-  isFinished-  ,stream2list-  ,stream2stream-  -- ** Basic Iteratees-  ,dropWhileStream-  ,dropStream-  ,headStream-  ,tryHead-  ,lastStream-  ,heads-  ,peekStream-  ,roll-  ,lengthStream-  ,chunkLength-  ,takeFromChunk-  -- ** Nested iteratee combinators-  ,breakStream-  ,breakE-  ,takeStream-  ,takeUpTo-  ,takeWhileE-  ,mapStream-  ,concatMapStream-  ,concatMapStreamM-  ,mapMaybeStream-  ,rigidMapStream-  ,filterStream-  ,filterStreamM-  ,groupStreamBy-  ,groupStreamOn-  ,mergeStreams-  ,mergeByChunks-  -- ** Folds-  ,foldStream-  -- * Enumerators-  -- ** Basic enumerators-  ,enumPureNChunk-  -- ** Enumerator Combinators-  ,enumWith-  ,zipStreams-  ,zipStreams3-  ,zipStreams4-  ,zipStreams5-  ,sequenceStreams_-  ,countConsumed-  -- ** Monadic functions-  ,mapStreamM-  ,mapStreamM_-  ,foldStreamM-  -- * Re-exported modules-  ,module Bio.Iteratee.Iteratee-)-where--import Bio.Iteratee.Iteratee-import Bio.Prelude-import Control.Monad.Trans.Class--import qualified Data.ByteString          as B-import qualified Data.ListLike            as LL-import qualified Data.ListLike.FoldableLL as FLL----- Useful combinators for implementing iteratees and enumerators---- | Check if a stream has received 'EOF'.-isFinished :: (Nullable s) => Iteratee s m Bool-isFinished = liftI check-  where-  check c@(Chunk xs)-    | nullC xs    = liftI check-    | otherwise   = idone False c-  check s@(EOF _) = idone True s-{-# INLINE isFinished #-}---- --------------------------------------------------------------------------- Primitive iteratees---- |Read a stream to the end and return all of its elements as a list.--- This iteratee returns all data from the stream *strictly*.-stream2list :: (Monad m, Nullable s, LL.ListLike s el) => Iteratee s m [el]-stream2list = liftM (concatMap LL.toList) getChunks-{-# INLINE stream2list #-}---- |Read a stream to the end and return all of its elements as a stream.--- This iteratee returns all data from the stream *strictly*.-stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s-stream2stream = liftM mconcat getChunks-{-# INLINE stream2stream #-}----- --------------------------------------------------------------------------- Parser combinators---- |Attempt to read the next element of the stream and return it--- Raise a (recoverable) error if the stream is terminated.------ The analogue of @List.head@------ Because @head@ can raise an error, it shouldn't be used when constructing--- iteratees for @convStream@.  Use @tryHead@ instead.-headStream :: (LL.ListLike s el) => Iteratee s m el-headStream = liftI step-  where-  step (Chunk vec)-    | LL.null vec  = icont step Nothing-    | otherwise    = idone (LL.head vec) (Chunk $ LL.tail vec)-  step stream      = icont step (Just (setEOF stream))-{-# INLINE headStream #-}---- | Similar to @headStream@, except it returns @Nothing@ if the stream--- is terminated.-tryHead :: (LL.ListLike s el) => Iteratee s m (Maybe el)-tryHead = liftI step-  where-  step (Chunk vec)-    | LL.null vec  = liftI step-    | otherwise    = idone (Just $ LL.head vec) (Chunk $ LL.tail vec)-  step stream      = idone Nothing stream-{-# INLINE tryHead #-}---- |Attempt to read the last element of the stream and return it--- Raise a (recoverable) error if the stream is terminated------ The analogue of @List.last@-lastStream :: (LL.ListLike s el, Nullable s) => Iteratee s m el-lastStream = liftI (step Nothing)-  where-  step l (Chunk xs)-    | nullC xs     = liftI (step l)-    | otherwise    = liftI $ step (Just $ LL.last xs)-  step l s@(EOF _) = case l of-    Nothing -> icont (step l) . Just . setEOF $ s-    Just x  -> idone x s-{-# INLINE lastStream #-}----- |Given a sequence of characters, attempt to match them against--- the characters on the stream.  Return the count of how many--- characters matched.  The matched characters are removed from the--- stream.--- For example, if the stream contains 'abd', then (heads 'abc')--- will remove the characters 'ab' and return 2.-heads :: (Monad m, Nullable s, LL.ListLike s el, Eq el) => s -> Iteratee s m Int-heads st | nullC st = return 0-heads st = loopE 0 st-  where-  loopE cnt xs-    | nullC xs  = return cnt-    | otherwise = liftI (step cnt xs)-  step cnt str (Chunk xs) | nullC xs  = liftI (step cnt str)-  step cnt str stream     | nullC str = idone cnt stream-  step cnt str s@(Chunk xs) =-    if LL.head str == LL.head xs-       then step (succ cnt) (LL.tail str) (Chunk $ LL.tail xs)-       else idone cnt s-  step cnt _ stream         = idone cnt stream-{-# INLINE heads #-}----- |Look ahead at the next element of the stream, without removing--- it from the stream.--- Return @Just c@ if successful, return @Nothing@ if the stream is--- terminated by 'EOF'.-peekStream :: (LL.ListLike s el) => Iteratee s m (Maybe el)-peekStream = liftI step-  where-    step s@(Chunk vec)-      | LL.null vec = liftI step-      | otherwise   = idone (Just $ LL.head vec) s-    step stream     = idone Nothing stream-{-# INLINE peekStream #-}---- | Return a chunk of @t@ elements length while consuming @d@ elements---   from the stream.  Useful for creating a 'rolling average' with---  'convStream'.-roll-  :: (Monad m, Nullable s, LL.ListLike s el, LL.ListLike s' s)-  => Int  -- ^ length of chunk (t)-  -> Int  -- ^ amount to consume (d)-  -> Iteratee s m s'-roll t d | t > d  = liftI step-  where-    step (Chunk vec)-      | LL.length vec >= t =-          idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec)-      | LL.null vec        = liftI step-      | otherwise          = liftI (step' vec)-    step stream            = idone LL.empty stream-    step' v1 (Chunk vec)   = step . Chunk $ v1 `mappend` vec-    step' v1 stream        = idone (LL.singleton v1) stream-roll t d = do r <- joinI (takeStream t stream2stream)-              dropStream (d-t)-              return $ LL.singleton r-  -- d is >= t, so this version works-{-# INLINE roll #-}----- |Drop n elements of the stream, if there are that many.------ The analogue of @List.drop@-dropStream :: (Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()-dropStream 0  = idone () (Chunk emptyP)-dropStream n' = liftI (step n')-  where-    step n (Chunk str)-      | LL.length str < n = liftI (step (n - LL.length str))-      | otherwise         = idone () (Chunk (LL.drop n str))-    step _ stream         = idone () stream-{-# INLINE dropStream #-}---- |Skip all elements while the predicate is true.------ The analogue of @List.dropWhile@-dropWhileStream :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m ()-dropWhileStream p = liftI step-  where-    step (Chunk str)-      | LL.null rest = liftI step-      | otherwise    = idone () (Chunk rest)-      where-        rest = LL.dropWhile p str-    step stream      = idone () stream-{-# INLINE dropWhileStream #-}----- | Return the total length of the remaining part of the stream.------ This forces evaluation of the entire stream.------ The analogue of @List.length@-lengthStream :: (Num a, LL.ListLike s el) => Iteratee s m a-lengthStream = liftI (step 0)-  where-    step !i (Chunk xs) = liftI (step $ i + fromIntegral (LL.length xs))-    step !i stream     = idone i stream-{-# INLINE lengthStream #-}---- | Get the length of the current chunk, or @Nothing@ if 'EOF'.------ This function consumes no input.-chunkLength :: (LL.ListLike s el) => Iteratee s m (Maybe Int)-chunkLength = liftI step- where-  step s@(Chunk xs) = idone (Just $ LL.length xs) s-  step stream       = idone Nothing stream-{-# INLINE chunkLength #-}---- | Take @n@ elements from the current chunk, or the whole chunk if--- @n@ is greater.-takeFromChunk ::-  (Nullable s, LL.ListLike s el)-  => Int-  -> Iteratee s m s-takeFromChunk n | n <= 0 = idone emptyP (Chunk emptyP)-takeFromChunk n = liftI step- where-  step (Chunk xs) = let (h,t) = LL.splitAt n xs in idone h $ Chunk t-  step stream     = idone emptyP stream-{-# INLINE takeFromChunk #-}---- |Takes an element predicate and returns the (possibly empty) prefix of--- the stream.  None of the characters in the string satisfy the character--- predicate.--- If the stream is not terminated, the first character of the remaining stream--- satisfies the predicate.------ N.B. 'breakE' should be used in preference to @breakStream@.--- @breakStream@ will retain all data until the predicate is met, which may--- result in a space leak.------ The analogue of @List.break@--breakStream :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m s-breakStream cpred = icont (step mempty) Nothing-  where-    step bfr (Chunk str)-      | LL.null str       =  icont (step bfr) Nothing-      | otherwise         =  case LL.break cpred str of-        (str', tail')-          | LL.null tail' -> icont (step (bfr `mappend` str)) Nothing-          | otherwise     -> idone (bfr `mappend` str') (Chunk tail')-    step bfr stream       =  idone bfr stream-{-# INLINE breakStream #-}---- ------------------------------------------------------ The converters show a different way of composing two iteratees:--- `vertical' rather than `horizontal'---- |Takes an element predicate and an iteratee, running the iteratee--- on all elements of the stream until the predicate is met.------ the following rule relates @break@ to @breakE@--- @break@ pred === @joinI@ (@breakE@ pred stream2stream)------ @breakE@ should be used in preference to @break@ whenever possible.-breakE-  :: (LL.ListLike s el, NullPoint s)-  => (el -> Bool)-  -> Enumeratee s s m a-breakE cpred = eneeCheckIfDonePass (icont . step)- where-  step k (Chunk s)-      | LL.null s  = liftI (step k)-      | otherwise  = case LL.break cpred s of-        (str', tail')-          | LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'-          | otherwise     -> idone (k $ Chunk str') (Chunk tail')-  step k stream           =  idone (liftI k) stream-{-# INLINE breakE #-}---- |Read n elements from a stream and apply the given iteratee to the--- stream of the read elements. Unless the stream is terminated early, we--- read exactly n elements, even if the iteratee has accepted fewer.------ The analogue of @List.take@-takeStream ::-  (Monad m, Nullable s, LL.ListLike s el)-  => Int   -- ^ number of elements to consume-  -> Enumeratee s s m a-takeStream n' iter- | n' <= 0   = return iter- | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)-  where-    on_done od oc x _ = runIter (dropStream n' >> return (return x)) od oc-    on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)-                                 else runIter (liftI (step n' k)) od oc-    on_cont od oc _ (Just e) = runIter (dropStream n' >> throwErr e) od oc-    step n k (Chunk str)-      | LL.null str        = liftI (step n k)-      | LL.length str <= n = takeStream (n - LL.length str) $ k (Chunk str)-      | otherwise          = idone (k (Chunk s1)) (Chunk s2)-      where (s1, s2) = LL.splitAt n str-    step _n k stream       = idone (liftI k) stream-{-# INLINE takeStream #-}---- |Read n elements from a stream and apply the given iteratee to the--- stream of the read elements. If the given iteratee accepted fewer--- elements, we stop.--- This is the variation of 'takeStream' with the early termination--- of processing of the outer stream once the processing of the inner stream--- finished early.------ Iteratees composed with 'takeUpTo' will consume only enough elements to--- reach a done state.  Any remaining data will be available in the outer--- stream.------ > > let iter = do--- > h <- joinI $ takeUpTo 5 I.head--- > t <- stream2list--- > return (h,t)--- >--- > > enumPureNChunk [1..10::Int] 3 iter >>= run >>= print--- > (1,[2,3,4,5,6,7,8,9,10])--- >--- > > enumPureNChunk [1..10::Int] 7 iter >>= run >>= print--- > (1,[2,3,4,5,6,7,8,9,10])------ in each case, @I.head@ consumes only one element, returning the remaining--- 4 elements to the outer stream-takeUpTo :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a-takeUpTo i iter- | i <= 0    = idone iter (Chunk emptyP)- | otherwise = Iteratee $ \od oc ->-    runIter iter (onDone od oc) (onCont od oc)-  where-    onDone od oc x str      = runIter (idone (return x) str) od oc-    onCont od oc k Nothing  = if i == 0 then od (liftI k) (Chunk mempty)-                                 else runIter (liftI (step i k)) od oc-    onCont od oc _ (Just e) = runIter (throwErr e) od oc-    step n k (Chunk str)-      | LL.null str       = liftI (step n k)-      | LL.length str < n = takeUpTo (n - LL.length str) $ k (Chunk str)-      | otherwise         =-         -- check to see if the inner iteratee has completed, and if so,-         -- grab any remaining stream to put it in the outer iteratee.-         -- the outer iteratee is always complete at this stage, although-         -- the inner may not be.-         let (s1, s2) = LL.splitAt n str-         in Iteratee $ \od' _ -> do-              res <- runIter (k (Chunk s1)) (\a s  -> return $ Left  (a, s))-                                            (\k' e -> return $ Right (k',e))-              case res of-                Left (a,Chunk s1') -> od' (return a)-                                          (Chunk $ s1' `LL.append` s2)-                Left  (a,s')       -> od' (idone a s') (Chunk s2)-                Right (k',e)       -> od' (icont k' e) (Chunk s2)-    step _ k stream       = idone (liftI k) stream-{-# INLINE takeUpTo #-}----- |Takes an element predicate and an iteratee, running the iteratee--- on all elements of the stream while the predicate is met.------ This is preferred to @takeWhile@.-takeWhileE- :: (LL.ListLike s el, NullPoint s)- => (el -> Bool)- -> Enumeratee s s m a-takeWhileE = breakE . (not .)-{-# INLINEABLE takeWhileE #-}---- | Map a function over an 'Iteratee'.--- This one is reimplemented and differs from the the one in--- "Data.Iteratee.ListLike" in so far that it doesn't pass on an 'EOF'--- received in the input, which is the expected behavior.-{-# INLINE mapStream #-}-mapStream :: (LL.ListLike (s el) el, LL.ListLike (s el') el', NullPoint (s el))-          => (el -> el') -> Enumeratee (s el) (s el') m a-mapStream = mapChunks . LL.map---- |Map the stream rigidly.------ Like 'mapStream', but the element type cannot change.--- This function is necessary for @ByteString@ and similar types--- that cannot have 'LooseMap' instances, and may be more efficient.-rigidMapStream-  :: (LL.ListLike s el, NullPoint s)-  => (el -> el)-  -> Enumeratee s s m a-rigidMapStream f = mapChunks (LL.rigidMap f)-{-# SPECIALIZE rigidMapStream :: (el -> el) -> Enumeratee [el] [el] m a #-}-{-# SPECIALIZE rigidMapStream :: (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}----- | Apply a function to the elements of a stream, concatenate the--- results into a stream.  No giant intermediate list is produced.-{-# INLINE concatMapStream #-}-concatMapStream :: (Monad m, LL.ListLike s a, NullPoint s) => (a -> t) -> Enumeratee s t m r-concatMapStream f = eneeCheckIfDone (liftI . go)-  where-    go k (EOF   mx)              = idone (liftI k) (EOF mx)-    go k (Chunk xs) | LL.null xs = liftI (go k)-                    | otherwise  = eneeCheckIfDone (flip go (Chunk (LL.tail xs))) . k . Chunk . f $ LL.head xs---- | Apply a monadic function to the elements of a stream, concatenate--- the results into a stream.  No giant intermediate list is produced.-{-# INLINE concatMapStreamM #-}-concatMapStreamM :: (Monad m, LL.ListLike s a, NullPoint s) => (a -> m t) -> Enumeratee s t m r-concatMapStreamM f = eneeCheckIfDone (liftI . go)-  where-    go k (EOF   mx)              = idone (liftI k) (EOF mx)-    go k (Chunk xs) | LL.null xs = liftI (go k)-                    | otherwise  = f (LL.head xs) `mBind`-                                   eneeCheckIfDone (flip go (Chunk (LL.tail xs))) . k . Chunk--{-# INLINE mapMaybeStream #-}-mapMaybeStream :: (LL.ListLike s a, NullPoint s, LL.ListLike t b) => (a -> Maybe b) -> Enumeratee s t m r-mapMaybeStream f = mapChunks mm-  where-    mm l = if LL.null l then LL.empty else-           case f (LL.head l) of Nothing -> mm (LL.tail l)-                                 Just b  -> LL.cons b $ mm (LL.tail l)----- |Creates an 'enumeratee' with only elements from the stream that--- satisfy the predicate function.  The outer stream is completely consumed.------ The analogue of @List.filter@--- XXX filterStream :: (ListLike s a, NullPoint s) => (a -> Bool) -> Enumeratee s s m r-filterStream-  :: (NullPoint s, LL.ListLike s el)-  => (el -> Bool)-  -> Enumeratee s s m a-filterStream p = mapChunks (LL.filter p)-{-# INLINE filterStream #-}---- | Apply a monadic filter predicate to an 'Iteratee'.-{-# INLINE filterStreamM #-}-filterStreamM :: (Monad m, LL.ListLike s a, Nullable s) => (a -> m Bool) -> Enumeratee s s m r-filterStreamM k = mapChunksM (go id)-  where-    go acc s | LL.null s = return $! acc LL.empty-             | otherwise = do p <- k (LL.head s)-                              let acc' = if p then LL.cons (LL.head s) . acc else acc-                              go acc' (LL.tail s)---- | Grouping on 'Iteratee's.  @groupStreamOn proj inner outer@ executes--- @inner (proj e)@, where @e@ is the first input element, to obtain an--- 'Iteratee' @i@, then passes elements @e@ to @i@ as long as @proj e@--- produces the same result.  If @proj e@ changes or the input ends, the--- pair of @proj e@ and the result of @run i@ is passed to @outer@.  At--- end of input, the resulting @outer@ is returned.-groupStreamOn :: (Monad m, LL.ListLike l e, Eq t1, Nullable l)-              => (e -> t1)-              -> (t1 -> m (Iteratee l m t2))-              -> Enumeratee l [(t1, t2)] m a-groupStreamOn proj inner = eneeCheckIfDonePass (icont . step)-  where-    step outer   (EOF   mx) = idone (liftI outer) $ EOF mx-    step outer c@(Chunk as)-        | LL.null as = liftI $ step outer-        | otherwise  = let x = proj (LL.head as)-                       in lift (inner x) >>= \i -> step' x i outer c--    -- We want to feed a 'Chunk' to the inner 'Iteratee', which might be-    -- finished.  In that case, we would want to abort, but we cannot,-    -- since the outer iteration is still going on.  So instead we-    -- discard data we would have fed to the inner 'Iteratee'.  (Use of-    -- 'enumPure1Chunk' is not appropriate, it would accumulate the-    -- data, just to have it discarded by the 'run' that eventually-    -- happens.--    step' c it outer (Chunk as)-        | LL.null as = liftI $ step' c it outer-        | (l,r) <- LL.span ((==) c . proj) as, not (LL.null l) =-            let od a    _str = idoneM a $ EOF Nothing-                oc k Nothing = return $ k (Chunk l)-                oc k       m = icontM k m-            in lift (runIter it od oc) >>= \it' -> step' c it' outer (Chunk r)--    step' c it outer str =-        lift (run it) >>= \b -> eneeCheckIfDone (`step` str) . outer $ Chunk [(c,b)]----- | Grouping on 'Iteratee's.  @groupStreamBy cmp inner outer@ executes--- @inner@ to obtain an 'Iteratee' @i@, then passes elements @e@ to @i@--- as long as @cmp e0 e@, where @e0@ is some preceeding element, is--- true.  Else, the result of @run i@ is passed to @outer@ and--- 'groupStreamBy' restarts.  At end of input, the resulting @outer@ is--- returned.-groupStreamBy :: (Monad m, LL.ListLike l t, Nullable l)-              => (t -> t -> Bool)-              -> m (Iteratee l m t2)-              -> Enumeratee l [t2] m a-groupStreamBy cmp inner = eneeCheckIfDonePass (icont . step)-  where-    step outer    (EOF   mx) = idone (liftI outer) $ EOF mx-    step outer  c@(Chunk as)-        | LL.null as = liftI $ step outer-        | otherwise  = lift inner >>= \i -> step' (LL.head as) i outer c--    step' c it outer (Chunk as)-        | LL.null as = liftI $ step' c it outer-        | (l,r) <- LL.span (cmp c) as, not (LL.null l) =-            let od a    _str = idoneM a $ EOF Nothing-                oc k Nothing = return $ k (Chunk l)-                oc k       m = icontM k m-            in lift (runIter it od oc) >>= \it' -> step' (LL.head l) it' outer (Chunk r)--    step' _ it outer str =-        lift (run it) >>= \b -> eneeCheckIfDone (`step` str) . outer $ Chunk [b]----- | @mergeStreams@ offers another way to nest iteratees: as a monad stack.--- This allows for the possibility of interleaving data from multiple--- streams.------ > -- print each element from a stream of lines.--- > logger :: (MonadIO m) => Iteratee [ByteString] m ()--- > logger = mapStreamM_ (liftIO . putStrLn . B.unpack)--- >--- > -- combine alternating lines from two sources--- > -- To see how this was derived, follow the types from--- > -- 'ileaveLines logger' and work outwards.--- > run =<< enumFile 10 "file1" (joinI $ enumLinesBS $--- >           ( enumFile 10 "file2" . joinI . enumLinesBS $ joinI--- >                 (ileaveLines logger)) >>= run)--- >--- > ileaveLines :: (Functor m, Monad m)--- >   => Enumeratee [ByteString] [ByteString] (Iteratee [ByteString] m)--- >        [ByteString]--- > ileaveLines = mergeStreams (\l1 l2 ->--- >    [B.pack "f1:\n\t" ,l1 ,B.pack "f2:\n\t" ,l2 ]--- >--- >----mergeStreams ::-  (LL.ListLike s1 el1-   ,LL.ListLike s2 el2-   ,Nullable s1-   ,Nullable s2-   ,Monad m)-  => (el1 -> el2 -> b)-  -> Enumeratee s2 b (Iteratee s1 m) a-mergeStreams f = convStream $ liftM2 f (lift headStream) headStream-{-# INLINE mergeStreams #-}---- | A version of mergeStreams which operates on chunks instead of--- elements.------ mergeByChunks offers more control than 'mergeStreams'.--- 'mergeStreams' terminates when the first stream terminates, however--- mergeByChunks will continue until both streams are exhausted.------ 'mergeByChunks' guarantees that both chunks passed to the merge--- function will have the same number of elements, although that number--- may vary between calls.-mergeByChunks ::-  (Nullable c2, Nullable c1-  ,LL.ListLike c1 el1, LL.ListLike c2 el2-  , Monad m)-  => (c1 -> c2 -> c3)  -- ^ merge function-  -> (c1 -> c3)-  -> (c2 -> c3)-  -> Enumeratee c2 c3 (Iteratee c1 m) a-mergeByChunks f f1 f2 = unfoldConvStream iter (0 :: Int)- where-  iter 1 = (\x -> (1,f1 x)) `liftM` lift getChunk-  iter 2 = (\x -> (2,f2 x)) `liftM` getChunk-  iter _ = do-    ml1 <- lift chunkLength-    ml2 <- chunkLength-    case (ml1, ml2) of-      (Just l1, Just l2) -> do-        let tval = min l1 l2-        c1 <- lift $ takeFromChunk tval-        c2 <- takeFromChunk tval-        return (0, f c1 c2)-      (Just _, Nothing) -> iter 1-      (Nothing, _)      -> iter 2-{-# INLINE mergeByChunks #-}---- --------------------------------------------------------------------------- Folds---- | Left-associative fold that is strict in the accumulator.--- This function should be used in preference to 'foldl' whenever possible.------ The analogue of @List.foldl'@.-foldStream-  :: LL.ListLike s el-  => (a -> el -> a)-  -> a-  -> Iteratee s m a-foldStream f i = liftI (step i)-  where-    step acc (Chunk xs)-      | LL.null xs = liftI (step acc)-      | otherwise  = liftI (step $! FLL.foldl' f acc xs)-    step acc stream = idone acc stream-{-# INLINE foldStream #-}---- --------------------------------------------------------------------------- Zips---- |Enumerate two iteratees over a single stream simultaneously.------ Compare to @List.zip@.-zipStreams-  :: (Monad m, Nullable s, LL.ListLike s el)-  => Iteratee s m a-  -> Iteratee s m b-  -> Iteratee s m (a, b)-zipStreams x0 y0 = do-    -- need to check if both iteratees are initially finished.  If so,-    -- we don't want to push a chunk which will be dropped-    (a', x') <- lift $ runIter x0 od oc-    (b', y') <- lift $ runIter y0 od oc-    case checkDone a' b' of-      Just (Right (a,b,s))  -> idone (a,b) s  -- 's' may be EOF, needs to stay-      Just (Left (Left a))  -> liftM (a,) y'-      Just (Left (Right b)) -> liftM (,b) x'-      Nothing               -> liftI (step x' y')-  where-    step x y (Chunk xs) | nullC xs = liftI (step x y)-    step x y (Chunk xs) = do-      (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x-      (b', y') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs y-      case checkDone a' b' of-        Just (Right (a,b,s))  -> idone (a,b) s-        Just (Left (Left a))  -> liftM (a,) y'-        Just (Left (Right b)) -> liftM (,b) x'-        Nothing               -> liftI (step x' y')-    step x y (EOF err) = joinIM $ case err of-      Nothing -> (liftM2.liftM2) (,) (enumEof   x) (enumEof   y)-      Just e  -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)--    od a s = return (Just (a, s), idone a s)-    oc k e = return (Nothing    , icont k e)--    checkDone r1 r2 = case (r1, r2) of-      (Just (a, s1), Just (b,s2)) -> Just $ Right (a, b, shorter s1 s2)-      (Just (a, _), Nothing)      -> Just . Left $ Left a-      (Nothing, Just (b, _))      -> Just . Left $ Right b-      (Nothing, Nothing)          -> Nothing--    shorter c1@(Chunk xs) c2@(Chunk ys)-      | LL.length xs < LL.length ys = c1-      | otherwise                   = c2-    shorter e@(EOF _)  _         = e-    shorter _          e@(EOF _) = e-{-# INLINE zipStreams #-}--zipStreams3-  :: (Monad m, Nullable s, LL.ListLike s el)-  => Iteratee s m a -> Iteratee s m b-  -> Iteratee s m c -> Iteratee s m (a, b, c)-zipStreams3 a b c = zipStreams a (zipStreams b c) >>=-  \(r1, (r2, r3)) -> return (r1, r2, r3)-{-# INLINE zipStreams3 #-}--zipStreams4-  :: (Monad m, Nullable s, LL.ListLike s el)-  => Iteratee s m a -> Iteratee s m b-  -> Iteratee s m c -> Iteratee s m d-  -> Iteratee s m (a, b, c, d)-zipStreams4 a b c d = zipStreams a (zipStreams3 b c d) >>=-  \(r1, (r2, r3, r4)) -> return (r1, r2, r3, r4)-{-# INLINE zipStreams4 #-}--zipStreams5-  :: (Monad m, Nullable s, LL.ListLike s el)-  => Iteratee s m a -> Iteratee s m b-  -> Iteratee s m c -> Iteratee s m d-  -> Iteratee s m e -> Iteratee s m (a, b, c, d, e)-zipStreams5 a b c d e = zipStreams a (zipStreams4 b c d e) >>=-  \(r1, (r2, r3, r4, r5)) -> return (r1, r2, r3, r4, r5)-{-# INLINE zipStreams5 #-}---- | Enumerate over two iteratees in parallel as long as the first iteratee--- is still consuming input.  The second iteratee will be terminated with EOF--- when the first iteratee has completed.  An example use is to determine--- how many elements an iteratee has consumed:------ > snd <$> enumWith (dropWhile (<5)) length------ Compare to @zipStreams@-enumWith-  :: (Monad m, Nullable s, LL.ListLike s el)-  => Iteratee s m a-  -> Iteratee s m b-  -> Iteratee s m (a, b)-enumWith i1 i2 = do-    -- as with zipStreams, first check to see if the initial iteratee is complete,-    -- otherwise data would be dropped.-    -- running the second iteratee as well to prevent a monadic effect mismatch-    -- although I think that would be highly unlikely to happen in common-    -- code-    (a', x') <- lift $ runIter i1 od oc-    (_,  y') <- lift $ runIter i2 od oc-    case a' of-      Just (a, s) -> flip idone s =<< lift (liftM (a,) $ run i2)-      Nothing     -> go x' y'-  where-    od a s = return (Just (a, s), idone a s)-    oc k e = return (Nothing    , icont k e)--    getUsed xs (Chunk ys) = LL.take (LL.length xs - LL.length ys) xs-    getUsed xs (EOF _)    = xs--    go x y = liftI step-      where-        step (Chunk xs) | nullC xs = liftI step-        step (Chunk xs) = do-          (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x-          case a' of-            Just (a, s) -> do-              b <- lift $ run =<< enumPure1Chunk (getUsed xs s) y-              idone (a, b) s-            Nothing        -> lift (enumPure1Chunk xs y) >>= go x'-        step (EOF err) = joinIM $ case err of-          Nothing -> (liftM2.liftM2) (,) (enumEof   x) (enumEof   y)-          Just e  -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)-{-# INLINE enumWith #-}---- |Enumerate a list of iteratees over a single stream simultaneously--- and discard the results. This is a different behavior than Prelude's--- sequence_ which runs iteratees in the list one after the other.------ Compare to @Prelude.sequence_@.-sequenceStreams_-  :: (Monad m, LL.ListLike s el, Nullable s)-  => [Iteratee s m a]-  -> Iteratee s m ()-sequenceStreams_ = self-  where-    self is = liftI step-      where-        step (Chunk xs) | LL.null xs = liftI step-        step s@(Chunk _) = do-          -- give a chunk to each iteratee-          is'  <- lift $ mapM (enumChunk s) is-          -- filter done iteratees-          (done, notDone) <- lift $ partition fst `liftM` mapM enumCheckIfDone is'-          if null notDone-            then idone () <=< remainingStream $ map snd done-            else self $ map snd notDone-        step s@(EOF _) = do-          s' <- remainingStream <=< lift $ mapM (enumChunk s) is-          case s' of-            EOF (Just e) -> throwErr e-            _            -> idone () s'--    -- returns the unconsumed part of the stream; "sequenceStreams_ is" consumes as-    -- much of the stream as the iteratee in is that consumes the most; e.g.-    -- sequenceStreams_ [I.head, I.last] consumes whole stream-    remainingStream-      :: (Monad m, Nullable s, LL.ListLike s el)-      => [Iteratee s m a] -> Iteratee s m (Stream s)-    remainingStream is = lift $-      return . foldl1 shorter <=< mapM (\i -> runIter i od oc) $ is-      where-        od _ s = return s-        oc _ e = return $ case e of-          Nothing -> mempty-          _       -> EOF e--    -- return the shorter one of two streams; errors are propagated with the-    -- priority given to the "left"-    shorter c1@(Chunk xs) c2@(Chunk ys)-      | LL.length xs < LL.length ys = c1-      | otherwise                   = c2-    shorter (EOF e1 ) (EOF e2 ) = EOF (e1 `mplus` e2)-    shorter e@(EOF _) _         = e-    shorter _         e@(EOF _) = e---- |Transform an iteratee into one that keeps track of how much data it--- consumes.-countConsumed :: forall a s el m n.-                 (Monad m, LL.ListLike s el, Nullable s, Integral n) =>-                 Iteratee s m a-              -> Iteratee s m (a, n)-countConsumed i = go 0 (const i) (Chunk emptyP)-  where-    go :: n -> (Stream s -> Iteratee s m a) -> Stream s-       -> Iteratee s m (a, n)-    go !n f str@(EOF _) = (, n) `liftM` f str-    go !n f str@(Chunk c) = Iteratee rI-      where-        newLen = n + fromIntegral (LL.length c)-        rI od oc = runIter (f str) onDone onCont-          where-            onDone a str'@(Chunk c') =-                od (a, newLen - fromIntegral (LL.length c')) str'-            onDone a str'@(EOF _) = od (a, n) str'-            onCont f' mExc = oc (go newLen f') mExc-{-# INLINE countConsumed #-}---- --------------------------------------------------------------------------- Enumerators---- |The pure n-chunk enumerator--- It passes a given stream of elements to the iteratee in @n@-sized chunks.-enumPureNChunk :: (Monad m, LL.ListLike s el) => s -> Int -> Enumerator s m a-enumPureNChunk str n iter-  | LL.null str = return iter-  | n > 0       = enum' str iter-  | otherwise   = error $ "enumPureNChunk called with n==" ++ show n-  where-    enum' str' iter'-      | LL.null str' = return iter'-      | otherwise    = let (s1, s2) = LL.splitAt n str'-                           on_cont k Nothing = enum' s2 . k $ Chunk s1-                           on_cont k e = return $ icont k e-                       in runIter iter' idoneM on_cont-{-# INLINE enumPureNChunk #-}---- --------------------------------------------------------------------------- Monadic functions---- | Map a monadic function over the elements of the stream and ignore the--- result.-mapStreamM_ :: (Monad m, Nullable s, LL.ListLike s el) => (el -> m b) -> Iteratee s m ()-mapStreamM_ = mapChunksM_ . LL.mapM_-{-# INLINE mapStreamM_ #-}---- | Map a monadic function over an 'Iteratee'.-mapStreamM :: (Monad m, LL.ListLike (s el) el, LL.ListLike (s el') el', NullPoint (s el))-           => (el -> m el') -> Enumeratee (s el) (s el') m a-mapStreamM = mapChunksM . LL.mapM-{-# INLINE mapStreamM #-}----- | Fold a monadic function over an 'Iteratee'.-foldStreamM :: (Monad m, Nullable s, LL.ListLike s a) => (b -> a -> m b) -> b -> Iteratee s m b-foldStreamM k = foldChunksM go-  where-    go b s | LL.null s = return b-           | otherwise = k b (LL.head s) >>= \b' -> go b' (LL.tail s)-{-# INLINE foldStreamM #-}

@@ -1,49 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- | Monadic Iteratees:--- incremental input parsers, processors and transformers------ Support for IO enumerators--module Bio.Iteratee.ReadableChunk ( ReadableChunk(..) ) where--import Control.Monad.IO.Class-import Data.Word-import Foreign.C-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Prelude--import qualified Data.ByteString      as B-import qualified Data.ByteString.Lazy as L---- |Class of streams which can be filled from a 'Ptr'.  Typically these--- are streams which can be read from a file, @Handle@, or similar resource.-------class (Storable el) => ReadableChunk s el | s -> el where-  readFromPtr ::-    MonadIO m =>-      Ptr el-      -> Int -- ^ The pointer must not be used after @readFromPtr@ completes.-      -> m s -- ^ The Int parameter is the length of the data in *bytes*.--instance ReadableChunk [Char] Char where-  readFromPtr buf l = liftIO $ peekCAStringLen (castPtr buf, l)--instance ReadableChunk [Word8] Word8 where-  readFromPtr buf l = liftIO $ peekArray l buf-instance ReadableChunk [Word16] Word16 where-  readFromPtr buf l = liftIO $ peekArray l buf-instance ReadableChunk [Word32] Word32 where-  readFromPtr buf l = liftIO $ peekArray l buf-instance ReadableChunk [Word] Word where-  readFromPtr buf l = liftIO $ peekArray l buf--instance ReadableChunk B.ByteString Word8 where-  readFromPtr buf l = liftIO $ B.packCStringLen (castPtr buf, l)--instance ReadableChunk L.ByteString Word8 where-  readFromPtr buf l = liftIO $-    return . L.fromChunks . (:[]) =<< readFromPtr buf l

@@ -713,7 +713,7 @@  -- | Inflate if Gzip format is recognized, otherwise pass through. enumInflateAny :: MonadIO m => Enumeratee ByteString ByteString m a-enumInflateAny it = do magic <- iLookAhead $ liftM2 (,) tryHead tryHead+enumInflateAny it = do magic <- iLookAhead $ liftM2 (,) tryHeadBS tryHeadBS                        case magic of                            (Just 0x1f, Just 0x8b) ->                                enumInflate GZip defaultDecompressParams it

@@ -6,6 +6,13 @@     module System.Posix.Files,     module System.Posix.IO,     module System.Posix.Types,+#if !MIN_VERSION_base_prelude(1,1,0)+    module Foreign.Storable,+    module Foreign.Ptr,+    module Foreign.ForeignPtr,+    module Foreign.StablePtr,+#endif+     Bytes, LazyBytes,     HashMap,     HashSet,@@ -63,11 +70,17 @@ import Data.IntSet         ( IntSet ) import Data.Text.Encoding  ( encodeUtf8, decodeUtf8With ) import Foreign.C.Error     ( throwErrnoIf_ )-import Foreign.Ptr         ( castPtr ) import System.IO           ( hPrint, hPutStr, hPutStrLn, stderr, stdout, stdin ) import System.Posix.Files import System.Posix.IO import System.Posix.Types++#if !MIN_VERSION_base_prelude(1,1,0)+import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.StablePtr+#endif  import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Lazy   as BL

@@ -1,142 +0,0 @@-module Bio.PriorityQueue (-        Sizeable(..),-        PQ_Conf(..),--        PQ,-        withPQ,-        makePQ,-        deletePQ,-        enqueuePQ,-        dequeuePQ,-        getMinPQ,-        peekMinPQ,-        sizePQ-) where--import Data.Binary-import Data.IORef-import qualified Control.Exception as CE-import Prelude---- | A Priority Queue that can fall back to external storage.------ Note that such a Priority Queue automatically gives rise to an--- external sorting algorithm:  enqueue everything, dequeue until empty.------ Whatever is to be stored in this queue needs to be in Binary, because--- it may need to be moved to external storage on demand.  We also need--- a way to estimate the memory consumption of an enqueued object.  When--- constructing the queue, the maximum amount of RAM to consume is set.--- Note that open input streams use memory for buffering, too.------ Enqueued objects are kept in an in memory heap until the memory--- consumption becomes too high.  At that point, the whole heap is--- sorted and dumped to external storage.  If necessary, the file to do--- so is created and kept open.  The newly created stream is added to a--- heap so that dequeueing objects amounts to performing a merge sort on--- multiple external streams.  To conserve on file descriptors, we--- concatenate multiple streams into a single file, then use pread(2) on--- that as appropriate.  If too many streams are open (how do we set--- that limit?), we do exactly that:  merge-sort all streams and the--- in-memory heap into a single new stream.  One file is created for--- each generation of streams, so that mergind handles streams of--- roughly equal length.------ XXX  Truth be told, this queue isn't backed externally, and ignores---      all limits.  It *is* a Priority Queue, though!------ XXX  May want to add callbacks for significant events (new file,---      massive merge, deletion of file?)------ XXX  Need to track memory consumption of input buffers.------ XXX  Need a way to decide when too many streams are open.  That point---      is reached when seeking takes about as much time as reading---      (which depends on buffer size and system characteristics), so---      that an additional merge pass becomes economical.------ XXX  These will be useful:---          unix-bytestring:System.Posix.IO.ByteString.fdPread---          temporary:System.IO.Temp.openBinaryTempFile---          lz4:Codec.Compression.LZ4--data PQ_Conf = PQ_Conf {-        max_mb :: Int,          -- ^ memory limit-        temp_path :: FilePath   -- ^ path to temporary files (a directory will be created)-        -- functions to report progress go here-    }--newtype PQ a = PQ (IORef (SkewHeap a, Int))--class Sizeable a where usedBytes :: a -> Int---- | Creates a priority queue.  Note that the priority queue creates--- files, which will only be cleaned up if deletePQ is called.-makePQ :: (Binary a, Ord a, Sizeable a) => PQ_Conf -> IO (PQ a)-makePQ _ = PQ `fmap` newIORef (Empty,0)---- | Deletes the priority queue and all associated temporary files.-deletePQ :: PQ a -> IO ()-deletePQ (PQ _) = return ()--withPQ :: (Binary a, Ord a, Sizeable a) => PQ_Conf -> (PQ a -> IO b) -> IO b-withPQ conf = CE.bracket (makePQ conf) deletePQ---- | Enqueues an element.--- This operation may result in the creation of a file or in an enormous--- merge of already created files.-enqueuePQ :: (Binary a, Ord a, Sizeable a) => a -> PQ a -> IO ()-enqueuePQ a (PQ pq) = do (p,s) <- readIORef pq-                         let !p' = insert a p-                             !s' = 1 + s-                         writeIORef pq (p',s')---- | Removes the minimum element from the queue.--- If the queue is already empty, nothing happens.  As a result, it is--- possible that one or more file become empty and are deleted.-dequeuePQ :: (Binary a, Ord a, Sizeable a ) => PQ a -> IO ()-dequeuePQ (PQ pq) = do (p,s) <- readIORef pq-                       let !p' = dropMin p-                           !s' = max 0 (s - 1)-                       writeIORef pq (p',s')----- | Returns the minimum element from the queue.--- If the queue is empty, Nothing is returned.  Else the minimum element--- currently in the queue.-peekMinPQ :: (Binary a, Ord a, Sizeable a) => PQ a -> IO (Maybe a)-peekMinPQ (PQ pq) = (getMin . fst) `fmap` readIORef pq--getMinPQ :: (Binary a, Ord a, Sizeable a) => PQ a -> IO (Maybe a)-getMinPQ (PQ pq) = do r <- (getMin . fst) `fmap` readIORef pq-                      case r of Nothing -> return () ; Just _ -> dequeuePQ  (PQ pq)-                      return r--sizePQ :: (Binary a, Ord a, Sizeable a) => PQ a -> IO Int-sizePQ (PQ pq) = snd `fmap` readIORef pq----- We need an in-memory heap anyway.  Here's a skew heap.-data SkewHeap a = Empty | Node a (SkewHeap a) (SkewHeap a)--singleton :: a -> SkewHeap a-singleton x = Node x Empty Empty--union :: Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a-Empty              `union` t2                 = t2-t1                 `union` Empty              = t1-t1@(Node x1 l1 r1) `union` t2@(Node x2 l2 r2)-   | x1 <= x2                                 = Node x1 (t2 `union` r1) l1-   | otherwise                                = Node x2 (t1 `union` r2) l2--insert :: Ord a => a -> SkewHeap a -> SkewHeap a-insert x heap = singleton x `union` heap--getMin :: SkewHeap a -> Maybe a-getMin Empty        = Nothing-getMin (Node x _ _) = Just x--dropMin :: Ord a => SkewHeap a -> SkewHeap a-dropMin Empty        = error "dropMin on empty queue... are you sure?!"-dropMin (Node _ l r) = l `union` r-

@@ -18,6 +18,18 @@     } } +void nuc_loop_wide( char* p, int stride, char* q, int u, int v )+{+    u *= stride ;+    v *= stride ;++    while( u < v ) {+        char a = q[ u ] ;+        *p++ = a ? 0x1 << (a&3) : 0xf  ;+        u += stride ;+    }+}+ void nuc_loop_asc( char* p, int stride, char* q, int u, int v ) {     u *= stride ;