diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,39 @@ ## [Unreleased] +## [0.1.4.2] - 2021-10-14 +### Changed +- More types of multiline properties are supported. + +## [0.1.4.1] - 2021-10-07 +### Changed +- CI fix + +## [0.1.4.0] - 2021-09-27 +### Changed +- Redesigned the Range type to reflect all possible cases. +- Switched to Megaparsec. + +## [0.1.3.25] - 2021-09-15 +### Added +- Pedantic build and CI + +## [0.1.3.24] - 2021-09-10 +### Changed +- GB parser made more verbose. + +## [0.1.3.23] - 2021-07-06 +### Added +Added ASN hydrogen names sometimes set by Scho + +## [0.1.3.22] - 2021-07-06 +### Changed +- `*` -> `Type` for GHC-9. + +## [0.1.3.21] - 2021-07-03 +### Changed +- Update dependency versions. + ## [0.1.3.20] - 2021-06-04 ### Changed - YLAB2-629: Fasta parser is now able to parse empty lines in the beginning. diff --git a/cobot-io.cabal b/cobot-io.cabal --- a/cobot-io.cabal +++ b/cobot-io.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: cobot-io -version: 0.1.3.20 +version: 0.1.4.2 synopsis: Biological data file formats and IO description: Please see the README on GitHub at category: Bio @@ -61,6 +61,7 @@ Bio.Sequence.Functions.Marking Bio.Sequence.Functions.Sequence Bio.Sequence.Functions.Weight + Bio.Sequence.Range Bio.Sequence.Utilities Bio.Structure Bio.Structure.Functions @@ -93,18 +94,21 @@ FlexibleContexts build-depends: array ==0.5.* - , attoparsec >=0.10 && <0.14 - , base >=4.7 && <5 + , attoparsec >=0.10 && <0.15 + , base >=4.14 && <5 , binary >=0.8.3.0 && <1.0 , bytestring >=0.10.8.1 && <0.11 + , cobot >=0.1.1.7 , containers >=0.5.7.1 && <0.7 , data-msgpack >=0.0.9 && <0.1 , deepseq ==1.4.* , http-conduit ==2.3.* - , hyraxAbif >=0.2.3.15 && <0.2.4.0 - , lens >=4.16 && <5.0 + , hyraxAbif >=0.2.3.27 && <0.2.4.0 + , lens >=4.16 && <5.1 , linear >=1.20 && <1.22 + , megaparsec >=9.0.1 , mtl >=2.2.1 && <2.3.0 + , parser-combinators >=1.2.1 , split , text >=1.2.2.1 && <1.3 , vector @@ -126,6 +130,7 @@ PDBParserSpec PDBSpec PDBWriterSpec + RangeSpec SequenceSpec StructureSpec UniprotSpec @@ -139,22 +144,25 @@ build-depends: QuickCheck >=2.9.2 && <2.15 , array ==0.5.* - , attoparsec >=0.10 && <0.14 - , base >=4.7 && <5 + , attoparsec >=0.10 && <0.15 + , base >=4.14 && <5 , binary >=0.8.3.0 && <1.0 , bytestring >=0.10.8.1 && <0.11 + , cobot >=0.1.1.7 , cobot-io , containers >=0.5.7.1 && <0.7 , data-msgpack >=0.0.9 && <0.1 , deepseq ==1.4.* , directory - , hspec >=2.4.1 && <2.8 + , hspec >=2.4.1 && <2.9 , http-conduit ==2.3.* - , hyraxAbif >=0.2.3.15 && <0.2.4.0 - , lens >=4.16 && <5.0 + , hyraxAbif >=0.2.3.27 && <0.2.4.0 + , lens >=4.16 && <5.1 , linear + , megaparsec >=9.0.1 , mtl >=2.2.1 && <2.3.0 , neat-interpolation >=0.3 + , parser-combinators >=1.2.1 , split , text >=1.2.2.1 && <1.3 , vector diff --git a/src/Bio/GB.hs b/src/Bio/GB.hs --- a/src/Bio/GB.hs +++ b/src/Bio/GB.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - module Bio.GB ( module T , fromFile @@ -13,19 +11,15 @@ import Bio.GB.Type as T import Bio.GB.Writer (genBankToText) import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Attoparsec.Text (parseOnly) import Data.Bifunctor (first) import Data.Text (Text, pack) import qualified Data.Text.IO as TIO (readFile, writeFile) -#if !MIN_VERSION_base(4,13,0) -import Control.Monad.Fail (MonadFail(..)) -import Prelude hiding (fail) -#endif +import Text.Megaparsec (eof, errorBundlePretty, parse) -- | Reads 'GenBankSequence' from givem file. -- fromFile :: (MonadFail m, MonadIO m) => FilePath -> m GenBankSequence -fromFile f = liftIO (TIO.readFile f) >>= either fail pure . parseOnly genBankP +fromFile f = liftIO (TIO.readFile f) >>= either (fail . errorBundlePretty) pure . parse (genBankP <* eof) "" -- | Writes 'GenBankSequence' to file. -- @@ -35,7 +29,7 @@ -- | Reads 'GenBankSequence' from 'Text'. -- fromText :: Text -> Either Text GenBankSequence -fromText = first pack . parseOnly genBankP +fromText = first (pack . errorBundlePretty) . parse (genBankP <* eof) "" -- | Writes 'GenBankSequence' to 'Text'. -- diff --git a/src/Bio/GB/Parser.hs b/src/Bio/GB/Parser.hs --- a/src/Bio/GB/Parser.hs +++ b/src/Bio/GB/Parser.hs @@ -2,28 +2,31 @@ module Bio.GB.Parser ( genBankP + , rangeP ) where -import Bio.GB.Type (Feature (..), Form (..), GenBankSequence (..), Locus (..), - Meta (..), Reference (..), Source (..), Version (..)) -import Bio.Sequence (MarkedSequence, Range, markedSequence) -import Control.Applicative ((<|>)) -import Data.Attoparsec.Combinator (manyTill) -import Data.Attoparsec.Text (Parser, char, decimal, digit, endOfInput, endOfLine, letter, - many', many1', satisfy, string, takeWhile, takeWhile1) -import Data.Bifunctor (bimap) -import Data.Char (isAlphaNum, isSpace, isUpper) -import Data.Functor (($>)) -import Data.Text (Text, intercalate, pack, splitOn, unpack) -import Prelude hiding (takeWhile) +import Bio.GB.Type (Feature (..), Form (..), GenBankSequence (..), + Locus (..), Meta (..), Parser, Reference (..), + Source (..), Version (..)) +import Bio.Sequence (Border (..), MarkedSequence, Range (..), + RangeBorder (..), markedSequence, shiftRange) +import Control.Monad.Combinators (many, manyTill, optional, some, (<|>)) +import Data.Char (isAlphaNum, isSpace, isUpper) +import Data.Functor (($>)) +import Data.Text (Text, intercalate, pack, splitOn, unpack) +import qualified Data.Text as T +import Text.Megaparsec (notFollowedBy, option, satisfy, sepBy1, takeWhile1P, + takeWhileP, try, ()) +import Text.Megaparsec.Char (char, digitChar, eol, letterChar, string) +import Text.Megaparsec.Char.Lexer (decimal) -- | Parser of .gb file. -- genBankP :: Parser GenBankSequence genBankP = GenBankSequence - <$> metaP - <*> gbSeqP - <* string "//" <* eolSpaceP <* endOfInput + <$> (metaP "Meta parser") + <*> (gbSeqP "GB sequence parser") + <* string "//" <* eolSpaceP -------------------------------------------------------------------------------- -- Block with meta-information. @@ -31,15 +34,15 @@ metaP :: Parser Meta metaP = do - locus' <- locusP + locus' <- locusP "Locus parser" - definitionM <- wrapMP definitionP - accessionM <- wrapMP accessionP - versionM <- wrapMP versionP - keywordsM <- wrapMP keywordsP - sourceM <- wrapMP sourceP - referencesL <- many' referenceP - commentsL <- many' commentP + definitionM <- optional definitionP "Definition parser" + accessionM <- optional accessionP "Accession parser" + versionM <- optional versionP "Version parser" + keywordsM <- optional keywordsP "Keywords parser" + sourceM <- optional sourceP "Source parser" + referencesL <- many referenceP "References parser" + commentsL <- many commentP "Comments parser" pure $ Meta locus' definitionM accessionM versionM keywordsM sourceM referencesL commentsL @@ -48,43 +51,43 @@ <$> textP <* space -- name <*> decimal <* space <* string "bp" <* space -- sequence length <*> textP <* space -- molecule type - <*> wrapMP formP <* space -- form of sequence - <*> wrapMP (pack <$> many1' (satisfy isUpper)) <* space -- GenBank division + <*> optional formP <* space -- form of sequence + <*> optional (pack <$> some (satisfy isUpper)) <* space -- GenBank division <*> textP -- modification date <* eolSpaceP) where - textP = takeWhile1 $ not . isSpace + textP = takeWhile1P Nothing $ not . isSpace formP :: Parser Form - formP = (string "linear" $> Linear) <|> (string "circular" $> Circular) + formP = try (string "linear" $> Linear) <|> (string "circular" $> Circular) definitionP :: Parser Text -definitionP = string "DEFINITION" *> space *> (emptyP <|> someLinesP) +definitionP = string "DEFINITION" *> space *> (try emptyP <|> someLinesP) accessionP :: Parser Text -accessionP = string "ACCESSION" *> space *> (emptyP <|> (pack - <$> many1' (alphaNumChar <|> char '_') +accessionP = string "ACCESSION" *> space *> (try emptyP <|> (pack + <$> some (try alphaNumChar <|> char '_') <* eolSpaceP)) versionP :: Parser Version versionP = string "VERSION" *> space *> ((Version <$> emptyP <*> pure Nothing) <|> (Version - <$> (pack <$> many1' versionP') - <*> wrapMP (pack <$> (space *> string "GI:" *> many1' versionP')) + <$> (pack <$> some versionP') + <*> optional (pack <$> (space *> string "GI:" *> some versionP')) <* eolSpaceP)) where - versionP' = alphaNumChar <|> char '_' <|> char '.' + versionP' = try alphaNumChar <|> try (char '_') <|> char '.' keywordsP :: Parser Text keywordsP = string "KEYWORDS" - *> (emptyP + *> (try emptyP <|> (space *> textWithSpacesP <* eolSpaceP)) sourceP :: Parser Source sourceP = string "SOURCE" *> space *> (Source <$> someLinesP - <*> wrapMP organismP) + <*> optional organismP) where organismP = string " ORGANISM" *> space *> someLinesP @@ -92,13 +95,13 @@ referenceP = string "REFERENCE" *> space *> (((\x -> Reference x Nothing Nothing Nothing Nothing) <$> emptyP) <|> (Reference <$> someLinesP - <*> wrapMP (string " AUTHORS" *> space *> someLinesP) - <*> wrapMP (string " TITLE" *> space *> someLinesP) - <*> wrapMP (string " JOURNAL" *> space *> someLinesP) - <*> wrapMP (string " PUBMED" *> space *> someLinesP))) + <*> optional (string " AUTHORS" *> space *> someLinesP) + <*> optional (string " TITLE" *> space *> someLinesP) + <*> optional (string " JOURNAL" *> space *> someLinesP) + <*> optional (string " PUBMED" *> space *> someLinesP))) commentP :: Parser Text -commentP = string "COMMENT" *> (emptyP <|> (many' (char ' ') *> someLinesP)) +commentP = string "COMMENT" *> (try emptyP <|> (many (char ' ') *> someLinesP)) -------------------------------------------------------------------------------- -- Block with FEATURES table. @@ -108,42 +111,85 @@ featuresP = -- skip unknown fields and stop on line with "FEATURES" manyTill (textWithSpacesP <* eolSpaceP) (string "FEATURES") *> space *> textWithSpacesP <* eolSpaceP - *> many1' featureP + *> some (featureP "Single feature parser") featureP :: Parser (Feature, Range) featureP = do _ <- string featureIndent1 - featureName' <- takeWhile (not . isSpace) <* space - (strand53, range) <- rangeP <* eolSpaceP + featureName' <- takeWhileP Nothing (not . isSpace) <* space + range <- rangeP <* eolSpaceP - props <- many1' propsP + props <- some propsP - pure (Feature featureName' strand53 props, range) + -- Ranges are 1-based, but the underlying Vector in the Feature is 0-based. + -- We shift the range left so the numberings match. + -- + pure (Feature featureName' props, shiftRange (-1) range) -rangeP :: Parser (Bool, Range) -rangeP = (string "complement(" *> rP False <* char ')') <|> rP True +rangeP :: Parser Range +rangeP = try spanP + <|> try betweenP + <|> try pointP + <|> try joinP + <|> complementP where - rP :: Bool -> Parser (Bool, Range) - rP b = fmap (bimap pred id) - <$> (,) b - <$> (((,) <$> decimal <* string ".." <*> decimal) <|> ((\x -> (x, x)) <$> decimal)) + spanP :: Parser Range + spanP = do + lowerBorderType <- option Precise (try $ char '<' *> pure Exceeded) + lowerBorderLocation <- decimal + _ <- string ".." + upperBorderType <- option Precise (try $ char '>' *> pure Exceeded) + upperBorderLocation <- decimal + pure $ Span (RangeBorder lowerBorderType lowerBorderLocation) (RangeBorder upperBorderType upperBorderLocation) + + betweenP :: Parser Range + betweenP = do + before <- decimal + _ <- char '^' + after <- decimal + pure $ Between before after + pointP :: Parser Range + pointP = fmap Point decimal + + joinP :: Parser Range + joinP = string "join(" *> fmap Join (rangeP `sepBy1` char ',') <* char ')' + + complementP :: Parser Range + complementP = fmap Complement $ string "complement(" *> rangeP <* char ')' + + propsP :: Parser (Text, Text) propsP = do _ <- string featureIndent2 _ <- char '/' - propName <- takeWhile1 (/= '=') + propName <- takeWhile1P Nothing (/= '=') _ <- char '=' - propText <- ((char '\"' *> takeWhile1 (/= '\"') <* char '\"') - <|> textWithSpacesP) - <* eolSpaceP + propText <- try ((char '\"' *> takeWhile1P Nothing (/= '\"') <* char '\"' <* eolSpaceP) + <|> multiLineProp) let propTextCorrect = mconcat $ filter (/= featureIndent2) $ splitOn featureIndent2 propText pure (propName, propTextCorrect) + where + indLine :: Parser Text + indLine = do + _ <- string featureIndent2 + notFollowedBy (char '/') + text <- textWithSpacesP + eolSpaceP + pure text + multiLineProp :: Parser Text + multiLineProp = do + fstText <- textWithSpacesP <* eolSpaceP + rest <- many (try indLine) + pure $ T.concat (fstText : rest) + + + -- | First level of identation in FEATURES table file. -- featureIndent1 :: Text @@ -159,10 +205,10 @@ -------------------------------------------------------------------------------- originP :: Parser String -originP = string "ORIGIN" *> eolSpaceP +originP = (string "ORIGIN" "String ORIGIN") *> eolSpaceP *> pure toText - <*> many1' (space *> many1' digit *> space1 - *> many1' (many1' letter <* (space1 <|> eolSpaceP))) + <*> some (space *> some digitChar *> space1 + *> some (some letterChar <* (try space1 <|> eolSpaceP))) where toText :: [[String]] -> String toText = concat . fmap concat @@ -172,9 +218,17 @@ -------------------------------------------------------------------------------- gbSeqP :: Parser (MarkedSequence Feature Char) gbSeqP = do - features <- featuresP - origin <- originP + features <- (featuresP "Features parser") + -- An extract from the GB specification (https://www.ncbi.nlm.nih.gov/genbank/release/current/): + -- NOTE: The BASE COUNT linetype is obsolete and was removed + -- from the GenBank flatfile format in October 2003. + -- Anyway, here, in 2021, we still might get plasmids with the BASE COUNT line present. + -- + _ <- optional $ try (string "BASE COUNT" *> textWithSpacesP *> eol) + + origin <- (originP "Origin parser") + either (fail . unpack) pure (markedSequence origin features) -------------------------------------------------------------------------------- @@ -187,29 +241,26 @@ firstIndent = pack $ replicate 12 ' ' eolSpaceP :: Parser () -eolSpaceP = () <$ many' (char ' ') <* endOfLine +eolSpaceP = () <$ many (char ' ') <* eol emptyP :: Parser Text -emptyP = many' (char ' ') *> char '.' *> eolSpaceP *> pure "." +emptyP = many (char ' ') *> char '.' *> eolSpaceP *> pure "." textWithSpacesP :: Parser Text -textWithSpacesP = takeWhile (`notElem` ['\n', '\r']) +textWithSpacesP = takeWhileP Nothing (`notElem` ['\n', '\r']) someLinesP :: Parser Text someLinesP = intercalate "\n" <$> someLinesIndentP firstIndent someLinesIndentP :: Text -> Parser [Text] someLinesIndentP indent = (:) <$> textWithSpacesP <* eolSpaceP - <*> (many' (string indent *> textWithSpacesP <* eolSpaceP)) - -wrapMP :: Parser a -> Parser (Maybe a) -wrapMP p = fmap Just p <|> pure Nothing + <*> (many (string indent *> textWithSpacesP <* eolSpaceP)) space :: Parser () -space = () <$ (many' $ satisfy isSpace) +space = () <$ (many $ satisfy isSpace) space1 :: Parser () -space1 = () <$ (many1' $ satisfy isSpace) +space1 = () <$ (some $ satisfy isSpace) alphaNumChar :: Parser Char alphaNumChar = satisfy isAlphaNum diff --git a/src/Bio/GB/Type.hs b/src/Bio/GB/Type.hs --- a/src/Bio/GB/Type.hs +++ b/src/Bio/GB/Type.hs @@ -7,18 +7,29 @@ , Source (..) , Reference (..) , Feature (..) + , Parser ) where -import Bio.Sequence (IsMarking, MarkedSequence) -import Data.Text (Text) +import Bio.Sequence (IsMarking, MarkedSequence) +import Control.DeepSeq (NFData) +import Data.Text (Text) +import Data.Void (Void) +import GHC.Generics (Generic) +import Text.Megaparsec (Parsec) +type Parser = Parsec Void Text + -- | Type that represents contents of .gb file that is used to store information about -- genetic constructions. -- -data GenBankSequence = GenBankSequence { meta :: Meta -- ^ meta-information about the sequence - , gbSeq :: MarkedSequence Feature Char -- ^ sequence that is marked by 'Feature's - } - deriving (Eq, Show) +data GenBankSequence + = GenBankSequence + { meta :: Meta + -- ^ meta-information about the sequence + , gbSeq :: MarkedSequence Feature Char + -- ^ sequence that is marked by 'Feature's + } + deriving (Eq, Show, Generic, NFData) -------------------------------------------------------------------------------- -- Block with meta-information. @@ -26,60 +37,95 @@ -- | Meta-information about sequence. -- -data Meta = Meta { locus :: Locus -- ^ general info about sequence - , definition :: Maybe Text -- ^ brief description of sequence - , accession :: Maybe Text -- ^ the unique identifier for a sequence record - , version :: Maybe Version -- ^ id of sequence in GenBank database - , keywords :: Maybe Text -- ^ word or phrase describing the sequence - , source :: Maybe Source -- ^ free-format information including an abbreviated form of the organism name, - -- sometimes followed by a molecule type - , references :: [Reference] -- ^ publications by the authors of the sequence that discuss the data reported in the record - , comments :: [Text] -- ^ comments about the sequence (note that there can be (!!!) empty comments) - } - deriving (Eq, Show) +data Meta + = Meta + { locus :: Locus + -- ^ general info about sequence + , definition :: Maybe Text + -- ^ brief description of sequence + , accession :: Maybe Text + -- ^ the unique identifier for a sequence record + , version :: Maybe Version + -- ^ id of sequence in GenBank database + , keywords :: Maybe Text + -- ^ word or phrase describing the sequence + , source :: Maybe Source + -- ^ free-format information including an abbreviated form of the organism name, + -- sometimes followed by a molecule type + , references :: [Reference] + -- ^ publications by the authors of the sequence that discuss the data reported in the record + , comments :: [Text] + -- ^ comments about the sequence (note that there can be (!!!) empty comments) + } + deriving (Eq, Show, Generic, NFData) -- | First line that should be present in every .gb file. Contains general info about sequence. -- -data Locus = Locus { name :: Text -- ^ name of sequence - , len :: Int -- ^ length of sequence - , molType :: Text -- ^ type of molecule that is sequenced - , form :: Maybe Form -- ^ form of sequence - , gbDivision :: Maybe Text -- ^ GenBank division to which a record belongs - , modificationDate :: Text -- ^ date of last modification of sequence - } - deriving (Eq, Show) +data Locus + = Locus + { name :: Text + -- ^ name of sequence + , len :: Int + -- ^ length of sequence + , molType :: Text + -- ^ type of molecule that is sequenced + , form :: Maybe Form + -- ^ form of sequence + , gbDivision :: Maybe Text + -- ^ GenBank division to which a record belongs + , modificationDate :: Text + -- ^ date of last modification of sequence + } + deriving (Eq, Show, Generic, NFData) -- | At this moment there are two known (to me) -- forms of seuqences that can be present in .gb file. -- -data Form = Linear | Circular - deriving (Eq, Show) +data Form + = Linear + | Circular + deriving (Eq, Show, Generic, NFData) -- | Id of sequence in GenBank database. -- -data Version = Version { versionT :: Text -- ^ id itself - , gbId :: Maybe Text -- ^ GenInfo Identifier that is assigned when sequence changes - } - deriving (Eq, Show) +data Version + = Version + { versionT :: Text + -- ^ id itself + , gbId :: Maybe Text + -- ^ GenInfo Identifier that is assigned when sequence changes + } + deriving (Eq, Show, Generic, NFData) -- | Information about source of this sequence. -- -data Source = Source { sourceT :: Text -- ^ free-format (as if all this format is not too much "free format") information - -- including an abbreviated form of the organism name, - -- sometimes followed by a molecule type - , organism :: Maybe Text -- ^ the formal scientific name for the source organism - } - deriving (Eq, Show) +data Source + = Source + { sourceT :: Text + -- ^ free-format (as if all this format is not too much "free format") information + -- including an abbreviated form of the organism name, + -- sometimes followed by a molecule type + , organism :: Maybe Text + -- ^ the formal scientific name for the source organism + } + deriving (Eq, Show, Generic, NFData) -- | Publications by the authors of the sequence that discuss the data reported in the record. -- -data Reference = Reference { referenceT :: Text -- ^ reference itself - , authors :: Maybe Text -- ^ list of authors in the order in which they appear in the cited article - , title :: Maybe Text -- ^ title of the published work - , journal :: Maybe Text -- ^ MEDLINE abbreviation of the journal name - , pubmed :: Maybe Text -- ^ PubMed Identifier - } - deriving (Eq, Show) +data Reference + = Reference + { referenceT :: Text + -- ^ reference itself + , authors :: Maybe Text + -- ^ list of authors in the order in which they appear in the cited article + , title :: Maybe Text + -- ^ title of the published work + , journal :: Maybe Text + -- ^ MEDLINE abbreviation of the journal name + , pubmed :: Maybe Text + -- ^ PubMed Identifier + } + deriving (Eq, Show, Generic, NFData) -------------------------------------------------------------------------------- -- Block with FEATURES table. @@ -92,11 +138,13 @@ -- | One single feature. -- -data Feature = Feature { fName :: Text -- ^ main information about feature - , fStrand53 :: Bool -- ^ set to True if sequence is contained on 5'-3' strand. - -- Set to False otherwise - , fProps :: [(Text, Text)] -- ^ properties of feature (such as "label", "gene", "note" etc.) - } - deriving (Eq, Show, Ord) +data Feature + = Feature + { fName :: Text + -- ^ main information about feature + , fProps :: [(Text, Text)] + -- ^ properties of feature (such as "label", "gene", "note" etc.) + } + deriving (Eq, Show, Ord, Generic, NFData) instance IsMarking Feature diff --git a/src/Bio/GB/Writer.hs b/src/Bio/GB/Writer.hs --- a/src/Bio/GB/Writer.hs +++ b/src/Bio/GB/Writer.hs @@ -2,16 +2,16 @@ ( genBankToText ) where -import Bio.GB.Type (Feature (..), GenBankSequence (..), - Locus (..), Meta (..), Reference (..), - Source (..), Version (..)) -import Bio.Sequence (Range, markings, toList) +import Bio.GB.Type (Feature (..), GenBankSequence (..), Locus (..), Meta (..), + Reference (..), Source (..), Version (..)) +import Bio.Sequence (Border (..), Range (..), RangeBorder (..), markings, shiftRange, + toList) import Control.Lens ((^.)) import qualified Data.List.Split as S (chunksOf) import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text as T (append, chunksOf, intercalate, length, - lines, null, pack, toLower, unwords) +import qualified Data.Text as T (append, chunksOf, intercalate, length, lines, null, pack, + toLower, unwords) genBankToText :: GenBankSequence -> Text genBankToText GenBankSequence{..} = interNewLine parts <> "\n" @@ -99,7 +99,7 @@ featureToText :: (Feature, Range) -> Text featureToText (Feature{..}, range) = interNewLine $ mainPart : sections where - mainPart = processMany featuresIndent (prependIndent featuresPreIndent fName) (featureRangeToText fStrand53 range) + mainPart = processMany featuresIndent (prependIndent featuresPreIndent fName) (featureRangeToText $ shiftRange 1 range) sections = fmap featurePropToText fProps featurePropToText :: (Text, Text) -> Text @@ -107,13 +107,17 @@ where mainPart = processMany featuresIndent mempty ("/" <> nameF <> "=\"" <> textF <> "\"") -featureRangeToText :: Bool -> Range -> Text -featureRangeToText complement (l, r) | l == r - 1 = processComplement complement $ showText (l + 1) - | otherwise = processComplement complement $ showText (l + 1) <> ".." <> showText r +featureRangeToText :: Range -> Text +featureRangeToText (Point pos) = showText pos +featureRangeToText (Span (RangeBorder rbLo lo) (RangeBorder rbHi hi)) = borderToText True rbLo <> showText lo <> ".." <> borderToText False rbHi <> showText hi where - processComplement :: Bool -> Text -> Text - processComplement True text = text - processComplement False text = "complement(" <> text <> ")" + borderToText :: Bool -> Border -> Text + borderToText _ Precise = "" + borderToText True Exceeded = "<" + borderToText False Exceeded = ">" +featureRangeToText (Between lo hi) = showText lo <> "^" <> showText hi +featureRangeToText (Join ranges) = "join(" <> T.intercalate "," (featureRangeToText <$> ranges) <> ")" +featureRangeToText (Complement range) = "complement(" <> featureRangeToText range <> ")" -- | Indentation of feature's properties in FEATURES section. -- diff --git a/src/Bio/PDB/BondRestoring.hs b/src/Bio/PDB/BondRestoring.hs --- a/src/Bio/PDB/BondRestoring.hs +++ b/src/Bio/PDB/BondRestoring.hs @@ -168,7 +168,7 @@ sideChainBonds :: Text -> [(Text, Text)] sideChainBonds "ALA" = bwhMany [("CB", ["HB1", "HB2", "HB3"])] sideChainBonds "ARG" = [("CB", "CG"), ("CG", "CD"), ("CD", "NE"), ("NE", "CZ"), ("CZ", "NH2"), ("CZ", "NH1")] ++ bwhMany[("CB", ["HB3", "HB2"]), ("CG", ["HG3", "HG2"]), ("CD", ["HD3", "HD2"]), ("NE", ["HE"]), ("NH1", ["HH12", "HH11"]), ("NH2", ["HH22", "HH21"])] -sideChainBonds "ASN" = [("CB", "CG"), ("CG", "OD1"), ("CG", "ND2")] ++ bwhMany [("CB", ["HB3", "HB2"]), ("ND2", ["HD22", "HD21"])] +sideChainBonds "ASN" = [("CB", "CG"), ("CG", "OD1"), ("CG", "ND2")] ++ bwhMany [("CB", ["HB3", "HB2"]), ("ND2", ["HD22", "HD21"]), ("ND2", ["HD2", "HD1"])] sideChainBonds "ASP" = [("CB", "CG"), ("CG", "OD1"), ("CG", "OD2")] ++ bwhMany [("CB", ["HB3", "HB2"]), ("OD2", ["HD2"])] -- in fact, these are bonds for ASH, but sometimes ASH called just ASP... sideChainBonds "ASH" = [("CB", "CG"), ("CG", "OD1"), ("CG", "OD2")] ++ bwhMany [("CB", ["HB3", "HB2"]), ("OD2", ["HD2"])] sideChainBonds "CYS" = [("CB", "SG")] ++ bwhMany [("CB", ["HB3", "HB2"]), ("SG", ["HG"])] diff --git a/src/Bio/Sequence.hs b/src/Bio/Sequence.hs --- a/src/Bio/Sequence.hs +++ b/src/Bio/Sequence.hs @@ -5,11 +5,13 @@ , module Bio.Sequence.Functions.Sequence , module Bio.Sequence.Functions.Weight , module Bio.Sequence.Functions.Marking + , module Bio.Sequence.Range ) where -import Bio.Sequence.Class hiding (_sequenceInner) -import Bio.Sequence.Functions.Marking -import Bio.Sequence.Functions.Sequence -import Bio.Sequence.Functions.Weight +import Bio.Sequence.Class hiding (_sequenceInner) +import Bio.Sequence.Functions.Marking +import Bio.Sequence.Functions.Sequence +import Bio.Sequence.Functions.Weight +import Bio.Sequence.Range diff --git a/src/Bio/Sequence/Class.hs b/src/Bio/Sequence/Class.hs --- a/src/Bio/Sequence/Class.hs +++ b/src/Bio/Sequence/Class.hs @@ -43,12 +43,15 @@ , _sequenceInner ) where -import Bio.Sequence.Utilities (Range, checkRange, unsafeEither) +import Bio.Sequence.Range (Range, checkRange, shiftRange) +import Bio.Sequence.Utilities (unsafeEither) +import Control.DeepSeq (NFData) import Control.Lens import Control.Monad.Except (MonadError, throwError) -import Data.Kind (Constraint) +import Data.Kind (Constraint, Type) import qualified Data.List as L (length, null) import Data.Text (Text) +import qualified Data.Text as T import Data.Vector (Vector) import qualified Data.Vector as V (fromList, length) import GHC.Generics (Generic) @@ -61,23 +64,28 @@ -- 'Sequence' represents sequence of objects of type 'a' that -- can have different markings of type 'mk' and weights of type 'w'. -- -data Sequence mk w a = Sequence { _sequ :: Vector a -- ^ sequence itself - , _markings :: [(mk, Range)] -- ^ list of pairs containing marking and 'Range', that corresponds to it - , _weights :: Vector w -- ^ weights for all elements in sequence - } - deriving (Eq, Show, Generic, Functor) +data Sequence mk w a + = Sequence + { _sequ :: Vector a + -- ^ sequence itself + , _markings :: [(mk, Range)] + -- ^ list of pairs containing marking and 'Range', that corresponds to it + , _weights :: Vector w + -- ^ weights for all elements in sequence + } + deriving (Eq, Show, Generic, NFData, Functor) instance Semigroup (Sequence mk w a) where sequA <> sequB = res where newSequ = sequA ^. sequ <> sequB ^. sequ - newMarkings = sequA ^. markings <> fmap (fmap (bimap addInd addInd)) (sequB ^. markings) + newMarkings = sequA ^. markings <> fmap (fmap (shiftRange addInd)) (sequB ^. markings) newWeights = sequA ^. weights <> sequB ^. weights res = Sequence newSequ newMarkings newWeights - addInd :: Int -> Int - addInd = (+ V.length (sequA ^. sequ)) + addInd :: Int + addInd = V.length (sequA ^. sequ) instance Monoid (Sequence mk () a) where mempty = Sequence mempty mempty mempty @@ -189,9 +197,9 @@ -- having not null weights type-safe. -- class (IsMarking (Marking s), IsWeight (Weight s)) => IsSequence s where - type Element s :: * - type Marking s :: * - type Weight s :: * + type Element s :: Type + type Marking s :: Type + type Weight s :: Type toSequence :: s -> Sequence (Marking s) (Weight s) (Element s) fromSequence :: Sequence (Marking s) (Weight s) (Element s) -> s @@ -302,7 +310,7 @@ Unit _ = TypeError ('Text "cobot-io: this function doesn't work with when not parametrized by ().") createSequenceInner :: (IsSequence s, MonadError Text m) => Bool -> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s -createSequenceInner checkMk checkW s markings' weights' | checkMk && not checkRanges = throwError rangesError +createSequenceInner checkMk checkW s markings' weights' | checkMk && not checkRanges = throwError rangesError | checkW && not checkNullWeights = throwError weightsNullError | checkW && not checkLenWeights = throwError weightsLenError | otherwise = pure resSequence @@ -313,8 +321,11 @@ resSequence = fromSequence $ Sequence seqVector markings' weightsVector checkRanges :: Bool - checkRanges = all (checkRange (L.length s)) $ fmap snd markings' + checkRanges = null faultyRanges + faultyRanges :: [Range] + faultyRanges = filter (not . checkRange (L.length s)) $ fmap snd markings' + checkNullWeights :: Bool checkNullWeights = not (L.null weights') @@ -322,7 +333,7 @@ checkLenWeights = L.length s == L.length weights' rangesError :: Text - rangesError = "Bio.Sequence.Class: invalid 'Range' found in sequence's marking." + rangesError = "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \n" <> T.pack (unlines (show <$> faultyRanges)) weightsNullError :: Text weightsNullError = "Bio.Sequence.Class: weights are null for sequence." diff --git a/src/Bio/Sequence/Functions/Marking.hs b/src/Bio/Sequence/Functions/Marking.hs --- a/src/Bio/Sequence/Functions/Marking.hs +++ b/src/Bio/Sequence/Functions/Marking.hs @@ -10,26 +10,22 @@ , listMarkings ) where -import Bio.Sequence.Class (ContainsMarking, - IsBareSequence, - IsMarkedSequence, - IsSequence (..), - markedSequence, markings, - sequ, unsafeMarkedSequence, - weights, _sequenceInner) -import Bio.Sequence.Functions.Sequence (length, unsafeGetRange) -import Bio.Sequence.Utilities (Range, checkRange, - unsafeEither) import Control.Lens -import Control.Monad.Except (MonadError, throwError) -import Data.List (nub) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Text (Text) -import qualified Data.Vector as V (toList) -import Prelude hiding (drop, head, length, - null, reverse, tail, take, - (!!)) +import Control.Monad.Except (MonadError, throwError) +import Data.List (nub) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text (Text) +import qualified Data.Vector as V (toList) +import Prelude hiding (drop, head, length, null, reverse, tail, take, (!!)) +import Bio.NucleicAcid.Nucleotide (Complementary (..)) +import Bio.Sequence.Class (ContainsMarking, IsBareSequence, IsMarkedSequence, + IsSequence (..), _sequenceInner, markedSequence, markings, + sequ, unsafeMarkedSequence, weights) +import Bio.Sequence.Functions.Sequence (length, unsafeGetRange) +import Bio.Sequence.Range (Range, checkRange) +import Bio.Sequence.Utilities (unsafeEither) + -- | Function that retrieves all elements in 'IsSequence' @s@ that are covered by given 'Marking'' @s@. -- Returns 'NonEmpty' list, because if 'Marking' is present in @s@, then list of -- all 'Marking's for @s@ can't be empty. If given 'Marking is not found in @s@, an @@ -38,7 +34,7 @@ -- > sequ = Sequence ['a', 'a', 'b', 'a'] [("Letter A", (0, 2)), ("Letter A", (3, 4)), ("Letter B", (2, 3))] mempty -- > getMarking sequ "Letter A" == ['a', 'a'] :| [['a']] -- -getMarking :: (ContainsMarking s, MonadError Text m) => s -> Marking s -> m (NonEmpty [Element s]) +getMarking :: (ContainsMarking s, MonadError Text m, Complementary (Element s)) => s -> Marking s -> m (NonEmpty [Element s]) getMarking (toSequence -> s) mk | not $ mk `member` (s ^. markings) = throwError markingNotFoundError | otherwise = pure $ res where @@ -47,7 +43,7 @@ markingNotFoundError :: Text markingNotFoundError = "Bio.Sequence.Functions.Marking: given marking not found in Sequence." -unsafeGetMarking :: ContainsMarking s => s -> Marking s -> NonEmpty [Element s] +unsafeGetMarking :: (ContainsMarking s, Complementary (Element s)) => s -> Marking s -> NonEmpty [Element s] unsafeGetMarking mk = unsafeEither . getMarking mk -- | Converts 'IsBareSequence' @s@ to 'IsMarkedSequence' @s'@ that is marked using provided list diff --git a/src/Bio/Sequence/Functions/Sequence.hs b/src/Bio/Sequence/Functions/Sequence.hs --- a/src/Bio/Sequence/Functions/Sequence.hs +++ b/src/Bio/Sequence/Functions/Sequence.hs @@ -12,32 +12,40 @@ , (!), (!?) ) where -import Bio.Sequence.Class (ContainsNoMarking, IsSequence (..), - markings, sequ, weights, - _sequenceInner) -import Bio.Sequence.Utilities (Range, checkRange, unsafeEither) import Control.Lens -import Control.Monad.Except (MonadError, throwError) -import qualified Data.Foldable as F (length, null, toList) -import qualified Data.List as L (drop, take) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import Data.Tuple (swap) -import qualified Data.Vector as V (drop, reverse, take, (!?)) -import Prelude hiding (drop, length, null, reverse, - tail, take) +import Control.Monad.Except (MonadError, throwError) +import qualified Data.Foldable as F (length, null, toList) +import qualified Data.List as L (drop, take) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Vector as V +import Prelude hiding (drop, length, null, reverse, tail, take) --- | Get elements from sequence that belong to given 'Range' (format of range is [a; b)). + +import Bio.NucleicAcid.Nucleotide (Complementary (..)) +import Bio.Sequence.Class (ContainsNoMarking, IsSequence (..), _sequenceInner, markings, + sequ, weights) +import Bio.Sequence.Range (Range (..), RangeBorder (..), checkRange, mapRange, swapRange) +import Bio.Sequence.Utilities (unsafeEither) + +-- | Get elements from sequence that belong to given 'Range'. If the range is a Span, then both lower and upper bounds are included. -- If given 'Range' is out of bounds, an error will be thrown. -- -- > sequ = Sequence ['a', 'a', 'b', 'a'] [("Letter A", (0, 2)), ("Letter A", (3, 4)), ("Letter B", (2, 3))] mempty -- > getRange sequ (0, 3) == Just ['a', 'a', 'b'] -- -getRange :: (IsSequence s, MonadError Text m) => s -> Range -> m [Element s] -getRange s r@(lInd, rInd) | checkRange (length s) r = pure $ L.take (rInd - lInd) $ L.drop lInd $ toList s - | otherwise = throwError "Bio.Sequence.Functions.Sequence: invalid range in getRange." +getRange :: (IsSequence s, MonadError Text m, Complementary (Element s)) => s -> Range -> m [Element s] +getRange s r | checkRange (length s) r = pure $ extractRange s r + | otherwise = throwError "Bio.Sequence.Functions.Sequence: invalid range in getRange." -unsafeGetRange :: IsSequence s => s -> Range -> [Element s] +extractRange :: (IsSequence s, Complementary (Element s)) => s -> Range -> [Element s] +extractRange s (Point pos) = [s ! pos] +extractRange s (Span (RangeBorder _ lo) (RangeBorder _ hi)) = L.drop lo . L.take (hi + 1) . toList $ s +extractRange _ (Between _ _) = [] +extractRange s (Join ranges) = concatMap (extractRange s) ranges +extractRange s (Complement range) = rcNA $ extractRange s range + +unsafeGetRange :: (IsSequence s, Complementary (Element s)) => s -> Range -> [Element s] unsafeGetRange s = unsafeEither . getRange s -- | Unsafe operator to get elemnt at given position in @s@. @@ -75,10 +83,10 @@ reverse :: IsSequence s => s -> s reverse (toSequence -> s) = res where - newMaxInd = length s + newMaxInd = length s - 1 newSequ = V.reverse $ s ^. sequ - newMarkings = fmap (fmap $ swap . bimap ((-) newMaxInd) ((-) newMaxInd)) $ s ^. markings + newMarkings = fmap (fmap $ swapRange . mapRange ((-) newMaxInd)) $ s ^. markings newWeights = V.reverse $ s ^. weights res = fromSequence $ _sequenceInner newSequ newMarkings newWeights diff --git a/src/Bio/Sequence/Range.hs b/src/Bio/Sequence/Range.hs new file mode 100644 --- /dev/null +++ b/src/Bio/Sequence/Range.hs @@ -0,0 +1,161 @@ +module Bio.Sequence.Range + ( Range (..) + , Border (..) + , RangeBorder (..) + , borderType + , borderLocation + , location + , lower + , upper + , before + , after + , ranges + , range + , checkRange + , shiftRange + , mapRange + , swapRange + , point + , preciseSpan + , between + , extendRight + , extendLeft + , overlap + , rangeMargins + ) where + +import Control.DeepSeq (NFData) +import Control.Lens (makeLenses) +import GHC.Generics (Generic) + +-- | The type of range border. A border is @Exceeded@ when its end point is beyond the +-- specified base number, otherwise it is @Precise@. +-- In GenBank, for example, @Exceeded@ borders are marked with < and >. +-- +data Border + = Precise + | Exceeded + deriving (Eq, Show, Generic, NFData) + +-- | The end point of a range with indication whether it is @Precise@ of @Exceeded@ (see @Border@). +-- +data RangeBorder + = RangeBorder + { _borderType :: Border + , _borderLocation :: Int + } + deriving (Eq, Show, Generic, NFData) + +makeLenses ''RangeBorder + +data Range + = Point + { _location :: Int + } + -- ^ The exact location of a single base feature + -- Example in GB: conf 258 + | Span + { _lower :: RangeBorder + , _upper :: RangeBorder + } + -- ^ A region consisting of a simple span of bases. + -- The symbols `<`and `>' are used to indicate that the beginning or end of the + -- feature is beyond the range of the presented sequence. + -- Examples in GB: tRNA 1..87 + -- tRNA <1..87 + -- tRNA 1..>87 + | Between + { _before :: Int + , _after :: Int + } + -- ^ The feature is between bases. + -- Example in GB: misc_recomb 105^106 + | Join + { _ranges :: [Range] + } + -- ^ The feature consists of the union of several ranges. + -- Example in GB: origin join(1, 23..50, 77..>100) + | Complement + { _range :: Range + } + -- ^ Indicates that the range is complementary. + -- Example in GB: rep complement(69..420) + deriving (Eq, Show, Generic, NFData) + +makeLenses ''Range + +point :: Int -> Range +point = Point + +preciseSpan :: (Int, Int) -> Range +preciseSpan (lo, hi) = Span (RangeBorder Precise lo) (RangeBorder Precise hi) + +between :: (Int, Int) -> Range +between = uncurry Between + +checkRange :: Int -> Range -> Bool +checkRange len (Point pos) = 0 <= pos && pos < len +checkRange len (Span (RangeBorder _ lInd) (RangeBorder _ rInd)) = lInd < rInd && 0 <= lInd && rInd < len +checkRange len (Between lInd rInd) = lInd < rInd && 0 <= lInd && rInd <= len +checkRange len (Join ranges') = all (checkRange len) ranges' +checkRange len (Complement range') = checkRange len range' + +mapRange :: (Int -> Int) -> Range -> Range +mapRange f (Point pos) = Point (f pos) +mapRange f (Span (RangeBorder bLo lo) (RangeBorder bHi hi)) = Span (RangeBorder bLo (f lo)) (RangeBorder bHi (f hi)) +mapRange f (Between lo hi) = Between (f lo) (f hi) +mapRange f (Join ranges') = Join $ fmap (mapRange f) ranges' +mapRange f (Complement range') = Complement $ mapRange f range' + +shiftRange :: Int -> Range -> Range +shiftRange delta = mapRange (+ delta) + +swapRange :: Range -> Range +swapRange r@Point{} = r +swapRange (Span brLo brHi) = Span brHi brLo +swapRange (Between lo hi) = Between hi lo +swapRange (Join ranges') = Join $ fmap swapRange ranges' +swapRange (Complement range') = Complement $ swapRange range' + +extendRight :: Int -> Range -> Range +extendRight delta (Point a) = Span (RangeBorder Precise a) (RangeBorder Precise (a + delta)) +extendRight delta (Span lo (RangeBorder r hi)) = Span lo (RangeBorder r (hi + delta)) +extendRight _ b@Between{} = b +extendRight delta (Join ranges') = Join $ extendRight delta <$> ranges' +extendRight delta (Complement range') = Complement $ extendRight delta range' + +extendLeft :: Int -> Range -> Range +extendLeft delta (Point a) = Span (RangeBorder Precise (a - delta)) (RangeBorder Precise a) +extendLeft delta (Span (RangeBorder r lo) hi) = Span (RangeBorder r (lo - delta)) hi +extendLeft _ b@Between{} = b +extendLeft delta (Join ranges') = Join $ extendLeft delta <$> ranges' +extendLeft delta (Complement range') = Complement $ extendLeft delta range' + +overlap :: Range -> Range -> Bool +overlap (Point a) (Point b) = a == b +overlap (Point a) (Span (RangeBorder _ lo) (RangeBorder _ hi)) = lo <= a && a <= hi +overlap (Point _) (Between _ _) = False + +overlap (Span (RangeBorder _ lo1) (RangeBorder _ hi1)) (Span (RangeBorder _ lo2) (RangeBorder _ hi2)) = + (lo1 <= lo2 && hi1 >= lo2) || + (lo1 >= lo2 && lo1 <= hi2) || + (lo1 <= lo2 && hi1 >= hi2) +overlap (Span (RangeBorder _ lo) (RangeBorder _ hi)) (Between b1 b2) = b1 >= lo && b2 <= hi + +overlap b1@Between{} b2@Between{} = b1 == b2 + +overlap r1 (Join ranges') = any (overlap r1) ranges' +overlap r1 (Complement range') = overlap r1 range' + +overlap r1 r2 = overlap r2 r1 + +rangeMargins :: Range -> (Int, Int) +rangeMargins rng = + case rng of + Point x -> (x, x) + Span (RangeBorder _ lo) (RangeBorder _ hi) -> (lo, hi) + Between lo hi -> (lo, hi) + Join children -> let (los, his) = unzip (rangeMargins <$> children) + in (minimum los, maximum his) + Complement child -> rangeMargins child + diff --git a/src/Bio/Sequence/Utilities.hs b/src/Bio/Sequence/Utilities.hs --- a/src/Bio/Sequence/Utilities.hs +++ b/src/Bio/Sequence/Utilities.hs @@ -1,18 +1,9 @@ module Bio.Sequence.Utilities - ( Range - , checkRange - , unsafeEither + ( unsafeEither ) where import Data.Text (Text) import qualified Data.Text as T (unpack) - --- | Range of form [a, b). --- -type Range = (Int, Int) - -checkRange :: Int -> Range -> Bool -checkRange len (lInd, rInd) = lInd < rInd && 0 <= lInd && rInd <= len unsafeEither :: Either Text a -> a unsafeEither = either (error . T.unpack) id diff --git a/test/FastaParserSpec.hs b/test/FastaParserSpec.hs --- a/test/FastaParserSpec.hs +++ b/test/FastaParserSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} module FastaParserSpec where @@ -36,25 +37,25 @@ onlyName = describe "onlyName" $ do it "correctly parses fasta without sequence" $ do let res = parseOnly fastaP ">3HMX:A|PDBID|CHAIN|SEQUENCE" - res `shouldBe` Right [FastaItem "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "")] + res `shouldBe` Right [FastaItem @Char "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "")] oneSequence :: Spec oneSequence = describe "oneSequence" $ do it "correctly parses one correct sequence" $ do let res = parseOnly fastaP ">3HMX:A|PDBID|CHAIN|SEQUENCE\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSE\nVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL\n" - res `shouldBe` Right [FastaItem "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL")] + res `shouldBe` Right [FastaItem @Char "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL")] twoSequences :: Spec twoSequences = describe "twoSequences" $ do it "correctly parses two correct sequences" $ do let res = parseOnly fastaP ">3HMX:A|PDBID|CHAIN|SEQUENCE\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSE\nVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL\n>7HMX:A|PDBID|CHAIN|SEQUENCE\nEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE\nVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL" - res `shouldBe` Right [FastaItem "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL"), FastaItem "7HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL")] + res `shouldBe` Right [FastaItem @Char "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL"), FastaItem @Char "7HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL")] sequenceWithDigit :: Spec sequenceWithDigit = describe "sequenceWithDigit" $ do it "correctly parses incorrect sequence with digit" $ do let res = parseOnly fastaP ">123\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEE4GITWTLDQSSE" - res `shouldBe` Right [FastaItem "123" (bareSequence "")] + res `shouldBe` Right [FastaItem @Char "123" (bareSequence "")] sequenceWithWrongName :: Spec sequenceWithWrongName = describe "sequenceWithWrongName" $ do @@ -66,31 +67,31 @@ sequenceWithSpacesInName = describe "sequenceWithSpacesInName" $ do it "correctly parses sequence with spaces in name" $ do let res = parseOnly fastaP "> this is my sequence \nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE" - res `shouldBe` Right [FastaItem "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE")] + res `shouldBe` Right [FastaItem @Char "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE")] sequenceWithSeveralEndOfLine :: Spec sequenceWithSeveralEndOfLine = describe "sequenceWithSeveralEndOfLine" $ do it "correctly parses sequence with several \n after name" $ do let res = parseOnly fastaP ">this is my sequence\n\n\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE" - res `shouldBe` Right [FastaItem "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE")] + res `shouldBe` Right [FastaItem @Char "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE")] sequenceWithSeveralEndOfLineInSequence :: Spec sequenceWithSeveralEndOfLineInSequence = describe "sequenceWithSeveralEndOfLineInSequence" $ do it "correctly parses sequence with several \n between sequence parts" $ do let res = parseOnly fastaP ">this is my sequence\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE\n\n\nYYYYYYYYYYYYYYYYYYYYYYYY" - res `shouldBe` Right [FastaItem "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSEYYYYYYYYYYYYYYYYYYYYYYYY")] + res `shouldBe` Right [FastaItem @Char "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSEYYYYYYYYYYYYYYYYYYYYYYYY")] sequenceWithTabsInName :: Spec sequenceWithTabsInName = describe "sequenceWithTabsInName" $ do it "correctly parses sequence with tabs in name" $ do let res = parseOnly fastaP ">\tthis\tis\tmy\tsequence\t\t\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE" - res `shouldBe` Right [FastaItem "this\tis\tmy\tsequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE")] + res `shouldBe` Right [FastaItem @Char "this\tis\tmy\tsequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE")] sequenceWithTabsInSequence :: Spec sequenceWithTabsInSequence = describe "sequenceWithTabsInSequence" $ do it "correctly parses sequence with tabs between sequence parts" $ do let res = parseOnly fastaP ">this is my sequence\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSE\t\t\nYYYYYYYYYYYYYYYYYYYYYYYY\t\n" - res `shouldBe` Right [FastaItem "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSEYYYYYYYYYYYYYYYYYYYYYYYY")] + res `shouldBe` Right [FastaItem @Char "this is my sequence" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEGITWTLDQSSEYYYYYYYYYYYYYYYYYYYYYYYY")] sequenceWithModifications :: Spec sequenceWithModifications = describe "sequenceWithModifications" $ do diff --git a/test/FastaWriterSpec.hs b/test/FastaWriterSpec.hs --- a/test/FastaWriterSpec.hs +++ b/test/FastaWriterSpec.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE TypeApplications #-} + module FastaWriterSpec where -import Bio.FASTA.Writer (fastaToText) -import Bio.FASTA.Type (FastaItem(..)) -import Bio.Sequence (bareSequence) -import Test.Hspec +import Bio.FASTA.Type (FastaItem (..)) +import Bio.FASTA.Writer (fastaToText) +import Bio.Sequence (bareSequence) +import Test.Hspec fastaWriterSpec :: Spec fastaWriterSpec = describe "Fasta format parser." $ do @@ -21,17 +23,17 @@ oneShortSequence :: Spec oneShortSequence = describe "oneShortSequence" $ do it "correctly write one correct short (less than 80 chars) sequence" $ do - let res = fastaToText [FastaItem "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL")] + let res = fastaToText [FastaItem @Char "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL")] res `shouldBe` ">3HMX:A|PDBID|CHAIN|SEQUENCE\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL\n" oneLongSequence :: Spec oneLongSequence = describe "oneLongSequence" $ do it "correctly write one correct long (more than 80 chars) sequence" $ do - let res = fastaToText [FastaItem "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLLLLHKKEDGIWSTDILKDQKEPKNKTFLRCEAKNYSGRFTCWWLTTISTDLTFSVKSSRGSSDPQGVTCGAATLSAERVRGDNKEYEYSVECQEDSACPAAEESLPIEVMVDAVHKLKYENYTSSFFIRDIIKPDPPKNLQLKPLKNSRQVEVSWEYPDTWSTPHSYFSLTFCVQVQGKSKREKKDRVFTDKTSATVICRKNASISVRAQDRYYSSSWSEWASVPCS")] + let res = fastaToText [FastaItem @Char "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLLLLHKKEDGIWSTDILKDQKEPKNKTFLRCEAKNYSGRFTCWWLTTISTDLTFSVKSSRGSSDPQGVTCGAATLSAERVRGDNKEYEYSVECQEDSACPAAEESLPIEVMVDAVHKLKYENYTSSFFIRDIIKPDPPKNLQLKPLKNSRQVEVSWEYPDTWSTPHSYFSLTFCVQVQGKSKREKKDRVFTDKTSATVICRKNASISVRAQDRYYSSSWSEWASVPCS")] res `shouldBe` ">3HMX:A|PDBID|CHAIN|SEQUENCE\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL\nLLHKKEDGIWSTDILKDQKEPKNKTFLRCEAKNYSGRFTCWWLTTISTDLTFSVKSSRGSSDPQGVTCGAATLSAERVRG\nDNKEYEYSVECQEDSACPAAEESLPIEVMVDAVHKLKYENYTSSFFIRDIIKPDPPKNLQLKPLKNSRQVEVSWEYPDTW\nSTPHSYFSLTFCVQVQGKSKREKKDRVFTDKTSATVICRKNASISVRAQDRYYSSSWSEWASVPCS\n" twoSequences :: Spec twoSequences = describe "twoSequences" $ do it "correctly write two correct sequences" $ do - let res = fastaToText [FastaItem "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL"), FastaItem "7HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLLLLHKKEDGIWSTDILKDQKEPKNKTFLRCEAKNYSGRFTCWWLTTISTDLTFSVKSSRGSSDPQGVTCGAATLSAERVRGDNKEYEYSVECQEDSACPAAEESLPIEVMVDAVHKLKYENYTSSFFIRDIIKPDPPKNLQLKPLKNSRQVEVSWEYPDTWSTPHSYFSLTFCVQVQGKSKREKKDRVFTDKTSATVICRKNASISVRAQDRYYSSSWSEWASVPCS")] + let res = fastaToText [FastaItem @Char "3HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL"), FastaItem @Char "7HMX:A|PDBID|CHAIN|SEQUENCE" (bareSequence "IWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLLLLHKKEDGIWSTDILKDQKEPKNKTFLRCEAKNYSGRFTCWWLTTISTDLTFSVKSSRGSSDPQGVTCGAATLSAERVRGDNKEYEYSVECQEDSACPAAEESLPIEVMVDAVHKLKYENYTSSFFIRDIIKPDPPKNLQLKPLKNSRQVEVSWEYPDTWSTPHSYFSLTFCVQVQGKSKREKKDRVFTDKTSATVICRKNASISVRAQDRYYSSSWSEWASVPCS")] res `shouldBe` ">3HMX:A|PDBID|CHAIN|SEQUENCE\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL\n>7HMX:A|PDBID|CHAIN|SEQUENCE\nIWELKKDVYVVELDWYPDAPGEMVVLTCDTPEEDGITWTLDQSSEVLGSGKTLTIQVKEFGDAGQYTCHKGGEVLSHSLL\nLLHKKEDGIWSTDILKDQKEPKNKTFLRCEAKNYSGRFTCWWLTTISTDLTFSVKSSRGSSDPQGVTCGAATLSAERVRG\nDNKEYEYSVECQEDSACPAAEESLPIEVMVDAVHKLKYENYTSSFFIRDIIKPDPPKNLQLKPLKNSRQVEVSWEYPDTW\nSTPHSYFSLTFCVQVQGKSKREKKDRVFTDKTSATVICRKNASISVRAQDRYYSSSWSEWASVPCS\n" diff --git a/test/GBParserSpec.hs b/test/GBParserSpec.hs --- a/test/GBParserSpec.hs +++ b/test/GBParserSpec.hs @@ -2,19 +2,69 @@ module GBParserSpec where -import Bio.GB (Feature (..), Form (..), GenBankSequence (..), - Locus (..), Meta (..), Reference (..), - Source (..), Version (..), fromFile) -import Bio.Sequence (Range, unsafeMarkedSequence) -import Test.Hspec +import Bio.GB (Feature (..), Form (..), GenBankSequence (..), Locus (..), Meta (..), + Reference (..), Source (..), Version (..), fromFile) +import Bio.GB.Parser (rangeP) +import Bio.Sequence (Border (..), Range (..), RangeBorder (..), preciseSpan, + unsafeMarkedSequence) +import Control.Lens (_Left, over) +import Data.Text (Text) +import Test.Hspec +import Text.Megaparsec (eof, errorBundlePretty, parse) gbParserSpec :: Spec gbParserSpec = describe "GenBank format parser." $ do + rangeTests pAAVGFPSpecP "test/GB/pAAV-GFP-CellBioLab.gb" pAAVCMVSpecP "test/GB/pAAV_CMV_RPE65_PolyA_linkers.gb" dottedMetaSpecP "test/GB/pAAV-GFP-CellBioLab-dots.gb" unknownFieldsSpecP "test/GB/pIntA-TRBV.gb" + baseCountWithSophisticatedRangesAndMultilineFeatures "test/GB/fromYanaWithLove.gb" +rangeTests :: Spec +rangeTests = describe "Range parser" $ do + it "correctly parses a simple span" $ + greedyRangeP "69..420" `shouldBe` successful (Span (RangeBorder Precise 69) (RangeBorder Precise 420)) + it "correctly parses a span with the lower border exceeded" $ + greedyRangeP "<69..420" `shouldBe` successful (Span (RangeBorder Exceeded 69) (RangeBorder Precise 420)) + it "correctly parses a span with the upper border exceeded" $ + greedyRangeP "69..>420" `shouldBe` successful (Span (RangeBorder Precise 69) (RangeBorder Exceeded 420)) + it "correctly parses a span with both border exceeded" $ + greedyRangeP "<69..>420" `shouldBe` successful (Span (RangeBorder Exceeded 69) (RangeBorder Exceeded 420)) + it "does not parse a span with the lower border exceeded incorrectly" $ + greedyRangeP ">69..420" `shouldSatisfy` isFail + it "does not parse a span with the upper border exceeded incorrectly" $ + greedyRangeP "69..<420" `shouldSatisfy` isFail + + it "correctly parses a 'between' statement" $ + greedyRangeP "41^42" `shouldBe` successful (Between 41 42) + it "does not parse a 'between' statement witn border excession marks" $ + greedyRangeP "<41^42" `shouldSatisfy` isFail + + it "correctly parses a single point feature" $ + greedyRangeP "42" `shouldBe` successful (Point 42) + it "does not parse a single point feature with border excession marks" $ + greedyRangeP "<3" `shouldSatisfy` isFail + + it "correctly parses a join() statement" $ + greedyRangeP "join(2,12..56)" `shouldBe` successful (Join [Point 2, Span (RangeBorder Precise 12) (RangeBorder Precise 56)]) + it "correctly parses a sophisticated join() statement" $ + greedyRangeP "join(2^3,<5..10,15,20..>28)" `shouldBe` successful (Join [Between 2 3, Span (RangeBorder Exceeded 5) (RangeBorder Precise 10), Point 15, Span (RangeBorder Precise 20) (RangeBorder Exceeded 28)]) + + it "correctly parses a complement() statement" $ + greedyRangeP "complement(69..>420)" `shouldBe` successful (Complement (Span (RangeBorder Precise 69) (RangeBorder Exceeded 420))) + it "correctly parses a join() incorporated into a complement()" $ + greedyRangeP "complement(join(2^3,<5..10,15,20..>28))" `shouldBe` successful (Complement (Join [Between 2 3, Span (RangeBorder Exceeded 5) (RangeBorder Precise 10), Point 15, Span (RangeBorder Precise 20) (RangeBorder Exceeded 28)])) + where + greedyRangeP :: Text -> Either String Range + greedyRangeP = over _Left errorBundlePretty . parse (rangeP <* eof) "" + + successful :: a -> Either String a + successful = Right + + isFail :: Either String a -> Bool + isFail = null + pAAVGFPSpecP :: FilePath -> Spec pAAVGFPSpecP path = describe "pAAVGFP" $ do it "correctly parses meta information" $ do @@ -47,7 +97,15 @@ mt <- meta <$> fromFile path name (locus mt) `shouldBe` "P2-32_pIntA-TRBV5-1_J1-1-Fc-lama-knob-EPEA" +baseCountWithSophisticatedRangesAndMultilineFeatures :: FilePath -> Spec +baseCountWithSophisticatedRangesAndMultilineFeatures path = describe "" $ do + it "correctly parses the 'BASE COUNT' line and features with sophisticated ranges" $ do + gbS <- gbSeq <$> fromFile path + gbS `shouldBe` unsafeMarkedSequence sophisticatedFeaturesSeq sophisticatedFeatures +compPreciseSpan :: (Int, Int) -> Range +compPreciseSpan = Complement . preciseSpan + pAAVGFPMeta :: Meta pAAVGFPMeta = Meta { locus=Locus "pAAV-GFP-CellBio" 5374 "ds-DNA" (Just Circular) (Just "SYN") "15-AUG-2016" , definition=Just $ "Saccharomyces cerevisiae TCP1-beta gene, partial cds, and Axl2p\n(AXL2) and Rev7p (REV7) genes, complete cds." @@ -63,31 +121,29 @@ } pAAVGFPFeatures :: [(Feature, Range)] -pAAVGFPFeatures = [ ( (Feature "misc_feature" True [ ("label", "Right ITR") - ] - ), (0, 130)) - , ( (Feature "enhancer" True [ ("label", "CMV enhancer") - , ("note", "human cytomegalovirus immediate early enhancer") +pAAVGFPFeatures = [ ( (Feature "misc_feature" [ ("label", "Right ITR") ] + ), preciseSpan (0, 129)) + , ( (Feature "enhancer" [ ("label", "CMV enhancer") + , ("note", "human cytomegalovirus immediate early enhancer") + ] + ), preciseSpan (205, 508)) + , ( (Feature "promoter" [ ("label", "CMV promoter") + , ("note", "human cytomegalovirus (CMV) immediate early \npromoter") + ] + ), preciseSpan (509, 711)) + , ( (Feature "misc_feature" [ ("label", "Human beta-globin Intron") ] + ), preciseSpan (804, 1296)) + , ( (Feature "CDS" [ ("codon_start", "1") + , ("product", "enhanced GFP") + , ("label", "EGFP") + , ("note", "mammalian codon-optimized") + ] + ), preciseSpan (1319, 2035)) + , ( (Feature "repeat_region" [ ("label", "Left ITR") + , ("note", "inverted terminal repeat of adeno-associated virus \nserotype 2\noooooo") + , ("prop", "1") ] - ), (205, 509)) - , ( (Feature "promoter" True [ ("label", "CMV promoter") - , ("note", "human cytomegalovirus (CMV) immediate early \npromoter") - ] - ), (509, 712)) - , ( (Feature "misc_feature" True [ ("label", "Human beta-globin Intron") - ] - ), (804, 1297)) - , ( (Feature "CDS" True [ ("codon_start", "1") - , ("product", "enhanced GFP") - , ("label", "EGFP") - , ("note", "mammalian codon-optimized") - ] - ), (1319, 2036)) - , ( (Feature "repeat_region" False [ ("label", "Left ITR") - , ("note", "inverted terminal repeat of adeno-associated virus \nserotype 2\noooooo") - , ("prop", "1") - ] - ), (2636, 2777)) + ), compPreciseSpan (2636, 2776)) ] pAAVGFPOrigin :: String @@ -106,41 +162,40 @@ } pAAVCMVFeatures :: [(Feature, Range)] -pAAVCMVFeatures = [ ( (Feature "rep_origin" True [ ("direction", "RIGHT") - , ("note", "f1 bacteriophage origin of replication; arrow\r\nindicates direction of (+) strand synthesis") - , ("label", "f1 ori") - , ("ApEinfo_fwdcolor", "#999999") - , ("ApEinfo_revcolor", "#999999") - , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") - ] - ), (3742, 4198)) - , ( (Feature "promoter" True [ ("gene", "bla") - , ("label", "AmpR promoter") - , ("ApEinfo_fwdcolor", "#346ee0") - , ("ApEinfo_revcolor", "#346ee0") - , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") - ] - ), (4479, 4584)) - , ( (Feature "CDS" True [ ("codon_start", "1") - , ("gene", "bla") - , ("product", "beta-lactamase") - , ("note", "confers resistance to ampicillin, carbenicillin,\r\nand related antibiotics") - , ("label", "AmpR") - , ("ApEinfo_fwdcolor", "#e9d024") - , ("ApEinfo_revcolor", "#e9d024") - , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") - ] - ), (4584, 5445)) - , ( (Feature "misc_feature" True [ ("label", "RightITR2") - , ("ApEinfo_fwdcolor", "#7eff74") - , ("ApEinfo_revcolor", "#7eff74") - , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") - ] - ), (3527, 3668)) - , ( (Feature "misc_feature" False [ ("label", "A->T") - ] - ), (199, 200)) +pAAVCMVFeatures = [ ( (Feature "rep_origin" [ ("direction", "RIGHT") + , ("note", "f1 bacteriophage origin of replication; arrow\r\nindicates direction of (+) strand synthesis") + , ("label", "f1 ori") + , ("ApEinfo_fwdcolor", "#999999") + , ("ApEinfo_revcolor", "#999999") + , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") + ] + ), preciseSpan (3742, 4197)) + , ( (Feature "promoter" [ ("gene", "bla") + , ("label", "AmpR promoter") + , ("ApEinfo_fwdcolor", "#346ee0") + , ("ApEinfo_revcolor", "#346ee0") + , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") + ] + ), preciseSpan (4479, 4583)) + , ( (Feature "CDS" [ ("codon_start", "1") + , ("gene", "bla") + , ("product", "beta-lactamase") + , ("note", "confers resistance to ampicillin, carbenicillin,\r\nand related antibiotics") + , ("label", "AmpR") + , ("ApEinfo_fwdcolor", "#e9d024") + , ("ApEinfo_revcolor", "#e9d024") + , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") ] + ), preciseSpan (4584, 5444)) + , ( (Feature "misc_feature" [ ("label", "RightITR2") + , ("ApEinfo_fwdcolor", "#7eff74") + , ("ApEinfo_revcolor", "#7eff74") + , ("ApEinfo_graphicformat", "arrow_data {{0 1 2 0 0 -1} {} 0}\r\nwidth 5 offset 0") + ] + ), preciseSpan (3527, 3667)) + , ( (Feature "misc_feature" [ ("label", "A->T") ] + ), Complement (Point 199)) + ] pAAVCMVOrigin :: String pAAVCMVOrigin = @@ -158,3 +213,118 @@ ] , comments=["."] } + +sophisticatedFeaturesSeq :: String +sophisticatedFeaturesSeq = "cctacagcgtgagctatgagaaagcgccacgcttcccgaagggagaaaggcggacaggtatccggtaagcggcagggtcggaacaggagagcgcacgagggagcttccagggggaaacgcctggtatctttatagtcctgtcgggtttcgccacctctgacttgagcgtcgatttttgtgatgctcgtcaggggggcggagcctatggaaaaacgccagcaacgcggcctttttacggttcctggccttttgctggccttttgctcacatgttctttcctgcgttatcccctgattctgtggataaccgtattaccgcctttgagtgagctgataccgctcgccgcagccgaacgaccgagcgcagcgagtcagtgagcgaggaagcgtacatttatattggctcatgtccaatatgaccgccatgttgacattgattattgactagaccgcgttacataacttacggtaaatggcccgcctggctgaccgcccaacgacccccgcccattgacgtcaataatgacgtatgttcccatagtaacgccaatagggactttccattgacgtcaatgggtggagtatttacggtaaactgcccacttggcagtacatcaagtgtatcatatgccaagtacgccccctattgacgtcaatgacggtaaatggcccgcctggcattatgcccagtacatgaccttatgggactttcctacttggcagtacatctacgtattagtcatcgctattaccatggtgatgcggttttggcagtacatcaatgggcgtggatagcggtttgactcacggggatttccaagtctccaccccattgacgtcaatgggagtttgttttggcaccaaaatcaacgggactttccaaaatgtcgtaacaactccgccccattgacgcaaatgggcggtaggcgtgtacggtgggaggtctatataagcagagctcgtttagtgaaccgtcagatcgcctggagacgccatccacgctgttttgacctccatagaagacaccgggaccgatccagcctccgcggccgggaacggtgcattggaacgcggattccccgtgccaagagtgacgtaagtaccgcctatagagtctataggcccacccccttggcttcttatgcatgctatactgtttttggcttggggtctatacacccccgcttcctcatgttataggtgatggtatagcttagcctataggtgtgggttattgaccattattgaccactcccctattggtgacgatactttccattactaatccataacatggctctttgccacaactctctttattggctatatgccaatacactgtccttcagagactgacacggactctgtatttttacaggatggggtctcatttattatttacaaattcacatatacaacaccaccgtccccagtgcccgcagtttttattaaacataacgtgggatctccacgcgaatctcgggtacgtgttccggacatgggctcatctccggtagcggcggagcttctacatccgagccctgctcccatgcctccagcgactcatggtcgctcggcagctccttgctcctaacagtggaggccagacttaggcacagcacgatgcccaccaccaccagtgtgccgcacaaggccgtggcggtagggtatgtgtctgaaaatgagctcggggagcgggcttgcaccgctgacgcatttggaagacttaaggcagcggcagaagaagatgcaggcagctgagttgttgtgttctgataagagtcagaggtaactcccgttgcggtgctgttaacggtggagggcagtgtagtctgagcagtactcgttgctgccgcgcgcgccaccagacataatagctgacagactaacagactgttcctttccatgggtcttttctgcagtcaccgtccttgacacgaagcttgccgccaccatggagaccgacaccctgctgctgtgggtgctgctgctgtgggtgcccgggtcgacgaagagctcatgagcggatacatatttgaatgtatttagaaaaataaacaaataggggtcagtgttacaaccaattaaccaattctgaacattatcgcgagcccatttatacctgaatatggctcataacaccccttgtttgcctggcggcagtagcgcggtggtcccacctgaccccatgccgaactcagaagtgaaacgccgtagcgccgatggtagtgtggggactccccatgcgagagtagggaactgccaggcatcaaataaaacgaaaggctcagtcgaaagactgggcctttcgcccgggctaattatggggtgtcgcccttggggtgagaccctcgagtgtacagaattcttactgatacgtgtccagatcaaccgctttcacgacctctaccagacacatgtgatcacggcgctcgtcgcggtctttgctcagtttggtgtggtaggtaatgtgatgataacgcgggatatgcactgccgcggagcccgccaacggacgattcatttggctgcatttggtaaccagtttttcggtcacaccttcaatatcgtacgcctggttgaactcaacgcggatgccattgttaacggtgtcaggcagaatatacagaatgcttggcgggcattggaatgcaacgttcttacgcagaatgtgaccgtctttcttaaagttctcaccagtcagcgtgacacgattgtagatagaaccgcgttcgtaggtaaccatagcacgcgtcttgtacacgccgtcgccttcgaagctgatggtacgctcttgggtataaccttccggcatggcgctcttaaagaaatccttgatgtggctcgggtacttgcgaaacactgaacaccgtagctcagggtgctcaccagggttgcccacgggacccggcaggtcgcccgtagtgcagatgtatttcgctttaatggtacccgtggtcgcgtcacccggtaccctcgcctttaatgataaatttcataccttcgacgtcgccttccagttcggtgatatacgggatctctttctcaaacagttttgcaccttccgtcaatgccgtcatatgtttacctcctaaggtctcgaaaagttaaacaaaattatttctaaagggaaaccgttgtggaattgtgagcgctcacaattccacatattataattgttatccgctcacaaagcaaataaatttttcatgatttcactgtgcatgaagctcgtaattgttatccgctcacaattaagggcgacacaaaatttattctaaatgataataaatactgataacatcttatagtttgtattatattttgtattatcgttgacatgtataattttgatatcaaaaactgattttccctttattattttcgagatttattttcttaattctctttaacaaactagaaatattgtatatacaaaaaatcataaataatagatgaatagtttaattataggtgttcatcaatcgaaaaagcaacgtatcttatttaaagtgcgttgcttttttctcatttataaggttaaataattctcatatatcaagcaaagtgacaggcgcccttaaatattctgacaaatgctctttccctaaactccccccataaaaaaacccgccgaagcgggtttttacgttatttgcggattaacgattactcgttatcagaaccgcccagggggcccgagcttaagactggccgtcgttttacaacacaagctcttccgtacggtggctgcaccatctgtcttcatcttcccgccatctgatgagcagttgaaatctggaactgcctctgttgtgtgcctgctgaataacttctatcccagagaggccaaagtacagtggaaggtggataacgccctccaatcgggtaactcccaggagagtgtcacagagcaggacagcaaggacagcacctacagcctcagcagcaccctgacgctgagcaaagcagactacgagaaacacaaagtctacgcctgcgaagtcacccatcagggcctgagctcgcccgtcacaaagagcttcaacaggggagagtgttaatagtctagacctaggtgatcataatcagccataccacatttgtagaggttttacttgctttaaaaaacctcccacacctccccctgaacctgaaacataaaatgaatgcaattgttgttgttaacttgtttattgcagcttataatggttacaaataaagcaatagcatcacaaatttcacaaataaagcatttttttcactgcattctagttgtggtttgtccaaactcatcaatgtatcttatcatgtctggagatctctagctagaggatcgatccccgccccggacgaactaaacctgactacgacatctctgccccttcttcgcggggcagtgcatgtaatcccttcagttggttggtacaacttgccaactgaaccctaaacgggtagcatatgcttcccgggtagtagtatatactatccagactaaccctaattcaatagcatatgttacccaacgggaagcatatgctatcgaattagggttagtaaaagggtcctaaggaacagcgatgtaggtgggcgggccaagataggggcgcgattgctgcgatctggaggacaaattacacacacttgcgcctgagcgccaagcacagggttgttggtcctcatattcacgaggtcgctgagagcacggtgggctaatgttgccatgggtagcatatactacccaaatatctggatagcatatgctatcctaatctatatctgggtagcataggctatcctaatctatatctgggtagcatatgctatcctaatctatatctgggtagtatatgctatcctaatttatatctgggtagcataggctatcctaatctatatctgggtagcatatgctatcctaatctatatctgggtagtatatgctatcctaatctgtatccgggtagcatatgctatcctaatagagattagggtagtatatgctatcctaatttatatctgggtagcatatactacccaaatatctggatagcatatgctatcctaatctatatctgggtagcatatgctatcctaatctatatctgggtagcataggctatcctaatctatatctgggtagcatatgctatcctaatctatatctgggtagtatatgctatcctaatttatatctgggtagcataggctatcctaatctatatctgggtagcatatgctatcctaatctatatctgggtagtatatgctatcctaatctgtatccgggtagcatatgctatcctcatgataagctgtcaaacatgagaattaattcttgaagacgaaagggcctcgtgatacgcctatttttataggttaatgtcatgataataatggtttcttagacgtcaggtggcacttttcggggaaatgtgcgcggaacccctatttgtttatttttctaaatacattcaaatatgtatccgctcatgagacaataaccctgataaatgcttcaataatattgaaaaaggaagagtatgagtattcaacatttccgtgtcgcccttattcccttttttgcggcattttgccttcctgtttttgctcacccagaaacgctggtgaaagtaaaagatgctgaagatcagttgggtgcacgagtgggttacatcgaactggatctcaacagcggtaagatccttgagagttttcgccccgaagaacgttttccaatgatgagcacttttaaagttctgctatgtggcgcggtattatcccgtgttgacgccgggcaagagcaactcggtcgccgcatacactattctcagaatgacttggttgagtactcaccagtcacagaaaagcatcttacggatggcatgacagtaagagaattatgcagtgctgccataaccatgagtgataacactgcggccaacttacttctgacaacgatcggaggaccgaaggagctaaccgcttttttgcacaacatgggggatcatgtaactcgccttgatcgttgggaaccggagctgaatgaagccataccaaacgacgagcgtgacaccacgatgcctgcagcaatggcaacaacgttgcgcaaactattaactggcgaactacttactctagcttcccggcaacaattaatagactggatggaggcggataaagttgcaggaccacttctgcgctcggcccttccggctggctggtttattgctgataaatctggagccggtgagcgtgggtctcgcggtatcattgcagcactggggccagatggtaagccctcccgtatcgtagttatctacacgacggggagtcaggcaactatggatgaacgaaatagacagatcgctgagataggtgcctcactgattaagcattggtaactgtcagaccaagtttactcatatatactttagattgatttaaaacttcatttttaatttaaaaggatctaggtgaagatcctttttgataatctcatgaccaaaatcccttaacgtgagttttcgttccactgagcgtcagaccccgtagaaaagatcaaaggatcttcttgagatcctttttttctgcgcgtaatctgctgcttgcaaacaaaaaaaccaccgctaccagcggtggtttgtttgccggatcaagagctaccaactctttttccgaaggtaactggcttcagcagagcgcagataccaaatactgttcttctagtgtagccgtagttaggccaccacttcaagaactctgtagcaccgcctacatacctcgctctgctaatcctgttaccagtggctgctgccagtggcgataagtcgtgtcttaccgggttggactcaagacgatagttaccggataaggcgcagcggtcgggctgaacggggggttcgtgcacacagcccagcttggagcgaacgacctacaccgaactgagata" + +sophisticatedFeatures :: [(Feature, Range)] +sophisticatedFeatures = + [ (Feature "source" + [ ("organism", "synthetic DNA construct") + , ("mol_type", "other DNA") + ] + , preciseSpan (0, 6950)) + + , (Feature "rep_origin" + [ ("label", "pUCorigin and also a multiline property") + , ("note", "/vntifkey=33") + ] + , Join [Point 0, preciseSpan (6550, 6950)]) + + , (Feature "enhancer" + [ ("label", "cmv enhanser") + , ("label", "cmv\\enhanser") + , ("note", "/vntifkey=9") + ] + , preciseSpan (448, 857)) + + , (Feature "misc_feature" + [ ("label", "hCMV promoter") + , ("label", "hCMV\\promoter") + , ("note", "/vntifkey=21") + ] + , preciseSpan (858, 983)) + + , (Feature "intron" + [ ("label", "IntronA") + , ("note", "/vntifkey=15") + ] + , preciseSpan (1011, 1918)) + + , (Feature "primer_bind" + [ ("label", "inv olig1") ] + , preciseSpan (1501, 1521)) + + , (Feature "misc_feature" + [ ("label", "Kozak") + , ("note", "/vntifkey=21") + ] + , preciseSpan (1944, 1952)) + + , (Feature "misc_feature" + [ ("label", "Leader IgK") + , ("note", "Leader IgK") + , ("note", "/ugene_name=Leader\\ IgK") + , ("note", "/vntifkey=21") + ] + , preciseSpan (1953, 2009)) + + , (Feature "misc_feature" + [ ("label", "START") + , ("note", "START") + , ("note", "/ugene_name=START") + , ("note", "/vntifkey=21") + ] + , preciseSpan (1953, 1955)) + + , (Feature "misc_feature" + [ ("label", "GFP stuffer") + , ("note", "GFP stuffer") + , ("note", "/ugene_name=GFP\\ stuffer") + , ("note", "/vntifkey=21") + ] + , preciseSpan (2010, 3738)) + + , (Feature "misc_feature" + [ ("label", "CK") + , ("note", "CK") + , ("note", "/ugene_name=CK") + , ("note", "/vntifkey=21") + ] + , preciseSpan (3739, 4059)) + + , (Feature "misc_feature" + [ ("label", "STOP") + , ("note", "STOP") + , ("note", "/ugene_name=STOP") + , ("note", "/vntifkey=21") + ] + , preciseSpan (4060, 4065)) + + , (Feature "misc_feature" + [ ("gene", "SV40_PA term") + , ("label", "SV40_PA term") + , ("label", "SV40_PA\\term") + , ("note", "/vntifkey=21") + ] + , preciseSpan (4078, 4316)) + + , (Feature "primer_bind" + [ ("label", "pEE_Clab") ] + , preciseSpan (4349, 4369)) + + , (Feature "rep_origin" + [ ("label", "EBV ori") + , ("label", "EBV\\ori") + , ("note", "/vntifkey=33") + ] + , preciseSpan (4581, 4974)) + + , (Feature "CDS" + [ ("codon_start", "1") + , ("label", "AmpR") + , ("note", "/vntifkey=4") + , ("translation", "MSIQHFRVALIPFFAAFCLPVFAHPETLVKVKDAEDQLGARVGYI\nELDLNSGKILESFRPEERFPMMSTFKVLLCGAVLSRVDAGQEQLGRRIHYSQNDLVEYS\nPVTEKHLTDGMTVRELCSAAITMSDNTAANLLLTTIGGPKELTAFLHNMGDHVTRLDRW\nEPELNEAIPNDERDTTMPAAMATTLRKLLTGELLTLASRQQLIDWMEADKVAGPLLRSA\nLPAGWFIADKSGAGERGSRGIIAALGPDGKPSRIVVIYTTGSQATMDERNRQIAEIGAS\nLIKHW") + ] + , preciseSpan (5542, 6402)) + ] diff --git a/test/RangeSpec.hs b/test/RangeSpec.hs new file mode 100644 --- /dev/null +++ b/test/RangeSpec.hs @@ -0,0 +1,290 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} + +module RangeSpec where + +import Bio.Sequence (Range (..), extendLeft, extendRight, mapRange, overlap, preciseSpan, + shiftRange) +import Test.Hspec + + +rangeSpec :: Spec +rangeSpec = do + rangeOverlapTests + rangeShiftTests + rangeMapTests + rangeExtendTests + +rangeOverlapTests :: Spec +rangeOverlapTests = describe "Range overlap tests" $ do + it "Point-Point, should not overlap" $ + overlap (Point 42) (Point 24) `shouldBe` False + it "Point-Point, should overlap" $ + overlap (Point 42) (Point 42) `shouldBe` True + + it "Point-Span, should not overlap" $ + overlap (Point 42) (preciseSpan (14, 24)) `shouldBe` False + it "Point-Span, should overlap" $ + overlap (Point 42) (preciseSpan (14, 42)) `shouldBe` True + it "Point-Span, should overlap" $ + overlap (Point 42) (preciseSpan (14, 43)) `shouldBe` True + it "Point-Span, should overlap" $ + overlap (Point 42) (preciseSpan (42, 50)) `shouldBe` True + it "Span-Point, should not overlap" $ + overlap (preciseSpan (14, 24)) (Point 42) `shouldBe` False + it "Span-Point, should overlap" $ + overlap (preciseSpan (14, 42)) (Point 42) `shouldBe` True + it "Span-Point, should overlap" $ + overlap (preciseSpan (14, 43)) (Point 42) `shouldBe` True + it "Span-Point, should overlap" $ + overlap (preciseSpan (42, 50)) (Point 42) `shouldBe` True + + it "Point-Between, should not overlap" $ + overlap (Point 42) (Between 42 43) `shouldBe` False + it "Between-Point, should not overlap" $ + overlap (Between 23 24) (Point 24) `shouldBe` False + + it "Point-Join, should not overlap" $ + overlap (Point 42) (Join [Point 24, preciseSpan (29, 41), Between 42 43, preciseSpan (77, 99)]) `shouldBe` False + it "Point-join, should overlap" $ + overlap (Point 42) (Join [Point 10, Point 20, preciseSpan (30, 50), Between 88 89]) `shouldBe` True + it "Join-Point, should not overlap" $ + flip overlap (Point 42) (Join [Point 24, preciseSpan (29, 41), Between 42 43, preciseSpan (77, 99)]) `shouldBe` False + it "Join-Point, should overlap" $ + flip overlap (Point 42) (Join [Point 10, Point 20, preciseSpan (30, 50), Between 88 89]) `shouldBe` True + + it "Point-Complement, should not overlap" $ + overlap (Point 42) (Join [Point 24, preciseSpan (29, 41), Between 42 43, preciseSpan (77, 99)]) `shouldBe` False + it "Point-Complement, should overlap" $ + overlap (Point 42) (Join [Point 10, Point 20, preciseSpan (30, 50), Between 88 89]) `shouldBe` True + it "Complement-Point, should not overlap" $ + flip overlap (Point 42) (Join [Point 24, preciseSpan (29, 41), Between 42 43, preciseSpan (77, 99)]) `shouldBe` False + it "Complement-Point, should overlap" $ + flip overlap (Point 42) (Join [Point 10, Point 20, preciseSpan (30, 50), Between 88 89]) `shouldBe` True + + it "Span-Span, should not overlap" $ + -- -----xxxxxxxxxxxxx--------------------------- + -- --------------------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (preciseSpan (30, 40)) `shouldBe` False + it "Span-Span, should not overlap" $ + -- -----xxxxxxxxxxxxx------------------- + -- ------------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (preciseSpan (21, 40)) `shouldBe` False + it "Span-Span, should overlap" $ + -- -----xxxxxxxxxxxxx------------------ + -- -----------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (preciseSpan (20, 40)) `shouldBe` True + it "Span-Span, should overlap" $ + -- -----xxxxxxxxxxxxx--------------- + -- --------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (preciseSpan (17, 40)) `shouldBe` True + it "Span-Span, should overlap" $ + -- -----xxxxxxxxxxxxx---------------- + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (preciseSpan (5, 40)) `shouldBe` True + it "Span-Span, should overlap" $ + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + -- -----xxxxxxxxxxxxx---------------- + overlap (preciseSpan (5, 40)) (preciseSpan (10, 20)) `shouldBe` True + + it "Span-Join, should not overlap" $ + -- ---xxxxxxxx-------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (preciseSpan (5, 10)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` False + it "Span-Join, should overlap" $ + -- ----xxxxxxxx------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (preciseSpan (6, 11)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Span-Join, should overlap" $ + -- ----------xxxxxxxx------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (preciseSpan (9, 18)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Span-Join, should overlap" $ + -- ------------------xxxxxxxx----------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (preciseSpan (18, 32)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Span-Join, should overlap" $ + -- -----------------------------xxxxxxxx + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (preciseSpan (40, 50)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Join-Span, should not overlap" $ + -- ---xxxxxxxx-------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (preciseSpan (5, 10)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` False + it "Join-Span, should overlap" $ + -- ----xxxxxxxx------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (preciseSpan (6, 11)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Join-Span, should overlap" $ + -- ----------xxxxxxxx------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (preciseSpan (9, 18)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Join-Span, should overlap" $ + -- ------------------xxxxxxxx----------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (preciseSpan (18, 32)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Join-Span, should overlap" $ + -- -----------------------------xxxxxxxx + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (preciseSpan (40, 50)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + + it "Span-Complement, should not overlap" $ + -- -----xxxxxxxxxxxxx--------------------------- + -- --------------------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (30, 40)) `shouldBe` False + it "Span-Complement, should not overlap" $ + -- -----xxxxxxxxxxxxx------------------- + -- ------------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (21, 40)) `shouldBe` False + it "Span-Complement, should overlap" $ + -- -----xxxxxxxxxxxxx------------------ + -- -----------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (20, 40)) `shouldBe` True + it "Span-Complement, should overlap" $ + -- -----xxxxxxxxxxxxx--------------- + -- --------------xxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (17, 40)) `shouldBe` True + it "Span-Complement, should overlap" $ + -- -----xxxxxxxxxxxxx---------------- + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (5, 40)) `shouldBe` True + it "Span-Complement, should overlap" $ + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + -- -----xxxxxxxxxxxxx---------------- + overlap (preciseSpan (5, 40)) (Complement $ preciseSpan (10, 20)) `shouldBe` True + it "Complement-Span, should not overlap" $ + -- -----xxxxxxxxxxxxx--------------------------- + -- --------------------------xxxxxxxxxxxxx------ + flip overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (30, 40)) `shouldBe` False + it "Complement-Span, should not overlap" $ + -- -----xxxxxxxxxxxxx------------------- + -- ------------------xxxxxxxxxxxxx------ + flip overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (21, 40)) `shouldBe` False + it "Complement-Span, should overlap" $ + -- -----xxxxxxxxxxxxx------------------ + -- -----------------xxxxxxxxxxxxx------ + flip overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (20, 40)) `shouldBe` True + it "Complement-Span, should overlap" $ + -- -----xxxxxxxxxxxxx--------------- + -- --------------xxxxxxxxxxxxx------ + flip overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (17, 40)) `shouldBe` True + it "Complement-Span, should overlap" $ + -- -----xxxxxxxxxxxxx---------------- + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + flip overlap (preciseSpan (10, 20)) (Complement $ preciseSpan (5, 40)) `shouldBe` True + it "Complement-Span, should overlap" $ + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + -- -----xxxxxxxxxxxxx---------------- + flip overlap (preciseSpan (5, 40)) (Complement $ preciseSpan (10, 20)) `shouldBe` True + + it "Join-Join, should not overlap" $ + -- ---xxx--|--xxxxx----x----xxxx------ + -- x|-----x---------xx---xx-------xxxx + overlap (Join [preciseSpan (5, 10), Between 15 16, preciseSpan (30, 40), Point 50, preciseSpan (60, 70)]) (Join [Point 1, Between 1 2, Point 15, preciseSpan (42, 46), preciseSpan (52, 55), preciseSpan (80, 100)]) `shouldBe` False + it "Join-Join, should overlap" $ + -- ---xxx--|--xxxxx----x----xxxx--- + -- x|-----x---------xx---xx----xxxx + overlap (Join [preciseSpan (5, 10), Between 15 16, preciseSpan (30, 40), Point 50, preciseSpan (60, 70)]) (Join [Point 1, Between 1 2, Point 15, preciseSpan (42, 46), preciseSpan (52, 55), preciseSpan (70, 100)]) `shouldBe` True + it "Join-Join, should overlap" $ + -- ---xxx--|--xxxxx--x------xxxx------ + -- x|-----x---------xx---xx-------xxxx + overlap (Join [preciseSpan (5, 10), Between 15 16, preciseSpan (30, 40), Point 46, preciseSpan (60, 70)]) (Join [Point 1, Between 1 2, Point 15, preciseSpan (42, 46), preciseSpan (52, 55), preciseSpan (80, 100)]) `shouldBe` True + + it "Join-Complement, should not overlap" $ + -- ---xxxxxxxx-------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (Complement $ preciseSpan (5, 10)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` False + it "Join-Complement, should overlap" $ + -- ----xxxxxxxx------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (Complement $ preciseSpan (6, 11)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Join-Complement, should overlap" $ + -- ----------xxxxxxxx------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (Complement $ preciseSpan (9, 18)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Join-Complement, should overlap" $ + -- ------------------xxxxxxxx----------- + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (Complement $ preciseSpan (18, 32)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Join-Complement, should overlap" $ + -- -----------------------------xxxxxxxx + -- -x---------|--xxxxx---xxxxxxxx------- + flip overlap (Complement $ preciseSpan (40, 50)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Complement-Join, should not overlap" $ + -- ---xxxxxxxx-------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (Complement $ preciseSpan (5, 10)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` False + it "Complement-Join, should overlap" $ + -- ----xxxxxxxx------------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (Complement $ preciseSpan (6, 11)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Complement-Join, should overlap" $ + -- ----------xxxxxxxx------------------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (Complement $ preciseSpan (9, 18)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Complement-Join, should overlap" $ + -- ------------------xxxxxxxx----------- + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (Complement $ preciseSpan (18, 32)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + it "Complement-Join, should overlap" $ + -- -----------------------------xxxxxxxx + -- -x---------|--xxxxx---xxxxxxxx------- + overlap (Complement $ preciseSpan (40, 50)) (Join [Point 2, Between 10 11, preciseSpan (15, 20), preciseSpan (30, 40)]) `shouldBe` True + + it "Complement-Complement, should not overlap" $ + -- -----xxxxxxxxxxxxx--------------------------- + -- --------------------------xxxxxxxxxxxxx------ + overlap (Complement $ preciseSpan (10, 20)) (Complement $ preciseSpan (30, 40)) `shouldBe` False + it "Complement-Complement, should not overlap" $ + -- -----xxxxxxxxxxxxx------------------- + -- ------------------xxxxxxxxxxxxx------ + overlap (Complement $ preciseSpan (10, 20)) (Complement $ preciseSpan (21, 40)) `shouldBe` False + it "Complement-Complement, should overlap" $ + -- -----xxxxxxxxxxxxx------------------ + -- -----------------xxxxxxxxxxxxx------ + overlap (Complement $ preciseSpan (10, 20)) (Complement $ preciseSpan (20, 40)) `shouldBe` True + it "Complement-Complement, should overlap" $ + -- -----xxxxxxxxxxxxx--------------- + -- --------------xxxxxxxxxxxxx------ + overlap (Complement $ preciseSpan (10, 20)) (Complement $ preciseSpan (17, 40)) `shouldBe` True + it "Complement-Complement, should overlap" $ + -- -----xxxxxxxxxxxxx---------------- + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + overlap (Complement $ preciseSpan (10, 20)) (Complement $ preciseSpan (5, 40)) `shouldBe` True + it "Complement-Complement, should overlap" $ + -- ---xxxxxxxxxxxxxxxxxxxxxxxxx------ + -- -----xxxxxxxxxxxxx---------------- + overlap (Complement $ preciseSpan (5, 40)) (Complement $ preciseSpan (10, 20)) `shouldBe` True + + +rangeShiftTests :: Spec +rangeShiftTests = describe "Range shift tests" $ do + it "Shifts a point" $ shiftRange 22 (Point 20) `shouldBe` Point 42 + it "Shifts a Between feature" $ shiftRange 22 (Between 20 21) `shouldBe` Between 42 43 + it "Shifts a span" $ shiftRange 22 (preciseSpan (20, 21)) `shouldBe` preciseSpan (42, 43) + it "Shifts a Join feature" $ shiftRange 22 (Join [Point 10, Between 11 12, preciseSpan (13, 14)]) `shouldBe` Join [Point 32, Between 33 34, preciseSpan (35, 36)] + it "Shifts a Complement feature" $ shiftRange 22 (Complement $ Point 20) `shouldBe` Complement (Point 42) + +rangeMapTests :: Spec +rangeMapTests = describe "Range map tests" $ do + it "Maps a point" $ mapRange ((-) 1) (Point 20) `shouldBe` Point (-19) + it "Maps a Between feature" $ mapRange ((-) 1) (Between 20 21) `shouldBe` Between (-19) (-20) + it "Maps a span" $ mapRange ((-) 1) (preciseSpan (20, 21)) `shouldBe` preciseSpan (-19, -20) + it "Maps a Join feature" $ mapRange ((-) 1) (Join [Point 10, Between 11 12, preciseSpan (13, 14)]) `shouldBe` Join [Point (-9), Between (-10) (-11), preciseSpan (-12, -13)] + it "Maps a Complement feature" $ mapRange ((-) 1) (Complement $ Point 20) `shouldBe` Complement (Point (-19)) + +rangeExtendTests :: Spec +rangeExtendTests = do + describe "Range extend tests" $ do + describe "Extend left" $ do + it "Extends a point" $ extendLeft 10 (Point 10) `shouldBe` preciseSpan (0, 10) + it "Extends a Between feature" $ extendLeft 10 (Between 10 11) `shouldBe` Between 10 11 + it "Extends a span" $ extendLeft 10 (preciseSpan (10, 20)) `shouldBe` preciseSpan (0, 20) + it "Extends a Join feature" $ extendLeft 10 (Join [Point 10, Between 11 12, preciseSpan (13, 14)]) `shouldBe` Join [preciseSpan (0, 10), Between 11 12, preciseSpan (3, 14)] + it "Extends a Complement feature" $ extendLeft 10 (Complement $ Point 10) `shouldBe` (Complement $ preciseSpan (0, 10)) + describe "Extend right" $ do + it "Extends a point" $ extendRight 10 (Point 10) `shouldBe` preciseSpan (10, 20) + it "Extends a Between feature" $ extendRight 10 (Between 10 11) `shouldBe` Between 10 11 + it "Extends a span" $ extendRight 10 (preciseSpan (10, 20)) `shouldBe` preciseSpan (10, 30) + it "Extends a Join feature" $ extendRight 10 (Join [Point 10, Between 11 12, preciseSpan (13, 14)]) `shouldBe` Join [preciseSpan (10, 20), Between 11 12, preciseSpan (13, 24)] + it "Extends a Complement feature" $ extendRight 10 (Complement $ Point 10) `shouldBe` (Complement $ preciseSpan (10, 20)) diff --git a/test/SequenceSpec.hs b/test/SequenceSpec.hs --- a/test/SequenceSpec.hs +++ b/test/SequenceSpec.hs @@ -3,19 +3,18 @@ module SequenceSpec where -import Bio.Sequence (BareSequence, IsMarking, IsWeight (..), - MarkedSequence, Sequence, WeightedSequence, - addMarkings, bareSequence, createSequence, - drop, getMarking, getRange, getWeight, - markedSequence, mean, meanInRange, reverse, - tail, take, toMarked, toWeighted, - unsafeCreateSequence, unsafeMarkedSequence, - unsafeWeightedSequence, weightedSequence) import qualified Data.List.NonEmpty as NE (fromList) import Data.Text (Text) import Prelude hiding (drop, reverse, tail, take) import Test.Hspec +import Bio.Sequence (BareSequence, IsMarking, IsWeight (..), MarkedSequence, + Range (..), Sequence, WeightedSequence, addMarkings, + bareSequence, createSequence, drop, getMarking, getRange, + getWeight, markedSequence, mean, meanInRange, preciseSpan, + reverse, tail, take, toMarked, toWeighted, unsafeCreateSequence, + unsafeMarkedSequence, unsafeWeightedSequence, weightedSequence) + instance IsWeight Int where toDouble = fromIntegral @@ -44,7 +43,8 @@ let seqE = weightedSequence [] [] :: Either Text TestWeightedSequence seqE `shouldBe` seqErr1 -newtype TestMarking = TestMarking Text +newtype TestMarking + = TestMarking Text deriving (Eq, Show, Ord) instance IsMarking TestMarking @@ -55,11 +55,11 @@ markedSequenceSpec = describe "Marked sequence" $ do it "successful creation of marked sequence" $ do - let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] :: Either Text TestMarkedSequence - seqE `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))]) + let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] :: Either Text TestMarkedSequence + seqE `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))]) - let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", (1, 5)), (TestMarking "a", (3, 5))] :: Either Text TestMarkedSequence - seqE `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", (1, 5)), (TestMarking "a", (3, 5))]) + let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", preciseSpan (1, 4)), (TestMarking "a", preciseSpan (3, 4))] :: Either Text TestMarkedSequence + seqE `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", preciseSpan (1, 4)), (TestMarking "a", preciseSpan (3, 4))]) let seqE = markedSequence [] [] :: Either Text TestMarkedSequence seqE `shouldBe` Right (unsafeMarkedSequence [] []) @@ -67,19 +67,18 @@ let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [] :: Either Text TestMarkedSequence seqE `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] []) it "unsuccessful creation of marked sequence" $ do - let seqErr = Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking." - let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (-1, 1))] :: Either Text TestMarkedSequence - seqE `shouldBe` seqErr + let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", preciseSpan (-1, 0))] :: Either Text TestMarkedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = -1}, _upper = RangeBorder {_borderType = Precise, _borderLocation = 0}}\n" - let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", (0, 6)), (TestMarking "a", (3, 5))] :: Either Text TestMarkedSequence - seqE `shouldBe` seqErr + let seqE = markedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", preciseSpan (0, 5)), (TestMarking "a", preciseSpan (3, 4))] :: Either Text TestMarkedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = 0}, _upper = RangeBorder {_borderType = Precise, _borderLocation = 5}}\n" - let seqE = markedSequence ['a'] [(TestMarking "a", (0, 0))] :: Either Text TestMarkedSequence - seqE `shouldBe` seqErr + let seqE = markedSequence ['a'] [(TestMarking "a", preciseSpan (0, -1))] :: Either Text TestMarkedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = 0}, _upper = RangeBorder {_borderType = Precise, _borderLocation = -1}}\n" - let seqE = markedSequence [] [(TestMarking "k", (0, 1))] :: Either Text TestMarkedSequence - seqE `shouldBe` seqErr + let seqE = markedSequence [] [(TestMarking "k", Point 0)] :: Either Text TestMarkedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nPoint {_location = 0}\n" type TestMarkedAndWeightedSequence = Sequence TestMarking Int Char @@ -87,38 +86,37 @@ markedAndWeightedSequenceSpec = describe "Marked and weighted sequence" $ do it "successful creation of marked and weighted sequence" $ do - let seqE = createSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence - seqE `shouldBe` Right (unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] [1, 2.. 5]) + let seqE = createSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence + seqE `shouldBe` Right (unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] [1, 2.. 5]) it "unsuccessful creation of marked and weighted sequence" $ do - let seqErr = Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking." - let seqE = createSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (-1, 1))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence - seqE `shouldBe` seqErr + let seqE = createSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", preciseSpan (-1, 0))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = -1}, _upper = RangeBorder {_borderType = Precise, _borderLocation = 0}}\n" - let seqE = createSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", (0, 6)), (TestMarking "a", (3, 5))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence - seqE `shouldBe` seqErr + let seqE = createSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "bca", preciseSpan (0, 5)), (TestMarking "a", preciseSpan (3, 4))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = 0}, _upper = RangeBorder {_borderType = Precise, _borderLocation = 5}}\n" - let seqE = createSequence ['a'] [(TestMarking "a", (0, 0))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence - seqE `shouldBe` seqErr + let seqE = createSequence ['a'] [(TestMarking "a", preciseSpan (0, -1))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = 0}, _upper = RangeBorder {_borderType = Precise, _borderLocation = -1}}\n" - let seqE = createSequence [] [(TestMarking "k", (0, 1))] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence - seqE `shouldBe` seqErr + let seqE = createSequence [] [(TestMarking "k", Point 0)] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nPoint {_location = 0}\n" - let seqE = createSequence ['a', 'b', 'c', 'd'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] [1, 2, 4] :: Either Text TestMarkedAndWeightedSequence - seqE `shouldBe` seqErr + let seqE = createSequence ['a', 'b', 'c', 'd'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] [1, 2, 4] :: Either Text TestMarkedAndWeightedSequence + seqE `shouldBe` Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = 3}, _upper = RangeBorder {_borderType = Precise, _borderLocation = 4}}\n" let seqE = createSequence ['a', 'b', 'c', 'a', 'a'] [] [1, 2.. 5] :: Either Text TestMarkedAndWeightedSequence seqE `shouldBe` Right (unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [] [1, 2.. 5]) let seqErr1 = Left "Bio.Sequence.Class: sequence and weights have different lengths." - let seqE = createSequence ['a', 'b', 'c', 'd'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 4))] [1, 2] :: Either Text TestMarkedAndWeightedSequence + let seqE = createSequence ['a', 'b', 'c', 'd'] [(TestMarking "a", Point 0), (TestMarking "a", Point 3)] [1, 2] :: Either Text TestMarkedAndWeightedSequence seqE `shouldBe` seqErr1 let seqErr2 = Left "Bio.Sequence.Class: weights are null for sequence." - let seqE = createSequence ['a', 'b', 'c', 'd'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 4))] [] :: Either Text TestMarkedAndWeightedSequence + let seqE = createSequence ['a', 'b', 'c', 'd'] [(TestMarking "a", Point 0), (TestMarking "a", Point 3)] [] :: Either Text TestMarkedAndWeightedSequence seqE `shouldBe` seqErr2 functionsSpec :: Spec @@ -145,32 +143,32 @@ getRangeSpec = describe "getRange" $ do let getRangeError = Left "Bio.Sequence.Functions.Sequence: invalid range in getRange." - let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] [1, 2.. 5] :: TestMarkedAndWeightedSequence + let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] [1, 2.. 5] :: TestMarkedAndWeightedSequence - it "sequence: ['a', 'b', 'c', 'a', 'a']; range: (0, 1)" $ do - getRange s (0, 1) `shouldBe` Right ['a'] - it "sequence: ['a', 'b', 'c', 'a', 'a']; range: (2, 5)" $ do - getRange s (2, 5) `shouldBe` Right ['c', 'a', 'a'] - it "sequence: ['a', 'b', 'c', 'a', 'a', 'd', 'e']; range: (5, 7)" $ do - let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a', 'd', 'e'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] [1, 2.. 7] :: TestMarkedAndWeightedSequence - getRange s (5, 7) `shouldBe` Right ['d', 'e'] - it "sequence: ['a', 'b', 'c', 'a', 'a']; range: (0, 0)" $ do - getRange s (0, 0) `shouldBe` getRangeError - it "sequence: ['a', 'b', 'c', 'a', 'a']; range: (3, 8)" $ do - getRange s (3, 8) `shouldBe` getRangeError + it "sequence: ['a', 'b', 'c', 'a', 'a']; range: 0" $ do + getRange s (Point 0) `shouldBe` Right ['a'] + it "sequence: ['a', 'b', 'c', 'a', 'a']; range: (2, 4)" $ do + getRange s (preciseSpan (2, 4)) `shouldBe` Right ['c', 'a', 'a'] + it "sequence: ['a', 'b', 'c', 'a', 'a', 'd', 'e']; range: (5, 6)" $ do + let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a', 'd', 'e'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] [1, 2.. 7] :: TestMarkedAndWeightedSequence + getRange s (preciseSpan (5, 6)) `shouldBe` Right ['d', 'e'] + it "sequence: ['a', 'b', 'c', 'a', 'a']; range: (0, -1)" $ do + getRange s (preciseSpan (0, -1)) `shouldBe` getRangeError + it "sequence: ['a', 'b', 'c', 'a', 'a']; range: (3, 7)" $ do + getRange s (preciseSpan (3, 7)) `shouldBe` getRangeError reverseSpec :: Spec reverseSpec = describe "reverse" $ do it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 1)), (a, (3, 5))]; weights: [1, 2.. 5]" $ do - let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] [1, 2.. 5] :: TestMarkedAndWeightedSequence - reverse s `shouldBe` unsafeCreateSequence ['a', 'a', 'c', 'b', 'a'] [(TestMarking "a", (4, 5)), (TestMarking "a", (0, 2))] [5, 4.. 1] + let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] [1, 2.. 5] :: TestMarkedAndWeightedSequence + reverse s `shouldBe` unsafeCreateSequence ['a', 'a', 'c', 'b', 'a'] [(TestMarking "a", Point 4), (TestMarking "a", preciseSpan (0, 1))] [5, 4.. 1] it "sequence: ['a', 'b']; markings: []; weights: [1, 2]" $ do let s = unsafeWeightedSequence ['a', 'b'] [1, 2] :: TestWeightedSequence reverse s `shouldBe` unsafeWeightedSequence ['b', 'a'] [2, 1] it "sequence: ['a', 'b', 'c', 'd', 'e']; markings: [(abc, (0, 3)), (abcd, (0, 4)), (de, (3, 5)), (abcde, (0, 5))]; weights: []" $ do - let s = unsafeMarkedSequence ['a', 'b', 'c', 'd', 'e'] [(TestMarking "abc", (0, 3)), (TestMarking "abcd", (0, 4)), (TestMarking "de", (3, 5)), (TestMarking "abcde", (0, 5))] :: TestMarkedSequence - reverse s `shouldBe` unsafeMarkedSequence ['e', 'd', 'c', 'b', 'a'] [(TestMarking "abc", (2, 5)), (TestMarking "abcd", (1, 5)), (TestMarking "de", (0, 2)), (TestMarking "abcde", (0, 5))] + let s = unsafeMarkedSequence ['a', 'b', 'c', 'd', 'e'] [(TestMarking "abc", preciseSpan (0, 2)), (TestMarking "abcd", preciseSpan (0, 3)), (TestMarking "de", preciseSpan (3, 4)), (TestMarking "abcde", preciseSpan (0, 4))] :: TestMarkedSequence + reverse s `shouldBe` unsafeMarkedSequence ['e', 'd', 'c', 'b', 'a'] [(TestMarking "abc", preciseSpan (2, 4)), (TestMarking "abcd", preciseSpan (1, 4)), (TestMarking "de", preciseSpan (0, 1)), (TestMarking "abcde", preciseSpan (0, 4))] dropSpec :: Spec dropSpec = @@ -214,11 +212,11 @@ getMarkingSpec :: Spec getMarkingSpec = describe "getMarking" $ do - it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 1)), (a, (3, 5))]; get: a" $ do - let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] [1, 2.. 5] :: TestMarkedAndWeightedSequence + it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, 0), (a, (3, 4))]; get: a" $ do + let s = unsafeCreateSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] [1, 2.. 5] :: TestMarkedAndWeightedSequence getMarking s (TestMarking "a") `shouldBe` Right (NE.fromList [['a'], ['a', 'a']]) it "sequence: ['a', 'b', 'c', 'd', 'e']; markings: [(abc, (0, 3)), (abcd, (0, 4)), (de, (3, 5)), (abcde, (0, 5))]; get: abcde" $ do - let s = unsafeMarkedSequence ['a', 'b', 'c', 'd', 'e'] [(TestMarking "abc", (0, 3)), (TestMarking "abcd", (0, 4)), (TestMarking "de", (3, 5)), (TestMarking "abcde", (0, 5))] :: TestMarkedSequence + let s = unsafeMarkedSequence ['a', 'b', 'c', 'd', 'e'] [(TestMarking "abc", preciseSpan (0, 2)), (TestMarking "abcd", preciseSpan (0, 3)), (TestMarking "de", preciseSpan (3, 4)), (TestMarking "abcde", preciseSpan (0, 4))] :: TestMarkedSequence getMarking s (TestMarking "abcde") `shouldBe` Right (NE.fromList [['a', 'b', 'c', 'd', 'e']]) type TestBareSequence = BareSequence Char @@ -229,25 +227,25 @@ let s = bareSequence ['a', 'b', 'c', 'a', 'a'] :: TestBareSequence it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 1)), (a, (3, 5))]" $ do - (toMarked s [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] :: Either Text TestMarkedSequence) `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))]) + (toMarked s [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] :: Either Text TestMarkedSequence) `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))]) it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 6)), (a, (3, 5))]" $ do - let rangesError = Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking." - (toMarked s [(TestMarking "a", (0, 6)), (TestMarking "a", (3, 5))] :: Either Text TestMarkedSequence) `shouldBe` rangesError + let rangesError = Left "Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \nSpan {_lower = RangeBorder {_borderType = Precise, _borderLocation = 0}, _upper = RangeBorder {_borderType = Precise, _borderLocation = 5}}\n" + (toMarked s [(TestMarking "a", preciseSpan (0, 5)), (TestMarking "a", preciseSpan (3, 4))] :: Either Text TestMarkedSequence) `shouldBe` rangesError addMarkingsSpec :: Spec addMarkingsSpec = describe "addMarkings" $ do - let s = unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5))] :: TestMarkedSequence + let s = unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4))] :: TestMarkedSequence let rangesError = Left "Bio.Sequence.Functions.Marking: can't add markings to Sequence, because some of them are out of range." it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 1)), (a, (3, 5))]; add: [(b, (1, 2))]" $ do - addMarkings s [(TestMarking "b", (1, 2))] `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5)), (TestMarking "b", (1, 2))]) + addMarkings s [(TestMarking "b", Point 1)] `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4)), (TestMarking "b", Point 1)]) it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 1)), (a, (3, 5))]; add: []" $ do addMarkings s [] `shouldBe` Right s it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 1)), (a, (3, 5))]; add: [(b, (1, 2)), (c, (2, 3)), (abcaa, (0, 5))]" $ do - addMarkings s [(TestMarking "b", (1, 2)), (TestMarking "c", (2, 3)), (TestMarking "abcaa", (0, 5))] `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", (0, 1)), (TestMarking "a", (3, 5)), (TestMarking "b", (1, 2)), (TestMarking "c", (2, 3)), (TestMarking "abcaa", (0, 5))]) + addMarkings s [(TestMarking "b", Point 1), (TestMarking "c", Point 2), (TestMarking "abcaa", preciseSpan (0, 4))] `shouldBe` Right (unsafeMarkedSequence ['a', 'b', 'c', 'a', 'a'] [(TestMarking "a", Point 0), (TestMarking "a", preciseSpan (3, 4)), (TestMarking "b", Point 1), (TestMarking "c", Point 2), (TestMarking "abcaa", preciseSpan (0, 4))]) it "sequence: ['a', 'b', 'c', 'a', 'a']; markings: [(a, (0, 1)), (a, (3, 5))]; add: [(b, (1, 2)), (c, (2, 3)), (abcaa, (0, 6))]" $ do - addMarkings s [(TestMarking "b", (1, 2)), (TestMarking "c", (2, 3)), (TestMarking "abcaa", (0, 6))] `shouldBe` rangesError + addMarkings s [(TestMarking "b", Point 1), (TestMarking "c", Point 2), (TestMarking "abcaa",preciseSpan (0, 5))] `shouldBe` rangesError meanAndMeanInRangeSpec :: Spec meanAndMeanInRangeSpec = diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,20 +1,21 @@ -import ABISpec -import FastaParserSpec -import FASTASpec -import FastaWriterSpec -import GBParserSpec -import GBWriterSpec -import MAEParserSpec -import MAESpec -import MMTFSpec -import PDBParserSpec -import PDBSpec -import PDBWriterSpec -import SequenceSpec -import StructureSpec -import System.IO -import Test.Hspec -import UniprotSpec +import ABISpec +import FASTASpec +import FastaParserSpec +import FastaWriterSpec +import GBParserSpec +import GBWriterSpec +import MAEParserSpec +import MAESpec +import MMTFSpec +import PDBParserSpec +import PDBSpec +import PDBWriterSpec +import RangeSpec +import SequenceSpec +import StructureSpec +import System.IO +import Test.Hspec +import UniprotSpec main :: IO () main = do @@ -23,6 +24,8 @@ -- MMTF mmtfCodecSpec mmtfParserSpec + -- Range + rangeSpec -- Sequence weightedSequenceSpec markedSequenceSpec