{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- the following ones are necessary for the generics-sop magic (deriveGeneric)
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeFamilies        #-}

module Poseidon.Janno (
    JannoRow(..),
    writeJannoFile,
    writeJannoFileWithoutEmptyCols,
    readJannoFile,
    createMinimalJanno,
    createMinimalSample,
    jannoHeaderString,
    JannoRows (..),
    jannoRows2EigenstratIndEntries,
    makeHeaderWithAdditionalColumns
) where

import           Poseidon.ColumnTypesJanno
import           Poseidon.ColumnTypesUtils
import           Poseidon.Utils

import           Control.Exception                    (throwIO)
import           Control.Monad                        (unless, when)
import qualified Control.Monad                        as OP
import qualified Control.Monad.Except                 as E
import           Control.Monad.IO.Class               (liftIO)
import qualified Control.Monad.Writer                 as W
import           Data.Bifunctor                       (second)
import qualified Data.ByteString.Char8                as Bchs
import qualified Data.ByteString.Lazy.Char8           as Bch
import qualified Data.Csv                             as Csv
import           Data.Either                          (lefts, rights)
import qualified Data.HashMap.Strict                  as HM
import           Data.List                            (elemIndex, foldl',
                                                       intercalate, nub, sort,
                                                       transpose, (\\))
import           Data.Maybe                           (catMaybes, fromJust)
import qualified Data.Text                            as T
import qualified Data.Vector                          as V
import           Generics.SOP.TH                      (deriveGeneric)
import           GHC.Generics                         (Generic)
import           Options.Applicative.Help.Levenshtein (editDistance)
import           SequenceFormats.Eigenstrat           (EigenstratIndEntry (..))
import qualified Text.Parsec                          as P

-- | A  data type to represent a janno file
newtype JannoRows = JannoRows {JannoRows -> [JannoRow]
getJannoRows :: [JannoRow]}
    deriving (Int -> JannoRows -> ShowS
[JannoRows] -> ShowS
JannoRows -> String
(Int -> JannoRows -> ShowS)
-> (JannoRows -> String)
-> ([JannoRows] -> ShowS)
-> Show JannoRows
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JannoRows -> ShowS
showsPrec :: Int -> JannoRows -> ShowS
$cshow :: JannoRows -> String
show :: JannoRows -> String
$cshowList :: [JannoRows] -> ShowS
showList :: [JannoRows] -> ShowS
Show, JannoRows -> JannoRows -> Bool
(JannoRows -> JannoRows -> Bool)
-> (JannoRows -> JannoRows -> Bool) -> Eq JannoRows
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JannoRows -> JannoRows -> Bool
== :: JannoRows -> JannoRows -> Bool
$c/= :: JannoRows -> JannoRows -> Bool
/= :: JannoRows -> JannoRows -> Bool
Eq, (forall x. JannoRows -> Rep JannoRows x)
-> (forall x. Rep JannoRows x -> JannoRows) -> Generic JannoRows
forall x. Rep JannoRows x -> JannoRows
forall x. JannoRows -> Rep JannoRows x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JannoRows -> Rep JannoRows x
from :: forall x. JannoRows -> Rep JannoRows x
$cto :: forall x. Rep JannoRows x -> JannoRows
to :: forall x. Rep JannoRows x -> JannoRows
Generic)

instance Semigroup JannoRows where
    (JannoRows [JannoRow]
j1) <> :: JannoRows -> JannoRows -> JannoRows
<> (JannoRows [JannoRow]
j2) = [JannoRow] -> JannoRows
JannoRows ([JannoRow] -> JannoRows) -> [JannoRow] -> JannoRows
forall a b. (a -> b) -> a -> b
$ [JannoRow]
j1 [JannoRow] -> [JannoRow] -> [JannoRow]
`combineTwoJannos` [JannoRow]
j2
        where
        combineTwoJannos :: [JannoRow] -> [JannoRow] -> [JannoRow]
        combineTwoJannos :: [JannoRow] -> [JannoRow] -> [JannoRow]
combineTwoJannos [JannoRow]
janno1 [JannoRow]
janno2 =
            let simpleJannoSum :: [JannoRow]
simpleJannoSum = [JannoRow]
janno1 [JannoRow] -> [JannoRow] -> [JannoRow]
forall a. [a] -> [a] -> [a]
++ [JannoRow]
janno2
                toAddColNames :: [ByteString]
toAddColNames = HashMap ByteString ByteString -> [ByteString]
forall k v. HashMap k v -> [k]
HM.keys ([HashMap ByteString ByteString] -> HashMap ByteString ByteString
forall k v. Eq k => [HashMap k v] -> HashMap k v
HM.unions ((JannoRow -> HashMap ByteString ByteString)
-> [JannoRow] -> [HashMap ByteString ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (CsvNamedRecord -> HashMap ByteString ByteString
getCsvNR (CsvNamedRecord -> HashMap ByteString ByteString)
-> (JannoRow -> CsvNamedRecord)
-> JannoRow
-> HashMap ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> CsvNamedRecord
jAdditionalColumns) [JannoRow]
simpleJannoSum))
                toAddEmptyCols :: HashMap ByteString ByteString
toAddEmptyCols = [(ByteString, ByteString)] -> HashMap ByteString ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ((ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
k -> (ByteString
k, ByteString
"n/a")) [ByteString]
toAddColNames)
            in (JannoRow -> JannoRow) -> [JannoRow] -> [JannoRow]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap ByteString ByteString -> JannoRow -> JannoRow
addEmptyAddColsToJannoRow HashMap ByteString ByteString
toAddEmptyCols) [JannoRow]
simpleJannoSum
        addEmptyAddColsToJannoRow :: Csv.NamedRecord -> JannoRow -> JannoRow
        addEmptyAddColsToJannoRow :: HashMap ByteString ByteString -> JannoRow -> JannoRow
addEmptyAddColsToJannoRow HashMap ByteString ByteString
toAdd JannoRow
x =
            JannoRow
x { jAdditionalColumns = CsvNamedRecord $ fillAddCols toAdd (getCsvNR $ jAdditionalColumns x) }
        fillAddCols :: Csv.NamedRecord -> Csv.NamedRecord -> Csv.NamedRecord
        fillAddCols :: HashMap ByteString ByteString
-> HashMap ByteString ByteString -> HashMap ByteString ByteString
fillAddCols HashMap ByteString ByteString
toAdd HashMap ByteString ByteString
cur = HashMap ByteString ByteString
-> HashMap ByteString ByteString -> HashMap ByteString ByteString
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap ByteString ByteString
cur (HashMap ByteString ByteString
toAdd HashMap ByteString ByteString
-> HashMap ByteString ByteString -> HashMap ByteString ByteString
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
`HM.difference` HashMap ByteString ByteString
cur)

instance Monoid JannoRows where
    mempty :: JannoRows
mempty = [JannoRow] -> JannoRows
JannoRows []
    mconcat :: [JannoRows] -> JannoRows
mconcat = (JannoRows -> JannoRows -> JannoRows)
-> JannoRows -> [JannoRows] -> JannoRows
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' JannoRows -> JannoRows -> JannoRows
forall a. Monoid a => a -> a -> a
mappend JannoRows
forall a. Monoid a => a
mempty

-- | A data type to represent a sample/janno file row
-- See https://github.com/poseidon-framework/poseidon2-schema/blob/master/janno_columns.tsv
-- for more details
data JannoRow = JannoRow
    { JannoRow -> String
jPoseidonID                 :: String
    , JannoRow -> GeneticSex
jGeneticSex                 :: GeneticSex
    , JannoRow -> ListColumn GroupName
jGroupName                  :: ListColumn GroupName
    , JannoRow -> Maybe (ListColumn JannoAlternativeID)
jAlternativeIDs             :: Maybe (ListColumn JannoAlternativeID)
    , JannoRow -> Maybe (ListColumn JannoRelationTo)
jRelationTo                 :: Maybe (ListColumn JannoRelationTo)
    , JannoRow -> Maybe (ListColumn JannoRelationDegree)
jRelationDegree             :: Maybe (ListColumn JannoRelationDegree)
    , JannoRow -> Maybe (ListColumn JannoRelationType)
jRelationType               :: Maybe (ListColumn JannoRelationType)
    , JannoRow -> Maybe JannoRelationNote
jRelationNote               :: Maybe JannoRelationNote
    , JannoRow -> Maybe JannoCollectionID
jCollectionID               :: Maybe JannoCollectionID
    , JannoRow -> Maybe JannoCountry
jCountry                    :: Maybe JannoCountry
    , JannoRow -> Maybe JannoCountryISO
jCountryISO                 :: Maybe JannoCountryISO
    , JannoRow -> Maybe JannoLocation
jLocation                   :: Maybe JannoLocation
    , JannoRow -> Maybe JannoSite
jSite                       :: Maybe JannoSite
    , JannoRow -> Maybe JannoLatitude
jLatitude                   :: Maybe JannoLatitude
    , JannoRow -> Maybe JannoLongitude
jLongitude                  :: Maybe JannoLongitude
    , JannoRow -> Maybe JannoDateType
jDateType                   :: Maybe JannoDateType
    , JannoRow -> Maybe (ListColumn JannoDateC14Labnr)
jDateC14Labnr               :: Maybe (ListColumn JannoDateC14Labnr)
    , JannoRow -> Maybe (ListColumn JannoDateC14UncalBP)
jDateC14UncalBP             :: Maybe (ListColumn JannoDateC14UncalBP)
    , JannoRow -> Maybe (ListColumn JannoDateC14UncalBPErr)
jDateC14UncalBPErr          :: Maybe (ListColumn JannoDateC14UncalBPErr)
    , JannoRow -> Maybe JannoDateBCADStart
jDateBCADStart              :: Maybe JannoDateBCADStart
    , JannoRow -> Maybe JannoDateBCADMedian
jDateBCADMedian             :: Maybe JannoDateBCADMedian
    , JannoRow -> Maybe JannoDateBCADStop
jDateBCADStop               :: Maybe JannoDateBCADStop
    , JannoRow -> Maybe JannoDateNote
jDateNote                   :: Maybe JannoDateNote
    , JannoRow -> Maybe JannoMTHaplogroup
jMTHaplogroup               :: Maybe JannoMTHaplogroup
    , JannoRow -> Maybe JannoYHaplogroup
jYHaplogroup                :: Maybe JannoYHaplogroup
    , JannoRow -> Maybe (ListColumn JannoSourceTissue)
jSourceTissue               :: Maybe (ListColumn JannoSourceTissue)
    , JannoRow -> Maybe JannoNrLibraries
jNrLibraries                :: Maybe JannoNrLibraries
    , JannoRow -> Maybe (ListColumn JannoLibraryName)
jLibraryNames               :: Maybe (ListColumn JannoLibraryName)
    , JannoRow -> Maybe (ListColumn JannoCaptureType)
jCaptureType                :: Maybe (ListColumn JannoCaptureType)
    , JannoRow -> Maybe JannoUDG
jUDG                        :: Maybe JannoUDG
    , JannoRow -> Maybe JannoLibraryBuilt
jLibraryBuilt               :: Maybe JannoLibraryBuilt
    , JannoRow -> Maybe JannoGenotypePloidy
jGenotypePloidy             :: Maybe JannoGenotypePloidy
    , JannoRow -> Maybe JannoDataPreparationPipelineURL
jDataPreparationPipelineURL :: Maybe JannoDataPreparationPipelineURL
    , JannoRow -> Maybe JannoEndogenous
jEndogenous                 :: Maybe JannoEndogenous
    , JannoRow -> Maybe JannoNrSNPs
jNrSNPs                     :: Maybe JannoNrSNPs
    , JannoRow -> Maybe JannoCoverageOnTargets
jCoverageOnTargets          :: Maybe JannoCoverageOnTargets
    , JannoRow -> Maybe JannoDamage
jDamage                     :: Maybe JannoDamage
    , JannoRow -> Maybe (ListColumn JannoContamination)
jContamination              :: Maybe (ListColumn JannoContamination)
    , JannoRow -> Maybe (ListColumn JannoContaminationErr)
jContaminationErr           :: Maybe (ListColumn JannoContaminationErr)
    , JannoRow -> Maybe (ListColumn JannoContaminationMeas)
jContaminationMeas          :: Maybe (ListColumn JannoContaminationMeas)
    , JannoRow -> Maybe JannoContaminationNote
jContaminationNote          :: Maybe JannoContaminationNote
    , JannoRow -> Maybe (ListColumn JannoGeneticSourceAccessionID)
jGeneticSourceAccessionIDs  :: Maybe (ListColumn JannoGeneticSourceAccessionID)
    , JannoRow -> Maybe JannoPrimaryContact
jPrimaryContact             :: Maybe JannoPrimaryContact
    , JannoRow -> Maybe (ListColumn JannoPublication)
jPublication                :: Maybe (ListColumn JannoPublication)
    , JannoRow -> Maybe JannoComment
jComments                   :: Maybe JannoComment
    , JannoRow -> Maybe (ListColumn JannoKeyword)
jKeywords                   :: Maybe (ListColumn JannoKeyword)
    , JannoRow -> CsvNamedRecord
jAdditionalColumns          :: CsvNamedRecord
    }
    deriving (Int -> JannoRow -> ShowS
[JannoRow] -> ShowS
JannoRow -> String
(Int -> JannoRow -> ShowS)
-> (JannoRow -> String) -> ([JannoRow] -> ShowS) -> Show JannoRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JannoRow -> ShowS
showsPrec :: Int -> JannoRow -> ShowS
$cshow :: JannoRow -> String
show :: JannoRow -> String
$cshowList :: [JannoRow] -> ShowS
showList :: [JannoRow] -> ShowS
Show, JannoRow -> JannoRow -> Bool
(JannoRow -> JannoRow -> Bool)
-> (JannoRow -> JannoRow -> Bool) -> Eq JannoRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JannoRow -> JannoRow -> Bool
== :: JannoRow -> JannoRow -> Bool
$c/= :: JannoRow -> JannoRow -> Bool
/= :: JannoRow -> JannoRow -> Bool
Eq, (forall x. JannoRow -> Rep JannoRow x)
-> (forall x. Rep JannoRow x -> JannoRow) -> Generic JannoRow
forall x. Rep JannoRow x -> JannoRow
forall x. JannoRow -> Rep JannoRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JannoRow -> Rep JannoRow x
from :: forall x. JannoRow -> Rep JannoRow x
$cto :: forall x. Rep JannoRow x -> JannoRow
to :: forall x. Rep JannoRow x -> JannoRow
Generic)

-- deriving with TemplateHaskell necessary for the generics magic in the Survey module
deriveGeneric ''JannoRow

-- This header also defines the output column order when writing to csv!
jannoHeader :: [Bchs.ByteString]
jannoHeader :: [ByteString]
jannoHeader = [
      ByteString
"Poseidon_ID"
    , ByteString
"Genetic_Sex"
    , ByteString
"Group_Name"
    , ByteString
"Alternative_IDs"
    , ByteString
"Relation_To", ByteString
"Relation_Degree", ByteString
"Relation_Type", ByteString
"Relation_Note"
    , ByteString
"Collection_ID"
    , ByteString
"Country", ByteString
"Country_ISO"
    , ByteString
"Location", ByteString
"Site", ByteString
"Latitude", ByteString
"Longitude"
    , ByteString
"Date_Type"
    , ByteString
"Date_C14_Labnr", ByteString
"Date_C14_Uncal_BP", ByteString
"Date_C14_Uncal_BP_Err"
    , ByteString
"Date_BC_AD_Start", ByteString
"Date_BC_AD_Median", ByteString
"Date_BC_AD_Stop"
    , ByteString
"Date_Note"
    , ByteString
"MT_Haplogroup", ByteString
"Y_Haplogroup"
    , ByteString
"Source_Tissue"
    , ByteString
"Nr_Libraries", ByteString
"Library_Names"
    , ByteString
"Capture_Type", ByteString
"UDG", ByteString
"Library_Built", ByteString
"Genotype_Ploidy"
    , ByteString
"Data_Preparation_Pipeline_URL"
    , ByteString
"Endogenous", ByteString
"Nr_SNPs", ByteString
"Coverage_on_Target_SNPs", ByteString
"Damage"
    , ByteString
"Contamination", ByteString
"Contamination_Err", ByteString
"Contamination_Meas", ByteString
"Contamination_Note"
    , ByteString
"Genetic_Source_Accession_IDs"
    , ByteString
"Primary_Contact"
    , ByteString
"Publication"
    , ByteString
"Note"
    , ByteString
"Keywords"
    ]

instance Csv.DefaultOrdered JannoRow where
    headerOrder :: JannoRow -> Header
headerOrder JannoRow
_ = [ByteString] -> Header
Csv.header [ByteString]
jannoHeader

jannoHeaderString :: [String]
jannoHeaderString :: JannoRowWarnings
jannoHeaderString = (ByteString -> String) -> [ByteString] -> JannoRowWarnings
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
Bchs.unpack [ByteString]
jannoHeader

-- This hashmap represents an empty janno file with all normal, specified columns
jannoRefHashMap :: HM.HashMap Bchs.ByteString ()
jannoRefHashMap :: HashMap ByteString ()
jannoRefHashMap = [(ByteString, ())] -> HashMap ByteString ()
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(ByteString, ())] -> HashMap ByteString ())
-> [(ByteString, ())] -> HashMap ByteString ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> (ByteString, ()))
-> [ByteString] -> [(ByteString, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
x -> (ByteString
x, ())) [ByteString]
jannoHeader

instance Csv.FromNamedRecord JannoRow where
    parseNamedRecord :: HashMap ByteString ByteString -> Parser JannoRow
parseNamedRecord HashMap ByteString ByteString
m = String
-> GeneticSex
-> ListColumn GroupName
-> Maybe (ListColumn JannoAlternativeID)
-> Maybe (ListColumn JannoRelationTo)
-> Maybe (ListColumn JannoRelationDegree)
-> Maybe (ListColumn JannoRelationType)
-> Maybe JannoRelationNote
-> Maybe JannoCollectionID
-> Maybe JannoCountry
-> Maybe JannoCountryISO
-> Maybe JannoLocation
-> Maybe JannoSite
-> Maybe JannoLatitude
-> Maybe JannoLongitude
-> Maybe JannoDateType
-> Maybe (ListColumn JannoDateC14Labnr)
-> Maybe (ListColumn JannoDateC14UncalBP)
-> Maybe (ListColumn JannoDateC14UncalBPErr)
-> Maybe JannoDateBCADStart
-> Maybe JannoDateBCADMedian
-> Maybe JannoDateBCADStop
-> Maybe JannoDateNote
-> Maybe JannoMTHaplogroup
-> Maybe JannoYHaplogroup
-> Maybe (ListColumn JannoSourceTissue)
-> Maybe JannoNrLibraries
-> Maybe (ListColumn JannoLibraryName)
-> Maybe (ListColumn JannoCaptureType)
-> Maybe JannoUDG
-> Maybe JannoLibraryBuilt
-> Maybe JannoGenotypePloidy
-> Maybe JannoDataPreparationPipelineURL
-> Maybe JannoEndogenous
-> Maybe JannoNrSNPs
-> Maybe JannoCoverageOnTargets
-> Maybe JannoDamage
-> Maybe (ListColumn JannoContamination)
-> Maybe (ListColumn JannoContaminationErr)
-> Maybe (ListColumn JannoContaminationMeas)
-> Maybe JannoContaminationNote
-> Maybe (ListColumn JannoGeneticSourceAccessionID)
-> Maybe JannoPrimaryContact
-> Maybe (ListColumn JannoPublication)
-> Maybe JannoComment
-> Maybe (ListColumn JannoKeyword)
-> CsvNamedRecord
-> JannoRow
JannoRow
        (String
 -> GeneticSex
 -> ListColumn GroupName
 -> Maybe (ListColumn JannoAlternativeID)
 -> Maybe (ListColumn JannoRelationTo)
 -> Maybe (ListColumn JannoRelationDegree)
 -> Maybe (ListColumn JannoRelationType)
 -> Maybe JannoRelationNote
 -> Maybe JannoCollectionID
 -> Maybe JannoCountry
 -> Maybe JannoCountryISO
 -> Maybe JannoLocation
 -> Maybe JannoSite
 -> Maybe JannoLatitude
 -> Maybe JannoLongitude
 -> Maybe JannoDateType
 -> Maybe (ListColumn JannoDateC14Labnr)
 -> Maybe (ListColumn JannoDateC14UncalBP)
 -> Maybe (ListColumn JannoDateC14UncalBPErr)
 -> Maybe JannoDateBCADStart
 -> Maybe JannoDateBCADMedian
 -> Maybe JannoDateBCADStop
 -> Maybe JannoDateNote
 -> Maybe JannoMTHaplogroup
 -> Maybe JannoYHaplogroup
 -> Maybe (ListColumn JannoSourceTissue)
 -> Maybe JannoNrLibraries
 -> Maybe (ListColumn JannoLibraryName)
 -> Maybe (ListColumn JannoCaptureType)
 -> Maybe JannoUDG
 -> Maybe JannoLibraryBuilt
 -> Maybe JannoGenotypePloidy
 -> Maybe JannoDataPreparationPipelineURL
 -> Maybe JannoEndogenous
 -> Maybe JannoNrSNPs
 -> Maybe JannoCoverageOnTargets
 -> Maybe JannoDamage
 -> Maybe (ListColumn JannoContamination)
 -> Maybe (ListColumn JannoContaminationErr)
 -> Maybe (ListColumn JannoContaminationMeas)
 -> Maybe JannoContaminationNote
 -> Maybe (ListColumn JannoGeneticSourceAccessionID)
 -> Maybe JannoPrimaryContact
 -> Maybe (ListColumn JannoPublication)
 -> Maybe JannoComment
 -> Maybe (ListColumn JannoKeyword)
 -> CsvNamedRecord
 -> JannoRow)
-> Parser String
-> Parser
     (GeneticSex
      -> ListColumn GroupName
      -> Maybe (ListColumn JannoAlternativeID)
      -> Maybe (ListColumn JannoRelationTo)
      -> Maybe (ListColumn JannoRelationDegree)
      -> Maybe (ListColumn JannoRelationType)
      -> Maybe JannoRelationNote
      -> Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap ByteString ByteString -> ByteString -> Parser String
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser a
filterLookup         HashMap ByteString ByteString
m ByteString
"Poseidon_ID"
        Parser
  (GeneticSex
   -> ListColumn GroupName
   -> Maybe (ListColumn JannoAlternativeID)
   -> Maybe (ListColumn JannoRelationTo)
   -> Maybe (ListColumn JannoRelationDegree)
   -> Maybe (ListColumn JannoRelationType)
   -> Maybe JannoRelationNote
   -> Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser GeneticSex
-> Parser
     (ListColumn GroupName
      -> Maybe (ListColumn JannoAlternativeID)
      -> Maybe (ListColumn JannoRelationTo)
      -> Maybe (ListColumn JannoRelationDegree)
      -> Maybe (ListColumn JannoRelationType)
      -> Maybe JannoRelationNote
      -> Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString -> ByteString -> Parser GeneticSex
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser a
filterLookup         HashMap ByteString ByteString
m ByteString
"Genetic_Sex"
        Parser
  (ListColumn GroupName
   -> Maybe (ListColumn JannoAlternativeID)
   -> Maybe (ListColumn JannoRelationTo)
   -> Maybe (ListColumn JannoRelationDegree)
   -> Maybe (ListColumn JannoRelationType)
   -> Maybe JannoRelationNote
   -> Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (ListColumn GroupName)
-> Parser
     (Maybe (ListColumn JannoAlternativeID)
      -> Maybe (ListColumn JannoRelationTo)
      -> Maybe (ListColumn JannoRelationDegree)
      -> Maybe (ListColumn JannoRelationType)
      -> Maybe JannoRelationNote
      -> Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (ListColumn GroupName)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser a
filterLookup         HashMap ByteString ByteString
m ByteString
"Group_Name"
        Parser
  (Maybe (ListColumn JannoAlternativeID)
   -> Maybe (ListColumn JannoRelationTo)
   -> Maybe (ListColumn JannoRelationDegree)
   -> Maybe (ListColumn JannoRelationType)
   -> Maybe JannoRelationNote
   -> Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoAlternativeID))
-> Parser
     (Maybe (ListColumn JannoRelationTo)
      -> Maybe (ListColumn JannoRelationDegree)
      -> Maybe (ListColumn JannoRelationType)
      -> Maybe JannoRelationNote
      -> Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoAlternativeID))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Alternative_IDs"
        Parser
  (Maybe (ListColumn JannoRelationTo)
   -> Maybe (ListColumn JannoRelationDegree)
   -> Maybe (ListColumn JannoRelationType)
   -> Maybe JannoRelationNote
   -> Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoRelationTo))
-> Parser
     (Maybe (ListColumn JannoRelationDegree)
      -> Maybe (ListColumn JannoRelationType)
      -> Maybe JannoRelationNote
      -> Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoRelationTo))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Relation_To"
        Parser
  (Maybe (ListColumn JannoRelationDegree)
   -> Maybe (ListColumn JannoRelationType)
   -> Maybe JannoRelationNote
   -> Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoRelationDegree))
-> Parser
     (Maybe (ListColumn JannoRelationType)
      -> Maybe JannoRelationNote
      -> Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoRelationDegree))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Relation_Degree"
        Parser
  (Maybe (ListColumn JannoRelationType)
   -> Maybe JannoRelationNote
   -> Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoRelationType))
-> Parser
     (Maybe JannoRelationNote
      -> Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoRelationType))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Relation_Type"
        Parser
  (Maybe JannoRelationNote
   -> Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoRelationNote)
-> Parser
     (Maybe JannoCollectionID
      -> Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoRelationNote)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Relation_Note"
        Parser
  (Maybe JannoCollectionID
   -> Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoCollectionID)
-> Parser
     (Maybe JannoCountry
      -> Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoCollectionID)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Collection_ID"
        Parser
  (Maybe JannoCountry
   -> Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoCountry)
-> Parser
     (Maybe JannoCountryISO
      -> Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoCountry)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Country"
        Parser
  (Maybe JannoCountryISO
   -> Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoCountryISO)
-> Parser
     (Maybe JannoLocation
      -> Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoCountryISO)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Country_ISO"
        Parser
  (Maybe JannoLocation
   -> Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoLocation)
-> Parser
     (Maybe JannoSite
      -> Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoLocation)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Location"
        Parser
  (Maybe JannoSite
   -> Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoSite)
-> Parser
     (Maybe JannoLatitude
      -> Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoSite)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Site"
        Parser
  (Maybe JannoLatitude
   -> Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoLatitude)
-> Parser
     (Maybe JannoLongitude
      -> Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoLatitude)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Latitude"
        Parser
  (Maybe JannoLongitude
   -> Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoLongitude)
-> Parser
     (Maybe JannoDateType
      -> Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoLongitude)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Longitude"
        Parser
  (Maybe JannoDateType
   -> Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoDateType)
-> Parser
     (Maybe (ListColumn JannoDateC14Labnr)
      -> Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoDateType)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_Type"
        Parser
  (Maybe (ListColumn JannoDateC14Labnr)
   -> Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoDateC14Labnr))
-> Parser
     (Maybe (ListColumn JannoDateC14UncalBP)
      -> Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoDateC14Labnr))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_C14_Labnr"
        Parser
  (Maybe (ListColumn JannoDateC14UncalBP)
   -> Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoDateC14UncalBP))
-> Parser
     (Maybe (ListColumn JannoDateC14UncalBPErr)
      -> Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoDateC14UncalBP))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_C14_Uncal_BP"
        Parser
  (Maybe (ListColumn JannoDateC14UncalBPErr)
   -> Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoDateC14UncalBPErr))
-> Parser
     (Maybe JannoDateBCADStart
      -> Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoDateC14UncalBPErr))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_C14_Uncal_BP_Err"
        Parser
  (Maybe JannoDateBCADStart
   -> Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoDateBCADStart)
-> Parser
     (Maybe JannoDateBCADMedian
      -> Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoDateBCADStart)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_BC_AD_Start"
        Parser
  (Maybe JannoDateBCADMedian
   -> Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoDateBCADMedian)
-> Parser
     (Maybe JannoDateBCADStop
      -> Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoDateBCADMedian)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_BC_AD_Median"
        Parser
  (Maybe JannoDateBCADStop
   -> Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoDateBCADStop)
-> Parser
     (Maybe JannoDateNote
      -> Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoDateBCADStop)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_BC_AD_Stop"
        Parser
  (Maybe JannoDateNote
   -> Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoDateNote)
-> Parser
     (Maybe JannoMTHaplogroup
      -> Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoDateNote)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Date_Note"
        Parser
  (Maybe JannoMTHaplogroup
   -> Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoMTHaplogroup)
-> Parser
     (Maybe JannoYHaplogroup
      -> Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoMTHaplogroup)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"MT_Haplogroup"
        Parser
  (Maybe JannoYHaplogroup
   -> Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoYHaplogroup)
-> Parser
     (Maybe (ListColumn JannoSourceTissue)
      -> Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoYHaplogroup)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Y_Haplogroup"
        Parser
  (Maybe (ListColumn JannoSourceTissue)
   -> Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoSourceTissue))
-> Parser
     (Maybe JannoNrLibraries
      -> Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoSourceTissue))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Source_Tissue"
        Parser
  (Maybe JannoNrLibraries
   -> Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoNrLibraries)
-> Parser
     (Maybe (ListColumn JannoLibraryName)
      -> Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoNrLibraries)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Nr_Libraries"
        Parser
  (Maybe (ListColumn JannoLibraryName)
   -> Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoLibraryName))
-> Parser
     (Maybe (ListColumn JannoCaptureType)
      -> Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoLibraryName))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Library_Names"
        Parser
  (Maybe (ListColumn JannoCaptureType)
   -> Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoCaptureType))
-> Parser
     (Maybe JannoUDG
      -> Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoCaptureType))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Capture_Type"
        Parser
  (Maybe JannoUDG
   -> Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoUDG)
-> Parser
     (Maybe JannoLibraryBuilt
      -> Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoUDG)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"UDG"
        Parser
  (Maybe JannoLibraryBuilt
   -> Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoLibraryBuilt)
-> Parser
     (Maybe JannoGenotypePloidy
      -> Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoLibraryBuilt)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Library_Built"
        Parser
  (Maybe JannoGenotypePloidy
   -> Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoGenotypePloidy)
-> Parser
     (Maybe JannoDataPreparationPipelineURL
      -> Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoGenotypePloidy)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Genotype_Ploidy"
        Parser
  (Maybe JannoDataPreparationPipelineURL
   -> Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoDataPreparationPipelineURL)
-> Parser
     (Maybe JannoEndogenous
      -> Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoDataPreparationPipelineURL)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Data_Preparation_Pipeline_URL"
        Parser
  (Maybe JannoEndogenous
   -> Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoEndogenous)
-> Parser
     (Maybe JannoNrSNPs
      -> Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoEndogenous)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Endogenous"
        Parser
  (Maybe JannoNrSNPs
   -> Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoNrSNPs)
-> Parser
     (Maybe JannoCoverageOnTargets
      -> Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoNrSNPs)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Nr_SNPs"
        Parser
  (Maybe JannoCoverageOnTargets
   -> Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoCoverageOnTargets)
-> Parser
     (Maybe JannoDamage
      -> Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoCoverageOnTargets)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Coverage_on_Target_SNPs"
        Parser
  (Maybe JannoDamage
   -> Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoDamage)
-> Parser
     (Maybe (ListColumn JannoContamination)
      -> Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoDamage)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Damage"
        Parser
  (Maybe (ListColumn JannoContamination)
   -> Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoContamination))
-> Parser
     (Maybe (ListColumn JannoContaminationErr)
      -> Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoContamination))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Contamination"
        Parser
  (Maybe (ListColumn JannoContaminationErr)
   -> Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoContaminationErr))
-> Parser
     (Maybe (ListColumn JannoContaminationMeas)
      -> Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoContaminationErr))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Contamination_Err"
        Parser
  (Maybe (ListColumn JannoContaminationMeas)
   -> Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoContaminationMeas))
-> Parser
     (Maybe JannoContaminationNote
      -> Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoContaminationMeas))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Contamination_Meas"
        Parser
  (Maybe JannoContaminationNote
   -> Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoContaminationNote)
-> Parser
     (Maybe (ListColumn JannoGeneticSourceAccessionID)
      -> Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoContaminationNote)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Contamination_Note"
        Parser
  (Maybe (ListColumn JannoGeneticSourceAccessionID)
   -> Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoGeneticSourceAccessionID))
-> Parser
     (Maybe JannoPrimaryContact
      -> Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString
-> Parser (Maybe (ListColumn JannoGeneticSourceAccessionID))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Genetic_Source_Accession_IDs"
        Parser
  (Maybe JannoPrimaryContact
   -> Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe JannoPrimaryContact)
-> Parser
     (Maybe (ListColumn JannoPublication)
      -> Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword)
      -> CsvNamedRecord
      -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoPrimaryContact)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Primary_Contact"
        Parser
  (Maybe (ListColumn JannoPublication)
   -> Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword)
   -> CsvNamedRecord
   -> JannoRow)
-> Parser (Maybe (ListColumn JannoPublication))
-> Parser
     (Maybe JannoComment
      -> Maybe (ListColumn JannoKeyword) -> CsvNamedRecord -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoPublication))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Publication"
        Parser
  (Maybe JannoComment
   -> Maybe (ListColumn JannoKeyword) -> CsvNamedRecord -> JannoRow)
-> Parser (Maybe JannoComment)
-> Parser
     (Maybe (ListColumn JannoKeyword) -> CsvNamedRecord -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe JannoComment)
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Note"
        Parser
  (Maybe (ListColumn JannoKeyword) -> CsvNamedRecord -> JannoRow)
-> Parser (Maybe (ListColumn JannoKeyword))
-> Parser (CsvNamedRecord -> JannoRow)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap ByteString ByteString
-> ByteString -> Parser (Maybe (ListColumn JannoKeyword))
forall a.
FromField a =>
HashMap ByteString ByteString -> ByteString -> Parser (Maybe a)
filterLookupOptional HashMap ByteString ByteString
m ByteString
"Keywords"
        -- beyond that read everything that is not in the set of defined variables
        -- as a separate hashmap
        Parser (CsvNamedRecord -> JannoRow)
-> Parser CsvNamedRecord -> Parser JannoRow
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CsvNamedRecord -> Parser CsvNamedRecord
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap ByteString ByteString -> CsvNamedRecord
CsvNamedRecord (HashMap ByteString ByteString
m HashMap ByteString ByteString
-> HashMap ByteString () -> HashMap ByteString ByteString
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
`HM.difference` HashMap ByteString ()
jannoRefHashMap))

instance Csv.ToNamedRecord JannoRow where
    toNamedRecord :: JannoRow -> HashMap ByteString ByteString
toNamedRecord JannoRow
j = HashMap ByteString ByteString -> HashMap ByteString ByteString
explicitNA (HashMap ByteString ByteString -> HashMap ByteString ByteString)
-> HashMap ByteString ByteString -> HashMap ByteString ByteString
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> HashMap ByteString ByteString
Csv.namedRecord [
          ByteString
"Poseidon_ID"                     ByteString -> String -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> String
jPoseidonID JannoRow
j
        , ByteString
"Genetic_Sex"                     ByteString -> GeneticSex -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> GeneticSex
jGeneticSex JannoRow
j
        , ByteString
"Group_Name"                      ByteString -> ListColumn GroupName -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> ListColumn GroupName
jGroupName JannoRow
j
        , ByteString
"Alternative_IDs"                 ByteString
-> Maybe (ListColumn JannoAlternativeID)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoAlternativeID)
jAlternativeIDs JannoRow
j
        , ByteString
"Relation_To"                     ByteString
-> Maybe (ListColumn JannoRelationTo) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoRelationTo)
jRelationTo JannoRow
j
        , ByteString
"Relation_Degree"                 ByteString
-> Maybe (ListColumn JannoRelationDegree)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoRelationDegree)
jRelationDegree JannoRow
j
        , ByteString
"Relation_Type"                   ByteString
-> Maybe (ListColumn JannoRelationType) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoRelationType)
jRelationType JannoRow
j
        , ByteString
"Relation_Note"                   ByteString -> Maybe JannoRelationNote -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoRelationNote
jRelationNote JannoRow
j
        , ByteString
"Collection_ID"                   ByteString -> Maybe JannoCollectionID -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoCollectionID
jCollectionID JannoRow
j
        , ByteString
"Country"                         ByteString -> Maybe JannoCountry -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoCountry
jCountry JannoRow
j
        , ByteString
"Country_ISO"                     ByteString -> Maybe JannoCountryISO -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoCountryISO
jCountryISO JannoRow
j
        , ByteString
"Location"                        ByteString -> Maybe JannoLocation -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoLocation
jLocation JannoRow
j
        , ByteString
"Site"                            ByteString -> Maybe JannoSite -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoSite
jSite JannoRow
j
        , ByteString
"Latitude"                        ByteString -> Maybe JannoLatitude -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoLatitude
jLatitude JannoRow
j
        , ByteString
"Longitude"                       ByteString -> Maybe JannoLongitude -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoLongitude
jLongitude JannoRow
j
        , ByteString
"Date_Type"                       ByteString -> Maybe JannoDateType -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoDateType
jDateType JannoRow
j
        , ByteString
"Date_C14_Labnr"                  ByteString
-> Maybe (ListColumn JannoDateC14Labnr) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoDateC14Labnr)
jDateC14Labnr JannoRow
j
        , ByteString
"Date_C14_Uncal_BP"               ByteString
-> Maybe (ListColumn JannoDateC14UncalBP)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoDateC14UncalBP)
jDateC14UncalBP JannoRow
j
        , ByteString
"Date_C14_Uncal_BP_Err"           ByteString
-> Maybe (ListColumn JannoDateC14UncalBPErr)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoDateC14UncalBPErr)
jDateC14UncalBPErr JannoRow
j
        , ByteString
"Date_BC_AD_Start"                ByteString -> Maybe JannoDateBCADStart -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoDateBCADStart
jDateBCADStart JannoRow
j
        , ByteString
"Date_BC_AD_Median"               ByteString -> Maybe JannoDateBCADMedian -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoDateBCADMedian
jDateBCADMedian JannoRow
j
        , ByteString
"Date_BC_AD_Stop"                 ByteString -> Maybe JannoDateBCADStop -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoDateBCADStop
jDateBCADStop JannoRow
j
        , ByteString
"Date_Note"                       ByteString -> Maybe JannoDateNote -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoDateNote
jDateNote JannoRow
j
        , ByteString
"MT_Haplogroup"                   ByteString -> Maybe JannoMTHaplogroup -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoMTHaplogroup
jMTHaplogroup JannoRow
j
        , ByteString
"Y_Haplogroup"                    ByteString -> Maybe JannoYHaplogroup -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoYHaplogroup
jYHaplogroup JannoRow
j
        , ByteString
"Source_Tissue"                   ByteString
-> Maybe (ListColumn JannoSourceTissue) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoSourceTissue)
jSourceTissue JannoRow
j
        , ByteString
"Nr_Libraries"                    ByteString -> Maybe JannoNrLibraries -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoNrLibraries
jNrLibraries JannoRow
j
        , ByteString
"Library_Names"                   ByteString
-> Maybe (ListColumn JannoLibraryName) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoLibraryName)
jLibraryNames JannoRow
j
        , ByteString
"Capture_Type"                    ByteString
-> Maybe (ListColumn JannoCaptureType) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoCaptureType)
jCaptureType JannoRow
j
        , ByteString
"UDG"                             ByteString -> Maybe JannoUDG -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoUDG
jUDG JannoRow
j
        , ByteString
"Library_Built"                   ByteString -> Maybe JannoLibraryBuilt -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoLibraryBuilt
jLibraryBuilt JannoRow
j
        , ByteString
"Genotype_Ploidy"                 ByteString -> Maybe JannoGenotypePloidy -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoGenotypePloidy
jGenotypePloidy JannoRow
j
        , ByteString
"Data_Preparation_Pipeline_URL"   ByteString
-> Maybe JannoDataPreparationPipelineURL
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoDataPreparationPipelineURL
jDataPreparationPipelineURL JannoRow
j
        , ByteString
"Endogenous"                      ByteString -> Maybe JannoEndogenous -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoEndogenous
jEndogenous JannoRow
j
        , ByteString
"Nr_SNPs"                         ByteString -> Maybe JannoNrSNPs -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoNrSNPs
jNrSNPs JannoRow
j
        , ByteString
"Coverage_on_Target_SNPs"         ByteString
-> Maybe JannoCoverageOnTargets -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoCoverageOnTargets
jCoverageOnTargets JannoRow
j
        , ByteString
"Damage"                          ByteString -> Maybe JannoDamage -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoDamage
jDamage JannoRow
j
        , ByteString
"Contamination"                   ByteString
-> Maybe (ListColumn JannoContamination)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoContamination)
jContamination JannoRow
j
        , ByteString
"Contamination_Err"               ByteString
-> Maybe (ListColumn JannoContaminationErr)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoContaminationErr)
jContaminationErr JannoRow
j
        , ByteString
"Contamination_Meas"              ByteString
-> Maybe (ListColumn JannoContaminationMeas)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoContaminationMeas)
jContaminationMeas JannoRow
j
        , ByteString
"Contamination_Note"              ByteString
-> Maybe JannoContaminationNote -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoContaminationNote
jContaminationNote JannoRow
j
        , ByteString
"Genetic_Source_Accession_IDs"    ByteString
-> Maybe (ListColumn JannoGeneticSourceAccessionID)
-> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoGeneticSourceAccessionID)
jGeneticSourceAccessionIDs JannoRow
j
        , ByteString
"Primary_Contact"                 ByteString -> Maybe JannoPrimaryContact -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoPrimaryContact
jPrimaryContact JannoRow
j
        , ByteString
"Publication"                     ByteString
-> Maybe (ListColumn JannoPublication) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoPublication)
jPublication JannoRow
j
        , ByteString
"Note"                            ByteString -> Maybe JannoComment -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe JannoComment
jComments JannoRow
j
        , ByteString
"Keywords"                        ByteString
-> Maybe (ListColumn JannoKeyword) -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
Csv..= JannoRow -> Maybe (ListColumn JannoKeyword)
jKeywords JannoRow
j
        -- beyond that add what is in the hashmap of additional columns
        ] HashMap ByteString ByteString
-> HashMap ByteString ByteString -> HashMap ByteString ByteString
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
`HM.union` (CsvNamedRecord -> HashMap ByteString ByteString
getCsvNR (CsvNamedRecord -> HashMap ByteString ByteString)
-> CsvNamedRecord -> HashMap ByteString ByteString
forall a b. (a -> b) -> a -> b
$ JannoRow -> CsvNamedRecord
jAdditionalColumns JannoRow
j)

-- | A function to create empty janno rows for a set of individuals
createMinimalJanno :: [EigenstratIndEntry] -> JannoRows
createMinimalJanno :: [EigenstratIndEntry] -> JannoRows
createMinimalJanno [] = JannoRows
forall a. Monoid a => a
mempty
createMinimalJanno [EigenstratIndEntry]
xs = [JannoRow] -> JannoRows
JannoRows ([JannoRow] -> JannoRows) -> [JannoRow] -> JannoRows
forall a b. (a -> b) -> a -> b
$ (EigenstratIndEntry -> JannoRow)
-> [EigenstratIndEntry] -> [JannoRow]
forall a b. (a -> b) -> [a] -> [b]
map EigenstratIndEntry -> JannoRow
createMinimalSample [EigenstratIndEntry]
xs

-- | A function to create an empty janno row for an individual
createMinimalSample :: EigenstratIndEntry -> JannoRow
createMinimalSample :: EigenstratIndEntry -> JannoRow
createMinimalSample (EigenstratIndEntry ByteString
id_ Sex
sex ByteString
pop) =
    JannoRow {
          jPoseidonID :: String
jPoseidonID                   = ByteString -> String
Bchs.unpack ByteString
id_ -- TODO: this will have to change. We need to make PoseidonID itself ByteString
        , jGeneticSex :: GeneticSex
jGeneticSex                   = Sex -> GeneticSex
GeneticSex Sex
sex
        , jGroupName :: ListColumn GroupName
jGroupName                    = [GroupName] -> ListColumn GroupName
forall a. [a] -> ListColumn a
ListColumn [Text -> GroupName
GroupName (Text -> GroupName)
-> (ByteString -> Text) -> ByteString -> GroupName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Bchs.unpack (ByteString -> GroupName) -> ByteString -> GroupName
forall a b. (a -> b) -> a -> b
$ ByteString
pop] -- same thing, see above.
        , jAlternativeIDs :: Maybe (ListColumn JannoAlternativeID)
jAlternativeIDs               = Maybe (ListColumn JannoAlternativeID)
forall a. Maybe a
Nothing
        , jRelationTo :: Maybe (ListColumn JannoRelationTo)
jRelationTo                   = Maybe (ListColumn JannoRelationTo)
forall a. Maybe a
Nothing
        , jRelationDegree :: Maybe (ListColumn JannoRelationDegree)
jRelationDegree               = Maybe (ListColumn JannoRelationDegree)
forall a. Maybe a
Nothing
        , jRelationType :: Maybe (ListColumn JannoRelationType)
jRelationType                 = Maybe (ListColumn JannoRelationType)
forall a. Maybe a
Nothing
        , jRelationNote :: Maybe JannoRelationNote
jRelationNote                 = Maybe JannoRelationNote
forall a. Maybe a
Nothing
        , jCollectionID :: Maybe JannoCollectionID
jCollectionID                 = Maybe JannoCollectionID
forall a. Maybe a
Nothing
        , jCountry :: Maybe JannoCountry
jCountry                      = Maybe JannoCountry
forall a. Maybe a
Nothing
        , jCountryISO :: Maybe JannoCountryISO
jCountryISO                   = Maybe JannoCountryISO
forall a. Maybe a
Nothing
        , jLocation :: Maybe JannoLocation
jLocation                     = Maybe JannoLocation
forall a. Maybe a
Nothing
        , jSite :: Maybe JannoSite
jSite                         = Maybe JannoSite
forall a. Maybe a
Nothing
        , jLatitude :: Maybe JannoLatitude
jLatitude                     = Maybe JannoLatitude
forall a. Maybe a
Nothing
        , jLongitude :: Maybe JannoLongitude
jLongitude                    = Maybe JannoLongitude
forall a. Maybe a
Nothing
        , jDateType :: Maybe JannoDateType
jDateType                     = Maybe JannoDateType
forall a. Maybe a
Nothing
        , jDateC14Labnr :: Maybe (ListColumn JannoDateC14Labnr)
jDateC14Labnr                 = Maybe (ListColumn JannoDateC14Labnr)
forall a. Maybe a
Nothing
        , jDateC14UncalBP :: Maybe (ListColumn JannoDateC14UncalBP)
jDateC14UncalBP               = Maybe (ListColumn JannoDateC14UncalBP)
forall a. Maybe a
Nothing
        , jDateC14UncalBPErr :: Maybe (ListColumn JannoDateC14UncalBPErr)
jDateC14UncalBPErr            = Maybe (ListColumn JannoDateC14UncalBPErr)
forall a. Maybe a
Nothing
        , jDateBCADStart :: Maybe JannoDateBCADStart
jDateBCADStart                = Maybe JannoDateBCADStart
forall a. Maybe a
Nothing
        , jDateBCADMedian :: Maybe JannoDateBCADMedian
jDateBCADMedian               = Maybe JannoDateBCADMedian
forall a. Maybe a
Nothing
        , jDateBCADStop :: Maybe JannoDateBCADStop
jDateBCADStop                 = Maybe JannoDateBCADStop
forall a. Maybe a
Nothing
        , jDateNote :: Maybe JannoDateNote
jDateNote                     = Maybe JannoDateNote
forall a. Maybe a
Nothing
        , jMTHaplogroup :: Maybe JannoMTHaplogroup
jMTHaplogroup                 = Maybe JannoMTHaplogroup
forall a. Maybe a
Nothing
        , jYHaplogroup :: Maybe JannoYHaplogroup
jYHaplogroup                  = Maybe JannoYHaplogroup
forall a. Maybe a
Nothing
        , jSourceTissue :: Maybe (ListColumn JannoSourceTissue)
jSourceTissue                 = Maybe (ListColumn JannoSourceTissue)
forall a. Maybe a
Nothing
        , jNrLibraries :: Maybe JannoNrLibraries
jNrLibraries                  = Maybe JannoNrLibraries
forall a. Maybe a
Nothing
        , jLibraryNames :: Maybe (ListColumn JannoLibraryName)
jLibraryNames                 = Maybe (ListColumn JannoLibraryName)
forall a. Maybe a
Nothing
        , jCaptureType :: Maybe (ListColumn JannoCaptureType)
jCaptureType                  = Maybe (ListColumn JannoCaptureType)
forall a. Maybe a
Nothing
        , jUDG :: Maybe JannoUDG
jUDG                          = Maybe JannoUDG
forall a. Maybe a
Nothing
        , jLibraryBuilt :: Maybe JannoLibraryBuilt
jLibraryBuilt                 = Maybe JannoLibraryBuilt
forall a. Maybe a
Nothing
        , jGenotypePloidy :: Maybe JannoGenotypePloidy
jGenotypePloidy               = Maybe JannoGenotypePloidy
forall a. Maybe a
Nothing
        , jDataPreparationPipelineURL :: Maybe JannoDataPreparationPipelineURL
jDataPreparationPipelineURL   = Maybe JannoDataPreparationPipelineURL
forall a. Maybe a
Nothing
        , jEndogenous :: Maybe JannoEndogenous
jEndogenous                   = Maybe JannoEndogenous
forall a. Maybe a
Nothing
        , jNrSNPs :: Maybe JannoNrSNPs
jNrSNPs                       = Maybe JannoNrSNPs
forall a. Maybe a
Nothing
        , jCoverageOnTargets :: Maybe JannoCoverageOnTargets
jCoverageOnTargets            = Maybe JannoCoverageOnTargets
forall a. Maybe a
Nothing
        , jDamage :: Maybe JannoDamage
jDamage                       = Maybe JannoDamage
forall a. Maybe a
Nothing
        , jContamination :: Maybe (ListColumn JannoContamination)
jContamination                = Maybe (ListColumn JannoContamination)
forall a. Maybe a
Nothing
        , jContaminationErr :: Maybe (ListColumn JannoContaminationErr)
jContaminationErr             = Maybe (ListColumn JannoContaminationErr)
forall a. Maybe a
Nothing
        , jContaminationMeas :: Maybe (ListColumn JannoContaminationMeas)
jContaminationMeas            = Maybe (ListColumn JannoContaminationMeas)
forall a. Maybe a
Nothing
        , jContaminationNote :: Maybe JannoContaminationNote
jContaminationNote            = Maybe JannoContaminationNote
forall a. Maybe a
Nothing
        , jGeneticSourceAccessionIDs :: Maybe (ListColumn JannoGeneticSourceAccessionID)
jGeneticSourceAccessionIDs    = Maybe (ListColumn JannoGeneticSourceAccessionID)
forall a. Maybe a
Nothing
        , jPrimaryContact :: Maybe JannoPrimaryContact
jPrimaryContact               = Maybe JannoPrimaryContact
forall a. Maybe a
Nothing
        , jPublication :: Maybe (ListColumn JannoPublication)
jPublication                  = Maybe (ListColumn JannoPublication)
forall a. Maybe a
Nothing
        , jComments :: Maybe JannoComment
jComments                     = Maybe JannoComment
forall a. Maybe a
Nothing
        , jKeywords :: Maybe (ListColumn JannoKeyword)
jKeywords                     = Maybe (ListColumn JannoKeyword)
forall a. Maybe a
Nothing
        -- The template should of course not have any additional columns
        , jAdditionalColumns :: CsvNamedRecord
jAdditionalColumns            = HashMap ByteString ByteString -> CsvNamedRecord
CsvNamedRecord (HashMap ByteString ByteString -> CsvNamedRecord)
-> HashMap ByteString ByteString -> CsvNamedRecord
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> HashMap ByteString ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList []
    }

-- Janno file writing

makeHeaderWithAdditionalColumns :: [JannoRow] -> Csv.Header
makeHeaderWithAdditionalColumns :: [JannoRow] -> Header
makeHeaderWithAdditionalColumns [JannoRow]
rows =
    [ByteString] -> Header
forall a. [a] -> Vector a
V.fromList ([ByteString] -> Header) -> [ByteString] -> Header
forall a b. (a -> b) -> a -> b
$ [ByteString]
jannoHeader [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
sort (HashMap ByteString ByteString -> [ByteString]
forall k v. HashMap k v -> [k]
HM.keys ([HashMap ByteString ByteString] -> HashMap ByteString ByteString
forall k v. Eq k => [HashMap k v] -> HashMap k v
HM.unions ((JannoRow -> HashMap ByteString ByteString)
-> [JannoRow] -> [HashMap ByteString ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (CsvNamedRecord -> HashMap ByteString ByteString
getCsvNR (CsvNamedRecord -> HashMap ByteString ByteString)
-> (JannoRow -> CsvNamedRecord)
-> JannoRow
-> HashMap ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> CsvNamedRecord
jAdditionalColumns) [JannoRow]
rows)))

writeJannoFile :: FilePath -> JannoRows -> IO ()
writeJannoFile :: String -> JannoRows -> IO ()
writeJannoFile String
path (JannoRows [JannoRow]
rows) = do
    let jannoAsBytestring :: ByteString
jannoAsBytestring = EncodeOptions -> Header -> [JannoRow] -> ByteString
forall a.
ToNamedRecord a =>
EncodeOptions -> Header -> [a] -> ByteString
Csv.encodeByNameWith EncodeOptions
encodingOptions ([JannoRow] -> Header
makeHeaderWithAdditionalColumns [JannoRow]
rows) [JannoRow]
rows
    String -> ByteString -> IO ()
Bch.writeFile String
path ByteString
jannoAsBytestring

writeJannoFileWithoutEmptyCols :: FilePath -> JannoRows -> IO ()
writeJannoFileWithoutEmptyCols :: String -> JannoRows -> IO ()
writeJannoFileWithoutEmptyCols String
path (JannoRows [JannoRow]
rows) = do
    let jannoAsBytestring :: ByteString
jannoAsBytestring = EncodeOptions -> Header -> [JannoRow] -> ByteString
forall a.
ToNamedRecord a =>
EncodeOptions -> Header -> [a] -> ByteString
Csv.encodeByNameWith EncodeOptions
encodingOptions ([JannoRow] -> Header
makeHeaderWithAdditionalColumns [JannoRow]
rows) [JannoRow]
rows
    case DecodeOptions
-> HasHeader
-> ByteString
-> Either String (Vector (Vector ByteString))
forall a.
FromRecord a =>
DecodeOptions
-> HasHeader -> ByteString -> Either String (Vector a)
Csv.decodeWith DecodeOptions
decodingOptions HasHeader
Csv.NoHeader ByteString
jannoAsBytestring :: Either String (V.Vector (V.Vector Bch.ByteString)) of
        Left String
_  -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"internal error, please report"
        Right Vector (Vector ByteString)
x -> do
            let janno :: [[ByteString]]
janno = Vector [ByteString] -> [[ByteString]]
forall a. Vector a -> [a]
V.toList (Vector [ByteString] -> [[ByteString]])
-> Vector [ByteString] -> [[ByteString]]
forall a b. (a -> b) -> a -> b
$ (Vector ByteString -> [ByteString])
-> Vector (Vector ByteString) -> Vector [ByteString]
forall a b. (a -> b) -> Vector a -> Vector b
V.map Vector ByteString -> [ByteString]
forall a. Vector a -> [a]
V.toList Vector (Vector ByteString)
x
                jannoTransposed :: [[ByteString]]
jannoTransposed = [[ByteString]] -> [[ByteString]]
forall a. [[a]] -> [[a]]
transpose [[ByteString]]
janno
                jannoTransposedFiltered :: [[ByteString]]
jannoTransposedFiltered = ([ByteString] -> Bool) -> [[ByteString]] -> [[ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"n/a") ([ByteString] -> Bool)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
tail) [[ByteString]]
jannoTransposed
                jannoBackTransposed :: [[ByteString]]
jannoBackTransposed = [[ByteString]] -> [[ByteString]]
forall a. [[a]] -> [[a]]
transpose [[ByteString]]
jannoTransposedFiltered
                jannoConcat :: ByteString
jannoConcat = ByteString -> [ByteString] -> ByteString
Bch.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ([ByteString] -> ByteString) -> [[ByteString]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> [ByteString] -> ByteString
Bch.intercalate ByteString
"\t") [[ByteString]]
jannoBackTransposed
            String -> ByteString -> IO ()
Bch.writeFile String
path (ByteString
jannoConcat ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")

-- | A function to load one janno file
readJannoFile :: FilePath -> PoseidonIO JannoRows
readJannoFile :: String -> PoseidonIO JannoRows
readJannoFile String
jannoPath = do
    String -> PoseidonIO ()
logDebug (String -> PoseidonIO ()) -> String -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ String
"Reading: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jannoPath
    ByteString
jannoFile <- 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
$ String -> IO ByteString
Bch.readFile String
jannoPath
    let jannoFileRows :: [ByteString]
jannoFileRows = ByteString -> [ByteString]
Bch.lines ByteString
jannoFile
    Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
jannoFileRows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ 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
$ PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> IO ()) -> PoseidonException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> PoseidonException
PoseidonFileConsistencyException String
jannoPath String
"File has less than two lines"
    String -> PoseidonIO ()
logDebug (String -> PoseidonIO ()) -> String -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
jannoFileRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" samples in this file"
    -- tupel with row number and row bytestring
    let jannoFileRowsWithNumber :: [(Int, ByteString)]
jannoFileRowsWithNumber = [Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
jannoFileRows)] [ByteString]
jannoFileRows
    -- filter out empty lines
        jannoFileRowsWithNumberFiltered :: [(Int, ByteString)]
jannoFileRowsWithNumberFiltered = ((Int, ByteString) -> Bool)
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_, ByteString
y) -> ByteString
y ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
Bch.empty) [(Int, ByteString)]
jannoFileRowsWithNumber
    -- create header + individual line combination
        headerOnlyPotentiallyWithQuotes :: ByteString
headerOnlyPotentiallyWithQuotes = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (Int, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ [(Int, ByteString)] -> (Int, ByteString)
forall a. HasCallStack => [a] -> a
head [(Int, ByteString)]
jannoFileRowsWithNumberFiltered
        -- removing the quotes like this might cause issues in edge cases
        headerOnly :: ByteString
headerOnly = (Char -> Bool) -> ByteString -> ByteString
Bch.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') ByteString
headerOnlyPotentiallyWithQuotes
        rowsOnly :: [(Int, ByteString)]
rowsOnly = [(Int, ByteString)] -> [(Int, ByteString)]
forall a. HasCallStack => [a] -> [a]
tail [(Int, ByteString)]
jannoFileRowsWithNumberFiltered
        jannoFileRowsWithHeader :: [(Int, ByteString)]
jannoFileRowsWithHeader = ((Int, ByteString) -> (Int, ByteString))
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> ByteString)
-> (Int, ByteString) -> (Int, ByteString)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\ByteString
x -> ByteString
headerOnly ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x)) [(Int, ByteString)]
rowsOnly
    -- report missing or additional columns
    let jannoColNames :: [ByteString]
jannoColNames = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
Bch.toStrict (Char -> ByteString -> [ByteString]
Bch.split Char
'\t' ByteString
headerOnly)
        missing_columns :: JannoRowWarnings
missing_columns = (ByteString -> String) -> [ByteString] -> JannoRowWarnings
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
Bchs.unpack ([ByteString] -> JannoRowWarnings)
-> [ByteString] -> JannoRowWarnings
forall a b. (a -> b) -> a -> b
$ [ByteString]
jannoHeader [ByteString] -> [ByteString] -> [ByteString]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ByteString]
jannoColNames
        additional_columns :: JannoRowWarnings
additional_columns = (ByteString -> String) -> [ByteString] -> JannoRowWarnings
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
Bchs.unpack ([ByteString] -> JannoRowWarnings)
-> [ByteString] -> JannoRowWarnings
forall a b. (a -> b) -> a -> b
$ [ByteString]
jannoColNames [ByteString] -> [ByteString] -> [ByteString]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ByteString]
jannoHeader
    --unless (null missing_columns) $ do
    --    logDebug ("Missing standard columns: " ++ intercalate ", " missing_columns)
    Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (JannoRowWarnings -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null JannoRowWarnings
additional_columns) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> PoseidonIO ()
logDebug (String
"Additional columns: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
        -- for each additional column a standard column is suggested: "Countro (Country?)"
            String -> JannoRowWarnings -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((String -> ShowS)
-> JannoRowWarnings -> JannoRowWarnings -> JannoRowWarnings
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
x String
y -> String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?)")
            JannoRowWarnings
additional_columns (JannoRowWarnings -> JannoRowWarnings -> JannoRowWarnings
findSimilarNames JannoRowWarnings
missing_columns JannoRowWarnings
additional_columns)))
    -- load janno by rows
    [Either PoseidonException JannoRow]
jannoRepresentation <- ((Int, ByteString)
 -> ReaderT Env IO (Either PoseidonException JannoRow))
-> [(Int, ByteString)]
-> ReaderT Env IO [Either PoseidonException JannoRow]
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 (String
-> (Int, ByteString)
-> ReaderT Env IO (Either PoseidonException JannoRow)
readJannoFileRow String
jannoPath) [(Int, ByteString)]
jannoFileRowsWithHeader
    -- error case management
    if Bool -> Bool
not ([PoseidonException] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Either PoseidonException JannoRow] -> [PoseidonException]
forall a b. [Either a b] -> [a]
lefts [Either PoseidonException JannoRow]
jannoRepresentation))
    then do
        (PoseidonException -> PoseidonIO ())
-> [PoseidonException] -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> PoseidonIO ()
logError (String -> PoseidonIO ())
-> (PoseidonException -> String)
-> PoseidonException
-> PoseidonIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonException -> String
renderPoseidonException) ([PoseidonException] -> PoseidonIO ())
-> [PoseidonException] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ Int -> [PoseidonException] -> [PoseidonException]
forall a. Int -> [a] -> [a]
take Int
5 ([PoseidonException] -> [PoseidonException])
-> [PoseidonException] -> [PoseidonException]
forall a b. (a -> b) -> a -> b
$ [Either PoseidonException JannoRow] -> [PoseidonException]
forall a b. [Either a b] -> [a]
lefts [Either PoseidonException JannoRow]
jannoRepresentation
        IO JannoRows -> PoseidonIO JannoRows
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO JannoRows -> PoseidonIO JannoRows)
-> IO JannoRows -> PoseidonIO JannoRows
forall a b. (a -> b) -> a -> b
$ PoseidonException -> IO JannoRows
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> IO JannoRows)
-> PoseidonException -> IO JannoRows
forall a b. (a -> b) -> a -> b
$ String -> String -> PoseidonException
PoseidonFileConsistencyException String
jannoPath String
"Broken lines."
    else do
        let consistentJanno :: Either PoseidonException JannoRows
consistentJanno = String -> JannoRows -> Either PoseidonException JannoRows
checkJannoConsistency String
jannoPath (JannoRows -> Either PoseidonException JannoRows)
-> JannoRows -> Either PoseidonException JannoRows
forall a b. (a -> b) -> a -> b
$ [JannoRow] -> JannoRows
JannoRows ([JannoRow] -> JannoRows) -> [JannoRow] -> JannoRows
forall a b. (a -> b) -> a -> b
$ [Either PoseidonException JannoRow] -> [JannoRow]
forall a b. [Either a b] -> [b]
rights [Either PoseidonException JannoRow]
jannoRepresentation
        case Either PoseidonException JannoRows
consistentJanno of
            Left PoseidonException
e -> do IO JannoRows -> PoseidonIO JannoRows
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO JannoRows -> PoseidonIO JannoRows)
-> IO JannoRows -> PoseidonIO JannoRows
forall a b. (a -> b) -> a -> b
$ PoseidonException -> IO JannoRows
forall e a. Exception e => e -> IO a
throwIO PoseidonException
e
            Right JannoRows
x -> do
                -- putStrLn ""
                -- putStrLn $ show $ map jSourceTissue x
                -- putStrLn $ show $ map jLongitude x
                -- putStrLn $ show $ map jUDG x
                JannoRows -> PoseidonIO JannoRows
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRows
x

findSimilarNames :: [String] -> [String] -> [String]
findSimilarNames :: JannoRowWarnings -> JannoRowWarnings -> JannoRowWarnings
findSimilarNames JannoRowWarnings
reference = ShowS -> JannoRowWarnings -> JannoRowWarnings
forall a b. (a -> b) -> [a] -> [b]
map (JannoRowWarnings -> ShowS
findSimilar JannoRowWarnings
reference)
    where
        findSimilar ::  [String] -> String -> String
        findSimilar :: JannoRowWarnings -> ShowS
findSimilar [] String
_  = []
        findSimilar JannoRowWarnings
ref String
x =
            let dists :: [Int]
dists = (String -> Int) -> JannoRowWarnings -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\String
y -> String
x String -> String -> Int
forall a. Eq a => [a] -> [a] -> Int
`editDistance` String
y) JannoRowWarnings
ref
            in JannoRowWarnings
ref JannoRowWarnings -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Int -> [Int] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
dists) [Int]
dists)

-- | A function to load one row of a janno file
readJannoFileRow :: FilePath -> (Int, Bch.ByteString) -> PoseidonIO (Either PoseidonException JannoRow)
readJannoFileRow :: String
-> (Int, ByteString)
-> ReaderT Env IO (Either PoseidonException JannoRow)
readJannoFileRow String
jannoPath (Int
lineNumber, ByteString
row) = do
    let decoded :: Either String (Header, Vector JannoRow)
decoded = DecodeOptions
-> ByteString -> Either String (Header, Vector JannoRow)
forall a.
FromNamedRecord a =>
DecodeOptions -> ByteString -> Either String (Header, Vector a)
Csv.decodeByNameWith DecodeOptions
decodingOptions ByteString
row
        simplifiedDecoded :: Either String JannoRow
simplifiedDecoded = (\(Header
_,Vector JannoRow
rs) -> Vector JannoRow -> JannoRow
forall a. Vector a -> a
V.head Vector JannoRow
rs) ((Header, Vector JannoRow) -> JannoRow)
-> Either String (Header, Vector JannoRow)
-> Either String JannoRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Header, Vector JannoRow)
decoded
    case Either String JannoRow
simplifiedDecoded of
        Left String
e -> do
            let betterError :: String
betterError = case Parsec String () CsvParseError
-> String -> String -> Either ParseError CsvParseError
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () CsvParseError
parseCsvParseError String
"" String
e of
                    Left ParseError
_       -> ShowS
removeUselessSuffix String
e
                    Right CsvParseError
result -> CsvParseError -> String
renderCsvParseError CsvParseError
result
            Either PoseidonException JannoRow
-> ReaderT Env IO (Either PoseidonException JannoRow)
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PoseidonException JannoRow
 -> ReaderT Env IO (Either PoseidonException JannoRow))
-> Either PoseidonException JannoRow
-> ReaderT Env IO (Either PoseidonException JannoRow)
forall a b. (a -> b) -> a -> b
$ PoseidonException -> Either PoseidonException JannoRow
forall a b. a -> Either a b
Left (PoseidonException -> Either PoseidonException JannoRow)
-> PoseidonException -> Either PoseidonException JannoRow
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> PoseidonException
PoseidonFileRowException String
jannoPath (Int -> String
forall a. Show a => a -> String
show Int
lineNumber) String
betterError
        Right JannoRow
jannoRow -> do
            -- cell-wise checks
            let inspectRes :: JannoRowWarnings
inspectRes = [JannoRowWarnings] -> JannoRowWarnings
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([JannoRowWarnings] -> JannoRowWarnings)
-> [JannoRowWarnings] -> JannoRowWarnings
forall a b. (a -> b) -> a -> b
$ [Maybe JannoRowWarnings] -> [JannoRowWarnings]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe JannoRowWarnings] -> [JannoRowWarnings])
-> [Maybe JannoRowWarnings] -> [JannoRowWarnings]
forall a b. (a -> b) -> a -> b
$ JannoRow -> [Maybe JannoRowWarnings]
forall a (xs :: [*]).
(Generic a, Code a ~ '[xs], All Suspicious xs) =>
a -> [Maybe JannoRowWarnings]
inspectEachField JannoRow
jannoRow
            Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
OP.unless (JannoRowWarnings -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null JannoRowWarnings
inspectRes) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
                String -> PoseidonIO ()
logWarning (String -> PoseidonIO ()) -> String -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ String
"Value anomaly in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jannoPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
renderLocation String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "
                (String -> PoseidonIO ()) -> JannoRowWarnings -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> PoseidonIO ()
logWarning JannoRowWarnings
inspectRes
            -- cross-column checks
            let (Either String JannoRow
errOrJannoRow, JannoRowWarnings
warnings) = Writer JannoRowWarnings (Either String JannoRow)
-> (Either String JannoRow, JannoRowWarnings)
forall w a. Writer w a -> (a, w)
W.runWriter (ExceptT String (Writer JannoRowWarnings) JannoRow
-> Writer JannoRowWarnings (Either String JannoRow)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
E.runExceptT (JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkJannoRowConsistency JannoRow
jannoRow))
            (String -> PoseidonIO ()) -> JannoRowWarnings -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> PoseidonIO ()
logWarning (String -> PoseidonIO ()) -> ShowS -> String -> PoseidonIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
renderWarning) JannoRowWarnings
warnings
             -- return result
            case Either String JannoRow
errOrJannoRow of
                Left String
e  -> Either PoseidonException JannoRow
-> ReaderT Env IO (Either PoseidonException JannoRow)
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PoseidonException JannoRow
 -> ReaderT Env IO (Either PoseidonException JannoRow))
-> Either PoseidonException JannoRow
-> ReaderT Env IO (Either PoseidonException JannoRow)
forall a b. (a -> b) -> a -> b
$ PoseidonException -> Either PoseidonException JannoRow
forall a b. a -> Either a b
Left (PoseidonException -> Either PoseidonException JannoRow)
-> PoseidonException -> Either PoseidonException JannoRow
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> PoseidonException
PoseidonFileRowException String
jannoPath String
renderLocation String
e
                Right JannoRow
r -> Either PoseidonException JannoRow
-> ReaderT Env IO (Either PoseidonException JannoRow)
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PoseidonException JannoRow
 -> ReaderT Env IO (Either PoseidonException JannoRow))
-> Either PoseidonException JannoRow
-> ReaderT Env IO (Either PoseidonException JannoRow)
forall a b. (a -> b) -> a -> b
$ JannoRow -> Either PoseidonException JannoRow
forall a b. b -> Either a b
Right JannoRow
r
            where
                renderWarning :: String -> String
                renderWarning :: ShowS
renderWarning String
e = String
"Cross-column anomaly in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jannoPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                  String
"in line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
renderLocation String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
                renderLocation :: String
                renderLocation :: String
renderLocation =  Int -> String
forall a. Show a => a -> String
show Int
lineNumber String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                  String
" (Poseidon_ID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ JannoRow -> String
jPoseidonID JannoRow
jannoRow String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- Global janno consistency checks

checkJannoConsistency :: FilePath -> JannoRows -> Either PoseidonException JannoRows
checkJannoConsistency :: String -> JannoRows -> Either PoseidonException JannoRows
checkJannoConsistency String
jannoPath JannoRows
xs
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ JannoRows -> Bool
checkIndividualUnique JannoRows
xs = PoseidonException -> Either PoseidonException JannoRows
forall a b. a -> Either a b
Left (PoseidonException -> Either PoseidonException JannoRows)
-> PoseidonException -> Either PoseidonException JannoRows
forall a b. (a -> b) -> a -> b
$ String -> String -> PoseidonException
PoseidonFileConsistencyException String
jannoPath
        String
"The Poseidon_IDs are not unique"
    | Bool
otherwise = JannoRows -> Either PoseidonException JannoRows
forall a b. b -> Either a b
Right JannoRows
xs

checkIndividualUnique :: JannoRows -> Bool
checkIndividualUnique :: JannoRows -> Bool
checkIndividualUnique (JannoRows [JannoRow]
rows) = [JannoRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JannoRow]
rows Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== JannoRowWarnings -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (JannoRowWarnings -> JannoRowWarnings
forall a. Eq a => [a] -> [a]
nub (JannoRowWarnings -> JannoRowWarnings)
-> JannoRowWarnings -> JannoRowWarnings
forall a b. (a -> b) -> a -> b
$ (JannoRow -> String) -> [JannoRow] -> JannoRowWarnings
forall a b. (a -> b) -> [a] -> [b]
map JannoRow -> String
jPoseidonID [JannoRow]
rows)

-- Row-wise janno consistency checks

type JannoRowWarnings = [String]
type JannoRowLog = E.ExceptT String (W.Writer JannoRowWarnings)

checkJannoRowConsistency :: JannoRow -> JannoRowLog JannoRow
checkJannoRowConsistency :: JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkJannoRowConsistency JannoRow
x =
    JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. a -> ExceptT String (Writer JannoRowWarnings) a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRow
x
    ExceptT String (Writer JannoRowWarnings) JannoRow
-> (JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow)
-> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a b.
ExceptT String (Writer JannoRowWarnings) a
-> (a -> ExceptT String (Writer JannoRowWarnings) b)
-> ExceptT String (Writer JannoRowWarnings) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkMandatoryStringNotEmpty
    ExceptT String (Writer JannoRowWarnings) JannoRow
-> (JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow)
-> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a b.
ExceptT String (Writer JannoRowWarnings) a
-> (a -> ExceptT String (Writer JannoRowWarnings) b)
-> ExceptT String (Writer JannoRowWarnings) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkC14ColsConsistent
    ExceptT String (Writer JannoRowWarnings) JannoRow
-> (JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow)
-> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a b.
ExceptT String (Writer JannoRowWarnings) a
-> (a -> ExceptT String (Writer JannoRowWarnings) b)
-> ExceptT String (Writer JannoRowWarnings) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkContamColsConsistent
    ExceptT String (Writer JannoRowWarnings) JannoRow
-> (JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow)
-> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a b.
ExceptT String (Writer JannoRowWarnings) a
-> (a -> ExceptT String (Writer JannoRowWarnings) b)
-> ExceptT String (Writer JannoRowWarnings) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkRelationColsConsistent

checkMandatoryStringNotEmpty :: JannoRow -> JannoRowLog JannoRow
checkMandatoryStringNotEmpty :: JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkMandatoryStringNotEmpty JannoRow
x =
    let notEmpty :: Bool
notEmpty = (Bool -> Bool
not (Bool -> Bool) -> (JannoRow -> Bool) -> JannoRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (JannoRow -> String) -> JannoRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JannoRow -> String
jPoseidonID (JannoRow -> Bool) -> JannoRow -> Bool
forall a b. (a -> b) -> a -> b
$ JannoRow
x) Bool -> Bool -> Bool
&&
                   (Bool -> Bool
not (Bool -> Bool) -> (JannoRow -> Bool) -> JannoRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GroupName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GroupName] -> Bool)
-> (JannoRow -> [GroupName]) -> JannoRow -> Bool
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 -> Bool) -> JannoRow -> Bool
forall a b. (a -> b) -> a -> b
$ JannoRow
x) Bool -> Bool -> Bool
&&
                   (Bool -> Bool
not (Bool -> Bool) -> (JannoRow -> Bool) -> JannoRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (JannoRow -> String) -> JannoRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupName -> String
forall a. Show a => a -> String
show (GroupName -> String)
-> (JannoRow -> GroupName) -> JannoRow -> String
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 -> Bool) -> JannoRow -> Bool
forall a b. (a -> b) -> a -> b
$ JannoRow
x)
    in case Bool
notEmpty of
        Bool
False -> String -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. String -> ExceptT String (Writer JannoRowWarnings) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError String
"Poseidon_ID or Group_Name are empty"
        Bool
True  -> JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. a -> ExceptT String (Writer JannoRowWarnings) a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRow
x

getCellLength :: Maybe (ListColumn a) -> Int
getCellLength :: forall a. Maybe (ListColumn a) -> Int
getCellLength = Int -> (ListColumn a -> Int) -> Maybe (ListColumn a) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (ListColumn a -> [a]) -> ListColumn a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListColumn a -> [a]
forall a. ListColumn a -> [a]
getListColumn)

allEqual :: Eq a => [a] -> Bool
allEqual :: forall a. Eq a => [a] -> Bool
allEqual [] = Bool
True
allEqual [a]
x  = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

checkC14ColsConsistent :: JannoRow -> JannoRowLog JannoRow
checkC14ColsConsistent :: JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkC14ColsConsistent JannoRow
x =
    let isTypeC14 :: Bool
isTypeC14        = JannoRow -> Maybe JannoDateType
jDateType JannoRow
x Maybe JannoDateType -> Maybe JannoDateType -> Bool
forall a. Eq a => a -> a -> Bool
== JannoDateType -> Maybe JannoDateType
forall a. a -> Maybe a
Just JannoDateType
C14
        lLabnr :: Int
lLabnr           = Maybe (ListColumn JannoDateC14Labnr) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoDateC14Labnr) -> Int)
-> Maybe (ListColumn JannoDateC14Labnr) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoDateC14Labnr)
jDateC14Labnr JannoRow
x
        lUncalBP :: Int
lUncalBP         = Maybe (ListColumn JannoDateC14UncalBP) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoDateC14UncalBP) -> Int)
-> Maybe (ListColumn JannoDateC14UncalBP) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoDateC14UncalBP)
jDateC14UncalBP JannoRow
x
        lUncalBPErr :: Int
lUncalBPErr      = Maybe (ListColumn JannoDateC14UncalBPErr) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoDateC14UncalBPErr) -> Int)
-> Maybe (ListColumn JannoDateC14UncalBPErr) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoDateC14UncalBPErr)
jDateC14UncalBPErr JannoRow
x
        anyMainColFilled :: Bool
anyMainColFilled = Int
lUncalBP Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
lUncalBPErr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        anyMainColEmpty :: Bool
anyMainColEmpty  = Int
lUncalBP Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
lUncalBPErr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        allSameLength :: Bool
allSameLength    = [Int] -> Bool
forall a. Eq a => [a] -> Bool
allEqual [Int
lLabnr, Int
lUncalBP, Int
lUncalBPErr] Bool -> Bool -> Bool
||
                          (Int
lLabnr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
lUncalBP Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lUncalBPErr)
    in case (Bool
isTypeC14, Bool
anyMainColFilled, Bool
anyMainColEmpty, Bool
allSameLength) of
        (Bool
False, Bool
False, Bool
_, Bool
_ )   -> JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. a -> ExceptT String (Writer JannoRowWarnings) a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRow
x
        (Bool
False, Bool
True, Bool
_, Bool
_ )    -> String -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. String -> ExceptT String (Writer JannoRowWarnings) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError String
"Date_Type is not \"C14\", but either \
                                         \Date_C14_Uncal_BP or Date_C14_Uncal_BP_Err are not empty"
        (Bool
True, Bool
_, Bool
False, Bool
False) -> String -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. String -> ExceptT String (Writer JannoRowWarnings) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError String
"Date_C14_Labnr, Date_C14_Uncal_BP and Date_C14_Uncal_BP_Err \
                                         \do not have the same lengths"
        (Bool
True, Bool
_, Bool
False, Bool
True ) -> JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. a -> ExceptT String (Writer JannoRowWarnings) a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRow
x
        -- this should be an error, but we have legacy packages with this issue, so it's only a warning
        (Bool
True, Bool
_, Bool
True, Bool
_ )     -> do
            JannoRowWarnings -> ExceptT String (Writer JannoRowWarnings) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
W.tell [String
"Date_Type is \"C14\", but either Date_C14_Uncal_BP or Date_C14_Uncal_BP_Err are empty"]
            JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. a -> ExceptT String (Writer JannoRowWarnings) a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRow
x

checkContamColsConsistent :: JannoRow -> JannoRowLog JannoRow
checkContamColsConsistent :: JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkContamColsConsistent JannoRow
x =
    let lContamination :: Int
lContamination      = Maybe (ListColumn JannoContamination) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoContamination) -> Int)
-> Maybe (ListColumn JannoContamination) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoContamination)
jContamination JannoRow
x
        lContaminationErr :: Int
lContaminationErr   = Maybe (ListColumn JannoContaminationErr) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoContaminationErr) -> Int)
-> Maybe (ListColumn JannoContaminationErr) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoContaminationErr)
jContaminationErr JannoRow
x
        lContaminationMeas :: Int
lContaminationMeas  = Maybe (ListColumn JannoContaminationMeas) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoContaminationMeas) -> Int)
-> Maybe (ListColumn JannoContaminationMeas) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoContaminationMeas)
jContaminationMeas JannoRow
x
        allSameLength :: Bool
allSameLength       = [Int] -> Bool
forall a. Eq a => [a] -> Bool
allEqual [Int
lContamination, Int
lContaminationErr, Int
lContaminationMeas]
    in case Bool
allSameLength of
        Bool
False -> String -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. String -> ExceptT String (Writer JannoRowWarnings) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError String
"Contamination, Contamination_Err and Contamination_Meas \
                      \do not have the same lengths"
        Bool
True  -> JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. a -> ExceptT String (Writer JannoRowWarnings) a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRow
x

checkRelationColsConsistent :: JannoRow -> JannoRowLog JannoRow
checkRelationColsConsistent :: JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
checkRelationColsConsistent JannoRow
x =
    let lRelationTo :: Int
lRelationTo     = Maybe (ListColumn JannoRelationTo) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoRelationTo) -> Int)
-> Maybe (ListColumn JannoRelationTo) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoRelationTo)
jRelationTo JannoRow
x
        lRelationDegree :: Int
lRelationDegree = Maybe (ListColumn JannoRelationDegree) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoRelationDegree) -> Int)
-> Maybe (ListColumn JannoRelationDegree) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoRelationDegree)
jRelationDegree JannoRow
x
        lRelationType :: Int
lRelationType   = Maybe (ListColumn JannoRelationType) -> Int
forall a. Maybe (ListColumn a) -> Int
getCellLength (Maybe (ListColumn JannoRelationType) -> Int)
-> Maybe (ListColumn JannoRelationType) -> Int
forall a b. (a -> b) -> a -> b
$ JannoRow -> Maybe (ListColumn JannoRelationType)
jRelationType JannoRow
x
        allSameLength :: Bool
allSameLength   = [Int] -> Bool
forall a. Eq a => [a] -> Bool
allEqual [Int
lRelationTo, Int
lRelationDegree, Int
lRelationType] Bool -> Bool -> Bool
||
                          ([Int] -> Bool
forall a. Eq a => [a] -> Bool
allEqual [Int
lRelationTo, Int
lRelationDegree] Bool -> Bool -> Bool
&& Int
lRelationType Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    in case Bool
allSameLength of
        Bool
False -> String -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. String -> ExceptT String (Writer JannoRowWarnings) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError String
"Relation_To, Relation_Degree and Relation_Type \
                      \do not have the same lengths. Relation_Type can be empty"
        Bool
True  -> JannoRow -> ExceptT String (Writer JannoRowWarnings) JannoRow
forall a. a -> ExceptT String (Writer JannoRowWarnings) a
forall (m :: * -> *) a. Monad m => a -> m a
return JannoRow
x

-- | a convenience function to construct Eigenstrat Ind entries out of jannoRows
jannoRows2EigenstratIndEntries :: JannoRows -> [EigenstratIndEntry]
jannoRows2EigenstratIndEntries :: JannoRows -> [EigenstratIndEntry]
jannoRows2EigenstratIndEntries (JannoRows [JannoRow]
jannoRows) = do -- list monad
    JannoRow
jannoRow <- [JannoRow]
jannoRows -- looping over jannoRows
    let GroupName Text
gText = [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 -> GroupName) -> JannoRow -> GroupName
forall a b. (a -> b) -> a -> b
$ JannoRow
jannoRow
    EigenstratIndEntry -> [EigenstratIndEntry]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (EigenstratIndEntry -> [EigenstratIndEntry])
-> EigenstratIndEntry -> [EigenstratIndEntry]
forall a b. (a -> b) -> a -> b
$ ByteString -> Sex -> ByteString -> EigenstratIndEntry
EigenstratIndEntry (String -> ByteString
Bchs.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ JannoRow -> String
jPoseidonID JannoRow
jannoRow) (GeneticSex -> Sex
sfSex (JannoRow -> GeneticSex
jGeneticSex JannoRow
jannoRow)) (String -> ByteString
Bchs.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
gText)