{-# LANGUAGE OverloadedStrings #-}

{-| A module to help with parsing VCF files. The VCF format is defined here:
<https://en.wikipedia.org/wiki/Variant_Call_Format>
-}

module SequenceFormats.VCF (VCFheader(..),
                     VCFentry(..),
                     vcfHeaderParser,
                     readVCFfromStdIn,
                     readVCFfromFile,
                     getGenotypes,
                     getDosages,
                     isTransversionSnp,
                     vcfToFreqSumEntry,
                     isBiallelicSnp,
                     printVCFtoStdOut,
                     writeVCFfile) where

import           SequenceFormats.FreqSum          (FreqSumEntry (..))
import           SequenceFormats.Utils            (Chrom (..),
                                                   SeqFormatException (..),
                                                   consumeProducer,
                                                   deflateFinaliser,
                                                   gzipConsumer,
                                                   readFileProdCheckCompress,
                                                   word, writeFromPopper)

import           Control.Applicative              ((<|>))
import           Control.Error                    (atErr)
import           Control.Monad                    (forM, unless, void)
import           Control.Monad.Catch              (MonadThrow, throwM)
import           Control.Monad.IO.Class           (MonadIO, liftIO)
import           Control.Monad.Trans.Class        (lift)
import           Control.Monad.Trans.State.Strict (runStateT)
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8            as B
import           Data.List                        (isSuffixOf)
import           Data.Maybe                       (fromMaybe)
import qualified Data.Streaming.Zlib              as Z
import           Pipes                            (Consumer, Producer, (>->))
import           Pipes.Attoparsec                 (parse)
import qualified Pipes.ByteString                 as PB
import qualified Pipes.Prelude                    as P
import           Pipes.Safe                       (MonadSafe, register)
import qualified Pipes.Safe.Prelude               as PS
import           System.IO                        (IOMode (..))

-- |A datatype to represent the VCF Header. Most comments are simply parsed as entire lines, but the very last comment line, containing the sample names, is separated out
data VCFheader = VCFheader {
    VCFheader -> [ByteString]
vcfHeaderComments :: [B.ByteString], -- ^A list of containing all comments starting with a single '#'
    VCFheader -> [ByteString]
vcfSampleNames    :: [B.ByteString] -- ^The list of sample names parsed from the last comment line
                             -- starting with '##'
} deriving (Int -> VCFheader -> ShowS
[VCFheader] -> ShowS
VCFheader -> String
(Int -> VCFheader -> ShowS)
-> (VCFheader -> String)
-> ([VCFheader] -> ShowS)
-> Show VCFheader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VCFheader -> ShowS
showsPrec :: Int -> VCFheader -> ShowS
$cshow :: VCFheader -> String
show :: VCFheader -> String
$cshowList :: [VCFheader] -> ShowS
showList :: [VCFheader] -> ShowS
Show, VCFheader -> VCFheader -> Bool
(VCFheader -> VCFheader -> Bool)
-> (VCFheader -> VCFheader -> Bool) -> Eq VCFheader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VCFheader -> VCFheader -> Bool
== :: VCFheader -> VCFheader -> Bool
$c/= :: VCFheader -> VCFheader -> Bool
/= :: VCFheader -> VCFheader -> Bool
Eq)

-- |A Datatype representing a single VCF entry.
data VCFentry = VCFentry {
    VCFentry -> Chrom
vcfChrom        :: Chrom, -- ^The chromosome
    VCFentry -> Int
vcfPos          :: Int, -- ^The position
    VCFentry -> Maybe ByteString
vcfId           :: Maybe B.ByteString, -- ^The SNP ID if non-missing
    VCFentry -> ByteString
vcfRef          :: B.ByteString, -- ^ The reference allele (supports also multi-character alleles for Indels)
    VCFentry -> [ByteString]
vcfAlt          :: [B.ByteString], -- ^The alternative alleles, each one possible of multiple characters
    VCFentry -> Maybe Double
vcfQual         :: Maybe Double, -- ^The quality value
    VCFentry -> Maybe ByteString
vcfFilter       :: Maybe B.ByteString, -- ^The Filter value, if non-missing.
    VCFentry -> [ByteString]
vcfInfo         :: [B.ByteString], -- ^A list of Info fields
    VCFentry -> Maybe ([ByteString], [[ByteString]])
vcfGenotypeInfo :: Maybe ([B.ByteString], [[B.ByteString]]) -- ^An optional tuple of format tags and genotype format fields for each sample.
} deriving (Int -> VCFentry -> ShowS
[VCFentry] -> ShowS
VCFentry -> String
(Int -> VCFentry -> ShowS)
-> (VCFentry -> String) -> ([VCFentry] -> ShowS) -> Show VCFentry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VCFentry -> ShowS
showsPrec :: Int -> VCFentry -> ShowS
$cshow :: VCFentry -> String
show :: VCFentry -> String
$cshowList :: [VCFentry] -> ShowS
showList :: [VCFentry] -> ShowS
Show, VCFentry -> VCFentry -> Bool
(VCFentry -> VCFentry -> Bool)
-> (VCFentry -> VCFentry -> Bool) -> Eq VCFentry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VCFentry -> VCFentry -> Bool
== :: VCFentry -> VCFentry -> Bool
$c/= :: VCFentry -> VCFentry -> Bool
/= :: VCFentry -> VCFentry -> Bool
Eq)

-- |reads a VCFheader and VCFentries from a text producer.
readVCFfromProd :: (MonadThrow m) =>
    Producer B.ByteString m () -> m (VCFheader, Producer VCFentry m ())
readVCFfromProd :: forall (m :: * -> *).
MonadThrow m =>
Producer ByteString m () -> m (VCFheader, Producer VCFentry m ())
readVCFfromProd Producer ByteString m ()
prod = do
    (Maybe (Either ParsingError VCFheader)
res, Producer ByteString m ()
rest) <- StateT
  (Producer ByteString m ())
  m
  (Maybe (Either ParsingError VCFheader))
-> Producer ByteString m ()
-> m (Maybe (Either ParsingError VCFheader),
      Producer ByteString m ())
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Parser ByteString VCFheader
-> Parser ByteString m (Maybe (Either ParsingError VCFheader))
forall (m :: * -> *) a b.
(Monad m, ParserInput a) =>
Parser a b -> Parser a m (Maybe (Either ParsingError b))
parse Parser ByteString VCFheader
vcfHeaderParser) Producer ByteString m ()
prod
    VCFheader
header <- case Maybe (Either ParsingError VCFheader)
res of
        Maybe (Either ParsingError VCFheader)
Nothing        -> SeqFormatException -> m VCFheader
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m VCFheader)
-> SeqFormatException -> m VCFheader
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"VCF file exhausted prematurely"
        Just (Left ParsingError
e)  -> SeqFormatException -> m VCFheader
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (String -> SeqFormatException
SeqFormatException (ParsingError -> String
forall a. Show a => a -> String
show ParsingError
e))
        Just (Right VCFheader
h) -> VCFheader -> m VCFheader
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VCFheader
h
    (VCFheader, Producer VCFentry m ())
-> m (VCFheader, Producer VCFentry m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (VCFheader
header, Parser VCFentry
-> Producer ByteString m () -> Producer VCFentry m ()
forall (m :: * -> *) a.
MonadThrow m =>
Parser a -> Producer ByteString m () -> Producer a m ()
consumeProducer Parser VCFentry
vcfEntryParser Producer ByteString m ()
rest)

-- |Reading a VCF from StdIn. Returns a VCFHeader and a Producer over VCFentries.
readVCFfromStdIn :: (MonadIO m, MonadThrow m) => m (VCFheader, Producer VCFentry m ())
readVCFfromStdIn :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
m (VCFheader, Producer VCFentry m ())
readVCFfromStdIn = Producer ByteString m () -> m (VCFheader, Producer VCFentry m ())
forall (m :: * -> *).
MonadThrow m =>
Producer ByteString m () -> m (VCFheader, Producer VCFentry m ())
readVCFfromProd Producer ByteString m ()
Producer' ByteString m ()
forall (m :: * -> *). MonadIO m => Producer' ByteString m ()
PB.stdin

-- |Reading a VCF from a file. Returns a VCFHeader and a Producer over VCFentries.
readVCFfromFile :: (MonadSafe m) => FilePath -> m (VCFheader, Producer VCFentry m ())
readVCFfromFile :: forall (m :: * -> *).
MonadSafe m =>
String -> m (VCFheader, Producer VCFentry m ())
readVCFfromFile = Producer ByteString m () -> m (VCFheader, Producer VCFentry m ())
forall (m :: * -> *).
MonadThrow m =>
Producer ByteString m () -> m (VCFheader, Producer VCFentry m ())
readVCFfromProd (Producer ByteString m () -> m (VCFheader, Producer VCFentry m ()))
-> (String -> Producer ByteString m ())
-> String
-> m (VCFheader, Producer VCFentry m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Producer ByteString m ()
forall (m :: * -> *).
MonadSafe m =>
String -> Producer ByteString m ()
readFileProdCheckCompress

vcfHeaderParser :: A.Parser VCFheader
vcfHeaderParser :: Parser ByteString VCFheader
vcfHeaderParser = [ByteString] -> [ByteString] -> VCFheader
VCFheader ([ByteString] -> [ByteString] -> VCFheader)
-> Parser ByteString [ByteString]
-> Parser ByteString ([ByteString] -> VCFheader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString -> Parser ByteString [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many1' Parser ByteString ByteString
doubleCommentLine Parser ByteString ([ByteString] -> VCFheader)
-> Parser ByteString [ByteString] -> Parser ByteString VCFheader
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString [ByteString]
headerLineWithSamples Parser ByteString [ByteString]
-> Parser ByteString [ByteString] -> Parser ByteString [ByteString]
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString [ByteString]
forall {a}. Parser ByteString [a]
headerLineNoSamples)
  where
    doubleCommentLine :: Parser ByteString ByteString
doubleCommentLine = do
        ByteString
c1 <- ByteString -> Parser ByteString ByteString
A.string ByteString
"##"
        ByteString
s_ <- (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n')
        Parser ()
A.endOfLine
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
c1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s_
    headerLineWithSamples :: Parser ByteString [ByteString]
headerLineWithSamples = do
        Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
A.string ByteString
"#CHROM\tPOS\tID\tREF\tALT\tQUAL\tFILTER\tINFO\tFORMAT\t"
        [ByteString]
sampleNames <- Parser ByteString ByteString
word Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString [ByteString]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy1'` Char -> Parser ByteString Char
A.char Char
'\t'
        Parser ()
A.endOfLine
        [ByteString] -> Parser ByteString [ByteString]
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
sampleNames
    headerLineNoSamples :: Parser ByteString [a]
headerLineNoSamples = ByteString -> Parser ByteString ByteString
A.string ByteString
"#CHROM\tPOS\tID\tREF\tALT\tQUAL\tFILTER\tINFO\n" Parser ByteString ByteString
-> Parser ByteString [a] -> Parser ByteString [a]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [a] -> Parser ByteString [a]
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

vcfEntryParser :: A.Parser VCFentry
vcfEntryParser :: Parser VCFentry
vcfEntryParser = Parser VCFentry
vcfEntryParserFull Parser VCFentry -> Parser VCFentry -> Parser VCFentry
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VCFentry
vcfEntryParserTruncated
  where
    vcfEntryParserFull :: Parser VCFentry
vcfEntryParserFull = Chrom
-> Int
-> Maybe ByteString
-> ByteString
-> [ByteString]
-> Maybe Double
-> Maybe ByteString
-> [ByteString]
-> Maybe ([ByteString], [[ByteString]])
-> VCFentry
VCFentry (Chrom
 -> Int
 -> Maybe ByteString
 -> ByteString
 -> [ByteString]
 -> Maybe Double
 -> Maybe ByteString
 -> [ByteString]
 -> Maybe ([ByteString], [[ByteString]])
 -> VCFentry)
-> Parser ByteString Chrom
-> Parser
     ByteString
     (Int
      -> Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Chrom
Chrom (ByteString -> Chrom)
-> Parser ByteString ByteString -> Parser ByteString Chrom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
word) Parser
  ByteString
  (Int
   -> Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Int
      -> Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Int
   -> Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Int
-> Parser
     ByteString
     (Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser
  ByteString
  (Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString (Maybe ByteString)
-> Parser
     ByteString
     (ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe ByteString)
parseId Parser
  ByteString
  (ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
        Parser ByteString Char
sp Parser
  ByteString
  (ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString ByteString
-> Parser
     ByteString
     ([ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
word Parser
  ByteString
  ([ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     ([ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  ([ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString [ByteString]
-> Parser
     ByteString
     (Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString [ByteString]
parseAlternativeAlleles Parser
  ByteString
  (Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString (Maybe Double)
-> Parser
     ByteString
     (Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Double)
parseQual Parser
  ByteString
  (Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString (Maybe ByteString)
-> Parser
     ByteString
     ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe ByteString)
parseFilter Parser
  ByteString
  ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
        Parser ByteString Char
sp Parser
  ByteString
  ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
-> Parser ByteString [ByteString]
-> Parser
     ByteString (Maybe ([ByteString], [[ByteString]]) -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString [ByteString]
parseInfoFields Parser
  ByteString (Maybe ([ByteString], [[ByteString]]) -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString (Maybe ([ByteString], [[ByteString]]) -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString (Maybe ([ByteString], [[ByteString]]) -> VCFentry)
-> Parser ByteString (Maybe ([ByteString], [[ByteString]]))
-> Parser VCFentry
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe ([ByteString], [[ByteString]]))
parseFormatStringsAndGenotypes Parser VCFentry -> Parser () -> Parser VCFentry
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
A.endOfLine
    vcfEntryParserTruncated :: Parser VCFentry
vcfEntryParserTruncated = Chrom
-> Int
-> Maybe ByteString
-> ByteString
-> [ByteString]
-> Maybe Double
-> Maybe ByteString
-> [ByteString]
-> Maybe ([ByteString], [[ByteString]])
-> VCFentry
VCFentry (Chrom
 -> Int
 -> Maybe ByteString
 -> ByteString
 -> [ByteString]
 -> Maybe Double
 -> Maybe ByteString
 -> [ByteString]
 -> Maybe ([ByteString], [[ByteString]])
 -> VCFentry)
-> Parser ByteString Chrom
-> Parser
     ByteString
     (Int
      -> Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Chrom
Chrom (ByteString -> Chrom)
-> Parser ByteString ByteString -> Parser ByteString Chrom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
word) Parser
  ByteString
  (Int
   -> Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Int
      -> Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Int
   -> Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Int
-> Parser
     ByteString
     (Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser
  ByteString
  (Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Maybe ByteString
      -> ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Maybe ByteString
   -> ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString (Maybe ByteString)
-> Parser
     ByteString
     (ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe ByteString)
parseId Parser
  ByteString
  (ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (ByteString
      -> [ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
        Parser ByteString Char
sp Parser
  ByteString
  (ByteString
   -> [ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString ByteString
-> Parser
     ByteString
     ([ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
word Parser
  ByteString
  ([ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     ([ByteString]
      -> Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  ([ByteString]
   -> Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString [ByteString]
-> Parser
     ByteString
     (Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString [ByteString]
parseAlternativeAlleles Parser
  ByteString
  (Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Maybe Double
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Maybe Double
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString (Maybe Double)
-> Parser
     ByteString
     (Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Double)
parseQual Parser
  ByteString
  (Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     (Maybe ByteString
      -> [ByteString]
      -> Maybe ([ByteString], [[ByteString]])
      -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString
  (Maybe ByteString
   -> [ByteString]
   -> Maybe ([ByteString], [[ByteString]])
   -> VCFentry)
-> Parser ByteString (Maybe ByteString)
-> Parser
     ByteString
     ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe ByteString)
parseFilter Parser
  ByteString
  ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
-> Parser ByteString Char
-> Parser
     ByteString
     ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
        Parser ByteString Char
sp Parser
  ByteString
  ([ByteString] -> Maybe ([ByteString], [[ByteString]]) -> VCFentry)
-> Parser ByteString [ByteString]
-> Parser
     ByteString (Maybe ([ByteString], [[ByteString]]) -> VCFentry)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString [ByteString]
parseInfoFields Parser
  ByteString (Maybe ([ByteString], [[ByteString]]) -> VCFentry)
-> Parser ByteString (Maybe ([ByteString], [[ByteString]]))
-> Parser VCFentry
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ([ByteString], [[ByteString]])
-> Parser ByteString (Maybe ([ByteString], [[ByteString]]))
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ([ByteString], [[ByteString]])
forall a. Maybe a
Nothing Parser VCFentry -> Parser () -> Parser VCFentry
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
A.endOfLine
    sp :: Parser ByteString Char
sp = (Char -> Bool) -> Parser ByteString Char
A.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
    parseId :: Parser ByteString (Maybe ByteString)
parseId = (Parser ByteString Char
parseDot Parser ByteString Char
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe ByteString -> Parser ByteString (Maybe ByteString)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing) Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
word)
    parseDot :: Parser ByteString Char
parseDot = Char -> Parser ByteString Char
A.char Char
'.'
    parseAlternativeAlleles :: Parser ByteString [ByteString]
parseAlternativeAlleles = (Parser ByteString Char
parseDot Parser ByteString Char
-> Parser ByteString [ByteString] -> Parser ByteString [ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ByteString] -> Parser ByteString [ByteString]
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Parser ByteString [ByteString]
-> Parser ByteString [ByteString] -> Parser ByteString [ByteString]
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
parseAllele Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
',')
    parseAllele :: Parser ByteString ByteString
parseAllele = (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
    parseQual :: Parser ByteString (Maybe Double)
parseQual = (Parser ByteString Char
parseDot Parser ByteString Char
-> Parser ByteString (Maybe Double)
-> Parser ByteString (Maybe Double)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Double -> Parser ByteString (Maybe Double)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Double
forall a. Maybe a
Nothing) Parser ByteString (Maybe Double)
-> Parser ByteString (Maybe Double)
-> Parser ByteString (Maybe Double)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> Parser ByteString Double -> Parser ByteString (Maybe Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double
A.double)
    parseFilter :: Parser ByteString (Maybe ByteString)
parseFilter = (Parser ByteString Char
parseDot Parser ByteString Char
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe ByteString -> Parser ByteString (Maybe ByteString)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing) Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
word)
    parseInfoFields :: Parser ByteString [ByteString]
parseInfoFields = (Parser ByteString Char
parseDot Parser ByteString Char
-> Parser ByteString [ByteString] -> Parser ByteString [ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ByteString] -> Parser ByteString [ByteString]
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Parser ByteString [ByteString]
-> Parser ByteString [ByteString] -> Parser ByteString [ByteString]
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
parseInfoField Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
';')
    parseInfoField :: Parser ByteString ByteString
parseInfoField = (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
    parseFormatStringsAndGenotypes :: Parser ByteString (Maybe ([ByteString], [[ByteString]]))
parseFormatStringsAndGenotypes = (\[ByteString]
f [[ByteString]]
g -> ([ByteString], [[ByteString]])
-> Maybe ([ByteString], [[ByteString]])
forall a. a -> Maybe a
Just ([ByteString]
f, [[ByteString]]
g)) ([ByteString]
 -> [[ByteString]] -> Maybe ([ByteString], [[ByteString]]))
-> Parser ByteString [ByteString]
-> Parser
     ByteString ([[ByteString]] -> Maybe ([ByteString], [[ByteString]]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ByteString]
parseFormatStrings Parser
  ByteString ([[ByteString]] -> Maybe ([ByteString], [[ByteString]]))
-> Parser ByteString Char
-> Parser
     ByteString ([[ByteString]] -> Maybe ([ByteString], [[ByteString]]))
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
sp Parser
  ByteString ([[ByteString]] -> Maybe ([ByteString], [[ByteString]]))
-> Parser ByteString [[ByteString]]
-> Parser ByteString (Maybe ([ByteString], [[ByteString]]))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString [[ByteString]]
parseGenotypeInfos 
    parseFormatStrings :: Parser ByteString [ByteString]
parseFormatStrings = Parser ByteString ByteString
parseFormatString Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
':'
    parseFormatString :: Parser ByteString ByteString
parseFormatString = (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
    parseGenotypeInfos :: Parser ByteString [[ByteString]]
parseGenotypeInfos = Parser ByteString [ByteString]
parseGenotype Parser ByteString [ByteString]
-> Parser ByteString Char -> Parser ByteString [[ByteString]]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ByteString Char
sp
    parseGenotype :: Parser ByteString [ByteString]
parseGenotype = Parser ByteString ByteString
parseGenoField Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
':'
    parseGenoField :: Parser ByteString ByteString
parseGenoField = (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- |returns True if the SNP is biallelic.
isBiallelicSnp :: B.ByteString -> [B.ByteString] -> Bool
isBiallelicSnp :: ByteString -> [ByteString] -> Bool
isBiallelicSnp ByteString
ref [ByteString]
alt = Bool
validRef Bool -> Bool -> Bool
&& Bool
validAlt
  where
    validRef :: Bool
validRef = (ByteString
ref ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"A", ByteString
"C", ByteString
"G", ByteString
"T"])
    validAlt :: Bool
validAlt = case [ByteString]
alt of
        [ByteString
alt'] -> ByteString
alt' ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"A", ByteString
"C", ByteString
"G", ByteString
"T"]
        [ByteString]
_      -> Bool
False

-- |returns True if the SNp is a biallelic Transversion SNP (i.e. one of G/T, G/C, A/T, A/C)
isTransversionSnp :: B.ByteString -> [B.ByteString] -> Bool
isTransversionSnp :: ByteString -> [ByteString] -> Bool
isTransversionSnp ByteString
ref [ByteString]
alt =
    case [ByteString]
alt of
        [ByteString
alt'] -> ByteString -> [ByteString] -> Bool
isBiallelicSnp ByteString
ref [ByteString]
alt Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Bool
forall {a} {a}.
(Eq a, Eq a, IsString a, IsString a) =>
a -> a -> Bool
isTransition ByteString
ref ByteString
alt')
        [ByteString]
_      -> Bool
False
  where
    isTransition :: a -> a -> Bool
isTransition a
r a
a = ((a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"A") Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"G")) Bool -> Bool -> Bool
|| ((a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"G") Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"A")) Bool -> Bool -> Bool
||
                       ((a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"C") Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"T")) Bool -> Bool -> Bool
|| ((a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"T") Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"C"))

-- |Extracts the genotype fields (for each sapmle) from a VCF entry
getGenotypes :: (MonadThrow m) => VCFentry -> m [B.ByteString]
getGenotypes :: forall (m :: * -> *). MonadThrow m => VCFentry -> m [ByteString]
getGenotypes VCFentry
vcfEntry = case VCFentry -> Maybe ([ByteString], [[ByteString]])
vcfGenotypeInfo VCFentry
vcfEntry of
    Maybe ([ByteString], [[ByteString]])
Nothing -> SeqFormatException -> m [ByteString]
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m [ByteString])
-> SeqFormatException -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"No Genotypes in this VCF"
    Just ([ByteString]
formatField, [[ByteString]]
genotypeFields) -> do
        Int
gtIndex <- case ((Int, ByteString) -> Bool)
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString
"GT") (ByteString -> Bool)
-> ((Int, ByteString) -> ByteString) -> (Int, ByteString) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) ([(Int, ByteString)] -> [(Int, ByteString)])
-> ([ByteString] -> [(Int, ByteString)])
-> [ByteString]
-> [(Int, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([ByteString] -> [(Int, ByteString)])
-> [ByteString] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ [ByteString]
formatField of
            []  -> SeqFormatException -> m Int
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m Int) -> SeqFormatException -> m Int
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"GT format field not found"
            [(Int, ByteString)
i] -> Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int)
-> ((Int, ByteString) -> Int) -> (Int, ByteString) -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> m Int) -> (Int, ByteString) -> m Int
forall a b. (a -> b) -> a -> b
$ (Int, ByteString)
i
            [(Int, ByteString)]
_   -> SeqFormatException -> m Int
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m Int) -> SeqFormatException -> m Int
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"Multiple GT fields specified in VCF format field"
        [[ByteString]] -> ([ByteString] -> m ByteString) -> m [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[ByteString]]
genotypeFields (([ByteString] -> m ByteString) -> m [ByteString])
-> ([ByteString] -> m ByteString) -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ \[ByteString]
indInfo ->
            case String -> [ByteString] -> Int -> Either String ByteString
forall e a. e -> [a] -> Int -> Either e a
atErr (String
"cannot find genotype from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ByteString] -> String
forall a. Show a => a -> String
show [ByteString]
indInfo) [ByteString]
indInfo Int
gtIndex of
                Left String
e  -> SeqFormatException -> m ByteString
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m ByteString)
-> (String -> SeqFormatException) -> String -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SeqFormatException
SeqFormatException (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
e
                Right ByteString
g -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
g

-- |Extracts the dosages (the sum of non-reference alleles) and ploidies per sample
getDosages :: (MonadThrow m) => VCFentry -> m [Maybe (Int, Int)]
getDosages :: forall (m :: * -> *).
MonadThrow m =>
VCFentry -> m [Maybe (Int, Int)]
getDosages VCFentry
vcfEntry = do
    [ByteString]
genotypes <- VCFentry -> m [ByteString]
forall (m :: * -> *). MonadThrow m => VCFentry -> m [ByteString]
getGenotypes VCFentry
vcfEntry
    [Maybe (Int, Int)] -> m [Maybe (Int, Int)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe (Int, Int)] -> m [Maybe (Int, Int)])
-> [Maybe (Int, Int)] -> m [Maybe (Int, Int)]
forall a b. (a -> b) -> a -> b
$ do
        ByteString
gen <- [ByteString]
genotypes
        case (Char -> Bool) -> ByteString -> [ByteString]
B.splitWith (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ByteString
gen of
            [ByteString
"0"]      -> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> [Maybe (Int, Int)])
-> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
0, Int
1)
            [ByteString
"1"]      -> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> [Maybe (Int, Int)])
-> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
1, Int
1)
            [ByteString
"0", ByteString
"0"] -> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> [Maybe (Int, Int)])
-> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
0, Int
2)
            [ByteString
"0", ByteString
"1"] -> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> [Maybe (Int, Int)])
-> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
1, Int
2)
            [ByteString
"1", ByteString
"0"] -> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> [Maybe (Int, Int)])
-> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
1, Int
2)
            [ByteString
"1", ByteString
"1"] -> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> [Maybe (Int, Int)])
-> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
2, Int
2)
            [ByteString]
_          -> Maybe (Int, Int) -> [Maybe (Int, Int)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing

-- |Converts a VCFentry to the simpler FreqSum format
vcfToFreqSumEntry :: (MonadThrow m) => VCFentry -> m FreqSumEntry
vcfToFreqSumEntry :: forall (m :: * -> *). MonadThrow m => VCFentry -> m FreqSumEntry
vcfToFreqSumEntry VCFentry
vcfEntry = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
B.length (VCFentry -> ByteString
vcfRef VCFentry
vcfEntry) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (m () -> m ())
-> (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqFormatException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"multi-site reference allele"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (VCFentry -> [ByteString]
vcfAlt VCFentry
vcfEntry) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (m () -> m ())
-> (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqFormatException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"need exactly one alternative allele"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
B.length ([ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
head ([ByteString] -> ByteString)
-> (VCFentry -> [ByteString]) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> [ByteString]
vcfAlt (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
vcfEntry) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (m () -> m ())
-> (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqFormatException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"multi-site alternative allele"
    let ref :: Char
ref = ByteString -> Char
B.head (VCFentry -> ByteString
vcfRef VCFentry
vcfEntry)
    let alt :: Char
alt = ByteString -> Char
B.head (ByteString -> Char)
-> (VCFentry -> ByteString) -> VCFentry -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
head ([ByteString] -> ByteString)
-> (VCFentry -> [ByteString]) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> [ByteString]
vcfAlt (VCFentry -> Char) -> VCFentry -> Char
forall a b. (a -> b) -> a -> b
$ VCFentry
vcfEntry
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char
ref Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'A', Char
'C', Char
'T', Char
'G', Char
'N']) (m () -> m ())
-> (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqFormatException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"Invalid Reference Allele"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char
alt Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'A', Char
'C', Char
'T', Char
'G', Char
'.']) (m () -> m ())
-> (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqFormatException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeqFormatException -> m ()) -> SeqFormatException -> m ()
forall a b. (a -> b) -> a -> b
$ String -> SeqFormatException
SeqFormatException String
"Invalid Alternative Allele"
    [Maybe (Int, Int)]
dosages <- VCFentry -> m [Maybe (Int, Int)]
forall (m :: * -> *).
MonadThrow m =>
VCFentry -> m [Maybe (Int, Int)]
getDosages VCFentry
vcfEntry
    FreqSumEntry -> m FreqSumEntry
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FreqSumEntry -> m FreqSumEntry) -> FreqSumEntry -> m FreqSumEntry
forall a b. (a -> b) -> a -> b
$ Chrom
-> Int
-> Maybe ByteString
-> Maybe Double
-> Char
-> Char
-> [Maybe (Int, Int)]
-> FreqSumEntry
FreqSumEntry (VCFentry -> Chrom
vcfChrom VCFentry
vcfEntry) (VCFentry -> Int
vcfPos VCFentry
vcfEntry) (VCFentry -> Maybe ByteString
vcfId VCFentry
vcfEntry) Maybe Double
forall a. Maybe a
Nothing Char
ref Char
alt [Maybe (Int, Int)]
dosages

printVCFtoStdOut :: (MonadIO m) => VCFheader -> Consumer VCFentry m ()
printVCFtoStdOut :: forall (m :: * -> *).
MonadIO m =>
VCFheader -> Consumer VCFentry m ()
printVCFtoStdOut VCFheader
vcfh = do
    IO () -> Consumer VCFentry m ()
forall a. IO a -> Proxy () VCFentry () X m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Consumer VCFentry m ())
-> (VCFheader -> IO ()) -> VCFheader -> Consumer VCFentry m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
B.putStr (ByteString -> IO ())
-> (VCFheader -> ByteString) -> VCFheader -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFheader -> ByteString
vcfHeaderToText (VCFheader -> Consumer VCFentry m ())
-> VCFheader -> Consumer VCFentry m ()
forall a b. (a -> b) -> a -> b
$ VCFheader
vcfh
    (VCFentry -> ByteString) -> Pipe VCFentry ByteString m ()
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map VCFentry -> ByteString
vcfEntryToText Pipe VCFentry ByteString m ()
-> Proxy () ByteString () X m () -> Consumer VCFentry m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Proxy () ByteString () X m ()
Consumer' ByteString m ()
forall (m :: * -> *). MonadIO m => Consumer' ByteString m ()
PB.stdout

vcfHeaderToText :: VCFheader -> B.ByteString
vcfHeaderToText :: VCFheader -> ByteString
vcfHeaderToText (VCFheader [ByteString]
comments [ByteString]
names) =
    let commentsBlock :: ByteString
commentsBlock = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\n" [ByteString]
comments
        namesLine :: ByteString
namesLine = case [ByteString]
names of
            [] -> ByteString
"#CHROM\tPOS\tID\tREF\tALT\tQUAL\tFILTER\tINFO"
            [ByteString]
_  -> ByteString
"#CHROM\tPOS\tID\tREF\tALT\tQUAL\tFILTER\tINFO\tFORMAT\t" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\t" [ByteString]
names)
    in  ByteString
commentsBlock ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
namesLine ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"

vcfEntryToText :: VCFentry -> B.ByteString
vcfEntryToText :: VCFentry -> ByteString
vcfEntryToText VCFentry
e =
    let baseFieldList :: [ByteString]
baseFieldList = [
            Chrom -> ByteString
unChrom (Chrom -> ByteString)
-> (VCFentry -> Chrom) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> Chrom
vcfChrom     (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
e,
            String -> ByteString
B.pack (String -> ByteString)
-> (VCFentry -> String) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (VCFentry -> Int) -> VCFentry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> Int
vcfPos (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
e,
            ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"." (Maybe ByteString -> ByteString)
-> (VCFentry -> Maybe ByteString) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> Maybe ByteString
vcfId  (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
e,
            VCFentry -> ByteString
vcfRef VCFentry
e,
            if [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (VCFentry -> [ByteString]
vcfAlt VCFentry
e) then ByteString
"." else ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," ([ByteString] -> ByteString)
-> (VCFentry -> [ByteString]) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> [ByteString]
vcfAlt (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
e,
            ByteString -> (Double -> ByteString) -> Maybe Double -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"." (String -> ByteString
B.pack (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Maybe Double -> ByteString)
-> (VCFentry -> Maybe Double) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> Maybe Double
vcfQual (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
e,
            ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"." (Maybe ByteString -> ByteString)
-> (VCFentry -> Maybe ByteString) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> Maybe ByteString
vcfFilter (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
e,
            if [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (VCFentry -> [ByteString]
vcfInfo VCFentry
e) then ByteString
"." else ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
";" ([ByteString] -> ByteString)
-> (VCFentry -> [ByteString]) -> VCFentry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VCFentry -> [ByteString]
vcfInfo (VCFentry -> ByteString) -> VCFentry -> ByteString
forall a b. (a -> b) -> a -> b
$ VCFentry
e]
        genotypeFieldList :: [ByteString]
genotypeFieldList = case VCFentry -> Maybe ([ByteString], [[ByteString]])
vcfGenotypeInfo VCFentry
e of
            Maybe ([ByteString], [[ByteString]])
Nothing -> []
            Just ([ByteString]
f, [[ByteString]]
gs) -> [ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
":" [ByteString]
f] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ ([ByteString] -> ByteString) -> [[ByteString]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
":") [[ByteString]]
gs
    in  (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\t" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
baseFieldList [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
genotypeFieldList

writeVCFfile :: (MonadSafe m) => FilePath -> VCFheader -> Consumer VCFentry m ()
writeVCFfile :: forall (m :: * -> *).
MonadSafe m =>
String -> VCFheader -> Consumer VCFentry m ()
writeVCFfile String
vcfFile VCFheader
vcfh = do
    (ReleaseKey
_, Handle
vcfFileH) <- m (ReleaseKey, Handle)
-> Proxy () VCFentry () X m (ReleaseKey, Handle)
forall (m :: * -> *) a.
Monad m =>
m a -> Proxy () VCFentry () X m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ReleaseKey, Handle)
 -> Proxy () VCFentry () X m (ReleaseKey, Handle))
-> m (ReleaseKey, Handle)
-> Proxy () VCFentry () X m (ReleaseKey, Handle)
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> m (ReleaseKey, Handle)
forall (m :: * -> *).
MonadSafe m =>
String -> IOMode -> m (ReleaseKey, Handle)
PS.openFile String
vcfFile IOMode
WriteMode
    Consumer ByteString m ()
vcfOutConsumer <- if String
".gz" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
vcfFile then do
            Deflate
def <- IO Deflate -> Proxy () VCFentry () X m Deflate
forall a. IO a -> Proxy () VCFentry () X m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deflate -> Proxy () VCFentry () X m Deflate)
-> IO Deflate -> Proxy () VCFentry () X m Deflate
forall a b. (a -> b) -> a -> b
$ Int -> WindowBits -> IO Deflate
Z.initDeflate Int
6 (Int -> WindowBits
Z.WindowBits Int
31)
            ReleaseKey
_ <- Base (Proxy () VCFentry () X m) ()
-> Proxy () VCFentry () X m ReleaseKey
forall (m :: * -> *). MonadSafe m => Base m () -> m ReleaseKey
register (Deflate -> Handle -> Base m ()
forall (m :: * -> *). MonadIO m => Deflate -> Handle -> m ()
deflateFinaliser Deflate
def Handle
vcfFileH)
            Popper
pop <- IO Popper -> Proxy () VCFentry () X m Popper
forall a. IO a -> Proxy () VCFentry () X m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Deflate -> ByteString -> IO Popper
Z.feedDeflate Deflate
def (VCFheader -> ByteString
vcfHeaderToText VCFheader
vcfh))
            IO () -> Consumer VCFentry m ()
forall a. IO a -> Proxy () VCFentry () X m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Popper -> Handle -> IO ()
forall (m :: * -> *). MonadIO m => Popper -> Handle -> m ()
writeFromPopper Popper
pop Handle
vcfFileH)
            Consumer ByteString m ()
-> Proxy () VCFentry () X m (Consumer ByteString m ())
forall a. a -> Proxy () VCFentry () X m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumer ByteString m ()
 -> Proxy () VCFentry () X m (Consumer ByteString m ()))
-> Consumer ByteString m ()
-> Proxy () VCFentry () X m (Consumer ByteString m ())
forall a b. (a -> b) -> a -> b
$ Deflate -> Handle -> Consumer ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Deflate -> Handle -> Consumer ByteString m ()
gzipConsumer Deflate
def Handle
vcfFileH
        else do
            IO () -> Consumer VCFentry m ()
forall a. IO a -> Proxy () VCFentry () X m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Consumer VCFentry m ())
-> IO () -> Consumer VCFentry m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPut Handle
vcfFileH (VCFheader -> ByteString
vcfHeaderToText VCFheader
vcfh)
            Consumer ByteString m ()
-> Proxy () VCFentry () X m (Consumer ByteString m ())
forall a. a -> Proxy () VCFentry () X m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumer ByteString m ()
 -> Proxy () VCFentry () X m (Consumer ByteString m ()))
-> Consumer ByteString m ()
-> Proxy () VCFentry () X m (Consumer ByteString m ())
forall a b. (a -> b) -> a -> b
$ Handle -> Consumer' ByteString m ()
forall (m :: * -> *) r.
MonadIO m =>
Handle -> Consumer' ByteString m r
PB.toHandle Handle
vcfFileH
    (VCFentry -> ByteString) -> Pipe VCFentry ByteString m ()
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map VCFentry -> ByteString
vcfEntryToText Pipe VCFentry ByteString m ()
-> Consumer ByteString m () -> Consumer VCFentry m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Consumer ByteString m ()
vcfOutConsumer