biostockholm 0.1 → 0.1.0.1
raw patch · 2 files changed
+74/−50 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- biostockholm.cabal +1/−1
- src/Bio/Sequence/Stockholm.hs +73/−49
biostockholm.cabal view
@@ -1,5 +1,5 @@ Name: biostockholm-Version: 0.1+Version: 0.1.0.1 Synopsis: Reading and writing Stockholm files (multiple sequence alignment, used by Rfam and Infernal). License: BSD3 License-file: LICENSE
src/Bio/Sequence/Stockholm.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, EmptyDataDecls, DeriveDataTypeable, OverloadedStrings #-}+{-# LANGUAGE BangPatterns, CPP, EmptyDataDecls, DeriveDataTypeable, OverloadedStrings #-} -- | Parsing and pretty printing of files in Stockholm 1.0 -- format. See:@@ -41,10 +41,9 @@ import Control.DeepSeq (NFData(..)) import Control.Monad (mplus) import Data.Char (isSpace)-import Data.List (foldl', find)+import Data.List (find) import Data.Maybe (fromMaybe) import Data.Typeable (Typeable)-import Text.Show (showParen, showString) -- from containers import qualified Data.Map as M@@ -327,8 +326,12 @@ --- | Type (F, C, S or R), corresponding sequence, name and data.-type ParseAnnRet = ((Char, Maybe SeqLabel, ByteString), ByteString)+-- | Some kind of annotation+data ParseAnnRet =+ FileAnn !(Ann FileAnnotation)+ | FileColAnn !(Ann (ColumnAnnotation InFile))+ | SeqAnn !ByteString !(Ann SequenceAnnotation)+ | SeqColAnn !ByteString !(Ann (ColumnAnnotation InSeq)) -- | @parseAnnotation line@ tries to parse a line as an annotation. parseAnnotation :: (StockholmExc e) => ByteString -> Exceptional e ParseAnnRet@@ -339,14 +342,12 @@ let Just (typ, rest) = B.uncons $ B.drop 3 line (word1, text1) = second dropSpace . B.break isSpace $ dropSpace rest (word2, text2) = second dropSpace . B.break isSpace $ text1- global = ((typ, Nothing, word1), text1)- seqspe = ((typ, Just (SeqLabel word1), word2), text2) in case typ of- 'F' -> return global- 'C' -> return global- 'S' -> return seqspe- 'R' -> return seqspe- _ -> throw (unknownAnnTypeExc typ)+ 'F' -> return $ FileAnn (parseAnn' word1 text1)+ 'C' -> return $ FileColAnn (parseAnn' word1 text1)+ 'S' -> return $ SeqAnn word1 (parseAnn' word2 text2)+ 'R' -> return $ SeqColAnn word1 (parseAnn' word2 text2)+ _ -> throw (unknownAnnTypeExc typ) dropSpace :: ByteString -> ByteString dropSpace = B.dropWhile isSpace@@ -378,77 +379,100 @@ filter (not . B.all isSpace) . B.lines where split [] = []- split xs = case break (B.isPrefixOf "//") xs of- (y, ys) -> y : split (tail ys)+ split xs = let ~(y, ys) = break (B.isPrefixOf "//") xs+ in y : split (tail ys) + parseStockholm' :: (StockholmExc e) => [ByteString] -> Exceptional e Stockholm parseStockholm' = header . filter (not . B.null) where -- Find header (h:hs)- | h == stockholm = do (annots,seqs) <- go initial hs+ | h == stockholm = do (annots, seqs) <- go (emptyPA, M.empty) hs return (makeStockholm annots seqs) | otherwise = throw headerExc where stockholm = "# STOCKHOLM 1.0"- initial = (M.empty, M.empty) header [] = throw emptyFileExc -- End of file go acc [] = return acc -- Annotation- go (annots,seqs) (line:ls) | B.take 2 line == "#=" = do+ go (!annots, !seqs) (line:ls) | B.take 2 line == "#=" = do annot <- parseAnnotation line- go (insertDM annot annots, seqs) ls+ go (insertPA annot annots, seqs) ls -- Comment- go (annots,seqs) (l:ls) | B.head l == '#' =- go (annots,seqs) ls+ go acc (l:ls) | B.head l == '#' = go acc ls -- Otherwise a sequence- go (annots,seqs) (line:ls) = do+ go (!annots, !seqs) (line:ls) = do seqData <- parseSeqData line go (annots, insertDM seqData seqs) ls -type DiffMap a b = M.Map a ([b] -> [b])+type DiffMap a b = M.Map a [b] -insertDM :: Ord a => (a,b) -> DiffMap a b -> DiffMap a b-insertDM (key,val) = M.insertWith (flip (.)) key (val:)+insertDM :: Ord a => (a, b) -> DiffMap a b -> DiffMap a b+insertDM (key, val) = M.insertWith' (\_ old -> val:old) key [val] finishDM :: (b -> ByteString) -> DiffMap a b -> M.Map a ByteString-finishDM f = fmap (B.concat . map f . ($ []))+finishDM f = fmap (B.concat . map f . reverse) --- | Glue everything in place, as the Stockholm format lets--- everything be everywhere and split in any number of parts.-makeStockholm :: DiffMap (Char, Maybe SeqLabel, ByteString) ByteString- -> DiffMap SeqLabel SeqData -> Stockholm-makeStockholm annotsDM seqsDM =- let annots = finishDM id annotsDM- seqs = finishDM unSD seqsDM+type AnnMap d = DiffMap d ByteString - -- Separate the global from the sequence annotations- go ('F', Nothing, feat) txt (f,c,r) = (parseAnn' feat txt:f,c,r)- go ('C', Nothing, feat) txt (f,c,r) = (f,parseAnn' feat txt:c,r)- go (typ, Just sq, feat) txt (f,c,r) = (f,c,(typ,sq,feat,txt):r)- go _ _ _ = error "makeStockholm: not here, ever"+insertAnn :: Ord d => Ann d -> AnnMap d -> AnnMap d+insertAnn (Ann key val) = insertDM (key, val) - -- Separate the sequence annotations to each annotation- add ('S',sq,feat,txt) = flip M.adjust sq $ \(StSeq sl sd sa ca) ->- StSeq sl sd (parseAnn' feat txt : sa) ca- add ('R',sq,feat,txt) = flip M.adjust sq $ \(StSeq sl sd sa ca) ->- StSeq sl sd sa (parseAnn' feat txt : ca)- add _ = error "makeStockholm: not here either"+finishAnn :: AnnMap d -> [Ann d]+finishAnn m = [Ann a b | (a, b) <- M.toList (finishDM id m)] - -- Glue everything- (file, clmn, rest) = M.foldWithKey go ([],[],[]) annots- plainseqs = M.mapWithKey (\k s -> StSeq k (SeqData s) [] []) seqs- in Stockholm file clmn (M.elems $ foldl' (flip add) plainseqs rest)+type SeqAnnMap d = M.Map ByteString (AnnMap d) +insertSM :: Ord d => ByteString -> Ann d -> SeqAnnMap d -> SeqAnnMap d+insertSM sq ann = M.alter (just . insertAnn ann . fromMaybe M.empty) sq+ where+ just !x = Just x +finishSM :: SeqAnnMap d -> M.Map ByteString [Ann d]+finishSM = fmap finishAnn +data PartialAnns =+ PartialAnns { paFileAnns :: !(AnnMap FileAnnotation)+ , paFileColAnns :: !(AnnMap (ColumnAnnotation InFile))+ , paSeqAnns :: !(SeqAnnMap SequenceAnnotation)+ , paSeqColAnns :: !(SeqAnnMap (ColumnAnnotation InSeq))+ } +emptyPA :: PartialAnns+emptyPA = PartialAnns M.empty M.empty M.empty M.empty++insertPA :: ParseAnnRet -> PartialAnns -> PartialAnns+insertPA (FileAnn ann) pa = pa { paFileAnns = insertAnn ann (paFileAnns pa) }+insertPA (FileColAnn ann) pa = pa { paFileColAnns = insertAnn ann (paFileColAnns pa) }+insertPA (SeqAnn sq ann) pa = pa { paSeqAnns = insertSM sq ann (paSeqAnns pa) }+insertPA (SeqColAnn sq ann) pa = pa { paSeqColAnns = insertSM sq ann (paSeqColAnns pa) }++++-- | Glue everything in place, as the Stockholm format lets+-- everything be everywhere and split in any number of parts.+makeStockholm :: PartialAnns -> DiffMap SeqLabel SeqData -> Stockholm+makeStockholm annots seqsDM =+ let fileAnns_ = finishAnn (paFileAnns annots)+ fileColAnns = finishAnn (paFileColAnns annots)+ seqAnns_ = finishSM (paSeqAnns annots)+ seqColAnns = finishSM (paSeqColAnns annots)++ stseqs = [StSeq label (SeqData dt) (f sq seqAnns_) (f sq seqColAnns)+ | (label@(SeqLabel sq), dt) <- M.toList (finishDM unSD seqsDM)]+ where+ f = M.findWithDefault []+ in Stockholm fileAnns_ fileColAnns stseqs+++ -- | Pretty-prints an Stockholm file. We follow Rfam preferences -- and do not wrap lines. prettyPrintStockholm :: Stockholm -> B.ByteString@@ -523,8 +547,8 @@ result2 :: [Stockholm] result2 = result ++ result -returnExc :: a -> Exceptional B.ByteString a-returnExc = return+returnExc :: [a] -> [Exceptional B.ByteString a]+returnExc = map return test_parseStockholm :: Specs test_parseStockholm =