sequence-formats 1.4.0.1 → 1.4.1

raw patch · 12 files changed

+50/−43 lines, 12 files

Files

• Changelog.md +7/−3
• sequence-formats.cabal +1/−1
• src/SequenceFormats/Eigenstrat.hs +4/−4
• src/SequenceFormats/Fasta.hs +2/−2
• src/SequenceFormats/FreqSum.hs +9/−8
• src/SequenceFormats/Pileup.hs +4/−5
• src/SequenceFormats/RareAlleleHistogram.hs +3/−3
• src/SequenceFormats/Utils.hs +8/−6
• src/SequenceFormats/VCF.hs +3/−3
• test/SequenceFormats/FreqSumSpec.hs +7/−7
• test/SequenceFormats/PileupSpec.hs +1/−0
• test/SequenceFormats/VCFSpec.hs +1/−1

@@ -29,8 +29,12 @@ V 1.3.3: Added Pileup as new format. Changed all tests to Hspec.  V 1.4.0: Added three features:-    - Chromosomes now include X, Y and MT (or chrX, chrY, chrMT), in that order after chr22. -    - SNP rsId information is now internally included as an option in the FreqSum data format.-    - Pileup Format now also records strand orientation+* Chromosomes now include `X`, `Y` and `MT` (or `chrX`, `chrY`, `chrMT`), in that order after `chr22`. +* SNP rsId information is now internallyincluded as an option in the FreqSum data format.+* Pileup Format now also records strandorientation  V 1.4.0.1: Added test file example.pileup to cabal extra-source-files to make tests work.++V 1.4.1:+* Added optional genetic position to FreqSumformat,+* changed various internal strings toByteStrings and vice versa.

@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: sequence-formats-version: 1.4.0.1+version: 1.4.1 license: GPL-3 license-file: LICENSE maintainer: stephan.schiffels@mac.com

@@ -61,7 +61,7 @@     ref <- A.skipMany1 A.space >> A.satisfy (A.inClass "ACTGN")     alt <- A.skipMany1 A.space >> A.satisfy (A.inClass "ACTGX")     void A.endOfLine-    return $ EigenstratSnpEntry (Chrom (B.unpack chrom)) pos geneticPos snpId_ ref alt+    return $ EigenstratSnpEntry (Chrom chrom) pos geneticPos snpId_ ref alt  bimParser :: A.Parser EigenstratSnpEntry bimParser = do@@ -72,7 +72,7 @@     ref <- A.skipMany1 A.space >> A.satisfy (A.inClass "ACTGN")     alt <- A.skipMany1 A.space >> A.satisfy (A.inClass "ACTGX")     void A.endOfLine-    return $ EigenstratSnpEntry (Chrom (B.unpack chrom)) pos geneticPos snpId_ ref alt+    return $ EigenstratSnpEntry (Chrom chrom) pos geneticPos snpId_ ref alt      eigenstratIndParser :: A.Parser EigenstratIndEntry eigenstratIndParser = do@@ -169,7 +169,7 @@ writeEigenstratSnp snpFileH =     let snpOutTextConsumer = PB.toHandle snpFileH         toTextPipe = P.map (\(EigenstratSnpEntry chrom pos gpos gid ref alt) ->-            let snpLine = B.intercalate "\t" [gid, B.pack (unChrom chrom), B.pack (show gpos),+            let snpLine = B.intercalate "\t" [gid, unChrom chrom, B.pack (show gpos),                     B.pack (show pos), B.singleton ref, B.singleton alt]             in  snpLine <> "\n")     in  toTextPipe >-> snpOutTextConsumer@@ -180,7 +180,7 @@ writeBim snpFileH =     let snpOutTextConsumer = PB.toHandle snpFileH         toTextPipe = P.map (\(EigenstratSnpEntry chrom pos gpos gid ref alt) ->-            B.intercalate "\t" [B.pack (unChrom chrom), gid, B.pack (show gpos), B.pack (show pos), B.singleton ref, B.singleton alt])+            B.intercalate "\t" [unChrom chrom, gid, B.pack (show gpos), B.pack (show pos), B.singleton ref, B.singleton alt])     in  toTextPipe >-> snpOutTextConsumer  -- |Function to write an Eigentrat Geno File. Returns a consumer expecting Eigenstrat Genolines.

@@ -31,7 +31,7 @@   where     go prod = do         (chrom_, prod') <- readNextFastaEntry prod-        hPutStr stderr ("found chromosome " <> unChrom chrom_)+        hPutStr stderr ("found chromosome " <> show chrom_)         if chrom_ == chrom         then return (void prod')         else do@@ -63,4 +63,4 @@     A.skipSpace     A.skipWhile (\c -> c /= '\n' && c /= '\r')     A.endOfLine-    return . Chrom . B.unpack $ chrom+    return . Chrom $ chrom

@@ -27,7 +27,7 @@  -- |A Datatype representing the Header data FreqSumHeader = FreqSumHeader {-    fshNames :: [B.ByteString], -- ^A list of individual or group names+    fshNames :: [String], -- ^A list of individual or group names     fshCounts :: [Int] -- ^A list of haplotype counts per individual/group. } deriving (Eq, Show) @@ -35,13 +35,14 @@ freqSumHeaderToText (FreqSumHeader names nCounts) =     "#CHROM\tPOS\tREF\tALT\t" <> B.intercalate "\t" tuples <> "\n"   where-    tuples = zipWith (\n c -> n <> "(" <> B.pack (show c) <> ")") names nCounts+    tuples = zipWith (\n c -> B.pack n <> "(" <> B.pack (show c) <> ")") names nCounts  -- |A Datatype to denote a single freqSum line data FreqSumEntry = FreqSumEntry {     fsChrom  :: Chrom, -- ^The chromosome of the site     fsPos    :: Int, -- ^The position of the site-    fsSnpId  :: Maybe String, -- ^An optional parameter to take the snpId. This is not parsed from or printed to freqSum format but is used in internal conversions from Eigenstrat.+    fsSnpId  :: Maybe B.ByteString, -- ^An optional parameter to take the snpId. This is not parsed from or printed to freqSum format but is used in internal conversions from Eigenstrat.+    fsGeneticPos :: Maybe Double, -- ^An optional parameter to take the genetic pos. This is not parsed from or printed to freqSum format but is used in internal conversions from Eigenstrat.     fsRef    :: Char, -- ^The reference allele     fsAlt    :: Char, -- ^The alternative allele     fsCounts :: [Maybe Int] -- ^A list of allele counts in each group. Nothing denotes missing data.@@ -49,8 +50,8 @@  -- |This function converts a single freqSum entry to a printable freqSum line. freqSumEntryToText :: FreqSumEntry -> B.ByteString-freqSumEntryToText (FreqSumEntry chrom pos _ ref alt maybeCounts) =-    B.intercalate "\t" [B.pack (unChrom chrom), B.pack (show pos), B.singleton ref, B.singleton alt, countStr] <> "\n"+freqSumEntryToText (FreqSumEntry chrom pos _ _ ref alt maybeCounts) =+    B.intercalate "\t" [unChrom chrom, B.pack (show pos), B.singleton ref, B.singleton alt, countStr] <> "\n"   where     countStr = B.intercalate "\t" . map (B.pack . show . convertToNum) $ maybeCounts      convertToNum Nothing = -1@@ -79,13 +80,13 @@     tuples <- A.string "#CHROM\tPOS\tREF\tALT\t" >> A.sepBy' tuple A.space <* A.endOfLine     let names = map fst tuples         counts = map snd tuples-    return $ FreqSumHeader names counts+    return $ FreqSumHeader (map B.unpack names) counts   where     tuple = (,) <$> A.takeWhile (\c -> isAlphaNum c || c == '_' || c == '-') <* A.char '(' <*> A.decimal <* A.char ')'  parseFreqSumEntry :: A.Parser FreqSumEntry-parseFreqSumEntry = FreqSumEntry <$> (Chrom . B.unpack <$> A.takeTill isSpace) <* A.skipSpace <*> A.decimal <*-    A.skipSpace <*> pure Nothing <*> base <* A.skipSpace <*> baseOrDot <* A.skipSpace <*> counts <* A.endOfLine+parseFreqSumEntry = FreqSumEntry <$> (Chrom <$> A.takeTill isSpace) <* A.skipSpace <*> A.decimal <*+    A.skipSpace <*> pure Nothing <*> pure Nothing <*> base <* A.skipSpace <*> baseOrDot <* A.skipSpace <*> counts <* A.endOfLine   where     counts = (parseMissing <|> parseCount) `A.sepBy` A.char '\t'     parseMissing = A.string "-1" *> pure Nothing

@@ -50,18 +50,17 @@     A.endOfLine     let baseStrings = map fst baseAndStrandEntries         strandInfoStrings = map snd baseAndStrandEntries-    let ret = PileupRow (Chrom $ B.unpack chrom) pos refA baseStrings strandInfoStrings+    let ret = PileupRow (Chrom chrom) pos refA baseStrings strandInfoStrings     --trace (show ret) $ return ret     return ret   where     parsePileupPerSample refA =-        processPileupEntry refA <$> A.decimal <* A.space <*> (B.unpack <$> word) <*-            A.space <* word+        processPileupEntry refA <$> A.decimal <* A.space <*> word <* A.space <* word -processPileupEntry :: Char -> Int -> String -> (String, [Strand])+processPileupEntry :: Char -> Int -> B.ByteString -> (String, [Strand]) processPileupEntry refA cov readBaseString =     if cov == 0 then ("", []) else-        let res = go readBaseString+        let res = go (B.unpack readBaseString)         in  (map fst res, map snd res)   where     go (x:xs)

@@ -26,7 +26,7 @@  -- |A datatype to represent an Allele Sharing Histogram: data RareAlleleHistogram = RareAlleleHistogram {-    raNames :: [B.ByteString], -- ^A list of branch names+    raNames :: [String], -- ^A list of branch names     raNVec :: [Int], -- ^A list of haploid sample sizes.     raMinAf :: Int, -- ^The minimum allele count     raMaxAf :: Int, -- ^The maximum allele count@@ -56,7 +56,7 @@         null (raConditionOn hist)     assertErr "can only print histogram with no exclude pattern due to format-legacy" $         null (raExcludePatterns hist)-    let head0 = "NAMES=" <> (B.intercalate "," . raNames $ hist)+    let head0 = "NAMES=" <> (B.intercalate "," . map B.pack . raNames $ hist)         head1 = "N=" <> (B.pack . intercalate "," . map show . raNVec $ hist)         head2 = "MAX_M=" <> (B.pack . show . raMaxAf $ hist)         head3 = "TOTAL_SITES=" <> (B.pack . show . raTotalNrSites $ hist)@@ -111,7 +111,7 @@             (_, _, Just _) -> Just . Map.fromList $ [(k, (jkMean, jkSE)) |                                                      (k, _, Just (jkMean, jkSE)) <- body]             _ -> Nothing-    return $ RareAlleleHistogram names nVec 1 maxM [][] totalNrSites countHist jkHist+    return $ RareAlleleHistogram (map B.unpack names) nVec 1 maxM [][] totalNrSites countHist jkHist   where     parseNames = A.string "NAMES=" *> name `A.sepBy1` A.char ',' <* A.endOfLine     name = A.takeWhile1 (\c -> isAlphaNum c || c == '_' || c == '-')

@@ -28,11 +28,11 @@ instance Exception SeqFormatException  -- |A wrapper datatype for Chromosome names.-newtype Chrom = Chrom {unChrom :: String} deriving (Eq)+newtype Chrom = Chrom {unChrom :: B.ByteString} deriving (Eq)  -- |Show instance for Chrom instance Show Chrom where-    show (Chrom c) = show c+    show (Chrom c) = B.unpack c  -- |Ord instance for Chrom instance Ord Chrom where@@ -40,17 +40,19 @@         let [c1NoChr, c2NoChr] = map removeChr [c1, c2]             [c1XYMTconvert, c2XYMTconvert] = map convertXYMT [c1NoChr, c2NoChr]         in  case (,) <$> readChrom c1XYMTconvert <*> readChrom c2XYMTconvert of-                Left e -> throw $ SeqFormatException e+                Left e -> throw e                 Right (cn1, cn2) -> cn1 `compare` cn2       where-        removeChr c = if take 3 c == "chr" then drop 3 c else c+        removeChr :: B.ByteString -> B.ByteString+        removeChr c = if B.take 3 c == "chr" then B.drop 3 c else c+        convertXYMT :: B.ByteString -> B.ByteString         convertXYMT c = case c of             "X"  -> "23"             "Y"  -> "24"             "MT" -> "90"             n    -> n-        readChrom :: String -> Either String Int-        readChrom c = readErr ("cannot parse chromosome " ++ c) $ c+        readChrom :: B.ByteString -> Either SeqFormatException Int+        readChrom c = readErr (SeqFormatException $ "cannot parse chromosome " ++ B.unpack c) . B.unpack $ c  -- |A function to help with reporting parsing errors to stderr. Returns a clean Producer over the  -- parsed datatype.

@@ -91,11 +91,11 @@ vcfEntryParser :: A.Parser VCFentry vcfEntryParser = vcfEntryParserFull <|> vcfEntryParserTruncated   where-    vcfEntryParserFull = VCFentry <$> (Chrom . B.unpack <$> word) <* sp <*> A.decimal <* sp <*> parseId <*+    vcfEntryParserFull = VCFentry <$> (Chrom <$> word) <* sp <*> A.decimal <* sp <*> parseId <*         sp <*> word <* sp <*> parseAlternativeAlleles <* sp <*> A.double <* sp <*> parseFilter <*          sp <*> parseInfoFields <* sp <*> parseFormatStrings <* sp <*> parseGenotypeInfos <*          A.endOfLine-    vcfEntryParserTruncated = VCFentry <$> (Chrom . B.unpack <$> word) <* sp <*> A.decimal <* sp <*> parseId <*+    vcfEntryParserTruncated = VCFentry <$> (Chrom <$> word) <* sp <*> A.decimal <* sp <*> parseId <*         sp <*> word <* sp <*> parseAlternativeAlleles <* sp <*> A.double <* sp <*> parseFilter <*         sp <*> parseInfoFields <*> pure [] <*> pure [] <* A.endOfLine     sp = A.satisfy (\c -> c == ' ' || c == '\t')@@ -161,5 +161,5 @@     let alt = B.head . head . vcfAlt $ vcfEntry     assertErr "Invalid Reference Allele" $ ref `elem` ['A', 'C', 'T', 'G', 'N']     assertErr "Invalid Alternative Allele" $ alt `elem` ['A', 'C', 'T', 'G', '.']-    return $ FreqSumEntry (vcfChrom vcfEntry) (vcfPos vcfEntry) (B.unpack <$> vcfId vcfEntry) ref alt dosages+    return $ FreqSumEntry (vcfChrom vcfEntry) (vcfPos vcfEntry) (vcfId vcfEntry) Nothing ref alt dosages     

@@ -49,11 +49,11 @@  mockDatFsEntries :: [FreqSumEntry] mockDatFsEntries = [-    FreqSumEntry (Chrom "11") 0      Nothing 'A' 'C' [Just 1, Just 1,  Just 1, Just 1,  Just 1],-    FreqSumEntry (Chrom "11") 100000 Nothing 'A' 'G' [Just 2, Just 1,  Just 0, Just 0,  Just 0],-    FreqSumEntry (Chrom "11") 200000 Nothing 'A' 'T' [Just 0, Just 1,  Just 1, Just 1,  Just 1],-    FreqSumEntry (Chrom "11") 300000 Nothing 'C' 'A' [Just 2, Nothing, Just 1, Just 0,  Just 0],-    FreqSumEntry (Chrom "11") 400000 Nothing 'G' 'A' [Just 0, Just 1,  Just 1, Just 1,  Just 1],-    FreqSumEntry (Chrom "11") 500000 Nothing 'T' 'A' [Just 2, Just 2,  Just 1, Nothing, Just 1],-    FreqSumEntry (Chrom "11") 600000 Nothing 'G' 'T' [Just 0, Just 0,  Just 1, Nothing, Nothing]]+    FreqSumEntry (Chrom "11") 0      Nothing Nothing 'A' 'C' [Just 1, Just 1,  Just 1, Just 1,  Just 1],+    FreqSumEntry (Chrom "11") 100000 Nothing Nothing 'A' 'G' [Just 2, Just 1,  Just 0, Just 0,  Just 0],+    FreqSumEntry (Chrom "11") 200000 Nothing Nothing 'A' 'T' [Just 0, Just 1,  Just 1, Just 1,  Just 1],+    FreqSumEntry (Chrom "11") 300000 Nothing Nothing 'C' 'A' [Just 2, Nothing, Just 1, Just 0,  Just 0],+    FreqSumEntry (Chrom "11") 400000 Nothing Nothing 'G' 'A' [Just 0, Just 1,  Just 1, Just 1,  Just 1],+    FreqSumEntry (Chrom "11") 500000 Nothing Nothing 'T' 'A' [Just 2, Just 2,  Just 1, Nothing, Just 1],+    FreqSumEntry (Chrom "11") 600000 Nothing Nothing 'G' 'T' [Just 0, Just 0,  Just 1, Nothing, Nothing]] 

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module SequenceFormats.PileupSpec (spec) where  import SequenceFormats.Pileup (readPileupFromFile, PileupRow(..), Strand(..))

@@ -74,7 +74,7 @@ testVcfToFreqsumEntry :: Spec testVcfToFreqsumEntry = describe "vcfToFreqsumEntry" $     it "should convert correctly" $ do-        let r = Right (FreqSumEntry (Chrom "1") 10492 (Just "testId") 'C' 'T' [Just 0, Just 0, Just 1, Just 0, Just 0])+        let r = Right (FreqSumEntry (Chrom "1") 10492 (Just "testId") Nothing 'C' 'T' [Just 0, Just 0, Just 1, Just 0, Just 0])         vcfToFreqSumEntry vcf1 `shouldBe` r  testIsBiallelicSnp :: Spec