Various minor fixes/changes suggested by Thiseas and others

CHANGELOG.md

@@ -1,3 +1,10 @@
+- V 2.2.1.0:
+    - Made the display of description and source url in the explorer page of the of the server's html API indendent of each other.
+    - Made the source column hide when the necessary URL is missing on the archive page.
+    - Added a input validation feature that checks line endings of the first (!) row in text files in packages. Only runs when checksums are present, because only then a difference in line endings can lead to unexpected behaviour.
+    - Made it possible to give ORCIDs with `--newContributors` in rectify.
+    - Fixed encoding issues in `trident list` when additional .janno columns are requested.
+    - Nicer error messages in case of missing input files in `validate`.
 - V 2.2.0.1:
     - By default only show the first five samples on the package page of the server's html API.
 - V 2.2.0.0:

poseidon-hs.cabal

@@ -1,5 +1,5 @@
 name:                poseidon-hs
-version:             2.2.0.1
+version:             2.2.1.0
 synopsis:            A package with tools for working with Poseidon genotype data
 description:         The tools in this package read and analyse Poseidon-formatted genotype databases, a modular system for storing genotype data from thousands of individuals.
 license:             MIT
@@ -85,6 +85,7 @@ Test-Suite poseidon-tools-tests
                         Poseidon.Core.MathHelpersSpec, Poseidon.Core.JannocoalesceSpec, Poseidon.Core.SummariseSpec,
                         Poseidon.Core.SurveySpec, Poseidon.Core.GenotypeDataSpec, Poseidon.Core.EntitiesListSpec,
                         Poseidon.Core.ChronicleSpec, Poseidon.Core.SequencingSourceSpec, Poseidon.Core.InterfaceSpec,
+                        Poseidon.Core.ContributorSpec
                         -- analysis
                         Poseidon.Analysis.FStatsSpec, Poseidon.Analysis.UtilsSpec
     default-language:   Haskell2010

src/Poseidon/CLI/Trident/Forge.hs

@@ -273,7 +273,7 @@ runForge (
                 (Just path) -> do
                     logInfo "Copying README file from source package"
                     let fullSourcePath = posPacBaseDir pacSource </> path
-                    liftIO $ checkFile fullSourcePath Nothing
+                    checkFile fullSourcePath Nothing
                     liftIO $ copyFile fullSourcePath $ outPath </> path
         copyCHANGELOGFile :: FilePath -> PoseidonPackage -> PoseidonIO ()
         copyCHANGELOGFile outPath pacSource = do
@@ -282,7 +282,7 @@ runForge (
                 (Just path) -> do
                     logInfo "Copying CHANGELOG file from source package"
                     let fullSourcePath = posPacBaseDir pacSource </> path
-                    liftIO $ checkFile fullSourcePath Nothing
+                    checkFile fullSourcePath Nothing
                     liftIO $ copyFile fullSourcePath $ outPath </> path
         compileGenotypeData :: FilePath -> GenotypeFileSpec -> [PoseidonPackage] -> [Int] -> PoseidonIO (VUM.IOVector Int)
         compileGenotypeData outPath gFileSpec relevantPackages relevantIndices = do

src/Poseidon/CLI/Trident/Init.hs

@@ -43,7 +43,7 @@ runInit (InitOptions genotypeDataIn outPathRaw maybeOutName minimal) = do
             GenotypePlink      genoFile _ snpFile _ indFile _ -> [genoFile, snpFile, indFile]
             GenotypeVCF        vcfFile  _                     -> [vcfFile]
     forM_ sourceFiles $ \sourceFile -> do
-        liftIO $ checkFile sourceFile Nothing
+        checkFile sourceFile Nothing
         let targetFile = outPath </> takeFileName sourceFile
         liftIO $ copyFile sourceFile targetFile
     -- create new package

src/Poseidon/CLI/Trident/List.hs

@@ -114,7 +114,7 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do
                     let addJannoColFlag = case addJannoColSpec of
                             AddColAll -> "&additionalJannoColumns=ALL"
                             AddColList [] -> ""
-                            AddColList moreJannoColumns -> "&additionalJannoColumns=" ++ intercalate "," moreJannoColumns
+                            AddColList moreJannoColumns -> "&additionalJannoColumns=" ++ T.unpack (T.intercalate "," moreJannoColumns)
                     apiReturn <- processApiResponse (remoteURL ++ "/individuals" ++ qDefault archive ++ addJannoColFlag) False
                     case apiReturn of
                         ApiReturnExtIndividualInfo indInfo -> return indInfo
@@ -153,7 +153,7 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do
                     let addJannoColFlag = case addColSpec of
                             AddColAll -> "&additionalBibColumns=ALL"
                             AddColList [] -> ""
-                            AddColList moreBibFields -> "&additionalBibColumns=" ++ intercalate "," moreBibFields
+                            AddColList moreBibFields -> "&additionalBibColumns=" ++ T.unpack (T.intercalate "," moreBibFields)
                     apiReturn <- processApiResponse (remoteURL ++ "/bibliography" ++ qDefault archive ++ addJannoColFlag) False
                     case apiReturn of
                         ApiReturnBibInfo bibInfo -> return bibInfo
@@ -164,7 +164,7 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do
 
             let addBibFieldNames = case addColSpec of
                     AddColAll -> nub . concatMap (map fst . bibInfoAddCols) $ bibInfos
-                    AddColList names -> names
+                    AddColList names -> map T.unpack names
 
             -- warning in case the additional Columns do not exist in the entire janno dataset,
             -- we only output this warning if the columns were requested explicitly. Not if

src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs

@@ -234,7 +234,7 @@ parseMaybeContributors = OP.option (Just <$> OP.eitherReader readContributorStri
     OP.long "newContributors" <>
     OP.metavar "DSL" <>
     OP.help "Contributors to add to the POSEIDON.yml file \
-            \ in the form \"[Firstname Lastname](Email address);...\"." <>
+            \ in the form \"[Firstname Lastname](Email address)<ORCID>;...\". The ORCIDs are optional." <>
     OP.value Nothing
     )
 
@@ -243,7 +243,7 @@ parseContributors = OP.option (OP.eitherReader readContributorString) (
     OP.long "newContributors" <>
     OP.metavar "DSL" <>
     OP.help "Contributors to add to the POSEIDON.yml file \
-            \ in the form \"[Firstname Lastname](Email address);...\"."
+            \ in the form \"[Firstname Lastname](Email address)<ORCID>;...\". The ORCIDs are optional."
     )
 
 readContributorString :: String -> Either String [ContributorSpec]

src/Poseidon/CLI/Trident/Serve.hs

@@ -33,9 +33,9 @@ import           Control.Monad                  (forM)
 import           Control.Monad.IO.Class         (MonadIO, liftIO)
 import           Data.Coerce                    (coerce)
 import           Data.List                      (groupBy, intercalate, sortOn)
-import           Data.List.Split                (splitOn)
 import           Data.Maybe                     (isJust)
 import           Data.Scientific                (toRealFloat)
+import qualified Data.Text                      as T
 import           Data.Text.Lazy                 (pack)
 import           Data.Time                      (Day)
 import           Data.Version                   (Version, parseVersion,
@@ -227,7 +227,7 @@ runServer (ServeOptions archBaseDirs port ignoreChecksums certFiles) serverReady
             indInfo <- case maybeAdditionalColumnsString of
                     Just "ALL" -> getExtendedIndividualInfo pacs AddColAll -- Nothing means all Janno Columns
                     Just additionalColumnsString ->
-                        let additionalColumnNames = splitOn "," additionalColumnsString
+                        let additionalColumnNames = T.splitOn "," additionalColumnsString
                         in  getExtendedIndividualInfo pacs (AddColList additionalColumnNames)
                     Nothing -> getExtendedIndividualInfo pacs (AddColList [])
             let retData = ApiReturnExtIndividualInfo indInfo
@@ -241,7 +241,7 @@ runServer (ServeOptions archBaseDirs port ignoreChecksums certFiles) serverReady
             bibInfo <- case maybeAdditionalBibFieldsString of
                     Just "ALL" -> getBibliographyInfo pacs AddColAll -- Nothing means all Janno Columns
                     Just additionalBibFieldsString ->
-                        let additionalBibFields = splitOn "," additionalBibFieldsString
+                        let additionalBibFields = T.splitOn "," additionalBibFieldsString
                         in  getBibliographyInfo pacs (AddColList additionalBibFields)
                     Nothing -> getBibliographyInfo pacs (AddColList [])
             let retData = ApiReturnBibInfo bibInfo

src/Poseidon/CLI/Trident/Validate.hs

@@ -10,14 +10,16 @@ import           Poseidon.Core.Janno            (JannoRows (..), readJannoFile)
 import           Poseidon.Core.Package          (PackageReadOptions (..),
                                                  PoseidonException (..),
                                                  PoseidonYamlStruct (..),
+                                                 checkGenoFiles,
                                                  defaultPackageReadOptions,
                                                  getJointIndividualInfo,
                                                  makePseudoPackageFromGenotypeData,
                                                  readPoseidonPackageCollectionWithSkipIndicator,
                                                  validateForge, validateGeno)
 import           Poseidon.Core.SequencingSource (SeqSourceRows (..),
                                                  readSeqSourceFile)
-import           Poseidon.Core.Utils            (PoseidonIO, logError, logInfo)
+import           Poseidon.Core.Utils            (PoseidonIO, checkFile,
+                                                 logError, logInfo)
 
 import           Control.Monad                  (forM_, unless, when)
 import           Control.Monad.Catch            (throwM)
@@ -96,6 +98,7 @@ runValidate (ValidateOptions
     conclude (not packagesSkipped) noExitCode
 runValidate (ValidateOptions (ValPlanPoseidonYaml path) _ _ noExitCode _) = do
     logInfo $ "Validating: " ++ path
+    checkFile path Nothing
     bs <- liftIO $ B.readFile path
     yml <- case decodeEither' bs of
         Left err  -> throwM $ PoseidonYamlParseException path err
@@ -108,21 +111,25 @@ runValidate (ValidateOptions (ValPlanGeno geno) _ _ noExitCode _) = do
             GenotypePlink      gf _ _ _ _ _ -> gf
             GenotypeVCF        gf _         -> gf
     logInfo $ "Validating: " ++ gFile
+    checkGenoFiles True "" (genotypeFileSpec geno)
     pac <- makePseudoPackageFromGenotypeData geno
     validateGeno pac True
     conclude True noExitCode
 runValidate (ValidateOptions (ValPlanJanno (VersionedFile pv path)) mandatoryJannoCols _ noExitCode _) = do
     logInfo $ "Validating: " ++ path
+    checkFile path Nothing
     (_,JannoRows entries) <- readJannoFile pv mandatoryJannoCols path
     logInfo $ "All " ++ show (length entries) ++ " entries are valid"
     conclude True noExitCode
 runValidate (ValidateOptions (ValPlanSSF (VersionedFile pv path)) _ mandatorySSFCols noExitCode _) = do
     logInfo $ "Validating: " ++ path
+    checkFile path Nothing
     (SeqSourceRows entries) <- readSeqSourceFile pv mandatorySSFCols path
     logInfo $ "All " ++ show (length entries) ++ " entries are valid"
     conclude True noExitCode
 runValidate (ValidateOptions (ValPlanBib path) _ _ noExitCode _) = do
     logInfo $ "Validating: " ++ path
+    checkFile path Nothing
     entries <- liftIO $ readBibTeXFile path
     logInfo $ "All " ++ show (length entries) ++ " entries are valid"
     conclude True noExitCode

src/Poseidon/Core/Contributor.hs

@@ -44,14 +44,14 @@ instance ToJSON ContributorSpec where
         ]
 
 contributorSpecParser :: P.Parser [ContributorSpec]
-contributorSpecParser = P.try (P.sepBy oneContributorSpecParser (P.char ';' <* P.spaces))
+contributorSpecParser = P.try (P.sepBy oneContributorSpecParser (P.char ';' <* P.spaces)) <* P.spaces <* P.eof
 
 oneContributorSpecParser :: P.Parser ContributorSpec
 oneContributorSpecParser = do
     name <- P.between (P.char '[') (P.char ']') (P.manyTill P.anyChar (P.lookAhead (P.char ']')))
     email <- P.between (P.char '(') (P.char ')') (P.manyTill P.anyChar (P.lookAhead (P.char ')')))
-    -- TODO: add option to add ORCID here
-    return (ContributorSpec name email Nothing)
+    orcid <- P.optionMaybe $ P.between (P.char '<') (P.char '>') parseORCID
+    return (ContributorSpec name email orcid)
 
 -- | A data type to represent an ORCID
 -- see https://support.orcid.org/hc/en-us/articles/360006897674-Structure-of-the-ORCID-Identifier
@@ -62,7 +62,7 @@ data ORCID = ORCID
     deriving (Show, Eq, Ord)
 
 instance FromJSON ORCID where
-    parseJSON (String s) = case P.runParser parseORCID () "" (unpack s) of
+    parseJSON (String s) = case P.runParser (parseORCID <* P.eof) () "" (unpack s) of
         Left err -> fail $ showParsecErr err
         Right x  -> pure x
     parseJSON _          = mzero
@@ -76,7 +76,7 @@ parseORCID = do
             fourBlock <* m
         <*> fourBlock <* m
         <*> fourBlock <* m
-        <*> threeBlock <*> checksumDigit <* P.eof
+        <*> threeBlock <*> checksumDigit
     guard (validateORCID orcid) P.<?> "ORCID is not valid"
     return orcid
   where