Additional adjustments in the generator modules

poseidon-analysis-hs.cabal

@@ -15,7 +15,7 @@ extra-source-files:  README.md,
 library
     exposed-modules:    Poseidon.Analysis.FStatsConfig, Poseidon.Analysis.RASconfig, Poseidon.Analysis.Utils,
                         Poseidon.Analysis.CLI.FStats, Poseidon.Analysis.CLI.RAS,
-                        Poseidon.Generator.CLI.AdmixPops, Poseidon.Generator.CLI.SpaceTime,
+                        Poseidon.Generator.CLI.AdmixPops,
                         Poseidon.Generator.Parsers, Poseidon.Generator.Types,
                         Poseidon.Generator.SampleGeno, Poseidon.Generator.Utils
     hs-source-dirs:     src

src/Poseidon/Generator/CLI/AdmixPops.hs

@@ -1,9 +1,17 @@
 module Poseidon.Generator.CLI.AdmixPops where
 
+import           Poseidon.ColumnTypesJanno     (JannoGenotypePloidy (..))
+import           Poseidon.EntityTypes          (HasNameAndVersion (..))
 import           Poseidon.Generator.Parsers
 import           Poseidon.Generator.SampleGeno
 import           Poseidon.Generator.Types
 import           Poseidon.Generator.Utils
+import           Poseidon.GenotypeData
+import           Poseidon.Janno                (JannoRows (..),
+                                                createMinimalJanno,
+                                                jGenotypePloidy)
+import           Poseidon.Package
+import           Poseidon.Utils
 
 import           Control.Exception             (catch, throwIO)
 import           Control.Monad                 (forM, unless, when)
@@ -18,10 +26,6 @@ import           Pipes
 import qualified Pipes.Group                   as PG
 import qualified Pipes.Prelude                 as P
 import           Pipes.Safe                    (runSafeT)
-import           Poseidon.EntityTypes          (HasNameAndVersion (..))
-import           Poseidon.GenotypeData
-import           Poseidon.Package
-import           Poseidon.Utils
 import           SequenceFormats.Eigenstrat
 import           SequenceFormats.Plink         (eigenstratInd2PlinkFam,
                                                 writePlink)
@@ -100,14 +104,18 @@ runAdmixPops (
     let gz = if outZip then "gz" else ""
     genotypeFileData <- case outFormat of
             GenotypeOutFormatEigenstrat ->
-                return $ GenotypeEigenstrat (outName <.> "geno" <.> gz)  Nothing
-                                   (outName <.> "snp" <.> gz)  Nothing
-                                   (outName <.> "ind") Nothing
-            GenotypeOutFormatPlink      ->
-                return $ GenotypePlink      (outName <.> "bed" <.> gz)  Nothing
-                                   (outName <.> "bim" <.> gz)  Nothing
-                                   (outName <.> "fam")  Nothing
-            GenotypeOutFormatVCF        -> throwM $ PoseidonGeneratorCLIParsingException "VCF output format not supported yet for admixing populations"
+                return $ GenotypeEigenstrat
+                    (outName <.> "geno" <.> gz) Nothing
+                    (outName <.> "snp" <.> gz) Nothing
+                    (outName <.> "ind") Nothing
+            GenotypeOutFormatPlink ->
+                return $ GenotypePlink
+                    (outName <.> "bed" <.> gz) Nothing
+                    (outName <.> "bim" <.> gz) Nothing
+                    (outName <.> "fam") Nothing
+            GenotypeOutFormatVCF ->
+                return $ GenotypeVCF
+                    (outName <.> "vcf" <.> gz) Nothing
     let genotypeData = GenotypeDataSpec genotypeFileData Nothing -- we set no snpSet
     pac <- newMinimalPackageTemplate outPath outName genotypeData
     liftIO $ writePoseidonPackage pac
@@ -122,10 +130,22 @@ runAdmixPops (
             let newIndEntries = map (\x -> EigenstratIndEntry (B.pack $ _indName x) Unknown (B.pack $ _groupName x)) preparedInds
             outConsumer <- case genotypeFileData of
                     GenotypeEigenstrat outG _ outS _ outI _ ->
-                        return $ writeEigenstrat (outPath </> outG) (outPath </> outS) (outPath </> outI) newIndEntries
-                    GenotypePlink      outG _ outS _ outI _ ->
-                        return $ writePlink      (outPath </> outG) (outPath </> outS) (outPath </> outI) (map (eigenstratInd2PlinkFam outPlinkPopMode) newIndEntries)
-                    GenotypeVCF _ _ -> throwM $ PoseidonGeneratorCLIParsingException "VCF output format not supported yet for admixing populations"
+                        return $ writeEigenstrat
+                            (outPath </> outG)
+                            (outPath </> outS)
+                            (outPath </> outI)
+                            newIndEntries
+                    GenotypePlink outG _ outS _ outI _ ->
+                        return $ writePlink
+                            (outPath </> outG)
+                            (outPath </> outS)
+                            (outPath </> outI)
+                            (map (eigenstratInd2PlinkFam outPlinkPopMode) newIndEntries)
+                    GenotypeVCF outG _ -> do
+                        let (JannoRows xs) = createMinimalJanno newIndEntries
+                            -- writeVCF needs to know if diploid or pseudo-haploid genotypes
+                            madeUpPloidyJannoRows = map (\x -> x {jGenotypePloidy = Just Diploid}) xs
+                        return $ writeVCF logA madeUpPloidyJannoRows (outPath </> outG)
             case methodSetting of
                 PerSNP marginalizeMissing -> do
                     runEffect $ eigenstratProd >->

src/Poseidon/Generator/Parsers.hs

@@ -3,14 +3,10 @@ module Poseidon.Generator.Parsers where
 import           Poseidon.Generator.Types
 import           Poseidon.Generator.Utils
 
-import           Poseidon.ColumnTypesJanno
-
 import           Control.Exception         (throwIO)
-import           Control.Monad             (guard)
 import           Data.List                 (intercalate)
 import           Data.Ratio                ((%))
 import qualified Text.Parsec               as P
-import qualified Text.Parsec.Number        as P
 import qualified Text.Parsec.String        as P
 
 renderRequestedInds :: [RequestedInd] -> String
@@ -55,53 +51,3 @@ parsePopulationWithFraction = do
     _ <- P.oneOf "="
     percP <- read <$> P.many1 P.digit
     return (PopFrac popP (percP % 100))
-
-readIndWithPositionString :: String -> Either String [IndWithPosition]
-readIndWithPositionString s = case P.runParser indWithPositionParser () "" s of
-    Left p  -> Left (show p)
-    Right x -> Right x
-
-readIndWithPositionFromFile :: FilePath -> IO [IndWithPosition]
-readIndWithPositionFromFile positionFile = do
-    let multiPositionParser = indWithPositionParser `P.sepBy1` (P.newline *> P.spaces)
-    eitherParseResult <- P.parseFromFile (P.spaces *> multiPositionParser <* P.spaces) positionFile
-    case eitherParseResult of
-        Left err -> throwIO $ PoseidonGeneratorCLIParsingException (show err)
-        Right r  -> return (concat r)
-
-indWithPositionParser :: P.Parser [IndWithPosition]
-indWithPositionParser = P.try (P.sepBy parseIndWithPosition (P.char ';' <* P.spaces))
-
-parseIndWithPosition :: P.Parser IndWithPosition
-parseIndWithPosition = do
-    _ <- P.oneOf "["
-    ind <- P.manyTill P.anyChar (P.string ":")
-    unit <- P.manyTill P.anyChar (P.string "]")
-    _ <- P.oneOf "("
-    spatpos <- parseSpatialTemporalPosition
-    _ <- P.oneOf ")"
-    return (IndWithPosition ind unit spatpos)
-
-parseSpatialTemporalPosition :: P.Parser SpatialTemporalPosition
-parseSpatialTemporalPosition = do
-    timeP <- pInt
-    _ <- P.oneOf ","
-    latP <- pLat
-    _ <- P.oneOf ","
-    lonP <- pLon
-    return (SpatialTemporalPosition timeP latP lonP)
-
-pInt :: P.Parser Int
-pInt = read <$> P.many1 P.digit
-
-pLat :: P.Parser JannoLatitude
-pLat = do
-    latP <- P.sign <*> P.floating2 True
-    guard (latP >= -90 && latP <= 90) P.<?> "valid latitude (-90 to 90)"
-    return (JannoLatitude latP)
-
-pLon :: P.Parser JannoLongitude
-pLon = do
-    lonP <- P.sign <*> P.floating2 True
-    guard (lonP >= -180 && lonP <= 180) P.<?> "valid longitude (-180 to 180)"
-    return (JannoLongitude lonP)

src/Poseidon/Generator/Types.hs

@@ -1,7 +1,6 @@
 module Poseidon.Generator.Types where
 
 import           Data.List                 (intercalate)
-import           Poseidon.ColumnTypesJanno
 
 data IndConcrete = IndConcrete {
       _indName   :: String
@@ -34,15 +33,3 @@ data PopFrac = PopFrac {
 instance Show PopFrac where
     show (PopFrac _pop _frac) =
         _pop ++ "=" ++ show _frac
-
-data IndWithPosition = IndWithPosition {
-      spatInd  :: String
-    , spatUnit :: String
-    , spatPos  :: SpatialTemporalPosition
-} deriving (Show)
-
-data SpatialTemporalPosition = SpatialTemporalPosition {
-      time :: Int
-    , lat  :: JannoLatitude
-    , lon  :: JannoLongitude
-} deriving (Show)