diff --git a/Biobase/Fasta.hs b/Biobase/Fasta.hs deleted file mode 100644 --- a/Biobase/Fasta.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE EmptyDataDecls #-} - --- | This module is currently home to a preliminary version of indices based --- on a minimal index of 'Zero' or 'One' (and possibly others). - -module Biobase.Fasta where - -import Data.ByteString.Char8 (ByteString) -import Bio.Core.Sequence (Offset(..)) - - - -data FastaWindow = FastaW - { _identifier :: !ByteString -- ^ the current identifier - , _description :: !ByteString -- ^ and description, if any - , _offset :: !Offset -- ^ Zero-based offset into the current stream - , _fasta :: !ByteString -- ^ window data - , _past :: !ByteString -- ^ the last window we saw. "" on first window. - } - deriving (Show,Eq) diff --git a/Biobase/Fasta/Export.hs b/Biobase/Fasta/Export.hs new file mode 100644 --- /dev/null +++ b/Biobase/Fasta/Export.hs @@ -0,0 +1,38 @@ +-- | Fasta export + +module Biobase.Fasta.Export where +import Biobase.Fasta.Types +import qualified Data.ByteString.Lazy.Char8 as B +import Data.List +import GHC.Int + +instance Show Fasta where + show (Fasta _header _sequence) = + (B.unpack _header) ++ "\n" ++ (B.unpack _sequence) ++ "\n" + +prettyPrintFasta :: Int -> Fasta -> String +prettyPrintFasta number (Fasta _header _sequence) = (B.unpack _header) ++ "\n" ++ (B.unpack sequenceLines) ++ "\n" + where sequenceSlices = breakByteString number _sequence + sequenceLines = B.intercalate (B.pack "\n") sequenceSlices + +prettyByteStringFasta :: Int -> Fasta -> B.ByteString +prettyByteStringFasta number (Fasta _header _sequence) = _header `B.append` bslinebreak `B.append` sequenceLines `B.append` bslinebreak + where sequenceSlices = breakByteString number _sequence + sequenceLines = B.intercalate (B.pack "\n") sequenceSlices + bslinebreak = B.pack "\n" + + +breakByteString :: Int -> B.ByteString -> [B.ByteString] +breakByteString number bs + | B.empty == currentLine = [] + | otherwise = currentLine:(breakByteString number rest) + where (currentLine,rest) = B.splitAt (fromIntToInt64 number) bs + +fromIntToInt64 :: Int -> Int64 +fromIntToInt64 = fromIntegral + +writeFastaFile :: FilePath -> [Fasta] -> IO () +writeFastaFile filePath fastas = do + let fastabs = map (prettyByteStringFasta 80) fastas + let outputbs= B.concat fastabs + B.writeFile filePath outputbs diff --git a/Biobase/Fasta/Import.hs b/Biobase/Fasta/Import.hs deleted file mode 100644 --- a/Biobase/Fasta/Import.hs +++ /dev/null @@ -1,118 +0,0 @@ -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE OverloadedStrings #-} - --- Conduit-based FASTA file format reading. Designed to be used in streaming --- applications. --- --- On parsing, one can choose the chunk size depending on the application. On --- rendering into bytestrings, the number of columns for each data line can be --- selected. This should be less than 80. - -module Biobase.Fasta.Import where - -import Control.Arrow (second) -import Control.Monad.IO.Class (liftIO, MonadIO (..)) -import Control.Monad (unless) -import Data.ByteString (ByteString, breakByte, takeWhile, empty, null, uncons) -import Data.Char -import Data.Conduit as C -import Data.Conduit.Binary as C -import Data.Conduit.List as CL -import Prelude as P hiding (null) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC -import Bio.Core.Sequence (Offset(..)) - -import Biobase.Fasta - - - --- | Parse from 'ByteString' into 'FastaWindow's with a past. - -parseFastaWindows :: Monad m => Int -> Conduit ByteString m FastaWindow -parseFastaWindows wsize = parseEvents wsize =$= CL.concatMapAccum go Nothing where - go (Header i d) _ = (Just (0,i,d,""), []) -- offset, identifier, description, past - go (Data x) Nothing = (Just (0,"","",""), [FastaW "" "" 0 x ""]) - go (Data x) (Just (k,i,d,p)) = (Just (k + (fromIntegral $ B.length x), i, d, x), [FastaW i d (Offset k) x p]) - go Done _ = (Nothing, []) - --- | Render from 'FastaWindow's into 'ByteString's. - -renderFastaWindows :: Monad m => Int -> Conduit FastaWindow m ByteString -renderFastaWindows cols = CL.concatMapAccum go Nothing =$= renderEvents cols where - go fw Nothing = (Just (_identifier fw), [Header (_identifier fw) (_description fw), Data (_fasta fw)]) - go fw (Just i) = if _identifier fw == i - then (Just i, [Data (_fasta fw)]) - else go fw Nothing - --- | An event is either a FASTA header or a part of a FASTA data stream, --- chunked into user-defineable pieces. If there is no more input, we are --- 'Done'. But we are only 'Done' if there was some input in the first place! - -data Event - = Header !ByteString !ByteString - | Data !ByteString - | Done - deriving (Eq,Show) - -isHeader :: Event -> Bool -isHeader (Header _ _) = True -isHeader _ = False - --- | Parse from 'ByteString' into 'Event's. - -parseEvents :: Monad m => Int -> GInfConduit ByteString m Event -parseEvents wsize = awaitE >>= either return goU where - loopU = awaitE >>= either finishU goU - loopH front = awaitE >>= either (finishH front) (goH front) - loopD k front = awaitE >>= either (finishD k front) (goD k front) - finishU r = yield Done >> return r - finishH front r = let final = front empty - in unless (null final) (yield . uncurry Header . second (B.drop 1) . breakByte 32 . B.drop 1 $ final) >> yield Done >> return r - finishD k front r = let final = front empty - in unless (null final) (yield $ Data final) >> yield Done >> return r - goU s = case BC.uncons s of - Just ('>', _) -> goH id s - Just _ -> goD 0 id s - Nothing -> loopU - goH sofar more = case uncons rpart of - Just (_, rpart') -> yield (uncurry Header . second (B.drop 1) . breakByte 32 . B.drop 1 $ sofar fpart) >> goU rpart' - Nothing -> loopH . B.append $ sofar more - where (fpart,rpart) = breakByte 10 more - goD k sofar more - | Just ('>',_) <- BC.uncons more = let final = sofar empty in unless (null final) (yield $ Data final) >> goU more - | otherwise = case uncons rpart of - Just (_, rpart') -> let k' = k + B.length fpart in case k' `compare` wsize of - LT -> goD k' (B.append $ sofar fpart) rpart' - EQ -> yield (Data $ sofar fpart) >> goU rpart' - GT -> let (lp,rp) = B.splitAt wsize $ sofar fpart in yield (Data lp) >> goD 0 id (B.append rp rpart) - Nothing -> let k' = k + B.length more in case k' `compare` wsize of - LT -> loopD k' . B.append $ sofar more - EQ -> yield (Data $ sofar more) >> loopU - GT -> let (lp,rp) = B.splitAt wsize $ sofar more in yield (Data lp) >> goD 0 id rp - where (fpart,rpart) = breakByte 10 more - --- | Render from 'Event's into 'ByteStrings'. 'cols' is the number of --- characters after which a newline is introduced into the stream. Such --- newlines are introduced only into 'Data' events. - -renderEvents :: Monad m => Int -> Conduit Event m ByteString -renderEvents cols = CL.concatMap go =$= CL.map (`BC.snoc` '\n') where - go (Header i d) = [printHeader $ Header i d] - go (Data xs) = rows xs - go (Done) = [] - rows xs = let (x,xs') = B.splitAt cols xs - in if B.length xs <= cols - then [xs] - else x : rows xs' - -printHeader (Header i d) = BC.concat $ [">",i] ++ (if null d then [] else [" ", d]) - - -test :: IO () -test = do - let prnt (Header i d) = BC.putStr i >> BC.putStrLn d - prnt (Data d) = BC.putStrLn d - runResourceT $ sourceFile "big.fa" $= parseEvents 1000 $$ CL.foldM (\_ x -> liftIO $ prnt x) () - diff --git a/Biobase/Fasta/Streaming.hs b/Biobase/Fasta/Streaming.hs new file mode 100644 --- /dev/null +++ b/Biobase/Fasta/Streaming.hs @@ -0,0 +1,228 @@ +-- | Streaming Fasta handling via the @streaming@ library. +-- +-- The functions in here should be streaming in constant memory. +-- +-- TODO Check if this is actually true with some unit tests. + +{-# LANGUAGE UnicodeSyntax #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} + + +module Biobase.Fasta.Streaming + ( module Biobase.Fasta.Streaming + ) where + +import Control.Monad +import Control.Monad.Trans.Resource (runResourceT, ResourceT(..), MonadResource) +import Data.ByteString.Streaming as BSS +import Data.ByteString.Streaming.Char8 as S8 +import Data.ByteString.Streaming.Internal (ByteString(..)) +import Data.Semigroup as SG +import Debug.Trace +import GHC.TypeLits +import Prelude as P +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as B +import qualified Streaming.Internal as SI +import Streaming as S +import Streaming.Prelude as SP +import qualified Data.List as L +import Biobase.Types.Index.Type +import Biobase.Fasta.Types + + +newtype HeaderSize = HeaderSize Int + deriving (Eq,Ord,Show) + +newtype OverlapSize = OverlapSize Int + deriving (Eq,Ord,Show) + +newtype CurrentSize = CurrentSize Int + deriving (Eq,Ord,Show) + +newtype Header (which ∷ k) = Header { getHeader ∷ BS.ByteString } + deriving (Eq,Ord,Show) + +newtype Overlap (which ∷ k) = Overlap { getOverlap ∷ BS.ByteString } + deriving (Eq,Ord,Show) + +-- | Current Fasta window, together with the start index (0-based). + +data Current (which ∷ k) = Current { currentFasta ∷ BS.ByteString, currentStart ∷ Index 0 } + deriving (Eq,Ord,Show) + +-- | Fully stream a fasta file, making sure to never exceed a constant amount +-- of memory. The @go@ function yields values of type @a@ down the line for +-- continued streaming. +-- +-- @ +-- r4 = toList . streamingFasta (HeaderSize 2) (OverlapSize 1) (CurrentSize 2) go . S8.fromStrict $ BS.pack t0 +-- where go (Header h) (Overlap o) (Current c) = yield (h,o,c) +-- @ + +streamingFasta + ∷ forall m w r a + . ( Monad m ) + ⇒ HeaderSize + -- ^ Maximal length of the header. Ok to set to @20 000@, only guards against + -- an extremely long header line. + → OverlapSize + -- ^ How much of the current size to carry over to the next step. Even if set + -- larger than current size, it will only be at most current size. (But see + -- todo at 'overlappedFasta') + → CurrentSize + -- ^ The size of each window to be processed. + → (Header w → Overlap w → Current w → Stream (Of a) m ()) + -- ^ The processing function. Takes in the header, any overlap from the + -- previous window, the current window and produces a stream of @a@s. + → ByteString m r + -- ^ A streaming bytestring of Fasta files. + → Stream (Of a) m r + -- ^ The outgoing stream of @a@s being processed. +{-# Inlinable streamingFasta #-} +streamingFasta (HeaderSize hSz) (OverlapSize oSz) (CurrentSize cSz) f = go (FindHeader [] 0) where + -- Find the next FASTA header + go (FindHeader hdr cnt) = \case + -- No more data to be had. If There is some part of a header, we will run + -- the handling function @f@ with empty input. @f@ can decide on how to + -- handle empty FASTA entries. + Empty retVal → do + -- handle case of last empty fasta + unless (P.null hdr) $ do + let thisHeader = BS.take hSz $ BS.concat $ P.reverse hdr + f (Header thisHeader) (Overlap BS.empty) (Current BS.empty 0) + SI.Return retVal + -- Effects are wrapped up into a 'Stream' effect. + Go m → SI.Effect $ liftM (go (FindHeader hdr cnt)) m + -- We have a chunk of bytestring @rawBS@ with more data in the bytestream + -- @bs@. We work on @b@, not the @rawBS@. In case we have no header parts + -- yet, all characters preceeding a fasta header symbol ('>' or ';') are + -- dropped. + Chunk rawBS bytestream + -- No newline in the @b@, hence we add the bytestring to the partial + -- header, and continue scanning. Note that we add only if we are below + -- the maximal header size @hSz@ to prevent malicious fasta files from + -- blowing up memory usage. + | Nothing ← mk → if cnt > hSz + then go (FindHeader hdr cnt) bytestream + else go (FindHeader (b:hdr) (BS.length b + cnt)) bytestream + -- We have found a newline at @k@. Prepare the full header (up to @hSz@ + -- size) and hand over to @HasHeader@ which processes actual fasta + -- payload. + | Just k ← mk → let thisHeader = BS.take hSz $ BS.concat $ P.reverse $ BS.take k b:hdr + in go (HasHeader thisHeader BS.empty [] 0 0) + (Chunk (BS.drop (k+1) b) bytestream) + where b = if P.null hdr then BS.dropWhile (\c → c/='>' && c/=';') rawBS else rawBS + mk = BS.elemIndex '\n' b + -- We actually do have a valid header now and process fasta in parts. + go hasHeader@(HasHeader hdr overlap cs cnt entries) = \case + -- No more data, process final input and return. + Empty retVal → do + when (cnt>0 || entries==0) $ f (Header hdr) (Overlap BS.empty) (Current (BS.concat $ reverse cs) 0) + SI.Return retVal + -- Effects to be dealt with. + Go m → SI.Effect $ liftM (go hasHeader) m + -- We have incoming data ... + Chunk b bytestream → case newFastaIndex b of + -- there is no new fasta starting, meaning that we need to process @b@ as + -- payload. We split at the maximal size we are allowed according to + -- @cSz@. If we have hit the limit, we run @f@ on this part of the data + -- and include the overlap as prefix. Otherwise we continue gathering. + -- Any newlines are removed from the data. + Nothing → let (this,next) = BS.splitAt (cSz-cnt) $ BS.filter (/= '\n') b + in if BS.length this + cnt >= cSz + then do let thisFasta = BS.concat $ reverse $ this:cs + f (Header hdr) (Overlap overlap) (Current thisFasta 0) + go (HasHeader hdr (BS.drop (BS.length thisFasta - oSz) thisFasta) [] 0 (entries+1)) + (if BS.null next then bytestream else Chunk next bytestream) + else go (HasHeader hdr overlap (this:cs) (BS.length this + cnt) entries) + (if BS.null next then bytestream else Chunk next bytestream) + -- We have a new fasta symbol in @b@. We split at the symbol and re-run + -- the first part (which will end up being the @Nothing@ case) and put + -- into @Chunk next bytestream@ the beginning of the next fasta entry. + -- This part will then be handled by the @otherwise@ case here. + Just new + | new > 0 → let (this,next) = BS.splitAt new b + in go (HasHeader hdr overlap cs cnt entries) $ Chunk this (Chunk next bytestream) + | otherwise → do let thisFasta = BS.concat $ reverse cs + -- we only emit on empty @thisFasta@, if there is + -- data, or it is the only (then empty) entry. + when (cnt>0 || entries==0) $ f (Header hdr) (Overlap overlap) (Current thisFasta 0) + go (FindHeader [] 0) $ Chunk b bytestream + -- Returns the first index (if any) of a new fasta entry symbol. + newFastaIndex b = getMin <$> (Min <$> BS.elemIndex '>' b) SG.<> (Min <$> BS.elemIndex ';' b) + +-- | Control structure for 'streamingFasta'. + +data FindHeader + = FindHeader + { headerParts ∷ [BS.ByteString] + -- ^ the collected header parts (in reverse order) + , headerLength ∷ !Int + -- ^ accumulated header length + } + | HasHeader + { header ∷ !BS.ByteString + -- ^ the (size-truncated) header for this fasta file + , dataOverlap ∷ !BS.ByteString + -- ^ overlap (if any) from earlier parts of the fasta file + , dataParts ∷ [BS.ByteString] + -- ^ collection of dataParts, in reverse order! + , dataLength ∷ !Int + -- ^ total length of data parts, simplifies checking if enough data was collected + , entries ∷ !Int + -- ^ count how many entries we have seen + } + + +{- +t0 = P.unlines + [ ">Aaaa" + , "123" + , ">Bbbb" + , "4567" + , ">Cccc" + , "890" + ] + + +r2 = splitFastaLines $ S8.lines $ S8.fromStrict $ BS.pack t0 + +r3 = streamFastaLines $ S8.lines $ S8.fromStrict $ BS.pack t0 + +-- r3' ∷ Stream (Stream (Of BS.ByteString) Identity) Identity () +r3' = toList . mapped toList $ maps (mapped toStrict) r3 + +r4 = toList . streamingFasta (HeaderSize 2) (OverlapSize 1) (CurrentSize 2) go . S8.fromStrict $ BS.pack t0 + where go (Header h) (Overlap o) (Current c) = yield (h,o,c) +-} + +--eachFasta :: forall (m0 :: * -> *). Header Int -> Overlap Int -> Current Int -> Stream (Of (BS.ByteString, BS.ByteString, BS.ByteString)) (ResourceT IO) () +eachFasta (Header h) (Overlap o) (Current c p) = SP.yield (h,o,c) + +--readFastaFile ∷ FilePath → IO () -- [(BS.ByteString,BS.ByteString,BS.ByteString)] +--readFastaFile f = do +-- let s = 1000000000000 +-- r ← runResourceT +-- $ SP.mapM_ (liftIO . P.print) +-- $ streamingFasta (HeaderSize s) (OverlapSize 0) (CurrentSize s) eachFasta +-- $ S8.readFile f +-- return r + +parseFastaFile ∷ FilePath → IO [Fasta] +parseFastaFile f = do + let s = 1000000000000 + r ← runResourceT + $ toList_ + $ streamingFasta (HeaderSize s) (OverlapSize 0) (CurrentSize s) eachFasta + $ S8.readFile f + let fastas = L.map (\(a,_,c) -> Fasta (B.fromStrict a) (B.fromStrict c)) r + return fastas + +parseFasta ∷ B.ByteString → [Fasta] +parseFasta input = L.map (\(a,_,c) -> Fasta (B.fromStrict a) (B.fromStrict c)) (L.head r) + where s = 1000000000000 + r = toList_ $ streamingFasta (HeaderSize s) (OverlapSize 0) (CurrentSize s) eachFasta $ BSS.fromLazy input diff --git a/Biobase/Fasta/Types.hs b/Biobase/Fasta/Types.hs new file mode 100644 --- /dev/null +++ b/Biobase/Fasta/Types.hs @@ -0,0 +1,56 @@ +{-# Language DeriveGeneric #-} + +module Biobase.Fasta.Types where + +import Control.DeepSeq +import Control.Lens +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Lazy.Char8 as B +import Data.Data +import GHC.Generics +import Biobase.Types.NucleotideSequence +import Biobase.Types.AminoAcidSequence + +-- | + +data Fasta = Fasta { fastaHeader :: B.ByteString, fastaSequence :: B.ByteString } + deriving (Eq) + +newtype RawFastaEntry = RawFastaEntry { _rawFastaEntry :: ByteString } + deriving (Show,Eq,Ord,Typeable) + +--makeLenses ''RawFastaEntry + +-- | 'StreamEvent's are chunked pieces of data, where the raw data is +-- a strict @ByteString@. Each element also retains information on the +-- first and last line and column (via 'streamLines') that are part of this +-- chunk. + +data StreamEvent + -- | A Header event, multiple header events signal that the header name + -- was longer than the chunk size. + = StreamHeader { streamHeader :: !ByteString, streamLines :: !LineInfo } + -- | A data event. We keep a pointer to the previous chunk (which is + -- useful for some algorithms). The chunk is free of newlines! + | StreamFasta { streamFasta :: !ByteString, prevStreamFasta :: !ByteString, streamLines :: !LineInfo, streamHeader :: !ByteString } + deriving (Show,Eq,Ord,Typeable,Generic) + +instance NFData StreamEvent + + + +-- | Complete information on line and column start and end for a chunk. +-- +-- TODO This is a 1-based format? Lets use the BiobaseTypes facilities! + +data LineInfo = LineInfo + { firstLine :: !Int -- ^ first line for this chunk @(lines in complete file!)@ + , firstCol :: !Int -- ^ first column in first line for this chunk + , lastLine :: !Int -- ^ last line for this chunk @(lines in complete file!)@ + , lastCol :: !Int -- ^ last column in last line for this chunk + , firstIndex :: !Int -- ^ first index in this fasta block. Counts just the number of symbols in the @Fasta@ payload. + } + deriving (Show,Eq,Ord,Typeable,Generic) + +instance NFData LineInfo + diff --git a/BiobaseFasta.cabal b/BiobaseFasta.cabal --- a/BiobaseFasta.cabal +++ b/BiobaseFasta.cabal @@ -1,59 +1,113 @@ name: BiobaseFasta -version: 0.0.1.0 -author: Christian Hoener zu Siederdissen -maintainer: choener@tbi.univie.ac.at -homepage: http://www.tbi.univie.ac.at/~choener/ -copyright: Christian Hoener zu Siederdissen, 2011-2013 +version: 0.2.0.0 +author: Christian Hoener zu Siederdissen, Florian Eggenhofer +maintainer: choener@bioinf.uni-leipzig.de +homepage: https://github.com/choener/BiobaseFasta +bug-reports: https://github.com/choener/BiobaseFasta/issues +copyright: Christian Hoener zu Siederdissen, 2011-2018 category: Bioinformatics -synopsis: conduit-based FASTA parser license: GPL-3 license-file: LICENSE build-type: Simple stability: experimental -cabal-version: >= 1.6.0 +cabal-version: >= 1.10.0 +tested-with: GHC == 8.4.3 +synopsis: streaming FASTA parser description: - Conduit-based handling of FASTA files. This library provides a - streaming interface. The user selects a window size, then - handles the window. For each window, the previous (past) window - is available, in case some data sits on the boundary between - windows. + Stream-based handling of FASTA files. The user selects a window + size, the library then handles the window. For each window, the + previous (past) window is available, in case some data sits on + the boundary between windows. . FastaTool is a simple tool providing information on FASTA files, and allowing to extract sequences and subsequences. . - The library is, in general, in a "preview" state. In cases - where you need to scan large FASTA files fast and with low - memory overhead, the 'streamFasta' function, however, should - already be useable enough. + Greg Schwartz' + package is a lot more complete. This one is mostly tailored to + my usage requirements (and may at some point use his library). extra-source-files: - changelog + changelog.md + README.md + tests/sample1.fa + tests/sample2.fa + tests/sample3.fa -library - build-depends: - base >3 && <5 , - biocore >= 0.2 , - bytestring , - conduit == 0.5.* , - containers , - transformers - exposed-modules: - Biobase.Fasta - Biobase.Fasta.Import +library + build-depends: base >= 4.7 && < 5.0 + , bytestring + , resourcet >= 1.0 + , streaming >= 0.1 + , streaming-bytestring >= 0.1 + , lens + , deepseq + -- + , BiobaseTypes == 0.1.4.* + exposed-modules: + Biobase.Fasta.Streaming, + Biobase.Fasta.Types, + Biobase.Fasta.Export + default-language: + Haskell2010 + default-extensions: BangPatterns + , DataKinds + , DeriveDataTypeable + , DeriveGeneric + , FlexibleContexts + , GADTs + , KindSignatures + , LambdaCase + , MultiWayIf + , NoMonomorphismRestriction + , PolyKinds + , RankNTypes + , RecordWildCards + , ScopedTypeVariables + , TemplateHaskell + , UnicodeSyntax + , ViewPatterns ghc-options: -O2 -executable FastaTool + + +test-suite properties + type: + exitcode-stdio-1.0 main-is: - FastaTool.hs - build-depends: - cmdargs == 0.10.* + properties.hs ghc-options: - -O2 + -threaded -rtsopts -with-rtsopts=-N + hs-source-dirs: + tests + default-language: + Haskell2010 + default-extensions: TemplateHaskell + , UnicodeSyntax + , OverloadedStrings + + build-depends: base + , QuickCheck + , bytestring + , filepath + , resourcet >= 1.0 + , streaming >= 0.1 + , streaming-bytestring >= 0.1 + , tasty >= 0.11 + , tasty-hunit >= 0.9 + , tasty-golden >= 2.3 + , tasty-quickcheck >= 0.8 + , tasty-silver >= 3.1.9 + , tasty-th >= 0.1 + , text + -- + , BiobaseFasta + + source-repository head type: git diff --git a/FastaTool.hs b/FastaTool.hs deleted file mode 100644 --- a/FastaTool.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} - -module Main where - -import Data.Conduit as C -import Data.Conduit.Binary as C -import Data.Conduit.List as CL -import Prelude hiding (length) -import System.Console.CmdArgs -import System.IO (stdin,stdout) -import Text.Printf -import qualified Data.ByteString.Char8 as B - -import Biobase.Fasta.Import - -import Control.Monad.IO.Class (liftIO, MonadIO (..)) - - -data Options - = Info - { description :: Bool - , length :: Bool - } - deriving (Show,Data,Typeable) - -info = Info - { description = False &= help "print description, not just the indentifier" - , length = False &= help "print length of data section, too. will be last element." - } - -main :: IO () -main = do - o <- cmdArgs $ modes [info &= auto] - case o of - (Info d l) -> doInfo d l - -doInfo d l = do - runResourceT - $ sourceHandle stdin - $= parseEvents 10000 - $= CL.concatMapAccum (countChars d l) Nothing - $$ sinkHandle stdout - -countChars showD showL = go where - go h@Header{} Nothing = ( Just (h,0) , [] ) - go h@Header{} (Just (hold, k)) = ( Just (h,0), [prnt hold k] ) - go (Data d) Nothing = ( Just (Header "" "",0), [] ) - go (Data d) (Just (h, k)) = ( Just (h, k + B.length d), [] ) - go Done Nothing = ( Nothing, [] ) - go Done (Just (h, k)) = ( Nothing, [prnt h k] ) - prnt hdr k = printHeader hdr `B.append` (B.pack $ if showL then printf " %8d" k else "") `B.append` "\n" - diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,24 @@ +[![Build Status](https://travis-ci.org/choener/BiobaseFasta.svg?branch=master)](https://travis-ci.org/choener/BiobaseFasta) + +# BiobaseFasta + +## A Haskell library for FASTA-file handling. + +The version does streaming using the 'streaming' library. + +The library is, in general, in a "preview" state. In cases where you need to +scan large FASTA files fast and with low memory overhead, the functions within +should already be useable enough. + +The wikipedia has information on the format: + + + + +#### Contact + +Christian Hoener zu Siederdissen +Leipzig University, Leipzig, Germany +choener@bioinf.uni-leipzig.de +http://www.bioinf.uni-leipzig.de/~choener/ + diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,2 +0,0 @@ -0.0.1.0 - * conduit-based (0.5.6) parsing with windows diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,18 @@ +0.2.0.0 +------- + +- this version now uses the streaming library + +0.1.0.0 +------- + +- chunk-based conduit parser +- small number of conduit functions for different chunk types +- quickcheck and unit tests +- travis-ci integration +- included stack.yaml (and working build) + +0.0.1.0 +------- + +- conduit-based (0.5.6) parsing with windows diff --git a/tests/properties.hs b/tests/properties.hs new file mode 100644 --- /dev/null +++ b/tests/properties.hs @@ -0,0 +1,97 @@ + +module Main where + +import Prelude as P +import Data.Functor.Of +import qualified Data.ByteString.Char8 as BS +import Data.ByteString.Streaming as BSS +import Data.ByteString.Streaming.Char8 as S8 +import Data.ByteString.Streaming.Internal (ByteString(..)) +import Streaming as S +import Streaming.Prelude as SP +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck as QC +--import Test.Tasty.Silver as S +--import Test.Tasty.Silver.Interactive as SI +import Test.Tasty.TH +import Control.Monad.Trans.Resource (runResourceT, ResourceT(..), MonadResource) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Test.Tasty.Golden as Golden +import System.FilePath (takeBaseName, replaceExtension) +import qualified Data.ByteString.Lazy.Char8 as BL8 + +import Biobase.Fasta.Streaming + + + +-- * golden tests + +readFastaFile ∷ FilePath → IO [(BS.ByteString,BS.ByteString,BS.ByteString)] +readFastaFile f = do + let s = 1000000 + xs :> r ← runResourceT + $ SP.toList + $ streamingFasta (HeaderSize s) (OverlapSize 0) (CurrentSize s) eachFasta + $ S8.readFile f + return xs + +lazyFastaOut = BL8.concat . P.map go + where go (h,o,c) = BL8.concat + [ BL8.fromStrict h + , BL8.pack "\n" + , BL8.fromStrict o + , BL8.pack "\n" + , BL8.fromStrict c + , BL8.pack "\n" + ] + +goldenTests ∷ IO TestTree +goldenTests = do + fastaFiles ← Golden.findByExtension [".fa"] "./tests/" + return $ testGroup "readFastaFile golden tests" + [ Golden.goldenVsString + (takeBaseName fastaFile) -- test name + goldenFile -- golden file path + (lazyFastaOut <$> readFastaFile fastaFile) -- action whose result is tested + | fastaFile <- fastaFiles + , let goldenFile = replaceExtension fastaFile ".fa-golden" + ] + +-- * unit tests + +smallInlineFasta = P.unlines + [ ">Aaaa" + , "123" + , ">Bbbb" + , "4567" + , ">Cccc" + , "890" + ] + +smallTest ∷ Int → Int → Int → Of [(BS.ByteString,BS.ByteString,BS.ByteString)] () +smallTest h o c = runIdentity + . toList + . streamingFasta (HeaderSize h) (OverlapSize o) (CurrentSize c) go + . S8.fromStrict + $ BS.pack smallInlineFasta + where go (Header h) (Overlap o) (Current c _) = yield (h,o,c) + +smallTest333 = testCase "3/3/3" $ do + let res :> r = smallTest 3 3 3 + assertEqual "return is null" () r + assertEqual "length is 4" 4 (P.length res) + assertEqual "!!0" (">Aa","","123") (res!!0) + assertEqual "!!1" (">Bb","","456") (res!!1) + assertEqual "!!2" (">Bb","456","7") (res!!2) + assertEqual "!!3" (">Cc","","890") (res!!3) + +main :: IO () +main = do + gs ← goldenTests + defaultMain $ testGroup "all tests" + [ testGroup "Golden" [gs] + , testGroup "unit tests" [smallTest333] + ] + diff --git a/tests/sample1.fa b/tests/sample1.fa new file mode 100644 --- /dev/null +++ b/tests/sample1.fa @@ -0,0 +1,6 @@ +;LCBO - Prolactin precursor - Bovine +; a sample sequence in FASTA format +MDSKGSSQKGSRLLLLLVVSNLLLCQGVVSTPVCPNGPGNCQVSLRDLFDRAVMVSHYIHDLSS +EMFNEFDKRYAQGKGFITMALNSCHTSSLPTPEDKEQAQQTHHEVLMSLILGLLRSWNDPLYHL +VTEVRGMKGAPDAILSRAIEIEEENKRLLEGMEMIFGQVIPGAKETEPYPVWSGLPSLQTKDED +ARYSAFYNLLHCLRRDSSKIDTYLKLLNCRIIYNNNC* diff --git a/tests/sample2.fa b/tests/sample2.fa new file mode 100644 --- /dev/null +++ b/tests/sample2.fa @@ -0,0 +1,4 @@ +>MCHU - Calmodulin - Human, rabbit, bovine, rat, and chicken +ADQLTEEQIAEFKEAFSLFDKDGDGTITTKELGTVMRSLGQNPTEAELQDMINEVDADGNGTID +FPEFLTMMARKMKDTDSEEEIREAFRVFDKDGNGYISAAELRHVMTNLGEKLTDEEVDEMIREA +DIDGDGQVNYEEFVQMMTAK* diff --git a/tests/sample3.fa b/tests/sample3.fa new file mode 100644 --- /dev/null +++ b/tests/sample3.fa @@ -0,0 +1,6 @@ +>gi|5524211|gb|AAD44166.1| cytochrome b [Elephas maximus maximus] +LCLYTHIGRNIYYGSYLYSETWNTGIMLLLITMATAFMGYVLPWGQMSFWGATVITNLFSAIPYIGTNLV +EWIWGGFSVDKATLNRFFAFHFILPFTMVALAGVHLTFLHETGSNNPLGLTSDSDKIPFHPYYTIKDFLG +LLILILLLLLLALLSPDMLGDPDNHMPADPLNTPLHIKPEWYFLFAYAILRSVPNKLGGVLALFLSIVIL +GLMPFLHTSKHRSMMLRPLSQALFWTLTMDLLTLTWIGSQPVEYPYTIIGQMASILYFSIILAFLPIAGX +IENY