diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Juan Paucar + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/spec/Spec.hs b/spec/Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/src/Bio/VCF/Internal/Types.hs b/src/Bio/VCF/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Bio/VCF/Internal/Types.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +{-# OPTIONS_GHC -funbox-strict-fields #-} + +module Bio.VCF.Internal.Types +( VCF(..) +, Header(..) +, Variation(..) +, Genotypes +, Patient(..) +) where + + +import Data.Aeson +import Data.Aeson.Types (typeMismatch) +import Data.ByteString (ByteString) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import GHC.Generics + +------------------------------------------------------------------------------- +-- Orphan instances for JSON from String, we are not really using BSON +------------------------------------------------------------------------------- + +instance FromJSON ByteString where + parseJSON (String a) = pure $ encodeUtf8 a + parseJSON invalid = typeMismatch "ByteString" invalid + +instance ToJSON ByteString where + toJSON = String . decodeUtf8 + +------------------------------------------------------------------------------- +------------------------------------------------------------------------------- + +data VCF = VCF + { header :: !Header + , variations :: ![(Variation, [ByteString])] + } deriving (Eq, Generic, Show) + +instance FromJSON VCF + +instance ToJSON VCF + + +data Header = Header + { fileFormat :: !ByteString + , informationFields :: ![InformationField] + , filterFields :: ![FilterField] + , formatFields :: ![FormatField] + , alternativeAlleleFields :: ![AlternativeAlleleField] + , assemblyField :: !ByteString + , contigFields :: ![ContigField] + , sampleFields :: ![SampleField] + , pedigreeFields :: !PedigreeInformation + } deriving (Eq, Generic, Show) + +instance FromJSON Header + +instance ToJSON Header + + +data Variation = Variation + { chrom :: !ByteString + , pos :: !Int + , idx :: ![ByteString] + , ref :: !ByteString + , alt :: ![ByteString] + , qual :: !(Maybe Float) + , filt :: ![ByteString] + , info :: ![ByteString] + , format :: !(Maybe [ByteString]) + } deriving (Eq, Generic, Show) + +instance FromJSON Variation + +instance ToJSON Variation + + +newtype Patient = Patient ByteString deriving (Eq, Generic, Show) + +instance FromJSON Patient + +instance ToJSON Patient + + +-- TODO: Probably it's a good idea to put these type alias inside their own +-- newtypes or check for a better way to represent them +-- +type InformationField = ByteString + +type FilterField = ByteString + +type FormatField = ByteString + +type AlternativeAlleleField = ByteString + +type ContigField = ByteString + +type SampleField = ByteString + +type PedigreeInformation = ByteString + +type Genotypes = [ByteString] + diff --git a/src/Bio/VCF/Parser/Helpers.hs b/src/Bio/VCF/Parser/Helpers.hs new file mode 100644 --- /dev/null +++ b/src/Bio/VCF/Parser/Helpers.hs @@ -0,0 +1,45 @@ +module Bio.VCF.Parser.Helpers +( tabOrSpace +, isTab +, isSpace +, notTabOrSpace +, isNumber +, isFloatNumber +, isBase +, isBaseOrDeletion +, endOfLine +) where + +import Data.Word (Word8) + +tabOrSpace :: Word8 -> Bool +tabOrSpace c = isTab c || isSpace c + +isTab :: Word8 -> Bool +isTab c = c == 9 + +isSpace :: Word8 -> Bool +isSpace c = c == 32 + +notTabOrSpace :: Word8 -> Bool +notTabOrSpace = not . tabOrSpace + +isNumber :: Word8 -> Bool +isNumber c = c >= 48 && c <= 57 + +isFloatNumber :: Word8 -> Bool +isFloatNumber c = isNumber c || c == 46 -- '.' + +isBase :: Word8 -> Bool +isBase c = c == 65 || c == 97 || -- A or a + c == 67 || c == 99 || -- C or c + c == 71 || c == 103 || -- G or g + c == 84 || c == 116 || -- T or t + c == 78 || c == 110 -- N or n + +isBaseOrDeletion :: Word8 -> Bool +isBaseOrDeletion c = isBase c || c == 42 || c == 44 || -- or '*' and ',' + c == 60 || c == 62 -- '<' and '>' + +endOfLine :: Word8 -> Bool +endOfLine c = c == 13 || c == 10 diff --git a/src/Bio/VCF/Parser/Parser.hs b/src/Bio/VCF/Parser/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Bio/VCF/Parser/Parser.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Bio.VCF.Parser.Parser where + +import qualified Data.Attoparsec.ByteString.Char8 as AC8 (notChar, char) +import qualified Data.ByteString as B (ByteString, append) +import qualified Data.ByteString.Char8 as BS8 (singleton, words, unpack, split) +import Control.Applicative (liftA2, (<|>), (<$>)) +import Data.Attoparsec.ByteString (try, takeWhile1, takeByteString, skipWhile, Parser, string, takeTill) +import Text.Read (readMaybe) + +import Bio.VCF.Internal.Types +import Bio.VCF.Parser.Helpers + +parseMetaInformation :: Parser B.ByteString +parseMetaInformation = AC8.char '#' *> + AC8.char '#' *> + takeByteString + +parseFormatLine :: Parser B.ByteString +parseFormatLine = AC8.char '#' *> + liftA2 B.append + (BS8.singleton `fmap` AC8.notChar '#') + takeByteString + +parsePatients :: Parser [Patient] +parsePatients = AC8.char '#' *> + string "CHROM" *> + skipWhile tabOrSpace *> + string "POS" *> + skipWhile tabOrSpace *> + string "ID" *> + skipWhile tabOrSpace *> + string "REF" *> + skipWhile tabOrSpace *> + string "ALT" *> + skipWhile tabOrSpace *> + string "QUAL" *> + skipWhile tabOrSpace *> + string "FILTER" *> + skipWhile tabOrSpace *> + string "INFO" *> + skipWhile tabOrSpace *> + string "FORMAT" *> + skipWhile tabOrSpace *> +--TODO use `sepBy` in this part instead of words to gain performance + (fmap . fmap) Patient (BS8.words <$> takeTill endOfLine) + +parseChrom :: Parser B.ByteString +parseChrom = try (string "") <|> takeWhile1 notTabOrSpace + +{-We don't care about the additional characters, it should be delegated to + - the whole parser-} +parsePosition :: Parser Int +parsePosition = read . BS8.unpack <$> takeWhile1 isNumber + +parseID :: Parser [B.ByteString] +parseID = BS8.split ':' <$> takeWhile1 notTabOrSpace + +parseRef :: Parser B.ByteString +parseRef = takeWhile1 isBase + +parseAlt :: Parser [B.ByteString] +parseAlt = try (makeList <$> string "") <|> + BS8.split ',' <$> takeWhile1 isBaseOrDeletion + where makeList x = [x] + +parseQual :: Parser (Maybe Float) +parseQual = readMaybe . BS8.unpack <$> takeWhile1 isFloatNumber + +parseFilter :: Parser [B.ByteString] +parseFilter = try (makeList <$> string "PASS") <|> + BS8.split ';' <$> takeWhile1 notTabOrSpace + where makeList x = [x] + +parseInformation :: Parser [B.ByteString] +parseInformation = BS8.split ';' <$> takeWhile1 notTabOrSpace + +parseFormat :: Parser (Maybe [B.ByteString]) +parseFormat = try ((Just . BS8.split ':') <$> takeWhile1 notTabOrSpace) <|> + pure Nothing + +parseGenotypes :: Parser [Genotypes] +parseGenotypes = fmap (BS8.split ':') . BS8.split ' ' <$> takeByteString + +parseVariation :: Parser (Variation, [Genotypes]) +parseVariation = do + vChrom <- parseChrom + skipWhile tabOrSpace + vPos <- parsePosition + skipWhile tabOrSpace + vId <- parseID + skipWhile tabOrSpace + vRef <- parseRef + skipWhile tabOrSpace + vAlt <- parseAlt + skipWhile tabOrSpace + vQual <- parseQual + skipWhile tabOrSpace + vFilter <- parseFilter + skipWhile tabOrSpace + vInfo <- parseInformation + skipWhile tabOrSpace + maybeFormat <- parseFormat + let variation = Variation vChrom vPos vId vRef vAlt vQual vFilter vInfo Nothing + case maybeFormat of + Just formats -> do + skipWhile tabOrSpace + genotypes <- parseGenotypes + return (variation{format = Just formats}, genotypes) + Nothing -> return (variation, []) diff --git a/vcf.cabal b/vcf.cabal new file mode 100644 --- /dev/null +++ b/vcf.cabal @@ -0,0 +1,45 @@ +name: vcf +version: 0.9.0 +synopsis: A package to parse VCF files inspired in similar python libraries +-- description: +license: MIT +license-file: LICENSE +author: Juan Paucar +maintainer: juantotish1@hotmail.com +-- copyright: +category: Bioinformatics +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + ghc-options : -Wall -O2 -optc-03 -optc-ffast-math -funfolding-use-threshold=16 -fno-warn-orphans + exposed-modules: Bio.VCF.Internal.Types, + Bio.VCF.Parser.Parser, + Bio.VCF.Parser.Helpers + -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && < 5, + aeson, + attoparsec >= 0.13, + bytestring, + text + hs-source-dirs: src + default-language: Haskell2010 + +test-suite spec + ghc-options : -Wall + type : exitcode-stdio-1.0 + hs-source-dirs : spec + main-is : Spec.hs + build-depends : base >=4.8 && < 5, + hspec, + hspec-expectations, + bytestring, + attoparsec, + vcf + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/juanpaucar/vcf