{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
module SequenceFormats.Plink (readBimStdIn,
readBimFile,
writeBim,
readFamFile,
readPlinkBedFile,
readPlink,
writePlink,
PlinkFamEntry(..),
plinkFam2EigenstratInd,
eigenstratInd2PlinkFam,
PlinkPopNameMode(..)) where
import SequenceFormats.Eigenstrat (EigenstratIndEntry (..),
EigenstratSnpEntry (..),
GenoEntry (..), GenoLine,
Sex (..))
import SequenceFormats.Utils (Chrom (..), consumeProducer,
readFileProd, word)
import Control.Applicative ((<|>))
import Control.Monad (forM_, void)
import Control.Monad.Catch (MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.State.Strict (runStateT)
import qualified Data.Attoparsec.ByteString as AB
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import qualified Data.ByteString as BB
import qualified Data.ByteString.Char8 as B
import Data.List (intercalate)
import Data.Vector (fromList, toList)
import Data.Word (Word8)
import Pipes (Consumer, Producer, (>->))
import Pipes.Attoparsec (ParsingError (..), parse)
import qualified Pipes.ByteString as PB
import qualified Pipes.Prelude as P
import Pipes.Safe (MonadSafe)
import qualified Pipes.Safe.Prelude as PS
import System.IO (Handle, IOMode (..),
hPutStrLn, withFile)
data PlinkFamEntry = PlinkFamEntry {
PlinkFamEntry -> String
_famFamilyID :: String,
PlinkFamEntry -> String
_famIndividualID :: String,
PlinkFamEntry -> String
_famFatherID :: String,
PlinkFamEntry -> String
_famMotherID :: String,
PlinkFamEntry -> Sex
_famSexCode :: Sex,
PlinkFamEntry -> String
_famPhenotype :: String
} deriving (PlinkFamEntry -> PlinkFamEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlinkFamEntry -> PlinkFamEntry -> Bool
$c/= :: PlinkFamEntry -> PlinkFamEntry -> Bool
== :: PlinkFamEntry -> PlinkFamEntry -> Bool
$c== :: PlinkFamEntry -> PlinkFamEntry -> Bool
Eq, Int -> PlinkFamEntry -> ShowS
[PlinkFamEntry] -> ShowS
PlinkFamEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlinkFamEntry] -> ShowS
$cshowList :: [PlinkFamEntry] -> ShowS
show :: PlinkFamEntry -> String
$cshow :: PlinkFamEntry -> String
showsPrec :: Int -> PlinkFamEntry -> ShowS
$cshowsPrec :: Int -> PlinkFamEntry -> ShowS
Show)
data PlinkPopNameMode = PlinkPopNameAsFamily | PlinkPopNameAsPhenotype | PlinkPopNameAsBoth deriving (PlinkPopNameMode -> PlinkPopNameMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlinkPopNameMode -> PlinkPopNameMode -> Bool
$c/= :: PlinkPopNameMode -> PlinkPopNameMode -> Bool
== :: PlinkPopNameMode -> PlinkPopNameMode -> Bool
$c== :: PlinkPopNameMode -> PlinkPopNameMode -> Bool
Eq, Int -> PlinkPopNameMode -> ShowS
[PlinkPopNameMode] -> ShowS
PlinkPopNameMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlinkPopNameMode] -> ShowS
$cshowList :: [PlinkPopNameMode] -> ShowS
show :: PlinkPopNameMode -> String
$cshow :: PlinkPopNameMode -> String
showsPrec :: Int -> PlinkPopNameMode -> ShowS
$cshowsPrec :: Int -> PlinkPopNameMode -> ShowS
Show)
bimParser :: A.Parser EigenstratSnpEntry
bimParser :: Parser EigenstratSnpEntry
bimParser = do
ByteString
chrom <- Parser ByteString
word
ByteString
snpId_ <- forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
word
Double
geneticPos <- forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Double
A.double
Int
pos <- forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Integral a => Parser a
A.decimal
Char
ref <- forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser Char
A.satisfy (String -> Char -> Bool
A.inClass String
"ACTGNX01234")
Char
alt <- forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser Char
A.satisfy (String -> Char -> Bool
A.inClass String
"ACTGNX01234")
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ()
A.endOfLine
let refConvert :: Char
refConvert = Char -> Char
convertNum Char
ref
altConvert :: Char
altConvert = Char -> Char
convertNum Char
alt
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Chrom
-> Int
-> Double
-> ByteString
-> Char
-> Char
-> EigenstratSnpEntry
EigenstratSnpEntry (ByteString -> Chrom
Chrom ByteString
chrom) Int
pos Double
geneticPos ByteString
snpId_ Char
refConvert Char
altConvert
where
convertNum :: Char -> Char
convertNum Char
'0' = Char
'N'
convertNum Char
'1' = Char
'A'
convertNum Char
'2' = Char
'C'
convertNum Char
'3' = Char
'G'
convertNum Char
'4' = Char
'T'
convertNum Char
x = Char
x
famParser :: A.Parser PlinkFamEntry
famParser :: Parser PlinkFamEntry
famParser = do
forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany Parser Char
A.space
String
famID <- ByteString -> String
B.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
word
String
indID <- ByteString -> String
B.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
word)
String
fatherID <- ByteString -> String
B.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
word)
String
motherID <- ByteString -> String
B.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
word)
Sex
sex <- forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Sex
parseSex
String
phen <- ByteString -> String
B.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 Parser Char
A.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
word)
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ()
A.endOfLine
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
-> String -> String -> String -> Sex -> String -> PlinkFamEntry
PlinkFamEntry String
famID String
indID String
fatherID String
motherID Sex
sex String
phen
where
parseSex :: Parser ByteString Sex
parseSex = Parser ByteString Sex
parseMale forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Sex
parseFemale forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Sex
parseUnknown
parseMale :: Parser ByteString Sex
parseMale = Char -> Parser Char
A.char Char
'1' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Sex
Male
parseFemale :: Parser ByteString Sex
parseFemale = Char -> Parser Char
A.char Char
'2' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Sex
Female
parseUnknown :: Parser ByteString Sex
parseUnknown = Parser Char
A.anyChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Sex
Unknown
plinkFam2EigenstratInd :: PlinkPopNameMode -> PlinkFamEntry -> EigenstratIndEntry
plinkFam2EigenstratInd :: PlinkPopNameMode -> PlinkFamEntry -> EigenstratIndEntry
plinkFam2EigenstratInd PlinkPopNameMode
plinkPopNameMode (PlinkFamEntry String
famId String
indId String
_ String
_ Sex
sex String
phen) =
let popName :: String
popName = case PlinkPopNameMode
plinkPopNameMode of
PlinkPopNameMode
PlinkPopNameAsFamily -> String
famId
PlinkPopNameMode
PlinkPopNameAsPhenotype -> String
phen
PlinkPopNameMode
PlinkPopNameAsBoth -> if String
famId forall a. Eq a => a -> a -> Bool
== String
phen then String
famId else String
famId forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ String
phen
in String -> Sex -> String -> EigenstratIndEntry
EigenstratIndEntry String
indId Sex
sex String
popName
eigenstratInd2PlinkFam :: PlinkPopNameMode -> EigenstratIndEntry -> PlinkFamEntry
eigenstratInd2PlinkFam :: PlinkPopNameMode -> EigenstratIndEntry -> PlinkFamEntry
eigenstratInd2PlinkFam PlinkPopNameMode
plinkPopNameMode (EigenstratIndEntry String
indId Sex
sex String
popName)=
case PlinkPopNameMode
plinkPopNameMode of
PlinkPopNameMode
PlinkPopNameAsFamily -> String
-> String -> String -> String -> Sex -> String -> PlinkFamEntry
PlinkFamEntry String
popName String
indId String
"0" String
"0" Sex
sex String
"0"
PlinkPopNameMode
PlinkPopNameAsPhenotype -> String
-> String -> String -> String -> Sex -> String -> PlinkFamEntry
PlinkFamEntry String
"DummyFamily" String
indId String
"0" String
"0" Sex
sex String
popName
PlinkPopNameMode
PlinkPopNameAsBoth -> String
-> String -> String -> String -> Sex -> String -> PlinkFamEntry
PlinkFamEntry String
popName String
indId String
"0" String
"0" Sex
sex String
popName
bedHeaderParser :: AB.Parser ()
= do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
AB.word8 Word8
0b01101100
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
AB.word8 Word8
0b00011011
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
AB.word8 Word8
0b00000001
bedGenotypeParser :: Int -> AB.Parser GenoLine
bedGenotypeParser :: Int -> Parser GenoLine
bedGenotypeParser Int
nrInds = do
let nrBytes :: Int
nrBytes = if Int
nrInds forall a. Integral a => a -> a -> a
`rem` Int
4 forall a. Eq a => a -> a -> Bool
== Int
0 then Int
nrInds forall a. Integral a => a -> a -> a
`quot` Int
4 else (Int
nrInds forall a. Integral a => a -> a -> a
`quot` Int
4) forall a. Num a => a -> a -> a
+ Int
1
[Word8]
bytes <- ByteString -> [Word8]
BB.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString
AB.take Int
nrBytes
let indBitPairs :: [Word8]
indBitPairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. (Bits b, Num b) => b -> [b]
getBitPairs [Word8]
bytes
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
nrInds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Eq a, Num a) => a -> GenoEntry
bitPairToGenotype forall a b. (a -> b) -> a -> b
$ [Word8]
indBitPairs
where
getBitPairs :: b -> [b]
getBitPairs b
byte = forall a b. (a -> b) -> [a] -> [b]
map (b
0b00000011 forall a. Bits a => a -> a -> a
.&.) [b
byte, forall a. Bits a => a -> Int -> a
shiftR b
byte Int
2, forall a. Bits a => a -> Int -> a
shiftR b
byte Int
4, forall a. Bits a => a -> Int -> a
shiftR b
byte Int
6]
bitPairToGenotype :: a -> GenoEntry
bitPairToGenotype a
0b00000000 = GenoEntry
HomRef
bitPairToGenotype a
0b00000010 = GenoEntry
Het
bitPairToGenotype a
0b00000011 = GenoEntry
HomAlt
bitPairToGenotype a
0b00000001 = GenoEntry
Missing
bitPairToGenotype a
_ = forall a. HasCallStack => String -> a
error String
"This should never happen"
readPlinkBedProd :: (MonadThrow m) => Int -> Producer B.ByteString m () -> m (Producer GenoLine m ())
readPlinkBedProd :: forall (m :: * -> *).
MonadThrow m =>
Int -> Producer ByteString m () -> m (Producer GenoLine m ())
readPlinkBedProd Int
nrInds Producer ByteString m ()
prod = do
(Maybe (Either ParsingError ())
res, Producer ByteString m ()
rest) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (m :: * -> *) a b.
(Monad m, ParserInput a) =>
Parser a b -> Parser a m (Maybe (Either ParsingError b))
parse Parser ()
bedHeaderParser) Producer ByteString m ()
prod
()
_ <- case Maybe (Either ParsingError ())
res of
Maybe (Either ParsingError ())
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ [String] -> String -> ParsingError
ParsingError [] String
"Bed file exhausted prematurely"
Just (Left ParsingError
e) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ParsingError
e
Just (Right ()
h) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadThrow m =>
Parser a -> Producer ByteString m () -> Producer a m ()
consumeProducer (Int -> Parser GenoLine
bedGenotypeParser Int
nrInds) Producer ByteString m ()
rest
readPlinkBedFile :: (MonadSafe m) => FilePath -> Int -> m (Producer GenoLine m ())
readPlinkBedFile :: forall (m :: * -> *).
MonadSafe m =>
String -> Int -> m (Producer GenoLine m ())
readPlinkBedFile String
file Int
nrInds = forall (m :: * -> *).
MonadThrow m =>
Int -> Producer ByteString m () -> m (Producer GenoLine m ())
readPlinkBedProd Int
nrInds (forall (m :: * -> *).
MonadSafe m =>
String -> Producer ByteString m ()
readFileProd String
file)
readBimStdIn :: (MonadThrow m, MonadIO m) => Producer EigenstratSnpEntry m ()
readBimStdIn :: forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
Producer EigenstratSnpEntry m ()
readBimStdIn = forall (m :: * -> *) a.
MonadThrow m =>
Parser a -> Producer ByteString m () -> Producer a m ()
consumeProducer Parser EigenstratSnpEntry
bimParser forall (m :: * -> *). MonadIO m => Producer' ByteString m ()
PB.stdin
readBimFile :: (MonadSafe m) => FilePath -> Producer EigenstratSnpEntry m ()
readBimFile :: forall (m :: * -> *).
MonadSafe m =>
String -> Producer EigenstratSnpEntry m ()
readBimFile = forall (m :: * -> *) a.
MonadThrow m =>
Parser a -> Producer ByteString m () -> Producer a m ()
consumeProducer Parser EigenstratSnpEntry
bimParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadSafe m =>
String -> Producer ByteString m ()
readFileProd
readFamFile :: (MonadIO m) => FilePath -> m [PlinkFamEntry]
readFamFile :: forall (m :: * -> *). MonadIO m => String -> m [PlinkFamEntry]
readFamFile String
fn =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
fn IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
forall (m :: * -> *) a. Monad m => Producer a m () -> m [a]
P.toListM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadThrow m =>
Parser a -> Producer ByteString m () -> Producer a m ()
consumeProducer Parser PlinkFamEntry
famParser (forall (m :: * -> *).
MonadIO m =>
Handle -> Producer' ByteString m ()
PB.fromHandle Handle
handle)
readPlink :: (MonadSafe m) => FilePath
-> FilePath
-> FilePath
-> m ([PlinkFamEntry], Producer (EigenstratSnpEntry, GenoLine) m ())
readPlink :: forall (m :: * -> *).
MonadSafe m =>
String
-> String
-> String
-> m ([PlinkFamEntry],
Producer (EigenstratSnpEntry, GenoLine) m ())
readPlink String
bedFile String
bimFile String
famFile = do
[PlinkFamEntry]
indEntries <- forall (m :: * -> *). MonadIO m => String -> m [PlinkFamEntry]
readFamFile String
famFile
let nrInds :: Int
nrInds = forall (t :: * -> *) a. Foldable t => t a -> Int
length [PlinkFamEntry]
indEntries
snpProd :: Producer EigenstratSnpEntry m ()
snpProd = forall (m :: * -> *).
MonadSafe m =>
String -> Producer EigenstratSnpEntry m ()
readBimFile String
bimFile
Producer GenoLine m ()
genoProd <- forall (m :: * -> *).
MonadSafe m =>
String -> Int -> m (Producer GenoLine m ())
readPlinkBedFile String
bedFile Int
nrInds
forall (m :: * -> *) a. Monad m => a -> m a
return ([PlinkFamEntry]
indEntries, forall (m :: * -> *) a r b x' x.
Monad m =>
Producer a m r -> Producer b m r -> Proxy x' x () (a, b) m r
P.zip Producer EigenstratSnpEntry m ()
snpProd Producer GenoLine m ()
genoProd)
writeBim :: (MonadIO m) => Handle
-> Consumer EigenstratSnpEntry m ()
writeBim :: forall (m :: * -> *).
MonadIO m =>
Handle -> Consumer EigenstratSnpEntry m ()
writeBim Handle
snpFileH =
let snpOutTextConsumer :: Proxy () ByteString y' y m r
snpOutTextConsumer = forall (m :: * -> *) r.
MonadIO m =>
Handle -> Consumer' ByteString m r
PB.toHandle Handle
snpFileH
toTextPipe :: Pipe EigenstratSnpEntry ByteString m r
toTextPipe = forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map (\(EigenstratSnpEntry Chrom
chrom Int
pos Double
gpos ByteString
gid Char
ref Char
alt) ->
let bimLine :: ByteString
bimLine = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\t" [Chrom -> ByteString
unChrom Chrom
chrom, ByteString
gid, String -> ByteString
B.pack (forall a. Show a => a -> String
show Double
gpos),
String -> ByteString
B.pack (forall a. Show a => a -> String
show Int
pos), Char -> ByteString
B.singleton Char
ref, Char -> ByteString
B.singleton Char
alt]
in ByteString
bimLine forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")
in forall {r}. Pipe EigenstratSnpEntry ByteString m r
toTextPipe 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
>-> forall {y'} {y} {r}. Proxy () ByteString y' y m r
snpOutTextConsumer
writeFam :: (MonadIO m) => FilePath -> [PlinkFamEntry] -> m ()
writeFam :: forall (m :: * -> *).
MonadIO m =>
String -> [PlinkFamEntry] -> m ()
writeFam String
f [PlinkFamEntry]
indEntries =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PlinkFamEntry]
indEntries forall a b. (a -> b) -> a -> b
$ \(PlinkFamEntry String
famId String
indId String
fatherId String
motherId Sex
sex String
phen) ->
Handle -> String -> IO ()
hPutStrLn Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
"\t" forall a b. (a -> b) -> a -> b
$ [String
famId, String
indId, String
fatherId, String
motherId, forall {a}. IsString a => Sex -> a
sexToStr Sex
sex, String
phen]
where
sexToStr :: Sex -> a
sexToStr Sex
sex = case Sex
sex of
Sex
Male -> a
"1"
Sex
Female -> a
"2"
Sex
Unknown -> a
"0"
writeBed :: (MonadIO m) => Handle
-> Consumer GenoLine m ()
writeBed :: forall (m :: * -> *). MonadIO m => Handle -> Consumer GenoLine m ()
writeBed Handle
bedFileH = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BB.hPut Handle
bedFileH ([Word8] -> ByteString
BB.pack [Word8
0b01101100, Word8
0b00011011, Word8
0b00000001])
let bedOutConsumer :: Proxy () ByteString y' y m r
bedOutConsumer = forall (m :: * -> *) r.
MonadIO m =>
Handle -> Consumer' ByteString m r
PB.toHandle Handle
bedFileH
toPlinkPipe :: Pipe GenoLine ByteString m r
toPlinkPipe = forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map ([Word8] -> ByteString
BB.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenoLine -> [Word8]
genoLineToBytes)
forall {r}. Pipe GenoLine ByteString m r
toPlinkPipe 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
>-> forall {y'} {y} {r}. Proxy () ByteString y' y m r
bedOutConsumer
where
genoLineToBytes :: GenoLine -> [Word8]
genoLineToBytes :: GenoLine -> [Word8]
genoLineToBytes GenoLine
genoLine = [GenoEntry] -> [Word8]
go (forall a. Vector a -> [a]
toList GenoLine
genoLine)
where
go :: [GenoEntry] -> [Word8]
go :: [GenoEntry] -> [Word8]
go [] = []
go (GenoEntry
g1 : GenoEntry
g2 : GenoEntry
g3 : GenoEntry
g4 : [GenoEntry]
rest) = [GenoEntry] -> Word8
constructByte [GenoEntry
g1, GenoEntry
g2, GenoEntry
g3, GenoEntry
g4] forall a. a -> [a] -> [a]
: [GenoEntry] -> [Word8]
go [GenoEntry]
rest
go [GenoEntry]
genoEntries = [[GenoEntry] -> Word8
constructByte [GenoEntry]
genoEntries]
constructByte :: [GenoEntry] -> Word8
constructByte :: [GenoEntry] -> Word8
constructByte [] = forall a. HasCallStack => String -> a
error String
"constructByte - should never happen"
constructByte [GenoEntry
g] = GenoEntry -> Word8
genoEntryToByte GenoEntry
g
constructByte (GenoEntry
g:[GenoEntry]
gs) = forall a. Bits a => a -> Int -> a
shiftL ([GenoEntry] -> Word8
constructByte [GenoEntry]
gs) Int
2 forall a. Bits a => a -> a -> a
.|. GenoEntry -> Word8
genoEntryToByte GenoEntry
g
genoEntryToByte :: GenoEntry -> Word8
genoEntryToByte :: GenoEntry -> Word8
genoEntryToByte GenoEntry
HomRef = Word8
0b00000000
genoEntryToByte GenoEntry
HomAlt = Word8
0b00000011
genoEntryToByte GenoEntry
Het = Word8
0b00000010
genoEntryToByte GenoEntry
Missing = Word8
0b00000001
writePlink :: (MonadSafe m) => FilePath
-> FilePath
-> FilePath
-> [PlinkFamEntry]
-> Consumer (EigenstratSnpEntry, GenoLine) m ()
writePlink :: forall (m :: * -> *).
MonadSafe m =>
String
-> String
-> String
-> [PlinkFamEntry]
-> Consumer (EigenstratSnpEntry, GenoLine) m ()
writePlink String
bedFile String
bimFile String
famFile [PlinkFamEntry]
indEntries = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> [PlinkFamEntry] -> m ()
writeFam String
famFile [PlinkFamEntry]
indEntries
let bimOutConsumer :: Proxy () EigenstratSnpEntry () X m ()
bimOutConsumer = forall (m :: * -> *) r.
MonadSafe m =>
String -> IOMode -> (Handle -> m r) -> m r
PS.withFile String
bimFile IOMode
WriteMode forall (m :: * -> *).
MonadIO m =>
Handle -> Consumer EigenstratSnpEntry m ()
writeBim
bedOutConsumer :: Proxy () GenoLine () X m ()
bedOutConsumer = forall (m :: * -> *) r.
MonadSafe m =>
String -> IOMode -> (Handle -> m r) -> m r
PS.withFile String
bedFile IOMode
WriteMode forall (m :: * -> *). MonadIO m => Handle -> Consumer GenoLine m ()
writeBed
forall (m :: * -> *) a r. Monad m => Consumer a m r -> Pipe a a m r
P.tee (forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map forall a b. (a, b) -> a
fst 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 () EigenstratSnpEntry () X m ()
bimOutConsumer) 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
>-> forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map forall a b. (a, b) -> b
snd 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 () GenoLine () X m ()
bedOutConsumer