{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Poseidon.Package (
PoseidonYamlStruct (..),
PoseidonPackage(..),
PoseidonException(..),
PackageReadOptions (..),
findAllPoseidonYmlFiles,
readPoseidonPackageCollection,
readPoseidonPackageCollectionWithSkipIndicator,
getJointGenotypeData,
getJointJanno,
getJointIndividualInfo,
getExtendedIndividualInfo,
newMinimalPackageTemplate,
newPackageTemplate,
renderMismatch,
zipWithPadding,
writePoseidonPackage,
defaultPackageReadOptions,
readPoseidonPackage,
makePseudoPackageFromGenotypeData,
getJannoRowsFromPac,
packagesToPackageInfos,
getAllGroupInfo,
validateGeno,
filterToRelevantPackages
) where
import Poseidon.BibFile (BibEntry (..), BibTeX,
readBibTeXFile)
import Poseidon.Contributor (ContributorSpec (..))
import Poseidon.EntityTypes (EntitySpec, HasNameAndVersion (..),
IndividualInfo (..),
IndividualInfoCollection,
PacNameAndVersion (..),
determineRelevantPackages,
isLatestInCollection,
makePacNameAndVersion,
renderNameWithVersion)
import Poseidon.GenotypeData (GenotypeDataSpec (..),
GenotypeFileSpec (..), joinEntries,
loadGenotypeData, loadIndividuals,
printSNPCopyProgress,
reduceGenotypeFilepaths)
import Poseidon.Janno (GeneticSex (..),
JannoLibraryBuilt (..),
JannoRow (..), JannoRows (..),
JannoUDG (..), ListColumn (..),
createMinimalJanno,
getMaybeListColumn,
jannoHeaderString, readJannoFile)
import Poseidon.PoseidonVersion (asVersion, latestPoseidonVersion,
showPoseidonVersion,
validPoseidonVersions)
import Poseidon.SequencingSource (SSFLibraryBuilt (..), SSFUDG (..),
SeqSourceRow (..),
SeqSourceRows (..),
readSeqSourceFile)
import Poseidon.ServerClient (AddJannoColSpec (..),
ExtendedIndividualInfo (..),
GroupInfo (..), PackageInfo (..))
import Poseidon.Utils (LogA, PoseidonException (..),
PoseidonIO, checkFile,
envErrorLength, envLogAction,
logDebug, logError, logInfo,
logWarning, logWithEnv,
renderPoseidonException)
import Control.DeepSeq (($!!))
import Control.Exception (catch, throwIO)
import Control.Monad (filterM, forM, forM_, unless, void,
when)
import Control.Monad.Catch (MonadThrow, throwM, try)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson (FromJSON, ToJSON, object,
parseJSON, toJSON, withObject,
(.!=), (.:), (.:?), (.=))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BSC
import Data.Char (isSpace)
import Data.Csv (toNamedRecord)
import Data.Either (lefts, rights)
import Data.Function (on)
import qualified Data.HashMap.Strict as HM
import Data.List (elemIndex, group, groupBy,
intercalate, nub, sort, sortOn,
(\\))
import Data.Maybe (catMaybes, fromMaybe, isNothing,
mapMaybe)
import Data.Time (Day, UTCTime (..), getCurrentTime)
import qualified Data.Vector as V
import Data.Version (Version (..), makeVersion)
import Data.Yaml (decodeEither')
import Data.Yaml.Pretty (defConfig, encodePretty,
setConfCompare, setConfDropNull)
import GHC.Generics (Generic)
import Pipes (Pipe, Producer, cat, for,
runEffect, yield, (>->))
import Pipes.OrderedZip (orderCheckPipe, orderedZip,
orderedZipAll)
import qualified Pipes.Prelude as P
import Pipes.Safe (MonadSafe, runSafeT)
import SequenceFormats.Eigenstrat (EigenstratIndEntry (..),
EigenstratSnpEntry (..),
GenoEntry (..), GenoLine,
readEigenstratSnpFile)
import SequenceFormats.Plink (readBimFile)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath (takeBaseName, takeDirectory,
takeExtension, takeFileName, (</>))
import System.IO (IOMode (ReadMode), hGetContents,
withFile)
data PoseidonYamlStruct = PoseidonYamlStruct
{ PoseidonYamlStruct -> Version
_posYamlPoseidonVersion :: Version
, PoseidonYamlStruct -> [Char]
_posYamlTitle :: String
, PoseidonYamlStruct -> Maybe [Char]
_posYamlDescription :: Maybe String
, PoseidonYamlStruct -> [ContributorSpec]
_posYamlContributor :: [ContributorSpec]
, PoseidonYamlStruct -> Maybe Version
_posYamlPackageVersion :: Maybe Version
, PoseidonYamlStruct -> Maybe Day
_posYamlLastModified :: Maybe Day
, PoseidonYamlStruct -> GenotypeDataSpec
_posYamlGenotypeData :: GenotypeDataSpec
, PoseidonYamlStruct -> Maybe [Char]
_posYamlJannoFile :: Maybe FilePath
, PoseidonYamlStruct -> Maybe [Char]
_posYamlJannoFileChkSum :: Maybe String
, PoseidonYamlStruct -> Maybe [Char]
_posYamlSeqSourceFile :: Maybe FilePath
, PoseidonYamlStruct -> Maybe [Char]
_posYamlSeqSourceFileChkSum :: Maybe String
, PoseidonYamlStruct -> Maybe [Char]
_posYamlBibFile :: Maybe FilePath
, PoseidonYamlStruct -> Maybe [Char]
_posYamlBibFileChkSum :: Maybe String
, PoseidonYamlStruct -> Maybe [Char]
_posYamlReadmeFile :: Maybe FilePath
, PoseidonYamlStruct -> Maybe [Char]
_posYamlChangelogFile :: Maybe FilePath
}
deriving (Int -> PoseidonYamlStruct -> ShowS
[PoseidonYamlStruct] -> ShowS
PoseidonYamlStruct -> [Char]
(Int -> PoseidonYamlStruct -> ShowS)
-> (PoseidonYamlStruct -> [Char])
-> ([PoseidonYamlStruct] -> ShowS)
-> Show PoseidonYamlStruct
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PoseidonYamlStruct -> ShowS
showsPrec :: Int -> PoseidonYamlStruct -> ShowS
$cshow :: PoseidonYamlStruct -> [Char]
show :: PoseidonYamlStruct -> [Char]
$cshowList :: [PoseidonYamlStruct] -> ShowS
showList :: [PoseidonYamlStruct] -> ShowS
Show, PoseidonYamlStruct -> PoseidonYamlStruct -> Bool
(PoseidonYamlStruct -> PoseidonYamlStruct -> Bool)
-> (PoseidonYamlStruct -> PoseidonYamlStruct -> Bool)
-> Eq PoseidonYamlStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoseidonYamlStruct -> PoseidonYamlStruct -> Bool
== :: PoseidonYamlStruct -> PoseidonYamlStruct -> Bool
$c/= :: PoseidonYamlStruct -> PoseidonYamlStruct -> Bool
/= :: PoseidonYamlStruct -> PoseidonYamlStruct -> Bool
Eq, (forall x. PoseidonYamlStruct -> Rep PoseidonYamlStruct x)
-> (forall x. Rep PoseidonYamlStruct x -> PoseidonYamlStruct)
-> Generic PoseidonYamlStruct
forall x. Rep PoseidonYamlStruct x -> PoseidonYamlStruct
forall x. PoseidonYamlStruct -> Rep PoseidonYamlStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PoseidonYamlStruct -> Rep PoseidonYamlStruct x
from :: forall x. PoseidonYamlStruct -> Rep PoseidonYamlStruct x
$cto :: forall x. Rep PoseidonYamlStruct x -> PoseidonYamlStruct
to :: forall x. Rep PoseidonYamlStruct x -> PoseidonYamlStruct
Generic)
poseidonJannoFilePath :: FilePath -> PoseidonYamlStruct -> Maybe FilePath
poseidonJannoFilePath :: [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonJannoFilePath [Char]
baseDir PoseidonYamlStruct
yml = ([Char]
baseDir [Char] -> ShowS
</>) ShowS -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PoseidonYamlStruct -> Maybe [Char]
_posYamlJannoFile PoseidonYamlStruct
yml
poseidonSeqSourceFilePath :: FilePath -> PoseidonYamlStruct -> Maybe FilePath
poseidonSeqSourceFilePath :: [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonSeqSourceFilePath [Char]
baseDir PoseidonYamlStruct
yml = ([Char]
baseDir [Char] -> ShowS
</>) ShowS -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PoseidonYamlStruct -> Maybe [Char]
_posYamlSeqSourceFile PoseidonYamlStruct
yml
poseidonBibFilePath :: FilePath -> PoseidonYamlStruct -> Maybe FilePath
poseidonBibFilePath :: [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonBibFilePath [Char]
baseDir PoseidonYamlStruct
yml = ([Char]
baseDir [Char] -> ShowS
</>) ShowS -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PoseidonYamlStruct -> Maybe [Char]
_posYamlBibFile PoseidonYamlStruct
yml
poseidonReadmeFilePath :: FilePath -> PoseidonYamlStruct -> Maybe FilePath
poseidonReadmeFilePath :: [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonReadmeFilePath [Char]
baseDir PoseidonYamlStruct
yml = ([Char]
baseDir [Char] -> ShowS
</>) ShowS -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PoseidonYamlStruct -> Maybe [Char]
_posYamlReadmeFile PoseidonYamlStruct
yml
poseidonChangelogFilePath :: FilePath -> PoseidonYamlStruct -> Maybe FilePath
poseidonChangelogFilePath :: [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonChangelogFilePath [Char]
baseDir PoseidonYamlStruct
yml = ([Char]
baseDir [Char] -> ShowS
</>) ShowS -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PoseidonYamlStruct -> Maybe [Char]
_posYamlChangelogFile PoseidonYamlStruct
yml
instance FromJSON PoseidonYamlStruct where
parseJSON :: Value -> Parser PoseidonYamlStruct
parseJSON = [Char]
-> (Object -> Parser PoseidonYamlStruct)
-> Value
-> Parser PoseidonYamlStruct
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"PoseidonYamlStruct" ((Object -> Parser PoseidonYamlStruct)
-> Value -> Parser PoseidonYamlStruct)
-> (Object -> Parser PoseidonYamlStruct)
-> Value
-> Parser PoseidonYamlStruct
forall a b. (a -> b) -> a -> b
$ \Object
v -> Version
-> [Char]
-> Maybe [Char]
-> [ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct
PoseidonYamlStruct
(Version
-> [Char]
-> Maybe [Char]
-> [ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser Version
-> Parser
([Char]
-> Maybe [Char]
-> [ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Version
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poseidonVersion"
Parser
([Char]
-> Maybe [Char]
-> [ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser [Char]
-> Parser
(Maybe [Char]
-> [ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Char]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
Parser
(Maybe [Char]
-> [ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser
([ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
Parser
([ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser [ContributorSpec]
-> Parser
(Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [ContributorSpec])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contributor" Parser (Maybe [ContributorSpec])
-> [ContributorSpec] -> Parser [ContributorSpec]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
Parser
(Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe Version)
-> Parser
(Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Version)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"packageVersion"
Parser
(Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe Day)
-> Parser
(GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Day)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lastModified"
Parser
(GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser GenotypeDataSpec
-> Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser GenotypeDataSpec
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"genotypeData"
Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jannoFile"
Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jannoFileChkSum"
Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sequencingSourceFile"
Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sequencingSourceFileChkSum"
Parser
(Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser
(Maybe [Char]
-> Maybe [Char] -> Maybe [Char] -> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bibFile"
Parser
(Maybe [Char]
-> Maybe [Char] -> Maybe [Char] -> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser (Maybe [Char] -> Maybe [Char] -> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bibFileChkSum"
Parser (Maybe [Char] -> Maybe [Char] -> PoseidonYamlStruct)
-> Parser (Maybe [Char])
-> Parser (Maybe [Char] -> PoseidonYamlStruct)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"readmeFile"
Parser (Maybe [Char] -> PoseidonYamlStruct)
-> Parser (Maybe [Char]) -> Parser PoseidonYamlStruct
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"changelogFile"
instance ToJSON PoseidonYamlStruct where
toJSON :: PoseidonYamlStruct -> Value
toJSON PoseidonYamlStruct
x = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [
Key
"poseidonVersion" Key -> Version -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Version
_posYamlPoseidonVersion PoseidonYamlStruct
x,
Key
"title" Key -> [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> [Char]
_posYamlTitle PoseidonYamlStruct
x,
Key
"description" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlDescription PoseidonYamlStruct
x] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
(if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ContributorSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PoseidonYamlStruct -> [ContributorSpec]
_posYamlContributor PoseidonYamlStruct
x) then [Key
"contributor" Key -> [ContributorSpec] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> [ContributorSpec]
_posYamlContributor PoseidonYamlStruct
x] else []) [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
[Key
"packageVersion" Key -> Maybe Version -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe Version
_posYamlPackageVersion PoseidonYamlStruct
x,
Key
"lastModified" Key -> Maybe Day -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe Day
_posYamlLastModified PoseidonYamlStruct
x,
Key
"genotypeData" Key -> GenotypeDataSpec -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> GenotypeDataSpec
_posYamlGenotypeData PoseidonYamlStruct
x,
Key
"jannoFile" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlJannoFile PoseidonYamlStruct
x,
Key
"jannoFileChkSum" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlJannoFileChkSum PoseidonYamlStruct
x,
Key
"sequencingSourceFile" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlSeqSourceFile PoseidonYamlStruct
x,
Key
"sequencingSourceFileChkSum" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlSeqSourceFileChkSum PoseidonYamlStruct
x,
Key
"bibFile" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlBibFile PoseidonYamlStruct
x,
Key
"bibFileChkSum" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlBibFileChkSum PoseidonYamlStruct
x,
Key
"readmeFile" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlReadmeFile PoseidonYamlStruct
x,
Key
"changelogFile" Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoseidonYamlStruct -> Maybe [Char]
_posYamlChangelogFile PoseidonYamlStruct
x
]
instance HasNameAndVersion PoseidonYamlStruct where
getPacName :: PoseidonYamlStruct -> [Char]
getPacName = PoseidonYamlStruct -> [Char]
_posYamlTitle
getPacVersion :: PoseidonYamlStruct -> Maybe Version
getPacVersion = PoseidonYamlStruct -> Maybe Version
_posYamlPackageVersion
data PoseidonPackage = PoseidonPackage
{ PoseidonPackage -> [Char]
posPacBaseDir :: FilePath
, PoseidonPackage -> Version
posPacPoseidonVersion :: Version
, PoseidonPackage -> PacNameAndVersion
posPacNameAndVersion :: PacNameAndVersion
, PoseidonPackage -> Maybe [Char]
posPacDescription :: Maybe String
, PoseidonPackage -> [ContributorSpec]
posPacContributor :: [ContributorSpec]
, PoseidonPackage -> Maybe Day
posPacLastModified :: Maybe Day
, PoseidonPackage -> GenotypeDataSpec
posPacGenotypeData :: GenotypeDataSpec
, PoseidonPackage -> Maybe [Char]
posPacJannoFile :: Maybe FilePath
, PoseidonPackage -> JannoRows
posPacJanno :: JannoRows
, PoseidonPackage -> Maybe [Char]
posPacJannoFileChkSum :: Maybe String
, PoseidonPackage -> Maybe [Char]
posPacSeqSourceFile :: Maybe FilePath
, PoseidonPackage -> SeqSourceRows
posPacSeqSource :: SeqSourceRows
, PoseidonPackage -> Maybe [Char]
posPacSeqSourceFileChkSum :: Maybe String
, PoseidonPackage -> Maybe [Char]
posPacBibFile :: Maybe FilePath
, PoseidonPackage -> BibTeX
posPacBib :: BibTeX
, PoseidonPackage -> Maybe [Char]
posPacBibFileChkSum :: Maybe String
, PoseidonPackage -> Maybe [Char]
posPacReadmeFile :: Maybe FilePath
, PoseidonPackage -> Maybe [Char]
posPacChangelogFile :: Maybe FilePath
}
deriving (Int -> PoseidonPackage -> ShowS
[PoseidonPackage] -> ShowS
PoseidonPackage -> [Char]
(Int -> PoseidonPackage -> ShowS)
-> (PoseidonPackage -> [Char])
-> ([PoseidonPackage] -> ShowS)
-> Show PoseidonPackage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PoseidonPackage -> ShowS
showsPrec :: Int -> PoseidonPackage -> ShowS
$cshow :: PoseidonPackage -> [Char]
show :: PoseidonPackage -> [Char]
$cshowList :: [PoseidonPackage] -> ShowS
showList :: [PoseidonPackage] -> ShowS
Show, PoseidonPackage -> PoseidonPackage -> Bool
(PoseidonPackage -> PoseidonPackage -> Bool)
-> (PoseidonPackage -> PoseidonPackage -> Bool)
-> Eq PoseidonPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoseidonPackage -> PoseidonPackage -> Bool
== :: PoseidonPackage -> PoseidonPackage -> Bool
$c/= :: PoseidonPackage -> PoseidonPackage -> Bool
/= :: PoseidonPackage -> PoseidonPackage -> Bool
Eq, (forall x. PoseidonPackage -> Rep PoseidonPackage x)
-> (forall x. Rep PoseidonPackage x -> PoseidonPackage)
-> Generic PoseidonPackage
forall x. Rep PoseidonPackage x -> PoseidonPackage
forall x. PoseidonPackage -> Rep PoseidonPackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PoseidonPackage -> Rep PoseidonPackage x
from :: forall x. PoseidonPackage -> Rep PoseidonPackage x
$cto :: forall x. Rep PoseidonPackage x -> PoseidonPackage
to :: forall x. Rep PoseidonPackage x -> PoseidonPackage
Generic)
instance Ord PoseidonPackage where
compare :: PoseidonPackage -> PoseidonPackage -> Ordering
compare PoseidonPackage
pacA PoseidonPackage
pacB = ([Char], Maybe Version) -> ([Char], Maybe Version) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PoseidonPackage -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
getPacName PoseidonPackage
pacA, PoseidonPackage -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion PoseidonPackage
pacA) (PoseidonPackage -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
getPacName PoseidonPackage
pacB, PoseidonPackage -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion PoseidonPackage
pacB)
instance HasNameAndVersion PoseidonPackage where
getPacName :: PoseidonPackage -> [Char]
getPacName = PacNameAndVersion -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
getPacName (PacNameAndVersion -> [Char])
-> (PoseidonPackage -> PacNameAndVersion)
-> PoseidonPackage
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonPackage -> PacNameAndVersion
posPacNameAndVersion
getPacVersion :: PoseidonPackage -> Maybe Version
getPacVersion = PacNameAndVersion -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion (PacNameAndVersion -> Maybe Version)
-> (PoseidonPackage -> PacNameAndVersion)
-> PoseidonPackage
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonPackage -> PacNameAndVersion
posPacNameAndVersion
data PackageReadOptions = PackageReadOptions
{ PackageReadOptions -> Bool
_readOptIgnoreChecksums :: Bool
, PackageReadOptions -> Bool
_readOptIgnoreGeno :: Bool
, PackageReadOptions -> Bool
_readOptGenoCheck :: Bool
, PackageReadOptions -> Bool
_readOptFullGeno :: Bool
, PackageReadOptions -> Bool
_readOptIgnorePosVersion :: Bool
, PackageReadOptions -> Bool
_readOptOnlyLatest :: Bool
}
defaultPackageReadOptions :: PackageReadOptions
defaultPackageReadOptions :: PackageReadOptions
defaultPackageReadOptions = PackageReadOptions {
_readOptIgnoreChecksums :: Bool
_readOptIgnoreChecksums = Bool
False
, _readOptIgnoreGeno :: Bool
_readOptIgnoreGeno = Bool
False
, _readOptGenoCheck :: Bool
_readOptGenoCheck = Bool
True
, _readOptFullGeno :: Bool
_readOptFullGeno = Bool
False
, _readOptIgnorePosVersion :: Bool
_readOptIgnorePosVersion = Bool
False
, _readOptOnlyLatest :: Bool
_readOptOnlyLatest = Bool
False
}
readPoseidonPackageCollection :: PackageReadOptions
-> [FilePath]
-> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection :: PackageReadOptions -> [[Char]] -> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection PackageReadOptions
opts [[Char]]
baseDirs = ([PoseidonPackage], Bool) -> [PoseidonPackage]
forall a b. (a, b) -> a
fst (([PoseidonPackage], Bool) -> [PoseidonPackage])
-> ReaderT Env IO ([PoseidonPackage], Bool)
-> PoseidonIO [PoseidonPackage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageReadOptions
-> [[Char]] -> ReaderT Env IO ([PoseidonPackage], Bool)
readPoseidonPackageCollectionWithSkipIndicator PackageReadOptions
opts [[Char]]
baseDirs
readPoseidonPackageCollectionWithSkipIndicator :: PackageReadOptions
-> [FilePath]
-> PoseidonIO ([PoseidonPackage], Bool)
readPoseidonPackageCollectionWithSkipIndicator :: PackageReadOptions
-> [[Char]] -> ReaderT Env IO ([PoseidonPackage], Bool)
readPoseidonPackageCollectionWithSkipIndicator PackageReadOptions
opts [[Char]]
baseDirs = do
[Char] -> PoseidonIO ()
logInfo [Char]
"Checking base directories... "
[[Char]]
goodDirs <- [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Char]] -> [[Char]])
-> ReaderT Env IO [Maybe [Char]] -> ReaderT Env IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> ReaderT Env IO (Maybe [Char]))
-> [[Char]] -> ReaderT Env IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> ReaderT Env IO (Maybe [Char])
checkIfBaseDirExists [[Char]]
baseDirs
[Char] -> PoseidonIO ()
logInfo [Char]
"Searching POSEIDON.yml files... "
[[Char]]
posFilesAllVersions <- IO [[Char]] -> ReaderT Env IO [[Char]]
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> ReaderT Env IO [[Char]])
-> IO [[Char]] -> ReaderT Env IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Char]]] -> [[Char]]) -> IO [[[Char]]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO [[Char]]) -> [[Char]] -> IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO [[Char]]
findAllPoseidonYmlFiles [[Char]]
goodDirs
[Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
posFilesAllVersions) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" found"
[[Char]]
posFiles <- if PackageReadOptions -> Bool
_readOptIgnorePosVersion PackageReadOptions
opts
then [[Char]] -> ReaderT Env IO [[Char]]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
posFilesAllVersions
else do
[Char] -> PoseidonIO ()
logInfo [Char]
"Checking Poseidon versions... "
[[Char]] -> ReaderT Env IO [[Char]]
filterByPoseidonVersion [[Char]]
posFilesAllVersions
[Char] -> PoseidonIO ()
logInfo [Char]
"Initializing packages... "
[Either PoseidonException PoseidonPackage]
eitherPackages <- ((Integer, [Char])
-> ReaderT Env IO (Either PoseidonException PoseidonPackage))
-> [(Integer, [Char])]
-> ReaderT Env IO [Either PoseidonException PoseidonPackage]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Integer, [Char])
-> ReaderT Env IO (Either PoseidonException PoseidonPackage)
tryDecodePoseidonPackage ([(Integer, [Char])]
-> ReaderT Env IO [Either PoseidonException PoseidonPackage])
-> [(Integer, [Char])]
-> ReaderT Env IO [Either PoseidonException PoseidonPackage]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [[Char]] -> [(Integer, [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [[Char]]
posFiles
Bool
skipIndicator <- if [PoseidonException] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PoseidonException] -> Bool)
-> ([Either PoseidonException PoseidonPackage]
-> [PoseidonException])
-> [Either PoseidonException PoseidonPackage]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either PoseidonException PoseidonPackage] -> [PoseidonException]
forall a b. [Either a b] -> [a]
lefts ([Either PoseidonException PoseidonPackage] -> Bool)
-> [Either PoseidonException PoseidonPackage] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either PoseidonException PoseidonPackage]
eitherPackages then Bool -> ReaderT Env IO Bool
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
[Char] -> PoseidonIO ()
logWarning [Char]
"Some packages were skipped due to issues:"
[([Char], Either PoseidonException PoseidonPackage)]
-> (([Char], Either PoseidonException PoseidonPackage)
-> PoseidonIO ())
-> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([[Char]]
-> [Either PoseidonException PoseidonPackage]
-> [([Char], Either PoseidonException PoseidonPackage)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
posFiles [Either PoseidonException PoseidonPackage]
eitherPackages) ((([Char], Either PoseidonException PoseidonPackage)
-> PoseidonIO ())
-> PoseidonIO ())
-> (([Char], Either PoseidonException PoseidonPackage)
-> PoseidonIO ())
-> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ \([Char]
posF, Either PoseidonException PoseidonPackage
epac) -> do
case Either PoseidonException PoseidonPackage
epac of
Left PoseidonException
e -> do
[Char] -> PoseidonIO ()
logWarning ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"In the package described in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
posF [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":"
[Char] -> PoseidonIO ()
logWarning ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ PoseidonException -> [Char]
renderPoseidonException PoseidonException
e
Either PoseidonException PoseidonPackage
_ -> () -> PoseidonIO ()
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> ReaderT Env IO Bool
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
let loadedPackages :: [PoseidonPackage]
loadedPackages = [Either PoseidonException PoseidonPackage] -> [PoseidonPackage]
forall a b. [Either a b] -> [b]
rights [Either PoseidonException PoseidonPackage]
eitherPackages
[PoseidonPackage]
filteredPackageList <-
if PackageReadOptions -> Bool
_readOptOnlyLatest PackageReadOptions
opts
then (PoseidonPackage -> ReaderT Env IO Bool)
-> [PoseidonPackage] -> PoseidonIO [PoseidonPackage]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([PoseidonPackage] -> PoseidonPackage -> ReaderT Env IO Bool
forall (m :: * -> *) a.
(MonadThrow m, HasNameAndVersion a) =>
[a] -> a -> m Bool
isLatestInCollection [PoseidonPackage]
loadedPackages) [PoseidonPackage]
loadedPackages
else [PoseidonPackage] -> PoseidonIO [PoseidonPackage]
forall a. a -> ReaderT Env IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PoseidonPackage] -> PoseidonIO [PoseidonPackage])
-> [PoseidonPackage] -> PoseidonIO [PoseidonPackage]
forall a b. (a -> b) -> a -> b
$ [PoseidonPackage]
loadedPackages
let duplicateGroups :: [[PoseidonPackage]]
duplicateGroups = ([PoseidonPackage] -> Bool)
-> [[PoseidonPackage]] -> [[PoseidonPackage]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool)
-> ([PoseidonPackage] -> Int) -> [PoseidonPackage] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PoseidonPackage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
([[PoseidonPackage]] -> [[PoseidonPackage]])
-> ([PoseidonPackage] -> [[PoseidonPackage]])
-> [PoseidonPackage]
-> [[PoseidonPackage]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoseidonPackage -> PoseidonPackage -> Bool)
-> [PoseidonPackage] -> [[PoseidonPackage]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\PoseidonPackage
a PoseidonPackage
b -> PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion PoseidonPackage
a PacNameAndVersion -> PacNameAndVersion -> Bool
forall a. Eq a => a -> a -> Bool
== PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion PoseidonPackage
b)
([PoseidonPackage] -> [[PoseidonPackage]])
-> ([PoseidonPackage] -> [PoseidonPackage])
-> [PoseidonPackage]
-> [[PoseidonPackage]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoseidonPackage -> PacNameAndVersion)
-> [PoseidonPackage] -> [PoseidonPackage]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion ([PoseidonPackage] -> [[PoseidonPackage]])
-> [PoseidonPackage] -> [[PoseidonPackage]]
forall a b. (a -> b) -> a -> b
$ [PoseidonPackage]
filteredPackageList
Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[PoseidonPackage]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[PoseidonPackage]]
duplicateGroups) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> PoseidonIO ()
logError [Char]
"There are duplicated packages in this package collection:"
[[PoseidonPackage]]
-> ([PoseidonPackage] -> ReaderT Env IO Any) -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[PoseidonPackage]]
duplicateGroups (([PoseidonPackage] -> ReaderT Env IO Any) -> PoseidonIO ())
-> ([PoseidonPackage] -> ReaderT Env IO Any) -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ \[PoseidonPackage]
xs -> do
[Char] -> PoseidonIO ()
logError ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Duplicate package " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PacNameAndVersion -> [Char]
forall a. Show a => a -> [Char]
show (PoseidonPackage -> PacNameAndVersion
posPacNameAndVersion (PoseidonPackage -> PacNameAndVersion)
-> PoseidonPackage -> PacNameAndVersion
forall a b. (a -> b) -> a -> b
$ [PoseidonPackage] -> PoseidonPackage
forall a. HasCallStack => [a] -> a
head [PoseidonPackage]
xs) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" found at"
[PoseidonPackage]
-> (PoseidonPackage -> PoseidonIO ()) -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PoseidonPackage]
xs ((PoseidonPackage -> PoseidonIO ()) -> PoseidonIO ())
-> (PoseidonPackage -> PoseidonIO ()) -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ \PoseidonPackage
x -> do
[Char] -> PoseidonIO ()
logError ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PoseidonPackage -> [Char]
posPacBaseDir PoseidonPackage
x
PoseidonException -> ReaderT Env IO Any
forall e a. Exception e => e -> ReaderT Env IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> ReaderT Env IO Any)
-> ([Char] -> PoseidonException) -> [Char] -> ReaderT Env IO Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> PoseidonException
PoseidonCollectionException ([Char] -> ReaderT Env IO Any) -> [Char] -> ReaderT Env IO Any
forall a b. (a -> b) -> a -> b
$ [Char]
"Detected duplicate packages."
let finalPackageList :: [PoseidonPackage]
finalPackageList = [PoseidonPackage] -> [PoseidonPackage]
forall a. Ord a => [a] -> [a]
sort [PoseidonPackage]
filteredPackageList
[Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Packages loaded: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char])
-> ([PoseidonPackage] -> Int) -> [PoseidonPackage] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PoseidonPackage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PoseidonPackage] -> [Char]) -> [PoseidonPackage] -> [Char]
forall a b. (a -> b) -> a -> b
$ [PoseidonPackage]
finalPackageList)
([PoseidonPackage], Bool)
-> ReaderT Env IO ([PoseidonPackage], Bool)
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PoseidonPackage]
finalPackageList, Bool
skipIndicator)
where
checkIfBaseDirExists :: FilePath -> PoseidonIO (Maybe FilePath)
checkIfBaseDirExists :: [Char] -> ReaderT Env IO (Maybe [Char])
checkIfBaseDirExists [Char]
p = do
Bool
exists <- IO Bool -> ReaderT Env IO Bool
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Env IO Bool) -> IO Bool -> ReaderT Env IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesDirectoryExist [Char]
p
if Bool
exists
then Maybe [Char] -> ReaderT Env IO (Maybe [Char])
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
p)
else do
[Char] -> PoseidonIO ()
logWarning ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Base directory (-d) " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
p [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" does not exist"
Maybe [Char] -> ReaderT Env IO (Maybe [Char])
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
filterByPoseidonVersion :: [FilePath] -> PoseidonIO [FilePath]
filterByPoseidonVersion :: [[Char]] -> ReaderT Env IO [[Char]]
filterByPoseidonVersion [[Char]]
posFiles = do
[Either PoseidonException [Char]]
eitherPaths <- IO [Either PoseidonException [Char]]
-> ReaderT Env IO [Either PoseidonException [Char]]
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Either PoseidonException [Char]]
-> ReaderT Env IO [Either PoseidonException [Char]])
-> IO [Either PoseidonException [Char]]
-> ReaderT Env IO [Either PoseidonException [Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Either PoseidonException [Char]))
-> [[Char]] -> IO [Either PoseidonException [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO (Either PoseidonException [Char])
isInVersionRange [[Char]]
posFiles
(PoseidonException -> PoseidonIO ())
-> [PoseidonException] -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> PoseidonIO ()
logWarning ([Char] -> PoseidonIO ())
-> (PoseidonException -> [Char])
-> PoseidonException
-> PoseidonIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonException -> [Char]
renderPoseidonException) ([PoseidonException] -> PoseidonIO ())
-> [PoseidonException] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Either PoseidonException [Char]] -> [PoseidonException]
forall a b. [Either a b] -> [a]
lefts [Either PoseidonException [Char]]
eitherPaths
[[Char]] -> ReaderT Env IO [[Char]]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> ReaderT Env IO [[Char]])
-> [[Char]] -> ReaderT Env IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Either PoseidonException [Char]] -> [[Char]]
forall a b. [Either a b] -> [b]
rights [Either PoseidonException [Char]]
eitherPaths
where
isInVersionRange :: FilePath -> IO (Either PoseidonException FilePath)
isInVersionRange :: [Char] -> IO (Either PoseidonException [Char])
isInVersionRange [Char]
posFile = do
[Char]
content <- [Char] -> IO [Char]
readFile' [Char]
posFile
let posLines :: [[Char]]
posLines = [Char] -> [[Char]]
lines [Char]
content
case [Char] -> [[Char]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Char]
"poseidonVersion:" (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
16) [[Char]]
posLines) of
Maybe Int
Nothing -> Either PoseidonException [Char]
-> IO (Either PoseidonException [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PoseidonException [Char]
-> IO (Either PoseidonException [Char]))
-> Either PoseidonException [Char]
-> IO (Either PoseidonException [Char])
forall a b. (a -> b) -> a -> b
$ PoseidonException -> Either PoseidonException [Char]
forall a b. a -> Either a b
Left (PoseidonException -> Either PoseidonException [Char])
-> PoseidonException -> Either PoseidonException [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> PoseidonException
PoseidonPackageMissingVersionException [Char]
posFile
Just Int
n -> do
let versionLine :: [Char]
versionLine = [[Char]]
posLines [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
versionString :: [Char]
versionString = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
16 [Char]
versionLine
if [Char]
versionString [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (PoseidonVersion -> [Char]) -> [PoseidonVersion] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonVersion -> [Char]
showPoseidonVersion [PoseidonVersion]
validPoseidonVersions
then Either PoseidonException [Char]
-> IO (Either PoseidonException [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PoseidonException [Char]
-> IO (Either PoseidonException [Char]))
-> Either PoseidonException [Char]
-> IO (Either PoseidonException [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either PoseidonException [Char]
forall a b. b -> Either a b
Right [Char]
posFile
else Either PoseidonException [Char]
-> IO (Either PoseidonException [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PoseidonException [Char]
-> IO (Either PoseidonException [Char]))
-> Either PoseidonException [Char]
-> IO (Either PoseidonException [Char])
forall a b. (a -> b) -> a -> b
$ PoseidonException -> Either PoseidonException [Char]
forall a b. a -> Either a b
Left (PoseidonException -> Either PoseidonException [Char])
-> PoseidonException -> Either PoseidonException [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> PoseidonException
PoseidonPackageVersionException [Char]
posFile [Char]
versionString
readFile' :: FilePath -> IO String
readFile' :: [Char] -> IO [Char]
readFile' [Char]
filename = [Char] -> IOMode -> (Handle -> IO [Char]) -> IO [Char]
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
filename IOMode
ReadMode ((Handle -> IO [Char]) -> IO [Char])
-> (Handle -> IO [Char]) -> IO [Char]
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
[Char]
theContent <- Handle -> IO [Char]
hGetContents Handle
handle
(Char -> IO Char) -> [Char] -> IO [Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> IO Char
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
theContent
tryDecodePoseidonPackage :: (Integer, FilePath) -> PoseidonIO (Either PoseidonException PoseidonPackage)
tryDecodePoseidonPackage :: (Integer, [Char])
-> ReaderT Env IO (Either PoseidonException PoseidonPackage)
tryDecodePoseidonPackage (Integer
numberPackage, [Char]
path) = do
[Char] -> PoseidonIO ()
logDebug ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Package " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
numberPackage [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path
ReaderT Env IO PoseidonPackage
-> ReaderT Env IO (Either PoseidonException PoseidonPackage)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (ReaderT Env IO PoseidonPackage
-> ReaderT Env IO (Either PoseidonException PoseidonPackage))
-> ([Char] -> ReaderT Env IO PoseidonPackage)
-> [Char]
-> ReaderT Env IO (Either PoseidonException PoseidonPackage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageReadOptions -> [Char] -> ReaderT Env IO PoseidonPackage
readPoseidonPackage PackageReadOptions
opts ([Char]
-> ReaderT Env IO (Either PoseidonException PoseidonPackage))
-> [Char]
-> ReaderT Env IO (Either PoseidonException PoseidonPackage)
forall a b. (a -> b) -> a -> b
$ [Char]
path
readPoseidonPackage :: PackageReadOptions
-> FilePath
-> PoseidonIO PoseidonPackage
readPoseidonPackage :: PackageReadOptions -> [Char] -> ReaderT Env IO PoseidonPackage
readPoseidonPackage PackageReadOptions
opts [Char]
ymlPath = do
let baseDir :: [Char]
baseDir = ShowS
takeDirectory [Char]
ymlPath
ByteString
bs <- IO ByteString -> ReaderT Env IO ByteString
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ReaderT Env IO ByteString)
-> IO ByteString -> ReaderT Env IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
B.readFile [Char]
ymlPath
yml :: PoseidonYamlStruct
yml@(PoseidonYamlStruct Version
ver [Char]
tit Maybe [Char]
des [ContributorSpec]
con Maybe Version
pacVer Maybe Day
mod_ GenotypeDataSpec
geno Maybe [Char]
jannoF Maybe [Char]
jannoC Maybe [Char]
seqSourceF Maybe [Char]
seqSourceC Maybe [Char]
bibF Maybe [Char]
bibC Maybe [Char]
readF Maybe [Char]
changeF) <- case ByteString -> Either ParseException PoseidonYamlStruct
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' ByteString
bs of
Left ParseException
err -> PoseidonException -> ReaderT Env IO PoseidonYamlStruct
forall e a. Exception e => e -> ReaderT Env IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> ReaderT Env IO PoseidonYamlStruct)
-> PoseidonException -> ReaderT Env IO PoseidonYamlStruct
forall a b. (a -> b) -> a -> b
$ [Char] -> ParseException -> PoseidonException
PoseidonYamlParseException [Char]
ymlPath ParseException
err
Right PoseidonYamlStruct
pac -> PoseidonYamlStruct -> ReaderT Env IO PoseidonYamlStruct
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PoseidonYamlStruct
pac
PoseidonYamlStruct -> PoseidonIO ()
checkYML PoseidonYamlStruct
yml
IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> Bool -> PoseidonYamlStruct -> IO ()
checkFiles [Char]
baseDir (PackageReadOptions -> Bool
_readOptIgnoreChecksums PackageReadOptions
opts) (PackageReadOptions -> Bool
_readOptIgnoreGeno PackageReadOptions
opts) PoseidonYamlStruct
yml
[EigenstratIndEntry]
indEntries <- [Char] -> GenotypeDataSpec -> PoseidonIO [EigenstratIndEntry]
loadIndividuals [Char]
baseDir GenotypeDataSpec
geno
let (Bool
checkSex, Bool
checkGroups) = case GenotypeDataSpec -> GenotypeFileSpec
genotypeFileSpec GenotypeDataSpec
geno of
GenotypeVCF [Char]
_ Maybe [Char]
_ -> (Bool
False, Bool
False)
GenotypeFileSpec
_ -> (Bool
True, Bool
True)
JannoRows
janno <- case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonJannoFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> do
JannoRows -> ReaderT Env IO JannoRows
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (JannoRows -> ReaderT Env IO JannoRows)
-> JannoRows -> ReaderT Env IO JannoRows
forall a b. (a -> b) -> a -> b
$ [EigenstratIndEntry] -> JannoRows
createMinimalJanno [EigenstratIndEntry]
indEntries
Just [Char]
p -> do
JannoRows
loadedJanno <- [Char] -> ReaderT Env IO JannoRows
readJannoFile [Char]
p
IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
-> JannoRows -> [EigenstratIndEntry] -> Bool -> Bool -> IO ()
checkJannoIndConsistency [Char]
tit JannoRows
loadedJanno [EigenstratIndEntry]
indEntries Bool
checkSex Bool
checkGroups
JannoRows -> ReaderT Env IO JannoRows
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRows
loadedJanno
SeqSourceRows
seqSource <- case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonSeqSourceFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> SeqSourceRows -> ReaderT Env IO SeqSourceRows
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SeqSourceRows
forall a. Monoid a => a
mempty
Just [Char]
p -> [Char] -> ReaderT Env IO SeqSourceRows
readSeqSourceFile [Char]
p
[Char] -> SeqSourceRows -> JannoRows -> PoseidonIO ()
checkSeqSourceJannoConsistency [Char]
tit SeqSourceRows
seqSource JannoRows
janno
BibTeX
bib <- case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonBibFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> BibTeX -> ReaderT Env IO BibTeX
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([] :: BibTeX)
Just [Char]
p -> IO BibTeX -> ReaderT Env IO BibTeX
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BibTeX -> ReaderT Env IO BibTeX)
-> IO BibTeX -> ReaderT Env IO BibTeX
forall a b. (a -> b) -> a -> b
$ [Char] -> IO BibTeX
readBibTeXFile [Char]
p
IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> JannoRows -> BibTeX -> IO ()
checkJannoBibConsistency [Char]
tit JannoRows
janno BibTeX
bib
Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageReadOptions -> Bool
_readOptFullGeno PackageReadOptions
opts) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Trying to parse genotype data for package: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
tit
let pac :: PoseidonPackage
pac = [Char]
-> Version
-> PacNameAndVersion
-> Maybe [Char]
-> [ContributorSpec]
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> JannoRows
-> Maybe [Char]
-> Maybe [Char]
-> SeqSourceRows
-> Maybe [Char]
-> Maybe [Char]
-> BibTeX
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonPackage
PoseidonPackage [Char]
baseDir Version
ver ([Char] -> Maybe Version -> PacNameAndVersion
PacNameAndVersion [Char]
tit Maybe Version
pacVer) Maybe [Char]
des [ContributorSpec]
con Maybe Day
mod_ GenotypeDataSpec
geno Maybe [Char]
jannoF JannoRows
janno Maybe [Char]
jannoC Maybe [Char]
seqSourceF SeqSourceRows
seqSource Maybe [Char]
seqSourceC Maybe [Char]
bibF BibTeX
bib Maybe [Char]
bibC Maybe [Char]
readF Maybe [Char]
changeF
Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (PackageReadOptions -> Bool
_readOptIgnoreGeno PackageReadOptions
opts) Bool -> Bool -> Bool
&& PackageReadOptions -> Bool
_readOptGenoCheck PackageReadOptions
opts) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$
PoseidonPackage -> Bool -> PoseidonIO ()
validateGeno PoseidonPackage
pac (PackageReadOptions -> Bool
_readOptFullGeno PackageReadOptions
opts)
PoseidonPackage -> ReaderT Env IO PoseidonPackage
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PoseidonPackage
pac
checkYML :: PoseidonYamlStruct -> PoseidonIO ()
checkYML :: PoseidonYamlStruct -> PoseidonIO ()
checkYML PoseidonYamlStruct
yml = do
let contributors :: [ContributorSpec]
contributors = PoseidonYamlStruct -> [ContributorSpec]
_posYamlContributor PoseidonYamlStruct
yml
Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ContributorSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ContributorSpec]
contributors) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> PoseidonIO ()
logWarning ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Contributor missing in POSEIDON.yml file of package " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PoseidonYamlStruct -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
renderNameWithVersion PoseidonYamlStruct
yml
validateGeno :: PoseidonPackage -> Bool -> PoseidonIO ()
validateGeno :: PoseidonPackage -> Bool -> PoseidonIO ()
validateGeno PoseidonPackage
pac Bool
checkFullGeno = do
LogA
logA <- PoseidonIO LogA
envLogAction
ErrorLength
errLength <- PoseidonIO ErrorLength
envErrorLength
IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (
SafeT IO () -> IO ()
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT IO () -> IO ()) -> SafeT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
eigenstratProd <- LogA
-> Bool
-> [PoseidonPackage]
-> Maybe [Char]
-> SafeT IO (Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ())
forall (m :: * -> *).
MonadSafe m =>
LogA
-> Bool
-> [PoseidonPackage]
-> Maybe [Char]
-> m (Producer (EigenstratSnpEntry, GenoLine) m ())
getJointGenotypeData LogA
logA Bool
False [PoseidonPackage
pac] Maybe [Char]
forall a. Maybe a
Nothing
if Bool
checkFullGeno
then do
UTCTime
currentTime <- IO UTCTime -> SafeT IO UTCTime
forall a. IO a -> SafeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
Effect (SafeT IO) () -> SafeT IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (SafeT IO) () -> SafeT IO ())
-> Effect (SafeT IO) () -> SafeT IO ()
forall a b. (a -> b) -> a -> b
$ Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
eigenstratProd Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
-> Proxy
()
(EigenstratSnpEntry, GenoLine)
()
(EigenstratSnpEntry, GenoLine)
(SafeT IO)
()
-> Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
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
>-> LogA
-> UTCTime
-> Proxy
()
(EigenstratSnpEntry, GenoLine)
()
(EigenstratSnpEntry, GenoLine)
(SafeT IO)
()
forall (m :: * -> *) a.
MonadIO m =>
LogA -> UTCTime -> Pipe a a m ()
printSNPCopyProgress LogA
logA UTCTime
currentTime Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
-> Proxy () (EigenstratSnpEntry, GenoLine) () X (SafeT IO) ()
-> Effect (SafeT IO) ()
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, GenoLine) () X (SafeT IO) ()
Consumer' (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
forall (m :: * -> *) a r. Functor m => Consumer' a m r
P.drain
else
Effect (SafeT IO) () -> SafeT IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (SafeT IO) () -> SafeT IO ())
-> Effect (SafeT IO) () -> SafeT IO ()
forall a b. (a -> b) -> a -> b
$ Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
eigenstratProd Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
-> Proxy
()
(EigenstratSnpEntry, GenoLine)
()
(EigenstratSnpEntry, GenoLine)
(SafeT IO)
()
-> Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
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
>-> Int
-> Proxy
()
(EigenstratSnpEntry, GenoLine)
()
(EigenstratSnpEntry, GenoLine)
(SafeT IO)
()
forall (m :: * -> *) a. Functor m => Int -> Pipe a a m ()
P.take Int
100 Producer (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
-> Proxy () (EigenstratSnpEntry, GenoLine) () X (SafeT IO) ()
-> Effect (SafeT IO) ()
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, GenoLine) () X (SafeT IO) ()
Consumer' (EigenstratSnpEntry, GenoLine) (SafeT IO) ()
forall (m :: * -> *) a r. Functor m => Consumer' a m r
P.drain
) (PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> IO ())
-> (SomeException -> PoseidonException) -> SomeException -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorLength -> SomeException -> PoseidonException
PoseidonGenotypeExceptionForward ErrorLength
errLength)
checkFiles :: FilePath -> Bool -> Bool -> PoseidonYamlStruct -> IO ()
checkFiles :: [Char] -> Bool -> Bool -> PoseidonYamlStruct -> IO ()
checkFiles [Char]
baseDir Bool
ignoreChecksums Bool
ignoreGenotypeFilesMissing PoseidonYamlStruct
yml = do
case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonReadmeFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [Char]
fn -> [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn Maybe [Char]
forall a. Maybe a
Nothing
case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonChangelogFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [Char]
fn -> [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn Maybe [Char]
forall a. Maybe a
Nothing
case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonBibFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [Char]
fn -> if Bool
ignoreChecksums
then [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn Maybe [Char]
forall a. Maybe a
Nothing
else [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn (Maybe [Char] -> IO ()) -> Maybe [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonYamlStruct -> Maybe [Char]
_posYamlBibFileChkSum PoseidonYamlStruct
yml
case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonJannoFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [Char]
fn -> if Bool
ignoreChecksums
then [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn Maybe [Char]
forall a. Maybe a
Nothing
else [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn (Maybe [Char] -> IO ()) -> Maybe [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonYamlStruct -> Maybe [Char]
_posYamlJannoFileChkSum PoseidonYamlStruct
yml
case [Char] -> PoseidonYamlStruct -> Maybe [Char]
poseidonSeqSourceFilePath [Char]
baseDir PoseidonYamlStruct
yml of
Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [Char]
fn -> if Bool
ignoreChecksums
then [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn Maybe [Char]
forall a. Maybe a
Nothing
else [Char] -> Maybe [Char] -> IO ()
checkFile [Char]
fn (Maybe [Char] -> IO ()) -> Maybe [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonYamlStruct -> Maybe [Char]
_posYamlSeqSourceFileChkSum PoseidonYamlStruct
yml
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ignoreGenotypeFilesMissing (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let gd :: GenotypeDataSpec
gd = PoseidonYamlStruct -> GenotypeDataSpec
_posYamlGenotypeData PoseidonYamlStruct
yml
d :: [Char]
d = [Char]
baseDir
case GenotypeDataSpec -> GenotypeFileSpec
genotypeFileSpec GenotypeDataSpec
gd of
GenotypeEigenstrat [Char]
genoF Maybe [Char]
genoFc [Char]
snpF Maybe [Char]
snpFc [Char]
indF Maybe [Char]
indFc -> do
if Bool
ignoreChecksums
then do
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
genoF) Maybe [Char]
forall a. Maybe a
Nothing
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
snpF) Maybe [Char]
forall a. Maybe a
Nothing
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
indF) Maybe [Char]
forall a. Maybe a
Nothing
else do
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
genoF) Maybe [Char]
genoFc
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
snpF) Maybe [Char]
snpFc
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
indF) Maybe [Char]
indFc
GenotypePlink [Char]
genoF Maybe [Char]
genoFc [Char]
snpF Maybe [Char]
snpFc [Char]
indF Maybe [Char]
indFc -> do
if Bool
ignoreChecksums
then do
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
genoF) Maybe [Char]
forall a. Maybe a
Nothing
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
snpF) Maybe [Char]
forall a. Maybe a
Nothing
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
indF) Maybe [Char]
forall a. Maybe a
Nothing
else do
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
genoF) Maybe [Char]
genoFc
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
snpF) Maybe [Char]
snpFc
[Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
indF) Maybe [Char]
indFc
GenotypeVCF [Char]
genoF Maybe [Char]
genoFc -> do
if Bool
ignoreChecksums
then [Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
genoF) Maybe [Char]
forall a. Maybe a
Nothing
else [Char] -> Maybe [Char] -> IO ()
checkFile ([Char]
d [Char] -> ShowS
</> [Char]
genoF) Maybe [Char]
genoFc
checkJannoIndConsistency :: String -> JannoRows -> [EigenstratIndEntry] -> Bool -> Bool -> IO ()
checkJannoIndConsistency :: [Char]
-> JannoRows -> [EigenstratIndEntry] -> Bool -> Bool -> IO ()
checkJannoIndConsistency [Char]
pacName (JannoRows [JannoRow]
rows) [EigenstratIndEntry]
indEntries Bool
checkGroups Bool
checkSex = do
let genoIDs :: [[Char]]
genoIDs = [ [Char]
x | EigenstratIndEntry [Char]
x Sex
_ [Char]
_ <- [EigenstratIndEntry]
indEntries]
genoSexs :: [Sex]
genoSexs = [ Sex
x | EigenstratIndEntry [Char]
_ Sex
x [Char]
_ <- [EigenstratIndEntry]
indEntries]
genoGroups :: [[Char]]
genoGroups = [ [Char]
x | EigenstratIndEntry [Char]
_ Sex
_ [Char]
x <- [EigenstratIndEntry]
indEntries]
let jannoIDs :: [[Char]]
jannoIDs = (JannoRow -> [Char]) -> [JannoRow] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map JannoRow -> [Char]
jPoseidonID [JannoRow]
rows
jannoSexs :: [Sex]
jannoSexs = (JannoRow -> Sex) -> [JannoRow] -> [Sex]
forall a b. (a -> b) -> [a] -> [b]
map (GeneticSex -> Sex
sfSex (GeneticSex -> Sex) -> (JannoRow -> GeneticSex) -> JannoRow -> Sex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> GeneticSex
jGeneticSex) [JannoRow]
rows
jannoGroups :: [[Char]]
jannoGroups = (JannoRow -> [Char]) -> [JannoRow] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName -> [Char]
forall a. Show a => a -> [Char]
show (GroupName -> [Char])
-> (JannoRow -> GroupName) -> JannoRow -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GroupName] -> GroupName
forall a. HasCallStack => [a] -> a
head ([GroupName] -> GroupName)
-> (JannoRow -> [GroupName]) -> JannoRow -> GroupName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListColumn GroupName -> [GroupName]
forall a. ListColumn a -> [a]
getListColumn (ListColumn GroupName -> [GroupName])
-> (JannoRow -> ListColumn GroupName) -> JannoRow -> [GroupName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> ListColumn GroupName
jGroupName) [JannoRow]
rows
let idMis :: Bool
idMis = [[Char]]
genoIDs [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Char]]
jannoIDs
sexMis :: Bool
sexMis = [Sex]
genoSexs [Sex] -> [Sex] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Sex]
jannoSexs
groupMis :: Bool
groupMis = [[Char]]
genoGroups [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Char]]
jannoGroups
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
idMis (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> IO ()) -> PoseidonException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> PoseidonException
PoseidonCrossFileConsistencyException [Char]
pacName ([Char] -> PoseidonException) -> [Char] -> PoseidonException
forall a b. (a -> b) -> a -> b
$
[Char]
"Individual ID mismatch between genotype data (left) and .janno files (right): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[[Char]] -> [[Char]] -> [Char]
renderMismatch [[Char]]
genoIDs [[Char]]
jannoIDs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
sexMis Bool -> Bool -> Bool
&& Bool
checkSex) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> IO ()) -> PoseidonException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> PoseidonException
PoseidonCrossFileConsistencyException [Char]
pacName ([Char] -> PoseidonException) -> [Char] -> PoseidonException
forall a b. (a -> b) -> a -> b
$
[Char]
"Individual Sex mismatch between genotype data (left) and .janno files (right): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[[Char]] -> [[Char]] -> [Char]
renderMismatch ((Sex -> [Char]) -> [Sex] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Sex -> [Char]
forall a. Show a => a -> [Char]
show [Sex]
genoSexs) ((Sex -> [Char]) -> [Sex] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Sex -> [Char]
forall a. Show a => a -> [Char]
show [Sex]
jannoSexs)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
groupMis Bool -> Bool -> Bool
&& Bool
checkGroups) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> IO ()) -> PoseidonException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> PoseidonException
PoseidonCrossFileConsistencyException [Char]
pacName ([Char] -> PoseidonException) -> [Char] -> PoseidonException
forall a b. (a -> b) -> a -> b
$
[Char]
"Individual GroupID mismatch between genotype data (left) and .janno files (right). Note \
\that this could be due to a wrong Plink file population-name encoding \
\(see the --inPlinkPopName option). " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[[Char]] -> [[Char]] -> [Char]
renderMismatch [[Char]]
genoGroups [[Char]]
jannoGroups
renderMismatch :: [String] -> [String] -> String
renderMismatch :: [[Char]] -> [[Char]] -> [Char]
renderMismatch [[Char]]
a [[Char]]
b =
let misMatchList :: [[Char]]
misMatchList = (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\ ([Char]
x, [Char]
y) -> [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")")
((([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool) -> ([Char], [Char]) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]] -> [[Char]] -> [([Char], [Char])]
forall a b. a -> b -> [a] -> [b] -> [(a, b)]
zipWithPadding [Char]
"?" [Char]
"?" [[Char]]
a [[Char]]
b)
in if [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
misMatchList Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5
then [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
5 [[Char]]
misMatchList) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", ..."
else [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
misMatchList
zipWithPadding :: a -> b -> [a] -> [b] -> [(a,b)]
zipWithPadding :: forall a b. a -> b -> [a] -> [b] -> [(a, b)]
zipWithPadding a
a b
b (a
x:[a]
xs) (b
y:[b]
ys) = (a
x,b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: a -> b -> [a] -> [b] -> [(a, b)]
forall a b. a -> b -> [a] -> [b] -> [(a, b)]
zipWithPadding a
a b
b [a]
xs [b]
ys
zipWithPadding a
a b
_ [] [b]
ys = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (a -> [a]
forall a. a -> [a]
repeat a
a) [b]
ys
zipWithPadding a
_ b
b [a]
xs [] = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs (b -> [b]
forall a. a -> [a]
repeat b
b)
checkSeqSourceJannoConsistency :: String -> SeqSourceRows -> JannoRows -> PoseidonIO ()
checkSeqSourceJannoConsistency :: [Char] -> SeqSourceRows -> JannoRows -> PoseidonIO ()
checkSeqSourceJannoConsistency [Char]
pacName (SeqSourceRows [SeqSourceRow]
sRows) (JannoRows [JannoRow]
jRows) = do
PoseidonIO ()
checkPoseidonIDOverlap
PoseidonIO ()
checkUDGandLibraryBuiltOverlap
where
js :: [([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt)]
js = (JannoRow -> ([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt))
-> [JannoRow]
-> [([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt)]
forall a b. (a -> b) -> [a] -> [b]
map (\JannoRow
r -> (JannoRow -> [Char]
jPoseidonID JannoRow
r, JannoRow -> Maybe JannoUDG
jUDG JannoRow
r, JannoRow -> Maybe JannoLibraryBuilt
jLibraryBuilt JannoRow
r)) [JannoRow]
jRows
ss :: [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
ss = (SeqSourceRow -> ([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt))
-> [SeqSourceRow]
-> [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
forall a b. (a -> b) -> [a] -> [b]
map (\SeqSourceRow
r -> (Maybe (ListColumn [Char]) -> [[Char]]
forall a. Maybe (ListColumn a) -> [a]
getMaybeListColumn (Maybe (ListColumn [Char]) -> [[Char]])
-> Maybe (ListColumn [Char]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ SeqSourceRow -> Maybe (ListColumn [Char])
sPoseidonID SeqSourceRow
r, SeqSourceRow -> Maybe SSFUDG
sUDG SeqSourceRow
r, SeqSourceRow -> Maybe SSFLibraryBuilt
sLibraryBuilt SeqSourceRow
r)) [SeqSourceRow]
sRows
checkPoseidonIDOverlap :: PoseidonIO ()
checkPoseidonIDOverlap :: PoseidonIO ()
checkPoseidonIDOverlap = do
let flatSeqSourceIDs :: [[Char]]
flatSeqSourceIDs = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]
a | ([[Char]]
a,Maybe SSFUDG
_,Maybe SSFLibraryBuilt
_) <- [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
ss]
misMatch :: [[Char]]
misMatch = [[Char]]
flatSeqSourceIDs [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]
a | ([Char]
a,Maybe JannoUDG
_,Maybe JannoLibraryBuilt
_) <- [([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt)]
js]
Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
misMatch) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> PoseidonIO ()
logWarning ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"The .ssf file in the package " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
pacName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
" features Poseidon_IDs that are not in the package: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
misMatch
checkUDGandLibraryBuiltOverlap :: PoseidonIO ()
checkUDGandLibraryBuiltOverlap :: PoseidonIO ()
checkUDGandLibraryBuiltOverlap = do
(([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt)
-> PoseidonIO ())
-> [([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt)]
-> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt) -> PoseidonIO ()
checkOneIndividual [([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt)]
js
where
checkOneIndividual :: (String, Maybe JannoUDG, Maybe JannoLibraryBuilt) -> PoseidonIO ()
checkOneIndividual :: ([Char], Maybe JannoUDG, Maybe JannoLibraryBuilt) -> PoseidonIO ()
checkOneIndividual ([Char]
jannoPoseidonID, Maybe JannoUDG
jannoUDG, Maybe JannoLibraryBuilt
jannoLibraryBuilt) = do
let relevantSeqSourceRows :: [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
relevantSeqSourceRows = (([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt) -> Bool)
-> [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
-> [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([[Char]]
seqSourcePoseidonID,Maybe SSFUDG
_,Maybe SSFLibraryBuilt
_) -> [Char]
jannoPoseidonID [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
seqSourcePoseidonID) [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
ss
allSeqSourceUDGs :: [SSFUDG]
allSeqSourceUDGs = [Maybe SSFUDG] -> [SSFUDG]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe SSFUDG] -> [SSFUDG]) -> [Maybe SSFUDG] -> [SSFUDG]
forall a b. (a -> b) -> a -> b
$ [Maybe SSFUDG
b | ([[Char]]
_,Maybe SSFUDG
b,Maybe SSFLibraryBuilt
_) <- [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
relevantSeqSourceRows]
allSeqSourceLibraryBuilts :: [SSFLibraryBuilt]
allSeqSourceLibraryBuilts = [Maybe SSFLibraryBuilt] -> [SSFLibraryBuilt]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe SSFLibraryBuilt] -> [SSFLibraryBuilt])
-> [Maybe SSFLibraryBuilt] -> [SSFLibraryBuilt]
forall a b. (a -> b) -> a -> b
$ [Maybe SSFLibraryBuilt
c | ([[Char]]
_,Maybe SSFUDG
_,Maybe SSFLibraryBuilt
c) <- [([[Char]], Maybe SSFUDG, Maybe SSFLibraryBuilt)]
relevantSeqSourceRows]
case Maybe JannoUDG
jannoUDG of
Maybe JannoUDG
Nothing -> () -> PoseidonIO ()
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just JannoUDG
j -> Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((SSFUDG -> Bool) -> [SSFUDG] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (JannoUDG -> SSFUDG -> Bool
compareU JannoUDG
j) [SSFUDG]
allSeqSourceUDGs) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$
PoseidonException -> PoseidonIO ()
forall e a. Exception e => e -> ReaderT Env IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> PoseidonIO ())
-> PoseidonException -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> PoseidonException
PoseidonCrossFileConsistencyException [Char]
pacName ([Char] -> PoseidonException) -> [Char] -> PoseidonException
forall a b. (a -> b) -> a -> b
$
[Char]
"The information on UDG treatment in .janno and .ssf do not match" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
" for the individual: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
jannoPoseidonID [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ JannoUDG -> [Char]
forall a. Show a => a -> [Char]
show JannoUDG
j [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" <> " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [SSFUDG] -> [Char]
forall a. Show a => a -> [Char]
show [SSFUDG]
allSeqSourceUDGs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
case Maybe JannoLibraryBuilt
jannoLibraryBuilt of
Maybe JannoLibraryBuilt
Nothing -> () -> PoseidonIO ()
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just JannoLibraryBuilt
j -> Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((SSFLibraryBuilt -> Bool) -> [SSFLibraryBuilt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (JannoLibraryBuilt -> SSFLibraryBuilt -> Bool
compareL JannoLibraryBuilt
j) [SSFLibraryBuilt]
allSeqSourceLibraryBuilts) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$
PoseidonException -> PoseidonIO ()
forall e a. Exception e => e -> ReaderT Env IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> PoseidonIO ())
-> PoseidonException -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> PoseidonException
PoseidonCrossFileConsistencyException [Char]
pacName ([Char] -> PoseidonException) -> [Char] -> PoseidonException
forall a b. (a -> b) -> a -> b
$
[Char]
"The information on library strandedness in .janno and .ssf do not match" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
" for the individual: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
jannoPoseidonID [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ JannoLibraryBuilt -> [Char]
forall a. Show a => a -> [Char]
show JannoLibraryBuilt
j [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" <> " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [SSFLibraryBuilt] -> [Char]
forall a. Show a => a -> [Char]
show [SSFLibraryBuilt]
allSeqSourceLibraryBuilts [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
compareU :: JannoUDG -> SSFUDG -> Bool
compareU :: JannoUDG -> SSFUDG -> Bool
compareU JannoUDG
Mixed SSFUDG
_ = Bool
True
compareU JannoUDG
Minus SSFUDG
SSFMinus = Bool
True
compareU JannoUDG
Half SSFUDG
SSFHalf = Bool
True
compareU JannoUDG
Plus SSFUDG
SSFPlus = Bool
True
compareU JannoUDG
_ SSFUDG
_ = Bool
False
compareL :: JannoLibraryBuilt -> SSFLibraryBuilt -> Bool
compareL :: JannoLibraryBuilt -> SSFLibraryBuilt -> Bool
compareL JannoLibraryBuilt
MixedSSDS SSFLibraryBuilt
_ = Bool
True
compareL JannoLibraryBuilt
DS SSFLibraryBuilt
SSFDS = Bool
True
compareL JannoLibraryBuilt
SS SSFLibraryBuilt
SSFSS = Bool
True
compareL JannoLibraryBuilt
_ SSFLibraryBuilt
_ = Bool
False
checkJannoBibConsistency :: String -> JannoRows -> BibTeX -> IO ()
checkJannoBibConsistency :: [Char] -> JannoRows -> BibTeX -> IO ()
checkJannoBibConsistency [Char]
pacName (JannoRows [JannoRow]
rows) BibTeX
bibtex = do
let literatureInJanno :: [[Char]]
literatureInJanno = (JannoPublication -> [Char]) -> [JannoPublication] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map JannoPublication -> [Char]
forall a. Show a => a -> [Char]
show ([JannoPublication] -> [[Char]]) -> [JannoPublication] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [JannoPublication] -> [JannoPublication]
forall a. Eq a => [a] -> [a]
nub ([JannoPublication] -> [JannoPublication])
-> ([JannoRow] -> [JannoPublication])
-> [JannoRow]
-> [JannoPublication]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListColumn JannoPublication -> [JannoPublication])
-> [ListColumn JannoPublication] -> [JannoPublication]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ListColumn JannoPublication -> [JannoPublication]
forall a. ListColumn a -> [a]
getListColumn ([ListColumn JannoPublication] -> [JannoPublication])
-> ([JannoRow] -> [ListColumn JannoPublication])
-> [JannoRow]
-> [JannoPublication]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JannoRow -> Maybe (ListColumn JannoPublication))
-> [JannoRow] -> [ListColumn JannoPublication]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe JannoRow -> Maybe (ListColumn JannoPublication)
jPublication ([JannoRow] -> [JannoPublication])
-> [JannoRow] -> [JannoPublication]
forall a b. (a -> b) -> a -> b
$ [JannoRow]
rows
literatureInBib :: [[Char]]
literatureInBib = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (BibEntry -> [Char]) -> BibTeX -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map BibEntry -> [Char]
bibEntryId BibTeX
bibtex
literatureNotInBibButInJanno :: [[Char]]
literatureNotInBibButInJanno = [[Char]]
literatureInJanno [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
literatureInBib
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
literatureNotInBibButInJanno) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> IO ()) -> PoseidonException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> PoseidonException
PoseidonCrossFileConsistencyException [Char]
pacName ([Char] -> PoseidonException) -> [Char] -> PoseidonException
forall a b. (a -> b) -> a -> b
$
[Char]
"The following papers lack BibTeX entries: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
literatureNotInBibButInJanno
findAllPoseidonYmlFiles :: FilePath -> IO [FilePath]
findAllPoseidonYmlFiles :: [Char] -> IO [[Char]]
findAllPoseidonYmlFiles [Char]
baseDir = do
[[Char]]
entries <- [Char] -> IO [[Char]]
listDirectory [Char]
baseDir
let posFiles :: [[Char]]
posFiles = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
baseDir [Char] -> ShowS
</>) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"POSEIDON.yml") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
takeFileName [[Char]]
entries
[[Char]]
subDirs <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesDirectoryExist ([[Char]] -> IO [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> IO [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
baseDir [Char] -> ShowS
</>) ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
entries
[[Char]]
morePosFiles <- ([[[Char]]] -> [[Char]]) -> IO [[[Char]]] -> IO [[Char]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[[Char]]] -> IO [[Char]])
-> ([[Char]] -> IO [[[Char]]]) -> [[Char]] -> IO [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> IO [[Char]]) -> [[Char]] -> IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO [[Char]]
findAllPoseidonYmlFiles ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
subDirs
[[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
posFiles [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
morePosFiles
getJointGenotypeData :: MonadSafe m =>
LogA
-> Bool
-> [PoseidonPackage]
-> Maybe FilePath
-> m (Producer (EigenstratSnpEntry, GenoLine) m ())
getJointGenotypeData :: forall (m :: * -> *).
MonadSafe m =>
LogA
-> Bool
-> [PoseidonPackage]
-> Maybe [Char]
-> m (Producer (EigenstratSnpEntry, GenoLine) m ())
getJointGenotypeData LogA
logA Bool
intersect [PoseidonPackage]
pacs Maybe [Char]
maybeSnpFile = do
[Producer (EigenstratSnpEntry, GenoLine) m ()]
genotypeProducers <- [m (Producer (EigenstratSnpEntry, GenoLine) m ())]
-> m [Producer (EigenstratSnpEntry, GenoLine) m ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [[Char]
-> GenotypeDataSpec
-> m (Producer (EigenstratSnpEntry, GenoLine) m ())
forall (m :: * -> *).
MonadSafe m =>
[Char]
-> GenotypeDataSpec
-> m (Producer (EigenstratSnpEntry, GenoLine) m ())
loadGenotypeData (PoseidonPackage -> [Char]
posPacBaseDir PoseidonPackage
pac) (PoseidonPackage -> GenotypeDataSpec
posPacGenotypeData PoseidonPackage
pac) | PoseidonPackage
pac <- [PoseidonPackage]
pacs]
let nrInds :: [Int]
nrInds = (PoseidonPackage -> Int) -> [PoseidonPackage] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([JannoRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([JannoRow] -> Int)
-> (PoseidonPackage -> [JannoRow]) -> PoseidonPackage -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRows -> [JannoRow]
getJannoRows (JannoRows -> [JannoRow])
-> (PoseidonPackage -> JannoRows) -> PoseidonPackage -> [JannoRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonPackage -> JannoRows
posPacJanno) [PoseidonPackage]
pacs
pacNames :: [[Char]]
pacNames = (PoseidonPackage -> [Char]) -> [PoseidonPackage] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
getPacName [PoseidonPackage]
pacs
prod :: Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
prod = ((EigenstratSnpEntry, GenoLine)
-> (EigenstratSnpEntry, GenoLine) -> Ordering)
-> [Producer (EigenstratSnpEntry, GenoLine) m ()]
-> Producer [Maybe (EigenstratSnpEntry, GenoLine)] m [()]
forall (m :: * -> *) a r.
Monad m =>
(a -> a -> Ordering)
-> [Producer a m r] -> Producer [Maybe a] m [r]
orderedZipAll (EigenstratSnpEntry, GenoLine)
-> (EigenstratSnpEntry, GenoLine) -> Ordering
compFunc [Producer (EigenstratSnpEntry, GenoLine) m ()]
genotypeProducers Producer [Maybe (EigenstratSnpEntry, GenoLine)] m [()]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
[Maybe (EigenstratSnpEntry, GenoLine)]
m
[()]
-> Producer [Maybe (EigenstratSnpEntry, GenoLine)] 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
>->
([Maybe (EigenstratSnpEntry, GenoLine)] -> Bool)
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
[Maybe (EigenstratSnpEntry, GenoLine)]
m
[()]
forall (m :: * -> *) a r. Functor m => (a -> Bool) -> Pipe a a m r
P.filter [Maybe (EigenstratSnpEntry, GenoLine)] -> Bool
filterUnionOrIntersection Producer [Maybe (EigenstratSnpEntry, GenoLine)] m [()]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
[()]
-> Proxy X () () (EigenstratSnpEntry, GenoLine) 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
>-> LogA
-> [Int]
-> [[Char]]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
[()]
forall (m :: * -> *) r.
MonadIO m =>
LogA
-> [Int]
-> [[Char]]
-> Pipe
[Maybe (EigenstratSnpEntry, GenoLine)]
(EigenstratSnpEntry, GenoLine)
m
r
joinEntryPipe LogA
logA [Int]
nrInds [[Char]]
pacNames
Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
jointProducer <- case Maybe [Char]
maybeSnpFile of
Maybe [Char]
Nothing -> do
Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
-> m (Proxy X () () (EigenstratSnpEntry, GenoLine) m [()])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
prod
Just [Char]
fn -> do
let snpProd :: Proxy X () () EigenstratSnpEntry m ()
snpProd = [Char] -> Proxy X () () EigenstratSnpEntry m ()
forall (m :: * -> *).
MonadSafe m =>
[Char] -> Producer EigenstratSnpEntry m ()
loadBimOrSnpFile [Char]
fn Proxy X () () EigenstratSnpEntry m ()
-> Proxy () EigenstratSnpEntry () EigenstratSnpEntry m ()
-> Proxy X () () EigenstratSnpEntry 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
>-> (EigenstratSnpEntry -> EigenstratSnpEntry -> Ordering)
-> Proxy () EigenstratSnpEntry () EigenstratSnpEntry m ()
forall (m :: * -> *) a r.
(MonadIO m, MonadSafe m, Show a) =>
(a -> a -> Ordering) -> Pipe a a m r
orderCheckPipe EigenstratSnpEntry -> EigenstratSnpEntry -> Ordering
compFunc3
Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
-> m (Proxy X () () (EigenstratSnpEntry, GenoLine) m [()])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
-> m (Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]))
-> Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
-> m (Proxy X () () (EigenstratSnpEntry, GenoLine) m [()])
forall a b. (a -> b) -> a -> b
$ ((EigenstratSnpEntry -> (EigenstratSnpEntry, GenoLine) -> Ordering)
-> Proxy X () () EigenstratSnpEntry m ()
-> Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
-> Producer
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
((), [()])
forall (m :: * -> *) a b r1 r2.
Monad m =>
(a -> b -> Ordering)
-> Producer a m r1
-> Producer b m r2
-> Producer (Maybe a, Maybe b) m (r1, r2)
orderedZip EigenstratSnpEntry -> (EigenstratSnpEntry, GenoLine) -> Ordering
compFunc2 Proxy X () () EigenstratSnpEntry m ()
snpProd Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
prod Producer
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
((), [()])
-> Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
[()]
-> Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
[()]
forall a b.
Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
a
-> Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
b
-> Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [()]
-> Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
[()]
forall a.
a
-> Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
a
forall (m :: * -> *) a. Monad m => a -> m a
return [()]) Proxy
X
()
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
[()]
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
[()]
-> Proxy X () () (EigenstratSnpEntry, GenoLine) 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
>-> Int
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
[()]
forall (m :: * -> *) r.
Monad m =>
Int
-> Pipe
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
(EigenstratSnpEntry, GenoLine)
m
r
selectSnps ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
nrInds)
Producer (EigenstratSnpEntry, GenoLine) m ()
-> m (Producer (EigenstratSnpEntry, GenoLine) m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
-> Producer (EigenstratSnpEntry, GenoLine) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Proxy X () () (EigenstratSnpEntry, GenoLine) m [()]
jointProducer)
where
compFunc :: (EigenstratSnpEntry, GenoLine) -> (EigenstratSnpEntry, GenoLine) -> Ordering
compFunc :: (EigenstratSnpEntry, GenoLine)
-> (EigenstratSnpEntry, GenoLine) -> Ordering
compFunc (EigenstratSnpEntry Chrom
c1 Int
p1 Double
_ ByteString
_ Char
_ Char
_, GenoLine
_) (EigenstratSnpEntry Chrom
c2 Int
p2 Double
_ ByteString
_ Char
_ Char
_, GenoLine
_) = (Chrom, Int) -> (Chrom, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Chrom
c1, Int
p1) (Chrom
c2, Int
p2)
compFunc2 :: EigenstratSnpEntry -> (EigenstratSnpEntry, GenoLine) -> Ordering
compFunc2 :: EigenstratSnpEntry -> (EigenstratSnpEntry, GenoLine) -> Ordering
compFunc2 (EigenstratSnpEntry Chrom
c1 Int
p1 Double
_ ByteString
_ Char
_ Char
_) (EigenstratSnpEntry Chrom
c2 Int
p2 Double
_ ByteString
_ Char
_ Char
_, GenoLine
_) = (Chrom, Int) -> (Chrom, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Chrom
c1, Int
p1) (Chrom
c2, Int
p2)
compFunc3 :: EigenstratSnpEntry -> EigenstratSnpEntry -> Ordering
compFunc3 :: EigenstratSnpEntry -> EigenstratSnpEntry -> Ordering
compFunc3 (EigenstratSnpEntry Chrom
c1 Int
p1 Double
_ ByteString
_ Char
_ Char
_) (EigenstratSnpEntry Chrom
c2 Int
p2 Double
_ ByteString
_ Char
_ Char
_) = (Chrom, Int) -> (Chrom, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Chrom
c1, Int
p1) (Chrom
c2, Int
p2)
filterUnionOrIntersection :: [Maybe (EigenstratSnpEntry, GenoLine)] -> Bool
filterUnionOrIntersection :: [Maybe (EigenstratSnpEntry, GenoLine)] -> Bool
filterUnionOrIntersection [Maybe (EigenstratSnpEntry, GenoLine)]
maybeTuples = Bool -> Bool
not Bool
intersect Bool -> Bool -> Bool
|| Bool -> Bool
not ((Maybe (EigenstratSnpEntry, GenoLine) -> Bool)
-> [Maybe (EigenstratSnpEntry, GenoLine)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe (EigenstratSnpEntry, GenoLine) -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe (EigenstratSnpEntry, GenoLine)]
maybeTuples)
selectSnps :: (Monad m) => Int -> Pipe (Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine)) (EigenstratSnpEntry, GenoLine) m r
selectSnps :: forall (m :: * -> *) r.
Monad m =>
Int
-> Pipe
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
(EigenstratSnpEntry, GenoLine)
m
r
selectSnps Int
n = Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
r
-> ((Maybe EigenstratSnpEntry,
Maybe (EigenstratSnpEntry, GenoLine))
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
())
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
m
r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (((Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
())
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
r)
-> ((Maybe EigenstratSnpEntry,
Maybe (EigenstratSnpEntry, GenoLine))
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
())
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
r
forall a b. (a -> b) -> a -> b
$ \case
(Just EigenstratSnpEntry
_, Just (EigenstratSnpEntry
es, GenoLine
gl)) -> (EigenstratSnpEntry, GenoLine)
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (EigenstratSnpEntry
es, GenoLine
gl)
(Just EigenstratSnpEntry
snp, Maybe (EigenstratSnpEntry, GenoLine)
Nothing) -> Bool
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
intersect (Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
())
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
forall a b. (a -> b) -> a -> b
$ (EigenstratSnpEntry, GenoLine)
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (EigenstratSnpEntry
snp, Int -> GenoEntry -> GenoLine
forall a. Int -> a -> Vector a
V.replicate Int
n GenoEntry
Missing)
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
_ -> ()
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
()
forall a.
a
-> Proxy
()
(Maybe EigenstratSnpEntry, Maybe (EigenstratSnpEntry, GenoLine))
()
(EigenstratSnpEntry, GenoLine)
m
a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getJointJanno :: [PoseidonPackage] -> JannoRows
getJointJanno :: [PoseidonPackage] -> JannoRows
getJointJanno [PoseidonPackage]
pacs = [JannoRows] -> JannoRows
forall a. Monoid a => [a] -> a
mconcat ([JannoRows] -> JannoRows) -> [JannoRows] -> JannoRows
forall a b. (a -> b) -> a -> b
$ (PoseidonPackage -> JannoRows) -> [PoseidonPackage] -> [JannoRows]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> JannoRows
posPacJanno [PoseidonPackage]
pacs
getJannoRowsFromPac :: PoseidonPackage -> [JannoRow]
getJannoRowsFromPac :: PoseidonPackage -> [JannoRow]
getJannoRowsFromPac PoseidonPackage
pac = let (JannoRows [JannoRow]
rows) = PoseidonPackage -> JannoRows
posPacJanno PoseidonPackage
pac in [JannoRow]
rows
joinEntryPipe :: (MonadIO m) => LogA -> [Int] -> [String] -> Pipe [Maybe (EigenstratSnpEntry, GenoLine)] (EigenstratSnpEntry, GenoLine) m r
joinEntryPipe :: forall (m :: * -> *) r.
MonadIO m =>
LogA
-> [Int]
-> [[Char]]
-> Pipe
[Maybe (EigenstratSnpEntry, GenoLine)]
(EigenstratSnpEntry, GenoLine)
m
r
joinEntryPipe LogA
logA [Int]
nrInds [[Char]]
pacNames = Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
[Maybe (EigenstratSnpEntry, GenoLine)]
m
r
-> ([Maybe (EigenstratSnpEntry, GenoLine)]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
())
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
[Maybe (EigenstratSnpEntry, GenoLine)]
m
r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (([Maybe (EigenstratSnpEntry, GenoLine)]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
())
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
r)
-> ([Maybe (EigenstratSnpEntry, GenoLine)]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
())
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
r
forall a b. (a -> b) -> a -> b
$ \[Maybe (EigenstratSnpEntry, GenoLine)]
maybeEntries -> do
Either PoseidonException (EigenstratSnpEntry, GenoLine)
eitherJE <- IO (Either PoseidonException (EigenstratSnpEntry, GenoLine))
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
(Either PoseidonException (EigenstratSnpEntry, GenoLine))
forall a.
IO a
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either PoseidonException (EigenstratSnpEntry, GenoLine))
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
(Either PoseidonException (EigenstratSnpEntry, GenoLine)))
-> (IO (EigenstratSnpEntry, GenoLine)
-> IO (Either PoseidonException (EigenstratSnpEntry, GenoLine)))
-> IO (EigenstratSnpEntry, GenoLine)
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
(Either PoseidonException (EigenstratSnpEntry, GenoLine))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (EigenstratSnpEntry, GenoLine)
-> IO (Either PoseidonException (EigenstratSnpEntry, GenoLine))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO (EigenstratSnpEntry, GenoLine)
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
(Either PoseidonException (EigenstratSnpEntry, GenoLine)))
-> IO (EigenstratSnpEntry, GenoLine)
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
(Either PoseidonException (EigenstratSnpEntry, GenoLine))
forall a b. (a -> b) -> a -> b
$ LogA
-> [Int]
-> [[Char]]
-> [Maybe (EigenstratSnpEntry, GenoLine)]
-> IO (EigenstratSnpEntry, GenoLine)
forall (m :: * -> *).
MonadIO m =>
LogA
-> [Int]
-> [[Char]]
-> [Maybe (EigenstratSnpEntry, GenoLine)]
-> m (EigenstratSnpEntry, GenoLine)
joinEntries LogA
logA [Int]
nrInds [[Char]]
pacNames [Maybe (EigenstratSnpEntry, GenoLine)]
maybeEntries
case Either PoseidonException (EigenstratSnpEntry, GenoLine)
eitherJE of
Left (PoseidonGenotypeException [Char]
err) ->
LogA
-> PoseidonIO ()
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
()
forall (m :: * -> *). MonadIO m => LogA -> PoseidonIO () -> m ()
logWithEnv LogA
logA (PoseidonIO ()
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
())
-> ([Char] -> PoseidonIO ())
-> [Char]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> PoseidonIO ()
logDebug ([Char]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
())
-> [Char]
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
()
forall a b. (a -> b) -> a -> b
$ [Char]
"Skipping SNP due to " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err
Left PoseidonException
e -> IO ()
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
()
forall a.
IO a
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
())
-> (PoseidonException -> IO ())
-> PoseidonException
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PoseidonException
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
())
-> PoseidonException
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
()
forall a b. (a -> b) -> a -> b
$ PoseidonException
e
Right (EigenstratSnpEntry
eigenstratSnpEntry, GenoLine
genoLine) -> (EigenstratSnpEntry, GenoLine)
-> Proxy
()
[Maybe (EigenstratSnpEntry, GenoLine)]
()
(EigenstratSnpEntry, GenoLine)
m
()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (EigenstratSnpEntry
eigenstratSnpEntry, GenoLine
genoLine)
loadBimOrSnpFile :: (MonadSafe m) => FilePath -> Producer EigenstratSnpEntry m ()
loadBimOrSnpFile :: forall (m :: * -> *).
MonadSafe m =>
[Char] -> Producer EigenstratSnpEntry m ()
loadBimOrSnpFile [Char]
fn
| ShowS
takeExtension [Char]
fn [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".snp", [Char]
".snp.gz"] = [Char] -> Producer EigenstratSnpEntry m ()
forall (m :: * -> *).
MonadSafe m =>
[Char] -> Producer EigenstratSnpEntry m ()
readEigenstratSnpFile [Char]
fn
| ShowS
takeExtension [Char]
fn [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".bim", [Char]
".bim.gz"] = [Char] -> Producer EigenstratSnpEntry m ()
forall (m :: * -> *).
MonadSafe m =>
[Char] -> Producer EigenstratSnpEntry m ()
readBimFile [Char]
fn
| Bool
otherwise = PoseidonException -> Producer EigenstratSnpEntry m ()
forall e a.
Exception e =>
e -> Proxy X () () EigenstratSnpEntry m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ([Char] -> PoseidonException
PoseidonGenotypeException [Char]
"option snpFile requires file endings to be *.snp or *.bim or *.snp.gz or *.bim.gz")
newMinimalPackageTemplate :: (MonadThrow m) => FilePath -> String -> GenotypeDataSpec -> m PoseidonPackage
newMinimalPackageTemplate :: forall (m :: * -> *).
MonadThrow m =>
[Char] -> [Char] -> GenotypeDataSpec -> m PoseidonPackage
newMinimalPackageTemplate [Char]
baseDir [Char]
name GenotypeDataSpec
gd = do
GenotypeDataSpec
reducedGD <- ([Char], GenotypeDataSpec) -> GenotypeDataSpec
forall a b. (a, b) -> b
snd (([Char], GenotypeDataSpec) -> GenotypeDataSpec)
-> m ([Char], GenotypeDataSpec) -> m GenotypeDataSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenotypeDataSpec -> m ([Char], GenotypeDataSpec)
forall (m :: * -> *).
MonadThrow m =>
GenotypeDataSpec -> m ([Char], GenotypeDataSpec)
reduceGenotypeFilepaths GenotypeDataSpec
gd
PoseidonPackage -> m PoseidonPackage
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PoseidonPackage -> m PoseidonPackage)
-> PoseidonPackage -> m PoseidonPackage
forall a b. (a -> b) -> a -> b
$ PoseidonPackage {
posPacBaseDir :: [Char]
posPacBaseDir = [Char]
baseDir
, posPacPoseidonVersion :: Version
posPacPoseidonVersion = PoseidonVersion -> Version
asVersion PoseidonVersion
latestPoseidonVersion
, posPacNameAndVersion :: PacNameAndVersion
posPacNameAndVersion = [Char] -> Maybe Version -> PacNameAndVersion
PacNameAndVersion [Char]
name Maybe Version
forall a. Maybe a
Nothing
, posPacDescription :: Maybe [Char]
posPacDescription = Maybe [Char]
forall a. Maybe a
Nothing
, posPacContributor :: [ContributorSpec]
posPacContributor = []
, posPacLastModified :: Maybe Day
posPacLastModified = Maybe Day
forall a. Maybe a
Nothing
, posPacGenotypeData :: GenotypeDataSpec
posPacGenotypeData = GenotypeDataSpec
reducedGD
, posPacJannoFile :: Maybe [Char]
posPacJannoFile = Maybe [Char]
forall a. Maybe a
Nothing
, posPacJanno :: JannoRows
posPacJanno = JannoRows
forall a. Monoid a => a
mempty
, posPacJannoFileChkSum :: Maybe [Char]
posPacJannoFileChkSum = Maybe [Char]
forall a. Maybe a
Nothing
, posPacSeqSourceFile :: Maybe [Char]
posPacSeqSourceFile = Maybe [Char]
forall a. Maybe a
Nothing
, posPacSeqSource :: SeqSourceRows
posPacSeqSource = SeqSourceRows
forall a. Monoid a => a
mempty
, posPacSeqSourceFileChkSum :: Maybe [Char]
posPacSeqSourceFileChkSum = Maybe [Char]
forall a. Maybe a
Nothing
, posPacBibFile :: Maybe [Char]
posPacBibFile = Maybe [Char]
forall a. Maybe a
Nothing
, posPacBib :: BibTeX
posPacBib = [] :: BibTeX
, posPacBibFileChkSum :: Maybe [Char]
posPacBibFileChkSum = Maybe [Char]
forall a. Maybe a
Nothing
, posPacReadmeFile :: Maybe [Char]
posPacReadmeFile = Maybe [Char]
forall a. Maybe a
Nothing
, posPacChangelogFile :: Maybe [Char]
posPacChangelogFile = Maybe [Char]
forall a. Maybe a
Nothing
}
makePseudoPackageFromGenotypeData :: GenotypeDataSpec -> PoseidonIO PoseidonPackage
makePseudoPackageFromGenotypeData :: GenotypeDataSpec -> ReaderT Env IO PoseidonPackage
makePseudoPackageFromGenotypeData GenotypeDataSpec
gd = do
([Char]
baseDir, GenotypeDataSpec
reducedGenotypeDataSpec) <- GenotypeDataSpec -> ReaderT Env IO ([Char], GenotypeDataSpec)
forall (m :: * -> *).
MonadThrow m =>
GenotypeDataSpec -> m ([Char], GenotypeDataSpec)
reduceGenotypeFilepaths GenotypeDataSpec
gd
let pacName :: [Char]
pacName = case GenotypeDataSpec -> GenotypeFileSpec
genotypeFileSpec GenotypeDataSpec
reducedGenotypeDataSpec of
GenotypeEigenstrat [Char]
fn Maybe [Char]
_ [Char]
_ Maybe [Char]
_ [Char]
_ Maybe [Char]
_ -> ShowS
takeBaseNameSmart [Char]
fn
GenotypePlink [Char]
fn Maybe [Char]
_ [Char]
_ Maybe [Char]
_ [Char]
_ Maybe [Char]
_ -> ShowS
takeBaseNameSmart [Char]
fn
GenotypeVCF [Char]
fn Maybe [Char]
_ -> ShowS
takeBaseNameSmart [Char]
fn
[EigenstratIndEntry]
inds <- [Char] -> GenotypeDataSpec -> PoseidonIO [EigenstratIndEntry]
loadIndividuals [Char]
baseDir GenotypeDataSpec
reducedGenotypeDataSpec
[Char]
-> [Char]
-> GenotypeDataSpec
-> Maybe (Either [EigenstratIndEntry] JannoRows)
-> SeqSourceRows
-> BibTeX
-> ReaderT Env IO PoseidonPackage
newPackageTemplate [Char]
baseDir [Char]
pacName GenotypeDataSpec
reducedGenotypeDataSpec (Either [EigenstratIndEntry] JannoRows
-> Maybe (Either [EigenstratIndEntry] JannoRows)
forall a. a -> Maybe a
Just ([EigenstratIndEntry] -> Either [EigenstratIndEntry] JannoRows
forall a b. a -> Either a b
Left [EigenstratIndEntry]
inds)) SeqSourceRows
forall a. Monoid a => a
mempty []
where
takeBaseNameSmart :: ShowS
takeBaseNameSmart [Char]
fn =
if ShowS
takeExtension [Char]
fn [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".gz" then ShowS
takeBaseName (Int -> ShowS
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
fn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [Char]
fn) else ShowS
takeBaseName [Char]
fn
newPackageTemplate ::
FilePath
-> String
-> GenotypeDataSpec
-> Maybe (Either [EigenstratIndEntry] JannoRows)
-> SeqSourceRows
-> BibTeX
-> PoseidonIO PoseidonPackage
newPackageTemplate :: [Char]
-> [Char]
-> GenotypeDataSpec
-> Maybe (Either [EigenstratIndEntry] JannoRows)
-> SeqSourceRows
-> BibTeX
-> ReaderT Env IO PoseidonPackage
newPackageTemplate [Char]
baseDir [Char]
name GenotypeDataSpec
genoData Maybe (Either [EigenstratIndEntry] JannoRows)
indsOrJanno SeqSourceRows
seqSource BibTeX
bib = do
(UTCTime Day
today DiffTime
_) <- IO UTCTime -> ReaderT Env IO UTCTime
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
PoseidonPackage
minimalTemplate <- [Char]
-> [Char] -> GenotypeDataSpec -> ReaderT Env IO PoseidonPackage
forall (m :: * -> *).
MonadThrow m =>
[Char] -> [Char] -> GenotypeDataSpec -> m PoseidonPackage
newMinimalPackageTemplate [Char]
baseDir [Char]
name GenotypeDataSpec
genoData
let fluffedUpTemplate :: PoseidonPackage
fluffedUpTemplate = PoseidonPackage
minimalTemplate {
posPacDescription :: Maybe [Char]
posPacDescription = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"Empty package template. Please add a description"
, posPacContributor :: [ContributorSpec]
posPacContributor = []
, posPacNameAndVersion :: PacNameAndVersion
posPacNameAndVersion = [Char] -> Maybe Version -> PacNameAndVersion
PacNameAndVersion [Char]
name (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
makeVersion [Int
0, Int
1, Int
0])
, posPacLastModified :: Maybe Day
posPacLastModified = Day -> Maybe Day
forall a. a -> Maybe a
Just Day
today
}
jannoFilledTemplate :: PoseidonPackage
jannoFilledTemplate = [Char]
-> Maybe (Either [EigenstratIndEntry] JannoRows)
-> PoseidonPackage
-> PoseidonPackage
completeJannoSpec [Char]
name Maybe (Either [EigenstratIndEntry] JannoRows)
indsOrJanno PoseidonPackage
fluffedUpTemplate
seqSourceFilledTemplate :: PoseidonPackage
seqSourceFilledTemplate = [Char] -> SeqSourceRows -> PoseidonPackage -> PoseidonPackage
completeSeqSourceSpec [Char]
name SeqSourceRows
seqSource PoseidonPackage
jannoFilledTemplate
bibFilledTemplate :: PoseidonPackage
bibFilledTemplate = [Char] -> BibTeX -> PoseidonPackage -> PoseidonPackage
completeBibSpec [Char]
name BibTeX
bib PoseidonPackage
seqSourceFilledTemplate
PoseidonPackage -> ReaderT Env IO PoseidonPackage
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PoseidonPackage
bibFilledTemplate
where
completeJannoSpec :: [Char]
-> Maybe (Either [EigenstratIndEntry] JannoRows)
-> PoseidonPackage
-> PoseidonPackage
completeJannoSpec [Char]
_ Maybe (Either [EigenstratIndEntry] JannoRows)
Nothing PoseidonPackage
inTemplate = PoseidonPackage
inTemplate
completeJannoSpec [Char]
name_ (Just (Left [EigenstratIndEntry]
a)) PoseidonPackage
inTemplate =
PoseidonPackage
inTemplate {
posPacJannoFile :: Maybe [Char]
posPacJannoFile = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
name_ [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".janno",
posPacJanno :: JannoRows
posPacJanno = [EigenstratIndEntry] -> JannoRows
createMinimalJanno [EigenstratIndEntry]
a
}
completeJannoSpec [Char]
name_ (Just (Right JannoRows
b)) PoseidonPackage
inTemplate =
PoseidonPackage
inTemplate {
posPacJannoFile :: Maybe [Char]
posPacJannoFile = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
name_ [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".janno",
posPacJanno :: JannoRows
posPacJanno = JannoRows
b
}
completeSeqSourceSpec :: [Char] -> SeqSourceRows -> PoseidonPackage -> PoseidonPackage
completeSeqSourceSpec [Char]
_ (SeqSourceRows []) PoseidonPackage
inTemplate = PoseidonPackage
inTemplate
completeSeqSourceSpec [Char]
name_ SeqSourceRows
xs PoseidonPackage
inTemplate =
PoseidonPackage
inTemplate {
posPacSeqSourceFile :: Maybe [Char]
posPacSeqSourceFile = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
name_ [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".ssf",
posPacSeqSource :: SeqSourceRows
posPacSeqSource = SeqSourceRows
xs
}
completeBibSpec :: [Char] -> BibTeX -> PoseidonPackage -> PoseidonPackage
completeBibSpec [Char]
_ [] PoseidonPackage
inTemplate = PoseidonPackage
inTemplate
completeBibSpec [Char]
name_ BibTeX
xs PoseidonPackage
inTemplate =
PoseidonPackage
inTemplate {
posPacBibFile :: Maybe [Char]
posPacBibFile = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
name_ [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".bib",
posPacBib :: BibTeX
posPacBib = BibTeX
xs
}
writePoseidonPackage :: PoseidonPackage -> IO ()
writePoseidonPackage :: PoseidonPackage -> IO ()
writePoseidonPackage (PoseidonPackage [Char]
baseDir Version
ver PacNameAndVersion
nameAndVer Maybe [Char]
des [ContributorSpec]
con Maybe Day
mod_ GenotypeDataSpec
geno Maybe [Char]
jannoF JannoRows
_ Maybe [Char]
jannoC Maybe [Char]
seqSourceF SeqSourceRows
_ Maybe [Char]
seqSourceC Maybe [Char]
bibF BibTeX
_ Maybe [Char]
bibFC Maybe [Char]
readF Maybe [Char]
changeF) = do
let yamlPac :: PoseidonYamlStruct
yamlPac = Version
-> [Char]
-> Maybe [Char]
-> [ContributorSpec]
-> Maybe Version
-> Maybe Day
-> GenotypeDataSpec
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> PoseidonYamlStruct
PoseidonYamlStruct Version
ver (PacNameAndVersion -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
getPacName PacNameAndVersion
nameAndVer) Maybe [Char]
des [ContributorSpec]
con (PacNameAndVersion -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion PacNameAndVersion
nameAndVer) Maybe Day
mod_ GenotypeDataSpec
geno Maybe [Char]
jannoF Maybe [Char]
jannoC Maybe [Char]
seqSourceF Maybe [Char]
seqSourceC Maybe [Char]
bibF Maybe [Char]
bibFC Maybe [Char]
readF Maybe [Char]
changeF
outF :: [Char]
outF = [Char]
baseDir [Char] -> ShowS
</> [Char]
"POSEIDON.yml"
[Char] -> ByteString -> IO ()
B.writeFile [Char]
outF (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. NFData a => (a -> b) -> a -> b
$!! Config -> PoseidonYamlStruct -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty Config
opts PoseidonYamlStruct
yamlPac
where
opts :: Config
opts = Bool -> Config -> Config
setConfDropNull Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Ordering) -> Config -> Config
setConfCompare (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Text -> Int) -> Text -> Text -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Int
fieldIndex) Config
defConfig
fieldIndex :: Text -> Int
fieldIndex Text
s = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fields) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text
s Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Text]
fields
fields :: [Text]
fields = [
Text
"poseidonVersion",
Text
"title",
Text
"description",
Text
"contributor",
Text
"name",
Text
"email",
Text
"orcid",
Text
"packageVersion",
Text
"lastModified",
Text
"genotypeData",
Text
"format",
Text
"genoFile",
Text
"genoFileChkSum",
Text
"snpFile",
Text
"snpFileChkSum",
Text
"indFile",
Text
"indFileChkSum",
Text
"snpSet",
Text
"jannoFile",
Text
"jannoFileChkSum",
Text
"sequencingSourceFile",
Text
"sequencingSourceFileChkSum",
Text
"bibFile",
Text
"bibFileChkSum",
Text
"readmeFile",
Text
"changelogFile"
]
packagesToPackageInfos :: (MonadThrow m) => [PoseidonPackage] -> m [PackageInfo]
packagesToPackageInfos :: forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> m [PackageInfo]
packagesToPackageInfos [PoseidonPackage]
pacs = do
[PoseidonPackage]
-> (PoseidonPackage -> m PackageInfo) -> m [PackageInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PoseidonPackage]
pacs ((PoseidonPackage -> m PackageInfo) -> m [PackageInfo])
-> (PoseidonPackage -> m PackageInfo) -> m [PackageInfo]
forall a b. (a -> b) -> a -> b
$ \PoseidonPackage
pac -> do
Bool
isLatest <- [PoseidonPackage] -> PoseidonPackage -> m Bool
forall (m :: * -> *) a.
(MonadThrow m, HasNameAndVersion a) =>
[a] -> a -> m Bool
isLatestInCollection [PoseidonPackage]
pacs PoseidonPackage
pac
PackageInfo -> m PackageInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageInfo -> m PackageInfo) -> PackageInfo -> m PackageInfo
forall a b. (a -> b) -> a -> b
$ PackageInfo {
pPac :: PacNameAndVersion
pPac = PoseidonPackage -> PacNameAndVersion
posPacNameAndVersion PoseidonPackage
pac,
pIsLatest :: Bool
pIsLatest = Bool
isLatest,
pPosVersion :: Version
pPosVersion = PoseidonPackage -> Version
posPacPoseidonVersion PoseidonPackage
pac,
pDescription :: Maybe [Char]
pDescription = PoseidonPackage -> Maybe [Char]
posPacDescription PoseidonPackage
pac,
pLastModified :: Maybe Day
pLastModified = PoseidonPackage -> Maybe Day
posPacLastModified PoseidonPackage
pac,
pNrIndividuals :: Int
pNrIndividuals = ([JannoRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([JannoRow] -> Int)
-> (PoseidonPackage -> [JannoRow]) -> PoseidonPackage -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonPackage -> [JannoRow]
getJannoRowsFromPac) PoseidonPackage
pac
}
getAllGroupInfo :: (MonadThrow m) => [PoseidonPackage] -> m [GroupInfo]
getAllGroupInfo :: forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> m [GroupInfo]
getAllGroupInfo [PoseidonPackage]
packages = do
let individualInfoUnnested :: [(GroupName, PacNameAndVersion)]
individualInfoUnnested = do
PoseidonPackage
pac <- [PoseidonPackage]
packages
JannoRow
jannoRow <- PoseidonPackage -> [JannoRow]
getJannoRowsFromPac PoseidonPackage
pac
let groups :: [GroupName]
groups = ListColumn GroupName -> [GroupName]
forall a. ListColumn a -> [a]
getListColumn (ListColumn GroupName -> [GroupName])
-> (JannoRow -> ListColumn GroupName) -> JannoRow -> [GroupName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> ListColumn GroupName
jGroupName (JannoRow -> [GroupName]) -> JannoRow -> [GroupName]
forall a b. (a -> b) -> a -> b
$ JannoRow
jannoRow
[(GroupName
g, PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion PoseidonPackage
pac) | GroupName
g <- [GroupName]
groups]
[[(GroupName, PacNameAndVersion)]]
-> ([(GroupName, PacNameAndVersion)] -> m GroupInfo)
-> m [GroupInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (([(GroupName, PacNameAndVersion)]
-> [[(GroupName, PacNameAndVersion)]]
forall a. Eq a => [a] -> [[a]]
group ([(GroupName, PacNameAndVersion)]
-> [[(GroupName, PacNameAndVersion)]])
-> ([(GroupName, PacNameAndVersion)]
-> [(GroupName, PacNameAndVersion)])
-> [(GroupName, PacNameAndVersion)]
-> [[(GroupName, PacNameAndVersion)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(GroupName, PacNameAndVersion)]
-> [(GroupName, PacNameAndVersion)]
forall a. Ord a => [a] -> [a]
sort) [(GroupName, PacNameAndVersion)]
individualInfoUnnested) (([(GroupName, PacNameAndVersion)] -> m GroupInfo)
-> m [GroupInfo])
-> ([(GroupName, PacNameAndVersion)] -> m GroupInfo)
-> m [GroupInfo]
forall a b. (a -> b) -> a -> b
$ \[(GroupName, PacNameAndVersion)]
group_ -> do
let groupName :: [Char]
groupName = GroupName -> [Char]
forall a. Show a => a -> [Char]
show (GroupName -> [Char])
-> ([(GroupName, PacNameAndVersion)] -> GroupName)
-> [(GroupName, PacNameAndVersion)]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GroupName] -> GroupName
forall a. HasCallStack => [a] -> a
head ([GroupName] -> GroupName)
-> ([(GroupName, PacNameAndVersion)] -> [GroupName])
-> [(GroupName, PacNameAndVersion)]
-> GroupName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupName, PacNameAndVersion) -> GroupName)
-> [(GroupName, PacNameAndVersion)] -> [GroupName]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName, PacNameAndVersion) -> GroupName
forall a b. (a, b) -> a
fst ([(GroupName, PacNameAndVersion)] -> [Char])
-> [(GroupName, PacNameAndVersion)] -> [Char]
forall a b. (a -> b) -> a -> b
$ [(GroupName, PacNameAndVersion)]
group_
groupPac :: PacNameAndVersion
groupPac = [PacNameAndVersion] -> PacNameAndVersion
forall a. HasCallStack => [a] -> a
head ([PacNameAndVersion] -> PacNameAndVersion)
-> ([(GroupName, PacNameAndVersion)] -> [PacNameAndVersion])
-> [(GroupName, PacNameAndVersion)]
-> PacNameAndVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupName, PacNameAndVersion) -> PacNameAndVersion)
-> [(GroupName, PacNameAndVersion)] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName, PacNameAndVersion) -> PacNameAndVersion
forall a b. (a, b) -> b
snd ([(GroupName, PacNameAndVersion)] -> PacNameAndVersion)
-> [(GroupName, PacNameAndVersion)] -> PacNameAndVersion
forall a b. (a -> b) -> a -> b
$ [(GroupName, PacNameAndVersion)]
group_
groupNrInds :: Int
groupNrInds = [(GroupName, PacNameAndVersion)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(GroupName, PacNameAndVersion)]
group_
Bool
isLatest <- [PacNameAndVersion] -> PacNameAndVersion -> m Bool
forall (m :: * -> *) a.
(MonadThrow m, HasNameAndVersion a) =>
[a] -> a -> m Bool
isLatestInCollection ((PoseidonPackage -> PacNameAndVersion)
-> [PoseidonPackage] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion [PoseidonPackage]
packages) PacNameAndVersion
groupPac
GroupInfo -> m GroupInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupInfo -> m GroupInfo) -> GroupInfo -> m GroupInfo
forall a b. (a -> b) -> a -> b
$ [Char] -> PacNameAndVersion -> Bool -> Int -> GroupInfo
GroupInfo [Char]
groupName PacNameAndVersion
groupPac Bool
isLatest Int
groupNrInds
getJointIndividualInfo :: (MonadThrow m) => [PoseidonPackage] -> m IndividualInfoCollection
getJointIndividualInfo :: forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> m IndividualInfoCollection
getJointIndividualInfo [PoseidonPackage]
packages = do
[[(IndividualInfo, Bool)]]
indInfoLatestPairs <- [PoseidonPackage]
-> (PoseidonPackage -> m [(IndividualInfo, Bool)])
-> m [[(IndividualInfo, Bool)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PoseidonPackage]
packages ((PoseidonPackage -> m [(IndividualInfo, Bool)])
-> m [[(IndividualInfo, Bool)]])
-> (PoseidonPackage -> m [(IndividualInfo, Bool)])
-> m [[(IndividualInfo, Bool)]]
forall a b. (a -> b) -> a -> b
$ \PoseidonPackage
pac -> do
Bool
isLatest <- [PoseidonPackage] -> PoseidonPackage -> m Bool
forall (m :: * -> *) a.
(MonadThrow m, HasNameAndVersion a) =>
[a] -> a -> m Bool
isLatestInCollection [PoseidonPackage]
packages PoseidonPackage
pac
[JannoRow]
-> (JannoRow -> m (IndividualInfo, Bool))
-> m [(IndividualInfo, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (PoseidonPackage -> [JannoRow]
getJannoRowsFromPac PoseidonPackage
pac) ((JannoRow -> m (IndividualInfo, Bool))
-> m [(IndividualInfo, Bool)])
-> (JannoRow -> m (IndividualInfo, Bool))
-> m [(IndividualInfo, Bool)]
forall a b. (a -> b) -> a -> b
$ \JannoRow
jannoRow -> do
let indInfo :: IndividualInfo
indInfo = [Char] -> [[Char]] -> PacNameAndVersion -> IndividualInfo
IndividualInfo
(JannoRow -> [Char]
jPoseidonID JannoRow
jannoRow)
(((GroupName -> [Char]) -> [GroupName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map GroupName -> [Char]
forall a. Show a => a -> [Char]
show ([GroupName] -> [[Char]])
-> (JannoRow -> [GroupName]) -> JannoRow -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListColumn GroupName -> [GroupName]
forall a. ListColumn a -> [a]
getListColumn (ListColumn GroupName -> [GroupName])
-> (JannoRow -> ListColumn GroupName) -> JannoRow -> [GroupName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> ListColumn GroupName
jGroupName) JannoRow
jannoRow)
(PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion PoseidonPackage
pac)
(IndividualInfo, Bool) -> m (IndividualInfo, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (IndividualInfo
indInfo, Bool
isLatest)
IndividualInfoCollection -> m IndividualInfoCollection
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (((IndividualInfo, Bool) -> IndividualInfo)
-> [(IndividualInfo, Bool)] -> [IndividualInfo]
forall a b. (a -> b) -> [a] -> [b]
map (IndividualInfo, Bool) -> IndividualInfo
forall a b. (a, b) -> a
fst ([(IndividualInfo, Bool)] -> [IndividualInfo])
-> ([[(IndividualInfo, Bool)]] -> [(IndividualInfo, Bool)])
-> [[(IndividualInfo, Bool)]]
-> [IndividualInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(IndividualInfo, Bool)]] -> [(IndividualInfo, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(IndividualInfo, Bool)]] -> [IndividualInfo])
-> [[(IndividualInfo, Bool)]] -> [IndividualInfo]
forall a b. (a -> b) -> a -> b
$ [[(IndividualInfo, Bool)]]
indInfoLatestPairs, ((IndividualInfo, Bool) -> Bool)
-> [(IndividualInfo, Bool)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (IndividualInfo, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(IndividualInfo, Bool)] -> [Bool])
-> ([[(IndividualInfo, Bool)]] -> [(IndividualInfo, Bool)])
-> [[(IndividualInfo, Bool)]]
-> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(IndividualInfo, Bool)]] -> [(IndividualInfo, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(IndividualInfo, Bool)]] -> [Bool])
-> [[(IndividualInfo, Bool)]] -> [Bool]
forall a b. (a -> b) -> a -> b
$ [[(IndividualInfo, Bool)]]
indInfoLatestPairs)
getExtendedIndividualInfo :: (MonadThrow m) => [PoseidonPackage] -> AddJannoColSpec -> m [ExtendedIndividualInfo]
getExtendedIndividualInfo :: forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> AddJannoColSpec -> m [ExtendedIndividualInfo]
getExtendedIndividualInfo [PoseidonPackage]
allPackages AddJannoColSpec
addJannoColSpec = [m ExtendedIndividualInfo] -> m [ExtendedIndividualInfo]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m ExtendedIndividualInfo] -> m [ExtendedIndividualInfo])
-> [m ExtendedIndividualInfo] -> m [ExtendedIndividualInfo]
forall a b. (a -> b) -> a -> b
$ do
PoseidonPackage
pac <- [PoseidonPackage]
allPackages
JannoRow
jannoRow <- PoseidonPackage -> [JannoRow]
getJannoRowsFromPac PoseidonPackage
pac
let name :: [Char]
name = JannoRow -> [Char]
jPoseidonID JannoRow
jannoRow
groups :: [[Char]]
groups = (GroupName -> [Char]) -> [GroupName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map GroupName -> [Char]
forall a. Show a => a -> [Char]
show ([GroupName] -> [[Char]]) -> [GroupName] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ListColumn GroupName -> [GroupName]
forall a. ListColumn a -> [a]
getListColumn (ListColumn GroupName -> [GroupName])
-> (JannoRow -> ListColumn GroupName) -> JannoRow -> [GroupName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> ListColumn GroupName
jGroupName (JannoRow -> [GroupName]) -> JannoRow -> [GroupName]
forall a b. (a -> b) -> a -> b
$ JannoRow
jannoRow
colNames :: [[Char]]
colNames = case AddJannoColSpec
addJannoColSpec of
AddJannoColSpec
AddJannoColAll -> [[Char]]
jannoHeaderString [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]
"Poseidon_ID", [Char]
"Group_Name"]
AddJannoColList [[Char]]
c -> [[Char]]
c
additionalColumnEntries :: [([Char], Maybe [Char])]
additionalColumnEntries = [([Char]
k, ByteString -> [Char]
BSC.unpack (ByteString -> [Char]) -> Maybe ByteString -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JannoRow -> NamedRecord
forall a. ToNamedRecord a => a -> NamedRecord
toNamedRecord JannoRow
jannoRow NamedRecord -> ByteString -> Maybe ByteString
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
HM.!? [Char] -> ByteString
BSC.pack [Char]
k) | [Char]
k <- [[Char]]
colNames]
Bool
isLatest <- [PoseidonPackage] -> PoseidonPackage -> [Bool]
forall (m :: * -> *) a.
(MonadThrow m, HasNameAndVersion a) =>
[a] -> a -> m Bool
isLatestInCollection [PoseidonPackage]
allPackages PoseidonPackage
pac
m ExtendedIndividualInfo -> [m ExtendedIndividualInfo]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (m ExtendedIndividualInfo -> [m ExtendedIndividualInfo])
-> (ExtendedIndividualInfo -> m ExtendedIndividualInfo)
-> ExtendedIndividualInfo
-> [m ExtendedIndividualInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtendedIndividualInfo -> m ExtendedIndividualInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtendedIndividualInfo -> [m ExtendedIndividualInfo])
-> ExtendedIndividualInfo -> [m ExtendedIndividualInfo]
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]]
-> PacNameAndVersion
-> Bool
-> [([Char], Maybe [Char])]
-> ExtendedIndividualInfo
ExtendedIndividualInfo [Char]
name [[Char]]
groups (PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion PoseidonPackage
pac) Bool
isLatest [([Char], Maybe [Char])]
additionalColumnEntries
filterToRelevantPackages :: (MonadThrow m) => (EntitySpec a) => [a] -> [PoseidonPackage] -> m [PoseidonPackage]
filterToRelevantPackages :: forall (m :: * -> *) a.
(MonadThrow m, EntitySpec a) =>
[a] -> [PoseidonPackage] -> m [PoseidonPackage]
filterToRelevantPackages [a]
entities [PoseidonPackage]
packages = do
IndividualInfoCollection
indInfoCollection <- [PoseidonPackage] -> m IndividualInfoCollection
forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> m IndividualInfoCollection
getJointIndividualInfo [PoseidonPackage]
packages
[PacNameAndVersion]
relevantPacs <- [a] -> IndividualInfoCollection -> m [PacNameAndVersion]
forall (m :: * -> *) a.
(MonadThrow m, EntitySpec a) =>
[a] -> IndividualInfoCollection -> m [PacNameAndVersion]
determineRelevantPackages [a]
entities IndividualInfoCollection
indInfoCollection
[PoseidonPackage] -> m [PoseidonPackage]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PoseidonPackage] -> m [PoseidonPackage])
-> [PoseidonPackage] -> m [PoseidonPackage]
forall a b. (a -> b) -> a -> b
$ (PoseidonPackage -> Bool) -> [PoseidonPackage] -> [PoseidonPackage]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PoseidonPackage
p -> PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion PoseidonPackage
p PacNameAndVersion -> [PacNameAndVersion] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PacNameAndVersion]
relevantPacs) [PoseidonPackage]
packages