diff --git a/fasta.cabal b/fasta.cabal --- a/fasta.cabal +++ b/fasta.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.6.1.1 +version: 0.6.2.0 -- A short (one-line) description of the package. synopsis: A simple, mindless parser for fasta files. @@ -58,7 +58,15 @@ Data.Fasta.Text.Lazy, Data.Fasta.Text.Lazy.Types, Data.Fasta.Text.Lazy.Parse, - Data.Fasta.Text.Lazy.Translation + Data.Fasta.Text.Lazy.Translation, + Data.Fasta.ByteString, + Data.Fasta.ByteString.Types, + Data.Fasta.ByteString.Parse, + Data.Fasta.ByteString.Translation, + Data.Fasta.ByteString.Lazy, + Data.Fasta.ByteString.Lazy.Types, + Data.Fasta.ByteString.Lazy.Parse, + Data.Fasta.ByteString.Lazy.Translation -- Modules included in this library but not exported. -- other-modules: @@ -67,11 +75,13 @@ build-depends: base >=4.6 && <4.9, parsec >=3.1 && <4.0, text >=1.1.0 && <1.4, + bytestring >=0.10 && <0.11, containers >= 0.5 && <0.6, split >= 0.2 && <0.3, pipes >= 4.1 && < 4.2, pipes-group >= 1.0 && < 1.1, pipes-text >= 0.0 && < 0.1, + pipes-bytestring >= 2.1 && < 2.2, lens >= 4.9 && < 4.10, foldl >= 1.0 && < 1.1 diff --git a/src/Data/Fasta/ByteString.hs b/src/Data/Fasta/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString.hs @@ -0,0 +1,14 @@ +-- Data.Fasta.ByteString module. +-- By Gregory W. Schwartz +-- +{- | Collects all application specific functions and types. Used here for Text. +-} + +module Data.Fasta.ByteString ( module Data.Fasta.ByteString.Types + , module Data.Fasta.ByteString.Parse + , module Data.Fasta.ByteString.Translation ) where + +-- Local +import Data.Fasta.ByteString.Types +import Data.Fasta.ByteString.Parse +import Data.Fasta.ByteString.Translation diff --git a/src/Data/Fasta/ByteString/Lazy.hs b/src/Data/Fasta/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString/Lazy.hs @@ -0,0 +1,15 @@ +-- Data.Fasta.Text.Lazy module. +-- By G.W. Schwartz +-- +{- | Collects all application specific functions and types. Used here for +Text.Lazy +-} + +module Data.Fasta.ByteString.Lazy ( module Data.Fasta.ByteString.Lazy.Types + , module Data.Fasta.ByteString.Lazy.Parse + , module Data.Fasta.ByteString.Lazy.Translation ) where + +-- Local +import Data.Fasta.ByteString.Lazy.Types +import Data.Fasta.ByteString.Lazy.Parse +import Data.Fasta.ByteString.Lazy.Translation diff --git a/src/Data/Fasta/ByteString/Lazy/Parse.hs b/src/Data/Fasta/ByteString/Lazy/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString/Lazy/Parse.hs @@ -0,0 +1,135 @@ +-- Parse module. +-- By Gregory W. Schwartz +-- +{- | Collection of functions for the parsing of a fasta file. Uses the lazy +- ByteString type. +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} + +module Data.Fasta.ByteString.Lazy.Parse ( parseFasta + , parseCLIPFasta + , pipesFasta + , removeNs + , removeN + , removeCLIPNs ) where + +-- Built-in +import Data.Char +import Control.Monad (void) +import Text.Parsec +import Text.Parsec.ByteString.Lazy +import qualified Data.Map.Strict as Map +import qualified Data.ByteString.Char8 as SB +import qualified Data.ByteString.Lazy.Char8 as B + +-- Cabal +import Pipes +import qualified Pipes.Prelude as P +import qualified Pipes.ByteString as PB +import qualified Pipes.Group as PG +import Control.Lens (view) +import qualified Control.Foldl as FL + +-- Local +import Data.Fasta.ByteString.Lazy.Types + +eol :: Parsec B.ByteString u String +eol = choice . map (try . string) $ ["\n\r", "\r\n", "\n", "\r"] + +eoe :: Parsec B.ByteString u () +eoe = do + lookAhead (void $ char '>') <|> eof + +fasta :: Parsec B.ByteString u FastaSequence +fasta = do + spaces + char '>' + header <- manyTill (satisfy (/= '>')) eol + fseq <- manyTill anyChar eoe + return (FastaSequence { fastaHeader = B.pack header + , fastaSeq = B.pack + . map toUpper + . removeWhitespace $ fseq } ) + where + removeWhitespace = filter (`notElem` ("\n\r " :: String)) + +fastaFile :: Parsec B.ByteString u [FastaSequence] +fastaFile = do + spaces + many fasta + +fastaCLIP :: Parsec B.ByteString u (FastaSequence, [FastaSequence]) +fastaCLIP = do + spaces + char '>' + germline <- fasta + clones <- many $ try fasta + return (germline, clones) + +fastaCLIPFile :: Parsec B.ByteString u [(FastaSequence, [FastaSequence])] +fastaCLIPFile = do + spaces + many fastaCLIP + +-- | Parse a standard fasta file into lazy text sequences +parseFasta :: B.ByteString -> [FastaSequence] +parseFasta = eToV . parse fastaFile "error" + where + eToV (Right x) = x + eToV (Left x) = error ("Unable to parse fasta file\n" ++ show x) + +-- | Parse a CLIP fasta file into lazy text sequences +parseCLIPFasta :: B.ByteString -> CloneMap +parseCLIPFasta = Map.fromList + . map (\(!x, (!y, !z)) -> ((x, y), z)) + . zip [0..] + . eToV + . parse fastaCLIPFile "error" + where + eToV (Right x) = x + eToV (Left x) = error ("Unable to parse fasta file\n" ++ show x) + +-- | Parse a standard fasta file into strict text sequences for pipes. This is +-- the highly recommeded way of parsing, as it is computationally fast and +-- uses memory based on line length +pipesFasta :: (MonadIO m) + => Producer SB.ByteString m () + -> Producer FastaSequence m () +pipesFasta p = FL.purely + PG.folds + FL.mconcat + ( view (PB.splits (fromIntegral $ ord '>')) + . PB.drop (1 :: Int) + $ p ) + >-> P.map toFasta + where + toFasta x = FastaSequence { fastaHeader = B.fromChunks + . take 1 + . SB.lines + $ x + , fastaSeq = B.fromChunks + . tail + . SB.lines + $ x } + +-- | Remove Ns from a collection of sequences +removeNs :: [FastaSequence] -> [FastaSequence] +removeNs = map (\x -> x { fastaSeq = noN . fastaSeq $ x }) + where + noN = B.map (\y -> if (y /= 'N' && y /= 'n') then y else '-') + +-- | Remove Ns from a sequence +removeN :: FastaSequence -> FastaSequence +removeN x = x { fastaSeq = noN . fastaSeq $ x } + where + noN = B.map (\y -> if (y /= 'N' && y /= 'n') then y else '-') + +-- | Remove Ns from a collection of CLIP fasta sequences +removeCLIPNs :: CloneMap -> CloneMap +removeCLIPNs = Map.fromList . map remove . Map.toList + where + remove ((!x, !y), !z) = ((x, newSeq y), map newSeq z) + newSeq !x = x { fastaSeq = noN . fastaSeq $ x } + noN = B.map (\y -> if (y /= 'N' && y /= 'n') then y else '-') diff --git a/src/Data/Fasta/ByteString/Lazy/Translation.hs b/src/Data/Fasta/ByteString/Lazy/Translation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString/Lazy/Translation.hs @@ -0,0 +1,81 @@ +-- Translation Module +-- By Gregory W. Schwartz + +{- | Collects all functions pertaining to the translation of nucleotides to +amino acids for Lazy ByteString. +-} + +{-# LANGUAGE OverloadedStrings #-} + +module Data.Fasta.ByteString.Lazy.Translation ( codon2aa + , translate ) where + +-- Built in +import Data.Char +import Data.Either +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.Int + +-- Local +import Data.Fasta.ByteString.Lazy.Types + +-- | Lazy ByteString version of chunksOf +chunksOf :: Int64 -> BL.ByteString -> [BL.ByteString] +chunksOf k = go + where + go t = case BL.splitAt k t of + (a,b) | BL.null a -> [] + | otherwise -> a : go b + +-- | Converts a codon to an amino acid +-- Remember, if there is an "N" in that DNA sequence, then it is invalid +codon2aa :: Codon -> Either BL.ByteString BL.ByteString +codon2aa x + | codon `elem` ["GCT", "GCC", "GCA", "GCG"] = Right "A" + | codon `elem` ["CGT", "CGC", "CGA", "CGG", "AGA", "AGG"] = Right "R" + | codon `elem` ["AAT", "AAC"] = Right "N" + | codon `elem` ["GAT", "GAC"] = Right "D" + | codon `elem` ["TGT", "TGC"] = Right "C" + | codon `elem` ["CAA", "CAG"] = Right "Q" + | codon `elem` ["GAA", "GAG"] = Right "E" + | codon `elem` ["GGT", "GGC", "GGA", "GGG"] = Right "G" + | codon `elem` ["CAT", "CAC"] = Right "H" + | codon `elem` ["ATT", "ATC", "ATA"] = Right "I" + | codon `elem` ["ATG"] = Right "M" + | codon `elem` ["TTA", "TTG", "CTT", "CTC", "CTA", "CTG"] = Right "L" + | codon `elem` ["AAA", "AAG"] = Right "K" + | codon `elem` ["TTT", "TTC"] = Right "F" + | codon `elem` ["CCT", "CCC", "CCA", "CCG"] = Right "P" + | codon `elem` ["TCT", "TCC", "TCA", "TCG", "AGT", "AGC"] = Right "S" + | codon `elem` ["ACT", "ACC", "ACA", "ACG"] = Right "T" + | codon `elem` ["TGG"] = Right "W" + | codon `elem` ["TAT", "TAC"] = Right "Y" + | codon `elem` ["GTT", "GTC", "GTA", "GTG"] = Right "V" + | codon `elem` ["TAA", "TGA", "TAG"] = Right "*" + | codon `elem` ["---", "..."] = Right "-" + | codon == "~~~" = Right "-" + | 'N' `BL.elem` codon = Right "-" + | '-' `BL.elem` codon = Right "-" + | '.' `BL.elem` codon = Right "-" + | otherwise = Left errorMsg + where + codon = BL.map toUpper x + errorMsg = BL.append "Unidentified codon: " codon + +-- | Translates a string of nucleotides. Returns a text with the error if the +-- codon is invalid. +translate :: Int64 -> FastaSequence -> Either BL.ByteString FastaSequence +translate pos x + | any isLeft' translation = Left $ head . lefts $ translation + | otherwise = Right $ x { fastaSeq = BL.concat + . rights + $ translation } + where + translation = map codon2aa + . filter ((== 3) . BL.length) + . chunksOf 3 + . BL.drop (pos - 1) + . fastaSeq + $ x + isLeft' (Left _) = True + isLeft' _ = False diff --git a/src/Data/Fasta/ByteString/Lazy/Types.hs b/src/Data/Fasta/ByteString/Lazy/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString/Lazy/Types.hs @@ -0,0 +1,39 @@ +-- Types module. +-- By G.W. Schwartz +-- +{- | Collects all application specific types. Used here for ByteString.Lazy +-} + +{-# LANGUAGE OverloadedStrings #-} + +module Data.Fasta.ByteString.Lazy.Types where + +-- Built-in +import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.Map as M + +-- Algebraic +data FastaSequence = FastaSequence { fastaHeader :: BL.ByteString + , fastaSeq :: BL.ByteString + } deriving (Eq, Ord, Show) + +-- Basic +type Clone = FastaSequence +type Germline = FastaSequence +type Codon = BL.ByteString + +-- Advanced +-- | A clone is a collection of sequences derived from a germline with +-- a specific identifier +type CloneMap = M.Map (Int, Germline) [Clone] + +-- Classes +class ShowFasta a where + showFasta :: a -> BL.ByteString + +-- Instances +instance ShowFasta FastaSequence where + showFasta FastaSequence {fastaHeader = x, fastaSeq = y} = BL.concat [ ">" + , x + , "\n" + , y ] diff --git a/src/Data/Fasta/ByteString/Parse.hs b/src/Data/Fasta/ByteString/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString/Parse.hs @@ -0,0 +1,126 @@ +-- Parse module. +-- By Gregory W. Schwartz +-- +{- | Collection of functions for the parsing of a fasta file. Uses the +- ByteString type. +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} + +module Data.Fasta.ByteString.Parse ( parseFasta + , parseCLIPFasta + , pipesFasta + , removeNs + , removeN + , removeCLIPNs ) where + +-- Built-in +import Data.Char +import Text.Parsec +import Text.Parsec.ByteString +import qualified Data.Map.Strict as Map +import qualified Data.ByteString.Char8 as B + +-- Cabal +import Pipes +import qualified Pipes.Prelude as P +import qualified Pipes.ByteString as PB +import qualified Pipes.Group as PG +import Control.Lens (view) +import qualified Control.Foldl as FL + +-- Local +import Data.Fasta.ByteString.Types + +eol :: Parsec B.ByteString u String +eol = choice . map (try . string) $ ["\n\r", "\r\n", "\n", "\r"] + +eoe :: Parsec B.ByteString u () +eoe = lookAhead (void $ char '>') <|> eof + +fasta :: Parsec B.ByteString u FastaSequence +fasta = do + spaces + char '>' + header <- manyTill (satisfy (/= '>')) eol + fseq <- manyTill anyChar eoe + return (FastaSequence { fastaHeader = B.pack header + , fastaSeq = B.pack + . map toUpper + . removeWhitespace + $ fseq } ) + where + removeWhitespace = filter (`notElem` ("\n\r " :: String)) + +fastaFile :: Parsec B.ByteString u [FastaSequence] +fastaFile = do + spaces + many fasta + +fastaCLIP :: Parsec B.ByteString u (FastaSequence, [FastaSequence]) +fastaCLIP = do + spaces + char '>' + germline <- fasta + clones <- many $ try fasta + return (germline, clones) + +fastaCLIPFile :: Parsec B.ByteString u [(FastaSequence, [FastaSequence])] +fastaCLIPFile = do + spaces + many fastaCLIP + +-- | Parse a standard fasta file into text sequences +parseFasta :: B.ByteString -> [FastaSequence] +parseFasta = eToV . parse fastaFile "error" + where + eToV (Right x) = x + eToV (Left x) = error ("Unable to parse fasta file\n" ++ show x) + +-- | Parse a CLIP fasta file into text sequences +parseCLIPFasta :: B.ByteString -> CloneMap +parseCLIPFasta = Map.fromList + . map (\(!x, (!y, !z)) -> ((x, y), z)) + . zip [0..] + . eToV + . parse fastaCLIPFile "error" + where + eToV (Right x) = x + eToV (Left x) = error ("Unable to parse fasta file\n" ++ show x) + +-- | Parse a standard fasta file into strict text sequences for pipes. This is +-- the highly recommeded way of parsing, as it is computationally fast and +-- uses memory based on line length +pipesFasta :: (MonadIO m) => Producer B.ByteString m () + -> Producer FastaSequence m () +pipesFasta p = FL.purely + PG.folds + FL.mconcat + ( view (PB.splits (fromIntegral $ ord '>')) + . PB.drop (1 :: Int) + $ p ) + >-> P.map toFasta + where + toFasta x = FastaSequence { fastaHeader = head . B.lines $ x + , fastaSeq = B.concat . tail . B.lines $ x } + +-- | Remove Ns from a collection of sequences +removeNs :: [FastaSequence] -> [FastaSequence] +removeNs = map (\x -> x { fastaSeq = noN . fastaSeq $ x }) + where + noN = B.map (\y -> if y /= 'N' && y /= 'n' then y else '-') + +-- | Remove Ns from a sequence +removeN :: FastaSequence -> FastaSequence +removeN x = x { fastaSeq = noN . fastaSeq $ x } + where + noN = B.map (\y -> if y /= 'N' && y /= 'n' then y else '-') + +-- | Remove Ns from a collection of CLIP fasta sequences +removeCLIPNs :: CloneMap -> CloneMap +removeCLIPNs = Map.fromList . map remove . Map.toList + where + remove ((!x, !y), !z) = ((x, newSeq y), map newSeq z) + newSeq !x = x { fastaSeq = noN . fastaSeq $ x } + noN = B.map (\y -> if y /= 'N' && y /= 'n' then y else '-') diff --git a/src/Data/Fasta/ByteString/Translation.hs b/src/Data/Fasta/ByteString/Translation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString/Translation.hs @@ -0,0 +1,80 @@ +-- Translation Module +-- By Gregory W. Schwartz + +{- | Collects all functions pertaining to the translation of nucleotides to +amino acids for ByteStrings +-} + +{-# LANGUAGE OverloadedStrings #-} + +module Data.Fasta.ByteString.Translation ( codon2aa + , translate ) where + +-- Built in +import Data.Char +import Data.Either +import qualified Data.ByteString.Char8 as B + +-- Local +import Data.Fasta.ByteString.Types + +-- | ByteString version of chunksOf +chunksOf :: Int -> B.ByteString -> [B.ByteString] +chunksOf k = go + where + go t = case B.splitAt k t of + (a,b) | B.null a -> [] + | otherwise -> a : go b + +-- | Converts a codon to an amino acid +-- Remember, if there is an "N" in that DNA sequence, then it is invalid +codon2aa :: Codon -> Either B.ByteString B.ByteString +codon2aa x + | codon `elem` ["GCT", "GCC", "GCA", "GCG"] = Right "A" + | codon `elem` ["CGT", "CGC", "CGA", "CGG", "AGA", "AGG"] = Right "R" + | codon `elem` ["AAT", "AAC"] = Right "N" + | codon `elem` ["GAT", "GAC"] = Right "D" + | codon `elem` ["TGT", "TGC"] = Right "C" + | codon `elem` ["CAA", "CAG"] = Right "Q" + | codon `elem` ["GAA", "GAG"] = Right "E" + | codon `elem` ["GGT", "GGC", "GGA", "GGG"] = Right "G" + | codon `elem` ["CAT", "CAC"] = Right "H" + | codon `elem` ["ATT", "ATC", "ATA"] = Right "I" + | codon `elem` ["ATG"] = Right "M" + | codon `elem` ["TTA", "TTG", "CTT", "CTC", "CTA", "CTG"] = Right "L" + | codon `elem` ["AAA", "AAG"] = Right "K" + | codon `elem` ["TTT", "TTC"] = Right "F" + | codon `elem` ["CCT", "CCC", "CCA", "CCG"] = Right "P" + | codon `elem` ["TCT", "TCC", "TCA", "TCG", "AGT", "AGC"] = Right "S" + | codon `elem` ["ACT", "ACC", "ACA", "ACG"] = Right "T" + | codon `elem` ["TGG"] = Right "W" + | codon `elem` ["TAT", "TAC"] = Right "Y" + | codon `elem` ["GTT", "GTC", "GTA", "GTG"] = Right "V" + | codon `elem` ["TAA", "TGA", "TAG"] = Right "*" + | codon `elem` ["---", "..."] = Right "-" + | codon == "~~~" = Right "-" + | "N" `B.isInfixOf` codon = Right "-" + | "-" `B.isInfixOf` codon = Right "-" + | "." `B.isInfixOf` codon = Right "-" + | otherwise = Left errorMsg + where + codon = B.map toUpper x + errorMsg = B.append "Unidentified codon: " codon + +-- | Translates a string of nucleotides. Returns a text with the error if the +-- codon is invalid. +translate :: Int -> FastaSequence -> Either B.ByteString FastaSequence +translate pos x + | any isLeft' translation = Left $ head . lefts $ translation + | otherwise = Right $ x { fastaSeq = B.concat + . rights + $ translation } + where + translation = map codon2aa + . filter ((== 3) . B.length) + . chunksOf 3 + . B.drop (pos - 1) + . fastaSeq + $ x + isLeft' (Left _) = True + isLeft' _ = False diff --git a/src/Data/Fasta/ByteString/Types.hs b/src/Data/Fasta/ByteString/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Fasta/ByteString/Types.hs @@ -0,0 +1,39 @@ +-- Types module. +-- By Gregory W. Schwartz +-- +{- | Collects all application specific types. Used here for Text. +-} + +{-# LANGUAGE OverloadedStrings #-} + +module Data.Fasta.ByteString.Types where + +-- Built-in +import qualified Data.ByteString.Char8 as B +import qualified Data.Map as M + +-- Algebraic +data FastaSequence = FastaSequence { fastaHeader :: B.ByteString + , fastaSeq :: B.ByteString + } deriving (Eq, Ord, Show) + +-- Basic +type Clone = FastaSequence +type Germline = FastaSequence +type Codon = B.ByteString + +-- Advanced +-- | A clone is a collection of sequences derived from a germline with +-- a specific identifier +type CloneMap = M.Map (Int, Germline) [Clone] + +-- Classes +class ShowFasta a where + showFasta :: a -> B.ByteString + +-- Instances +instance ShowFasta FastaSequence where + showFasta FastaSequence {fastaHeader = x, fastaSeq = y} = B.concat [ ">" + , x + , "\n" + , y ]