diff options
Diffstat (limited to 'Data/FastQ.hs')
| -rw-r--r-- | Data/FastQ.hs | 34 |
1 files changed, 14 insertions, 20 deletions
diff --git a/Data/FastQ.hs b/Data/FastQ.hs index 1f4f814..3e2f26c 100644 --- a/Data/FastQ.hs +++ b/Data/FastQ.hs @@ -21,6 +21,7 @@ import Data.Word (Word8) import Lens.Micro import Lens.Micro.TH import Streamly.Data.Array (Array) +import qualified Streamly.Data.Fold as F import Streamly.Data.Stream (Stream) import qualified Streamly.Data.Stream as S import qualified Streamly.External.ByteString as SB @@ -80,6 +81,7 @@ parse l r = parseEntry l r = let [hdr, seq, "+", qual] = SB.fromArray l & BC.lines [hdr', seq', "+", qual'] = SB.fromArray r & BC.lines + str = error $ "parseEntry:" <> BC.unpack str in (Read qual seq hdr, Read qual' seq' hdr') unparse :: FilePath -> FilePath -> Stream IO ReadPair -> IO () @@ -88,39 +90,31 @@ unparse l r str = do rh <- openFile r WriteMode ld <- initDeflate 0 gzipWindow rd <- initDeflate 0 gzipWindow - fmap unparse' str & toLazyBS >>= uncurry (writeFiles lh rh ld rd) + fmap unparse' str & S.fold (F.drainMapM $ writeFiles lh rh ld rd) + flush rd rh + flush ld lh + hClose rh + hClose lh where - writeFiles l r ld rd (BSL.Chunk a as) (BSL.Chunk b bs) = do + writeFiles l r ld rd (a, b) = do putCompressed ld l a putCompressed rd r b - writeFiles l r ld rd as bs - writeFiles l r ld rd BSL.Empty BSL.Empty = do - flush rd r - flush ld l - writeFiles _ _ _ _ _ _ = error "unparse: stream mismatch" putCompressed d h chunk = do popper <- feedDeflate d chunk - writePopper popper h + writePopper h popper - flush d h = - finishDeflate d >>= \case - Just rest -> B.hPut h rest - Nothing -> pure () + flush d h = finishDeflate d & writePopper h - writePopper p h = + writePopper h p = p >>= \case Just str -> do B.hPut h str - writePopper p h + writePopper h p Nothing -> pure () unparse' :: ReadPair -> (ByteString, ByteString) unparse' read = - ( BC.unlines [read ^. _1 . header, read ^. _1 . nucs, "+", read ^. _1 . qual], - BC.unlines [read ^. _2 . header, read ^. _2 . nucs, "+", read ^. _2 . qual] + ( BC.unlines ["@" <> read ^. _1 . header, read ^. _1 . nucs, "+", read ^. _1 . qual], + BC.unlines ["@" <> read ^. _2 . header, read ^. _2 . nucs, "+", read ^. _2 . qual] ) - - toLazyBS :: Stream IO (ByteString, ByteString) -> IO (BSL.ByteString, BSL.ByteString) - toLazyBS = - S.foldrM (\(l, r) b -> bimap (BSL.chunk ("@" <> l)) (BSL.chunk ("@" <> r)) <$> unsafeInterleaveIO b) (pure (BSL.Empty, BSL.Empty)) |