From 464aa80d6e10123bca2ba757911f96cf58de41ed Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 16:47:50 +0200 Subject: [PATCH 01/20] new module modify that is planned to replace rectify --- poseidon-hs.cabal | 2 +- src-executables/Main-trident.hs | 17 ++ src/Poseidon/CLI/Trident/Modify.hs | 221 ++++++++++++++++++ .../CLI/Trident/OptparseApplicativeParsers.hs | 10 +- src/Poseidon/CLI/Trident/Rectify.hs | 22 +- .../GoldenTestCheckSumFile.txt | 18 +- .../genoconvert/out_vcf/Schiffels_2016.vcf.gz | Bin 495 -> 495 bytes .../GoldenTestsRunCommands.hs | 102 ++++---- 8 files changed, 308 insertions(+), 84 deletions(-) create mode 100644 src/Poseidon/CLI/Trident/Modify.hs diff --git a/poseidon-hs.cabal b/poseidon-hs.cabal index ed185b9b..975c2faf 100644 --- a/poseidon-hs.cabal +++ b/poseidon-hs.cabal @@ -28,7 +28,7 @@ library Poseidon.CLI.Trident.Survey, Poseidon.CLI.Trident.Forge, Poseidon.CLI.Trident.Init, Poseidon.CLI.Trident.Rectify, Poseidon.CLI.Trident.Fetch, Poseidon.CLI.Trident.Genoconvert, Poseidon.CLI.Trident.OptparseApplicativeParsers, Poseidon.CLI.Trident.Timetravel, - Poseidon.CLI.Trident.Jannocoalesce, + Poseidon.CLI.Trident.Jannocoalesce, Poseidon.CLI.Trident.Modify -- analysis Poseidon.Analysis.FStatsConfig, Poseidon.Analysis.RASconfig, Poseidon.Analysis.Utils, Poseidon.Analysis.Generator.Parsers, Poseidon.Analysis.Generator.Types, diff --git a/src-executables/Main-trident.hs b/src-executables/Main-trident.hs index ba6cdbdd..0e16be49 100644 --- a/src-executables/Main-trident.hs +++ b/src-executables/Main-trident.hs @@ -18,6 +18,8 @@ import Poseidon.CLI.Trident.List (ListOptions (. import Poseidon.CLI.Trident.OptparseApplicativeParsers import Poseidon.CLI.Trident.Rectify (RectifyOptions (..), runRectify) +import Poseidon.CLI.Trident.Modify (ModifyOptions (..), + runModify) import Poseidon.CLI.Trident.Serve (ServeOptions (..), runServerMainThread) import Poseidon.CLI.Trident.Summarise (SummariseOptions (..), @@ -69,6 +71,7 @@ data Subcommand = | CmdSummarise SummariseOptions | CmdSurvey SurveyOptions | CmdRectify RectifyOptions + | CmdModify ModifyOptions | CmdValidate ValidateOptions | CmdChronicle ChronicleOptions | CmdTimetravel TimetravelOptions @@ -98,6 +101,7 @@ runCmd o = case o of CmdInit opts -> runInit opts CmdList opts -> runList opts CmdRectify opts -> runRectify opts + CmdModify opts -> runModify opts CmdServe opts -> runServerMainThread opts CmdSummarise opts -> runSummarise opts CmdSurvey opts -> runSurvey opts @@ -137,6 +141,7 @@ subcommandParser = OP.subparser ( OP.command "genoconvert" genoconvertOptInfo <> OP.command "jannocoalesce" jannocoalesceOptInfo <> OP.command "rectify" rectifyOptInfo <> + OP.command "modify" modifyOptInfo <> OP.commandGroup "Package creation and manipulation commands:" ) <|> OP.subparser ( @@ -179,6 +184,8 @@ subcommandParser = OP.subparser ( )) rectifyOptInfo = OP.info (OP.helper <*> (CmdRectify <$> rectifyOptParser)) (OP.progDesc "Adjust POSEIDON.yml files automatically to package changes") + modifyOptInfo = OP.info (OP.helper <*> (CmdModify <$> modifyOptParser)) + (OP.progDesc "Modify certain elements of Poseidon packages") validateOptInfo = OP.info (OP.helper <*> (CmdValidate <$> validateOptParser)) (OP.progDesc "Check Poseidon packages or package components for structural correctness") chronicleOptInfo = OP.info (OP.helper <*> (CmdChronicle <$> chronicleOptParser)) @@ -251,6 +258,16 @@ rectifyOptParser = RectifyOptions <$> parseBasePaths <*> parseJannoRemoveEmptyCols <*> parseOnlyLatest +modifyOptParser :: OP.Parser ModifyOptions +modifyOptParser = ModifyOptions <$> parseBasePaths + <*> parseIgnorePoseidonVersion + <*> parseMaybePoseidonVersion + <*> parseMaybePackageVersionUpdate + <*> parseChecksumsToRectify + <*> parseMaybeContributors + <*> parseJannoRemoveEmptyCols + <*> parseOnlyLatest + validateOptParser :: OP.Parser ValidateOptions validateOptParser = ValidateOptions <$> parseValidatePlan <*> parseMandatoryJannoCols diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs new file mode 100644 index 00000000..414d8d8a --- /dev/null +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Poseidon.CLI.Trident.Modify ( + runModify, ModifyOptions (..), PackageVersionUpdate (..), ChecksumsToModify (..) + ) where + +import Poseidon.Core.Contributor (ContributorSpec (..)) +import Poseidon.Core.EntityTypes (HasNameAndVersion (..), + PacNameAndVersion (..), + renderNameWithVersion) +import Poseidon.Core.GenotypeData (GenotypeDataSpec (..), + GenotypeFileSpec (..)) +import Poseidon.Core.Janno (makeJannoHeader, + writeJannoFileWithoutEmptyCols) +import Poseidon.Core.Package (PackageReadOptions (..), + PoseidonPackage (..), + defaultPackageReadOptions, + readPoseidonPackageCollection, + writePoseidonPackage) +import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) +import Poseidon.Core.Utils (PoseidonIO, getChecksum, + logDebug, logInfo, logWarning) +import Poseidon.Core.Version (VersionComponent (..), + updateThreeComponentVersion) + +import Control.DeepSeq ((<$!!>)) +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.List (nub) +import Data.Maybe (fromJust) +import Data.Time (UTCTime (..), getCurrentTime) +import Data.Version (Version (..), makeVersion, + showVersion) +import System.Directory (doesFileExist, removeFile) +import System.FilePath (()) + +data ModifyOptions = ModifyOptions + { _modifyBaseDirs :: [FilePath] + , _modifyIgnorePoseidonVersion :: Bool + , _modifyPoseidonVersion :: Maybe Version + , _modifyPackageVersionUpdate :: Maybe PackageVersionUpdate + , _modifyChecksums :: ChecksumsToModify + , _modifyNewContributors :: Maybe [ContributorSpec] + , _modifyJannoRemoveEmptyCols :: Bool + , _modifyOnlyLatest :: Bool + } + +data PackageVersionUpdate = PackageVersionUpdate + { _pacVerUpVersionComponent :: VersionComponent + , _pacVerUpLog :: Maybe String + } + +data ChecksumsToModify = + ChecksumNone | + ChecksumAll | + ChecksumsDetail + { _modifyChecksumGeno :: Bool + , _modifyChecksumJanno :: Bool + , _modifyChecksumSSF :: Bool + , _modifyChecksumBib :: Bool + } + +runModify :: ModifyOptions -> PoseidonIO () +runModify (ModifyOptions + baseDirs + ignorePosVer newPosVer pacVerUpdate checksumUpdate newContributors + jannoRemoveEmptyCols + onlyLatest + ) = do + let pacReadOpts = defaultPackageReadOptions { + _readOptIgnoreChecksums = True + , _readOptIgnoreGeno = True + , _readOptGenoCheck = False + , _readOptOnlyLatest = onlyLatest + } + allPackages <- readPoseidonPackageCollection + pacReadOpts {_readOptIgnorePosVersion = ignorePosVer} + baseDirs + logInfo "Starting per-package update procedure" + mapM_ modifyOnePackage allPackages + logInfo "Done" + where + modifyOnePackage :: PoseidonPackage -> PoseidonIO () + modifyOnePackage inPac = do + logInfo $ "Modifying package: " ++ renderNameWithVersion inPac + when jannoRemoveEmptyCols $ do + case posPacJannoFile inPac of + Nothing -> do + logWarning "No .janno file to modify with --jannoRemoveEmpty" + Just jannoPath -> do + logInfo "Reordering and removing empty columns from .janno file" + liftIO $ writeJannoFileWithoutEmptyCols + (posPacBaseDir inPac jannoPath) + (makeJannoHeader (posPacJanno inPac)) + (posPacJanno inPac) + updatedPacPosVer <- updatePoseidonVersion newPosVer inPac + updatedPacContri <- addContributors newContributors updatedPacPosVer + updatedPacChecksums <- updateChecksums checksumUpdate updatedPacContri + completeAndWritePackage pacVerUpdate updatedPacChecksums + +updatePoseidonVersion :: Maybe Version -> PoseidonPackage -> PoseidonIO PoseidonPackage +updatePoseidonVersion Nothing pac = return pac +updatePoseidonVersion (Just ver) pac = do + logDebug "Updating Poseidon version" + return pac { posPacPoseidonVersion = PoseidonVersion ver } + +addContributors :: Maybe [ContributorSpec] -> PoseidonPackage -> PoseidonIO PoseidonPackage +addContributors Nothing pac = return pac +addContributors (Just cs) pac = do + logDebug "Updating list of contributors" + return pac { posPacContributor = nub (posPacContributor pac ++ cs) } + +updateChecksums :: ChecksumsToModify -> PoseidonPackage -> PoseidonIO PoseidonPackage +updateChecksums checksumSetting pac = do + case checksumSetting of + ChecksumNone -> logDebug "Update no checksums" >> return pac + ChecksumAll -> update True True True True + ChecksumsDetail g j s b -> update g j s b + where + update :: Bool -> Bool -> Bool -> Bool -> PoseidonIO PoseidonPackage + update g j s b = do + let d = posPacBaseDir pac + let gFileSpec = genotypeFileSpec . posPacGenotypeData $ pac + newGenotypeFileSpec <- + if g + then do + logDebug "Updating genotype data checksums" + case gFileSpec of + GenotypeEigenstrat gf gfc sf sfc if_ ifc -> do + [genoChkSum, snpChkSum, indChkSum] <- + sequence [testAndGetChecksum (d f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + return $ GenotypeEigenstrat gf genoChkSum sf snpChkSum if_ indChkSum + GenotypePlink gf gfc sf sfc if_ ifc -> do + [genoChkSum, snpChkSum, indChkSum] <- + sequence [testAndGetChecksum (d f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + return $ GenotypePlink gf genoChkSum sf snpChkSum if_ indChkSum + GenotypeVCF gf gfc -> do + genoChkSum <- testAndGetChecksum (d gf) gfc + return $ GenotypeVCF gf genoChkSum + else return gFileSpec + newJannoChkSum <- + if j + then do + logDebug "Updating .janno file checksums" + case posPacJannoFile pac of + Nothing -> return $ posPacJannoFileChkSum pac + Just fn -> Just <$!!> getChk (d fn) + else return $ posPacJannoFileChkSum pac + newSeqSourceChkSum <- + if s + then do + logDebug "Updating .ssf file checksums" + case posPacSeqSourceFile pac of + Nothing -> return $ posPacSeqSourceFileChkSum pac + Just fn -> Just <$!!> getChk (d fn) + else return $ posPacSeqSourceFileChkSum pac + newBibChkSum <- + if b + then do + logDebug "Updating .bib file checksums" + case posPacBibFile pac of + Nothing -> return $ posPacBibFileChkSum pac + Just fn -> Just <$!!> getChk (d fn) + else return $ posPacBibFileChkSum pac + let gd = posPacGenotypeData pac + return $ pac { + posPacGenotypeData = gd {genotypeFileSpec = newGenotypeFileSpec}, + posPacJannoFileChkSum = newJannoChkSum, + posPacSeqSourceFileChkSum = newSeqSourceChkSum, + posPacBibFileChkSum = newBibChkSum + } + getChk :: (MonadIO m) => FilePath -> m String + getChk = liftIO . getChecksum + testAndGetChecksum :: (MonadIO m) => FilePath -> Maybe String -> m (Maybe String) + testAndGetChecksum file defaultChkSum = do + e <- liftIO . doesFileExist $ file + if e then Just <$!!> getChk file else return defaultChkSum + + +completeAndWritePackage :: Maybe PackageVersionUpdate -> PoseidonPackage -> PoseidonIO () +completeAndWritePackage Nothing pac = do + logDebug "Writing rectified POSEIDON.yml file" + liftIO $ writePoseidonPackage pac +completeAndWritePackage (Just (PackageVersionUpdate component logText)) pac = do + updatedPacPacVer <- updatePackageVersion component pac + updatePacChangeLog <- writeOrUpdateChangelogFile logText updatedPacPacVer + logDebug "Writing rectified POSEIDON.yml file" + liftIO $ writePoseidonPackage updatePacChangeLog + +updatePackageVersion :: VersionComponent -> PoseidonPackage -> PoseidonIO PoseidonPackage +updatePackageVersion component pac = do + logDebug "Updating package version" + (UTCTime today _) <- liftIO getCurrentTime + let pacNameAndVer = posPacNameAndVersion pac + let outPac = pac { + posPacNameAndVersion = pacNameAndVer {panavVersion = maybe (Just $ makeVersion [0, 1, 0]) + (Just . updateThreeComponentVersion component) + (getPacVersion pac) + } + , posPacLastModified = Just today + } + return outPac + +writeOrUpdateChangelogFile :: Maybe String -> PoseidonPackage -> PoseidonIO PoseidonPackage +writeOrUpdateChangelogFile Nothing pac = return pac +writeOrUpdateChangelogFile (Just logText) pac = do + case posPacChangelogFile pac of + Nothing -> do + logDebug "Creating CHANGELOG.md" + liftIO $ writeFile (posPacBaseDir pac "CHANGELOG.md") $ + "- V " ++ showVersion (fromJust $ getPacVersion pac) ++ ": " ++ + logText ++ "\n" + return pac { posPacChangelogFile = Just "CHANGELOG.md" } + Just x -> do + logDebug "Updating CHANGELOG.md" + changelogFile <- liftIO $ readFile (posPacBaseDir pac x) + liftIO $ removeFile (posPacBaseDir pac x) + liftIO $ writeFile (posPacBaseDir pac x) $ + "- V " ++ showVersion (fromJust $ getPacVersion pac) ++ ": " + ++ logText ++ "\n" ++ changelogFile + return pac diff --git a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs index 48681602..c2bd60da 100644 --- a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs +++ b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs @@ -8,7 +8,7 @@ import Poseidon.CLI.Trident.Jannocoalesce (CoalesceJannoColumnSpec (.. JannoSourceSpec (..)) import Poseidon.CLI.Trident.List (ListEntity (..), RepoLocationSpec (..)) -import Poseidon.CLI.Trident.Rectify (ChecksumsToRectify (..), +import Poseidon.CLI.Trident.Rectify (ChecksumsToModify (..), PackageVersionUpdate (..)) import Poseidon.CLI.Trident.Serve (ArchiveConfig (..), ArchiveSpec (..)) @@ -171,17 +171,17 @@ parseRemoveOld = OP.switch ( OP.help "Remove the old genotype files when creating the new ones." ) -parseChecksumsToRectify :: OP.Parser ChecksumsToRectify +parseChecksumsToRectify :: OP.Parser ChecksumsToModify parseChecksumsToRectify = parseChecksumNone <|> parseChecksumAll <|> parseChecksumsDetail where - parseChecksumNone :: OP.Parser ChecksumsToRectify + parseChecksumNone :: OP.Parser ChecksumsToModify parseChecksumNone = pure ChecksumNone - parseChecksumAll :: OP.Parser ChecksumsToRectify + parseChecksumAll :: OP.Parser ChecksumsToModify parseChecksumAll = ChecksumAll <$ OP.flag' () ( OP.long "checksumAll" <> OP.help "Update all checksums.") - parseChecksumsDetail :: OP.Parser ChecksumsToRectify + parseChecksumsDetail :: OP.Parser ChecksumsToModify parseChecksumsDetail = ChecksumsDetail <$> parseChecksumGeno <*> parseChecksumJanno <*> diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index a260970f..fdac3464 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Poseidon.CLI.Trident.Rectify ( - runRectify, RectifyOptions (..), PackageVersionUpdate (..), ChecksumsToRectify (..) + runRectify, RectifyOptions (..), PackageVersionUpdate (..), ChecksumsToModify (..) ) where import Poseidon.Core.Contributor (ContributorSpec (..)) @@ -22,6 +22,7 @@ import Poseidon.Core.Utils (PoseidonIO, getChecksum, logDebug, logInfo, logWarning) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) +import Poseidon.CLI.Trident.Modify (PackageVersionUpdate (..), ChecksumsToModify (..)) import Control.DeepSeq ((<$!!>)) import Control.Monad (when) @@ -39,27 +40,12 @@ data RectifyOptions = RectifyOptions , _rectifyIgnorePoseidonVersion :: Bool , _rectifyPoseidonVersion :: Maybe Version , _rectifyPackageVersionUpdate :: Maybe PackageVersionUpdate - , _rectifyChecksums :: ChecksumsToRectify + , _rectifyChecksums :: ChecksumsToModify , _rectifyNewContributors :: Maybe [ContributorSpec] , _rectifyJannoRemoveEmptyCols :: Bool , _rectifyOnlyLatest :: Bool } -data PackageVersionUpdate = PackageVersionUpdate - { _pacVerUpVersionComponent :: VersionComponent - , _pacVerUpLog :: Maybe String - } - -data ChecksumsToRectify = - ChecksumNone | - ChecksumAll | - ChecksumsDetail - { _rectifyChecksumGeno :: Bool - , _rectifyChecksumJanno :: Bool - , _rectifyChecksumSSF :: Bool - , _rectifyChecksumBib :: Bool - } - runRectify :: RectifyOptions -> PoseidonIO () runRectify (RectifyOptions baseDirs @@ -110,7 +96,7 @@ addContributors (Just cs) pac = do logDebug "Updating list of contributors" return pac { posPacContributor = nub (posPacContributor pac ++ cs) } -updateChecksums :: ChecksumsToRectify -> PoseidonPackage -> PoseidonIO PoseidonPackage +updateChecksums :: ChecksumsToModify -> PoseidonPackage -> PoseidonIO PoseidonPackage updateChecksums checksumSetting pac = do case checksumSetting of ChecksumNone -> logDebug "Update no checksums" >> return pac diff --git a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt index e43036b7..7f2d9f8d 100644 --- a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt +++ b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt @@ -58,15 +58,15 @@ a9fcb59cb933d8f183f3c3f6fbf2e213 genoconvert init_vcf/Schiffels_vcf/geno.fam 3c38f40efe215a047c02f4e98e0390da genoconvert genoconvert/zip_roundtrip/Schiffels_2016.bed 8538ffd971ebb12cf5ef6e338da27970 genoconvert genoconvert/zip_roundtrip/Schiffels_2016.bim a9fcb59cb933d8f183f3c3f6fbf2e213 genoconvert genoconvert/zip_roundtrip/Schiffels_2016.fam -57c109be74d7c596bcb76aae03b2d124 rectify init/Schiffels/POSEIDON.yml -4aeae97cfc44b55b2a8005425d786148 rectify init/Schiffels/CHANGELOG.md -174375c685f2e1b7432172e6075f1f2f rectify init/Schiffels/POSEIDON.yml -3bb396e099d5b8771a3409f5fe85d70b rectify init/Schiffels/CHANGELOG.md -667074fbd38a002cf44750e92346a118 rectify init/Schiffels/POSEIDON.yml -3bb396e099d5b8771a3409f5fe85d70b rectify init/Schiffels/CHANGELOG.md -ebf0b456d5e09686ee7131db06848104 rectify init/Schiffels/POSEIDON.yml -3bb396e099d5b8771a3409f5fe85d70b rectify init/Schiffels/CHANGELOG.md -083fe7ef4206c979356a3a2454d780b1 rectify init/Schiffels/Schiffels.janno +57c109be74d7c596bcb76aae03b2d124 modify init/Schiffels/POSEIDON.yml +4aeae97cfc44b55b2a8005425d786148 modify init/Schiffels/CHANGELOG.md +174375c685f2e1b7432172e6075f1f2f modify init/Schiffels/POSEIDON.yml +3bb396e099d5b8771a3409f5fe85d70b modify init/Schiffels/CHANGELOG.md +667074fbd38a002cf44750e92346a118 modify init/Schiffels/POSEIDON.yml +3bb396e099d5b8771a3409f5fe85d70b modify init/Schiffels/CHANGELOG.md +ebf0b456d5e09686ee7131db06848104 modify init/Schiffels/POSEIDON.yml +3bb396e099d5b8771a3409f5fe85d70b modify init/Schiffels/CHANGELOG.md +083fe7ef4206c979356a3a2454d780b1 modify init/Schiffels/Schiffels.janno 5b5c20071f3e53346fdfa04f9dbb0223 forge forge/ForgePac1/POSEIDON.yml 1286a2580e4bfbed7d804d5f3fe125f7 forge forge/ForgePac1/ForgePac1.geno 848cf0fab32e4078a88cc17ad8ec3381 forge forge/ForgePac1/ForgePac1.janno diff --git a/test/PoseidonGoldenTests/GoldenTestData/genoconvert/out_vcf/Schiffels_2016.vcf.gz b/test/PoseidonGoldenTests/GoldenTestData/genoconvert/out_vcf/Schiffels_2016.vcf.gz index 4d23fd675770b8d15a4695cb0866463ccc5a8c9b..8baafd44e017998d14fa11629c1b505f8462b63d 100644 GIT binary patch delta 22 ecmaFQ{GNG23X{X)jcJXH9OiFiSZ}j1FaQ8$SqFju delta 22 ecmaFQ{GNG23eyUfUByU;qGT0tfs6 diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index ab2aaec0..ace2135a 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -20,10 +20,10 @@ import Poseidon.CLI.Trident.List (ListEntity (..), ListOptions (..), RepoLocationSpec (..), runList) -import Poseidon.CLI.Trident.Rectify (ChecksumsToRectify (..), +import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), PackageVersionUpdate (..), - RectifyOptions (..), - runRectify) + ModifyOptions (..), + runModify) import Poseidon.CLI.Trident.Serve (ArchiveConfig (..), ArchiveSpec (..), ServeOptions (..), @@ -237,8 +237,8 @@ runCLICommands interactive testDir checkFilePath = do testPipelineSurvey testDir checkFilePath hPutStrLn stderr "--- genoconvert" testPipelineGenoconvert testDir checkFilePath - hPutStrLn stderr "--- rectify" - testPipelineRectify testDir checkFilePath + hPutStrLn stderr "--- modify" + testPipelineModify testDir checkFilePath hPutStrLn stderr "--- forge" testPipelineForge testDir checkFilePath hPutStrLn stderr "--- chronicle & timetravel" @@ -645,68 +645,68 @@ testPipelineGenoconvert testDir checkFilePath = do } testLog $ runGenoconvert genoconvertOpts7 -testPipelineRectify :: FilePath -> FilePath -> IO () -testPipelineRectify testDir checkFilePath = do - let rectifyOpts1 = RectifyOptions { - _rectifyBaseDirs = [testDir "init" "Schiffels"] - , _rectifyPoseidonVersion = Nothing - , _rectifyIgnorePoseidonVersion = False - , _rectifyPackageVersionUpdate = Just (PackageVersionUpdate Major (Just "test1")) - , _rectifyChecksums = ChecksumNone - , _rectifyNewContributors = Nothing - , _rectifyJannoRemoveEmptyCols = False - , _rectifyOnlyLatest = False +testPipelineModify :: FilePath -> FilePath -> IO () +testPipelineModify testDir checkFilePath = do + let modifyOpts1 = ModifyOptions { + _modifyBaseDirs = [testDir "init" "Schiffels"] + , _modifyPoseidonVersion = Nothing + , _modifyIgnorePoseidonVersion = False + , _modifyPackageVersionUpdate = Just (PackageVersionUpdate Major (Just "test1")) + , _modifyChecksums = ChecksumNone + , _modifyNewContributors = Nothing + , _modifyJannoRemoveEmptyCols = False + , _modifyOnlyLatest = False } - let action1 = testLog (runRectify rectifyOpts1) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") - runAndChecksumFiles checkFilePath testDir action1 "rectify" [ + let action1 = testLog (runModify modifyOpts1) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") + runAndChecksumFiles checkFilePath testDir action1 "modify" [ "init" "Schiffels" "POSEIDON.yml" , "init" "Schiffels" "CHANGELOG.md" ] - let rectifyOpts2 = RectifyOptions { - _rectifyBaseDirs = [testDir "init" "Schiffels"] - , _rectifyPoseidonVersion = Just $ makeVersion [2,7,1] - , _rectifyIgnorePoseidonVersion = False - , _rectifyPackageVersionUpdate = Just (PackageVersionUpdate Minor (Just "test2")) - , _rectifyChecksums = ChecksumAll - , _rectifyNewContributors = Nothing - , _rectifyJannoRemoveEmptyCols = False - , _rectifyOnlyLatest = False + let modifyOpts2 = ModifyOptions { + _modifyBaseDirs = [testDir "init" "Schiffels"] + , _modifyPoseidonVersion = Just $ makeVersion [2,7,1] + , _modifyIgnorePoseidonVersion = False + , _modifyPackageVersionUpdate = Just (PackageVersionUpdate Minor (Just "test2")) + , _modifyChecksums = ChecksumAll + , _modifyNewContributors = Nothing + , _modifyJannoRemoveEmptyCols = False + , _modifyOnlyLatest = False } - let action2 = testLog (runRectify rectifyOpts2) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") - runAndChecksumFiles checkFilePath testDir action2 "rectify" [ + let action2 = testLog (runModify modifyOpts2) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") + runAndChecksumFiles checkFilePath testDir action2 "modify" [ "init" "Schiffels" "POSEIDON.yml" , "init" "Schiffels" "CHANGELOG.md" ] - let rectifyOpts3 = RectifyOptions { - _rectifyBaseDirs = [testDir "init" "Schiffels"] - , _rectifyPoseidonVersion = Nothing - , _rectifyIgnorePoseidonVersion = False - , _rectifyPackageVersionUpdate = Just (PackageVersionUpdate Patch Nothing) - , _rectifyChecksums = ChecksumNone - , _rectifyNewContributors = Just [ + let modifyOpts3 = ModifyOptions { + _modifyBaseDirs = [testDir "init" "Schiffels"] + , _modifyPoseidonVersion = Nothing + , _modifyIgnorePoseidonVersion = False + , _modifyPackageVersionUpdate = Just (PackageVersionUpdate Patch Nothing) + , _modifyChecksums = ChecksumNone + , _modifyNewContributors = Just [ ContributorSpec "Josiah Carberry" "carberry@brown.edu" (Just $ ORCID {_orcidNums = "000000021825009", _orcidChecksum = '7'}) , ContributorSpec "Herbert Testmann" "herbert@testmann.tw" Nothing ] - , _rectifyJannoRemoveEmptyCols = False - , _rectifyOnlyLatest = False + , _modifyJannoRemoveEmptyCols = False + , _modifyOnlyLatest = False } - let action3 = testLog (runRectify rectifyOpts3) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") - runAndChecksumFiles checkFilePath testDir action3 "rectify" [ + let action3 = testLog (runModify modifyOpts3) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") + runAndChecksumFiles checkFilePath testDir action3 "modify" [ "init" "Schiffels" "POSEIDON.yml" , "init" "Schiffels" "CHANGELOG.md" ] - let rectifyOpts4 = RectifyOptions { - _rectifyBaseDirs = [testDir "init" "Schiffels"] - , _rectifyPoseidonVersion = Nothing - , _rectifyIgnorePoseidonVersion = False - , _rectifyPackageVersionUpdate = Nothing - , _rectifyChecksums = ChecksumAll - , _rectifyNewContributors = Nothing - , _rectifyJannoRemoveEmptyCols = True - , _rectifyOnlyLatest = False + let modifyOpts4 = ModifyOptions { + _modifyBaseDirs = [testDir "init" "Schiffels"] + , _modifyPoseidonVersion = Nothing + , _modifyIgnorePoseidonVersion = False + , _modifyPackageVersionUpdate = Nothing + , _modifyChecksums = ChecksumAll + , _modifyNewContributors = Nothing + , _modifyJannoRemoveEmptyCols = True + , _modifyOnlyLatest = False } - let action4 = testLog (runRectify rectifyOpts4) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") - runAndChecksumFiles checkFilePath testDir action4 "rectify" [ + let action4 = testLog (runModify modifyOpts4) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") + runAndChecksumFiles checkFilePath testDir action4 "modify" [ "init" "Schiffels" "POSEIDON.yml" , "init" "Schiffels" "CHANGELOG.md" , "init" "Schiffels" "Schiffels.janno" From a92aeb7ae203245c8805a6eace270869435b22d8 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 17:14:17 +0200 Subject: [PATCH 02/20] started to shape rectify into the tool we want it to be in the future --- src-executables/Main-trident.hs | 4 - src/Poseidon/CLI/Trident/Modify.hs | 3 +- .../CLI/Trident/OptparseApplicativeParsers.hs | 2 +- src/Poseidon/CLI/Trident/Rectify.hs | 173 ++---------------- 4 files changed, 22 insertions(+), 160 deletions(-) diff --git a/src-executables/Main-trident.hs b/src-executables/Main-trident.hs index 0e16be49..905df832 100644 --- a/src-executables/Main-trident.hs +++ b/src-executables/Main-trident.hs @@ -251,12 +251,8 @@ surveyOptParser = SurveyOptions <$> parseBasePaths rectifyOptParser :: OP.Parser RectifyOptions rectifyOptParser = RectifyOptions <$> parseBasePaths <*> parseIgnorePoseidonVersion - <*> parseMaybePoseidonVersion <*> parseMaybePackageVersionUpdate - <*> parseChecksumsToRectify <*> parseMaybeContributors - <*> parseJannoRemoveEmptyCols - <*> parseOnlyLatest modifyOptParser :: OP.Parser ModifyOptions modifyOptParser = ModifyOptions <$> parseBasePaths diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index 414d8d8a..45dcce12 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module Poseidon.CLI.Trident.Modify ( - runModify, ModifyOptions (..), PackageVersionUpdate (..), ChecksumsToModify (..) + runModify, ModifyOptions (..), PackageVersionUpdate (..), ChecksumsToModify (..), + updateChecksums, addContributors, completeAndWritePackage ) where import Poseidon.Core.Contributor (ContributorSpec (..)) diff --git a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs index c2bd60da..93bb89f1 100644 --- a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs +++ b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs @@ -8,7 +8,7 @@ import Poseidon.CLI.Trident.Jannocoalesce (CoalesceJannoColumnSpec (.. JannoSourceSpec (..)) import Poseidon.CLI.Trident.List (ListEntity (..), RepoLocationSpec (..)) -import Poseidon.CLI.Trident.Rectify (ChecksumsToModify (..), +import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), PackageVersionUpdate (..)) import Poseidon.CLI.Trident.Serve (ArchiveConfig (..), ArchiveSpec (..)) diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index fdac3464..32680d52 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Poseidon.CLI.Trident.Rectify ( - runRectify, RectifyOptions (..), PackageVersionUpdate (..), ChecksumsToModify (..) + runRectify, RectifyOptions (..) ) where import Poseidon.Core.Contributor (ContributorSpec (..)) @@ -22,10 +22,10 @@ import Poseidon.Core.Utils (PoseidonIO, getChecksum, logDebug, logInfo, logWarning) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) -import Poseidon.CLI.Trident.Modify (PackageVersionUpdate (..), ChecksumsToModify (..)) +import Poseidon.CLI.Trident.Modify (PackageVersionUpdate (..), ChecksumsToModify (..), updateChecksums, addContributors, completeAndWritePackage) import Control.DeepSeq ((<$!!>)) -import Control.Monad (when) +import Control.Monad (when, filterM) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.List (nub) import Data.Maybe (fromJust) @@ -38,170 +38,35 @@ import System.FilePath (()) data RectifyOptions = RectifyOptions { _rectifyBaseDirs :: [FilePath] , _rectifyIgnorePoseidonVersion :: Bool - , _rectifyPoseidonVersion :: Maybe Version , _rectifyPackageVersionUpdate :: Maybe PackageVersionUpdate - , _rectifyChecksums :: ChecksumsToModify , _rectifyNewContributors :: Maybe [ContributorSpec] - , _rectifyJannoRemoveEmptyCols :: Bool - , _rectifyOnlyLatest :: Bool } runRectify :: RectifyOptions -> PoseidonIO () -runRectify (RectifyOptions - baseDirs - ignorePosVer newPosVer pacVerUpdate checksumUpdate newContributors - jannoRemoveEmptyCols - onlyLatest - ) = do +runRectify (RectifyOptions baseDirs ignorePosVer pacVerUpdate newContributors) = do let pacReadOpts = defaultPackageReadOptions { _readOptIgnoreChecksums = True , _readOptIgnoreGeno = True , _readOptGenoCheck = False - , _readOptOnlyLatest = onlyLatest + , _readOptOnlyLatest = False + , _readOptIgnorePosVersion = ignorePosVer } - allPackages <- readPoseidonPackageCollection - pacReadOpts {_readOptIgnorePosVersion = ignorePosVer} - baseDirs - logInfo "Starting per-package update procedure" - mapM_ rectifyOnePackage allPackages + allPackages <- readPoseidonPackageCollection pacReadOpts baseDirs + logInfo "Find packages that need rectification" + toRectifyPackages <- filterM needsRectification allPackages + case toRectifyPackages of + [] -> do + logInfo "Nothing to rectify" + xs -> do + logInfo "Starting per-package update procedure" + mapM_ rectifyOnePackage xs logInfo "Done" where rectifyOnePackage :: PoseidonPackage -> PoseidonIO () rectifyOnePackage inPac = do logInfo $ "Rectifying package: " ++ renderNameWithVersion inPac - when jannoRemoveEmptyCols $ do - case posPacJannoFile inPac of - Nothing -> do - logWarning "No .janno file to modify with --jannoRemoveEmpty" - Just jannoPath -> do - logInfo "Reordering and removing empty columns from .janno file" - liftIO $ writeJannoFileWithoutEmptyCols - (posPacBaseDir inPac jannoPath) - (makeJannoHeader (posPacJanno inPac)) - (posPacJanno inPac) - updatedPacPosVer <- updatePoseidonVersion newPosVer inPac - updatedPacContri <- addContributors newContributors updatedPacPosVer - updatedPacChecksums <- updateChecksums checksumUpdate updatedPacContri - completeAndWritePackage pacVerUpdate updatedPacChecksums + updatedPackage <- updateChecksums ChecksumAll inPac >>= addContributors newContributors + completeAndWritePackage pacVerUpdate updatedPackage -updatePoseidonVersion :: Maybe Version -> PoseidonPackage -> PoseidonIO PoseidonPackage -updatePoseidonVersion Nothing pac = return pac -updatePoseidonVersion (Just ver) pac = do - logDebug "Updating Poseidon version" - return pac { posPacPoseidonVersion = PoseidonVersion ver } - -addContributors :: Maybe [ContributorSpec] -> PoseidonPackage -> PoseidonIO PoseidonPackage -addContributors Nothing pac = return pac -addContributors (Just cs) pac = do - logDebug "Updating list of contributors" - return pac { posPacContributor = nub (posPacContributor pac ++ cs) } - -updateChecksums :: ChecksumsToModify -> PoseidonPackage -> PoseidonIO PoseidonPackage -updateChecksums checksumSetting pac = do - case checksumSetting of - ChecksumNone -> logDebug "Update no checksums" >> return pac - ChecksumAll -> update True True True True - ChecksumsDetail g j s b -> update g j s b - where - update :: Bool -> Bool -> Bool -> Bool -> PoseidonIO PoseidonPackage - update g j s b = do - let d = posPacBaseDir pac - let gFileSpec = genotypeFileSpec . posPacGenotypeData $ pac - newGenotypeFileSpec <- - if g - then do - logDebug "Updating genotype data checksums" - case gFileSpec of - GenotypeEigenstrat gf gfc sf sfc if_ ifc -> do - [genoChkSum, snpChkSum, indChkSum] <- - sequence [testAndGetChecksum (d f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] - return $ GenotypeEigenstrat gf genoChkSum sf snpChkSum if_ indChkSum - GenotypePlink gf gfc sf sfc if_ ifc -> do - [genoChkSum, snpChkSum, indChkSum] <- - sequence [testAndGetChecksum (d f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] - return $ GenotypePlink gf genoChkSum sf snpChkSum if_ indChkSum - GenotypeVCF gf gfc -> do - genoChkSum <- testAndGetChecksum (d gf) gfc - return $ GenotypeVCF gf genoChkSum - else return gFileSpec - newJannoChkSum <- - if j - then do - logDebug "Updating .janno file checksums" - case posPacJannoFile pac of - Nothing -> return $ posPacJannoFileChkSum pac - Just fn -> Just <$!!> getChk (d fn) - else return $ posPacJannoFileChkSum pac - newSeqSourceChkSum <- - if s - then do - logDebug "Updating .ssf file checksums" - case posPacSeqSourceFile pac of - Nothing -> return $ posPacSeqSourceFileChkSum pac - Just fn -> Just <$!!> getChk (d fn) - else return $ posPacSeqSourceFileChkSum pac - newBibChkSum <- - if b - then do - logDebug "Updating .bib file checksums" - case posPacBibFile pac of - Nothing -> return $ posPacBibFileChkSum pac - Just fn -> Just <$!!> getChk (d fn) - else return $ posPacBibFileChkSum pac - let gd = posPacGenotypeData pac - return $ pac { - posPacGenotypeData = gd {genotypeFileSpec = newGenotypeFileSpec}, - posPacJannoFileChkSum = newJannoChkSum, - posPacSeqSourceFileChkSum = newSeqSourceChkSum, - posPacBibFileChkSum = newBibChkSum - } - getChk :: (MonadIO m) => FilePath -> m String - getChk = liftIO . getChecksum - testAndGetChecksum :: (MonadIO m) => FilePath -> Maybe String -> m (Maybe String) - testAndGetChecksum file defaultChkSum = do - e <- liftIO . doesFileExist $ file - if e then Just <$!!> getChk file else return defaultChkSum - - -completeAndWritePackage :: Maybe PackageVersionUpdate -> PoseidonPackage -> PoseidonIO () -completeAndWritePackage Nothing pac = do - logDebug "Writing rectified POSEIDON.yml file" - liftIO $ writePoseidonPackage pac -completeAndWritePackage (Just (PackageVersionUpdate component logText)) pac = do - updatedPacPacVer <- updatePackageVersion component pac - updatePacChangeLog <- writeOrUpdateChangelogFile logText updatedPacPacVer - logDebug "Writing rectified POSEIDON.yml file" - liftIO $ writePoseidonPackage updatePacChangeLog - -updatePackageVersion :: VersionComponent -> PoseidonPackage -> PoseidonIO PoseidonPackage -updatePackageVersion component pac = do - logDebug "Updating package version" - (UTCTime today _) <- liftIO getCurrentTime - let pacNameAndVer = posPacNameAndVersion pac - let outPac = pac { - posPacNameAndVersion = pacNameAndVer {panavVersion = maybe (Just $ makeVersion [0, 1, 0]) - (Just . updateThreeComponentVersion component) - (getPacVersion pac) - } - , posPacLastModified = Just today - } - return outPac - -writeOrUpdateChangelogFile :: Maybe String -> PoseidonPackage -> PoseidonIO PoseidonPackage -writeOrUpdateChangelogFile Nothing pac = return pac -writeOrUpdateChangelogFile (Just logText) pac = do - case posPacChangelogFile pac of - Nothing -> do - logDebug "Creating CHANGELOG.md" - liftIO $ writeFile (posPacBaseDir pac "CHANGELOG.md") $ - "- V " ++ showVersion (fromJust $ getPacVersion pac) ++ ": " ++ - logText ++ "\n" - return pac { posPacChangelogFile = Just "CHANGELOG.md" } - Just x -> do - logDebug "Updating CHANGELOG.md" - changelogFile <- liftIO $ readFile (posPacBaseDir pac x) - liftIO $ removeFile (posPacBaseDir pac x) - liftIO $ writeFile (posPacBaseDir pac x) $ - "- V " ++ showVersion (fromJust $ getPacVersion pac) ++ ": " - ++ logText ++ "\n" ++ changelogFile - return pac +needsRectification :: PoseidonPackage -> PoseidonIO Bool +needsRectification = undefined From e7e2c92551e693abc2cb3d1c0d7c2b679f56b6b0 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 17:57:08 +0200 Subject: [PATCH 03/20] code to check if a package needs rectification --- src/Poseidon/CLI/Trident/Modify.hs | 4 +--- src/Poseidon/CLI/Trident/Rectify.hs | 36 +++++++++++++++++++++++++++-- src/Poseidon/Core/Utils.hs | 4 +++- 3 files changed, 38 insertions(+), 6 deletions(-) diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index 45dcce12..6a57c89e 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -20,7 +20,7 @@ import Poseidon.Core.Package (PackageReadOptions (..), writePoseidonPackage) import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) import Poseidon.Core.Utils (PoseidonIO, getChecksum, - logDebug, logInfo, logWarning) + logDebug, logInfo, logWarning, getChk) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) @@ -170,8 +170,6 @@ updateChecksums checksumSetting pac = do posPacSeqSourceFileChkSum = newSeqSourceChkSum, posPacBibFileChkSum = newBibChkSum } - getChk :: (MonadIO m) => FilePath -> m String - getChk = liftIO . getChecksum testAndGetChecksum :: (MonadIO m) => FilePath -> Maybe String -> m (Maybe String) testAndGetChecksum file defaultChkSum = do e <- liftIO . doesFileExist $ file diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index 32680d52..2dc67cfd 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -19,7 +19,7 @@ import Poseidon.Core.Package (PackageReadOptions (..), writePoseidonPackage) import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) import Poseidon.Core.Utils (PoseidonIO, getChecksum, - logDebug, logInfo, logWarning) + logDebug, logInfo, logWarning, getChk) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) import Poseidon.CLI.Trident.Modify (PackageVersionUpdate (..), ChecksumsToModify (..), updateChecksums, addContributors, completeAndWritePackage) @@ -69,4 +69,36 @@ runRectify (RectifyOptions baseDirs ignorePosVer pacVerUpdate newContributors) = completeAndWritePackage pacVerUpdate updatedPackage needsRectification :: PoseidonPackage -> PoseidonIO Bool -needsRectification = undefined +needsRectification pac = do + let d = posPacBaseDir pac + let gFileSpec = genotypeFileSpec . posPacGenotypeData $ pac + chkGeno <- do + logDebug "Checking genotype data checksums" + case gFileSpec of + GenotypeEigenstrat gf gfc sf sfc if_ ifc -> do + and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + GenotypePlink gf gfc sf sfc if_ ifc -> do + and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + GenotypeVCF gf gfc -> do + checkChecksum d (Just gf) gfc + chkJanno <- do + logDebug "Checking .janno file checksum" + checkChecksum d (posPacJannoFile pac) (posPacJannoFileChkSum pac) + chkSeqSource <- do + logDebug "Updating .ssf file checksums" + checkChecksum d (posPacSeqSourceFile pac) (posPacSeqSourceFileChkSum pac) + chkBib <- do + logDebug "Updating .bib file checksums" + checkChecksum d (posPacBibFile pac) (posPacBibFileChkSum pac) + return $ and [chkGeno, chkJanno, chkSeqSource, chkBib] + +checkChecksum :: (MonadIO m) => FilePath -> Maybe FilePath -> Maybe String -> m Bool +checkChecksum _ Nothing _ = return True +checkChecksum _ _ Nothing = return True +checkChecksum baseDir (Just file) (Just expectedCheckSum) = do + exists <- liftIO . doesFileExist $ baseDir file + if exists + then do + realChecksum <- getChk $ baseDir file + return $ realChecksum == expectedCheckSum + else return True diff --git a/src/Poseidon/Core/Utils.hs b/src/Poseidon/Core/Utils.hs index 81e0e1d5..46a1c5fb 100644 --- a/src/Poseidon/Core/Utils.hs +++ b/src/Poseidon/Core/Utils.hs @@ -14,7 +14,7 @@ module Poseidon.Core.Utils ( checkFile, checkLineEnding, checkLineEndingIfNotZipped, - getChecksum, + getChecksum, getChk, logWarning, logInfo, logDebug, @@ -297,6 +297,8 @@ checkFile fn maybeChkSum = do when (fnChkSum /= chkSum) $ throwM (PoseidonFileChecksumException fn) -- helper functions to get the checksum of a file +getChk :: (MonadIO m) => FilePath -> m String +getChk = liftIO . getChecksum getChecksum :: FilePath -> IO String getChecksum f = do fileContent <- LB.readFile f From ec8d1fcd3131ddb86dfc8fe1e99991999485e08d Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 18:02:36 +0200 Subject: [PATCH 04/20] some more minor simplification --- src-executables/Main-trident.hs | 1 - src/Poseidon/CLI/Trident/Rectify.hs | 14 +++++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src-executables/Main-trident.hs b/src-executables/Main-trident.hs index 905df832..c10a19d8 100644 --- a/src-executables/Main-trident.hs +++ b/src-executables/Main-trident.hs @@ -250,7 +250,6 @@ surveyOptParser = SurveyOptions <$> parseBasePaths rectifyOptParser :: OP.Parser RectifyOptions rectifyOptParser = RectifyOptions <$> parseBasePaths - <*> parseIgnorePoseidonVersion <*> parseMaybePackageVersionUpdate <*> parseMaybeContributors diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index 2dc67cfd..d447c032 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -37,19 +37,18 @@ import System.FilePath (()) data RectifyOptions = RectifyOptions { _rectifyBaseDirs :: [FilePath] - , _rectifyIgnorePoseidonVersion :: Bool , _rectifyPackageVersionUpdate :: Maybe PackageVersionUpdate , _rectifyNewContributors :: Maybe [ContributorSpec] } runRectify :: RectifyOptions -> PoseidonIO () -runRectify (RectifyOptions baseDirs ignorePosVer pacVerUpdate newContributors) = do +runRectify (RectifyOptions baseDirs pacVerUpdate newContributors) = do let pacReadOpts = defaultPackageReadOptions { _readOptIgnoreChecksums = True , _readOptIgnoreGeno = True , _readOptGenoCheck = False , _readOptOnlyLatest = False - , _readOptIgnorePosVersion = ignorePosVer + , _readOptIgnorePosVersion = True } allPackages <- readPoseidonPackageCollection pacReadOpts baseDirs logInfo "Find packages that need rectification" @@ -85,10 +84,10 @@ needsRectification pac = do logDebug "Checking .janno file checksum" checkChecksum d (posPacJannoFile pac) (posPacJannoFileChkSum pac) chkSeqSource <- do - logDebug "Updating .ssf file checksums" + logDebug "Checking .ssf file checksum" checkChecksum d (posPacSeqSourceFile pac) (posPacSeqSourceFileChkSum pac) chkBib <- do - logDebug "Updating .bib file checksums" + logDebug "Checking .bib file checksum" checkChecksum d (posPacBibFile pac) (posPacBibFileChkSum pac) return $ and [chkGeno, chkJanno, chkSeqSource, chkBib] @@ -96,9 +95,10 @@ checkChecksum :: (MonadIO m) => FilePath -> Maybe FilePath -> Maybe String -> m checkChecksum _ Nothing _ = return True checkChecksum _ _ Nothing = return True checkChecksum baseDir (Just file) (Just expectedCheckSum) = do - exists <- liftIO . doesFileExist $ baseDir file + let f = baseDir file + exists <- liftIO . doesFileExist $ f if exists then do - realChecksum <- getChk $ baseDir file + realChecksum <- getChk f return $ realChecksum == expectedCheckSum else return True From 1820865723dea4e33674e636e26a9a7cf4cf819a Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 22:01:23 +0200 Subject: [PATCH 05/20] faster md5 algorithm? --- poseidon-hs.cabal | 2 +- src/Poseidon/Core/Utils.hs | 12 +++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/poseidon-hs.cabal b/poseidon-hs.cabal index 975c2faf..394a1230 100644 --- a/poseidon-hs.cabal +++ b/poseidon-hs.cabal @@ -40,7 +40,7 @@ library build-depends: base >= 4.7 && < 5, sequence-formats>=1.6.1, text, time, pipes-safe, foldl, exceptions, pipes, bytestring, filepath, yaml, aeson, directory, parsec, vector, pipes-ordered-zip, table-layout<1.0.0.0, mtl, split, warp, warp-tls, wai-cors, - scotty, cassava, pureMD5, wai, githash, attoparsec, pipes-group, + scotty, cassava, cryptohash-md5, base16-bytestring, wai, githash, attoparsec, pipes-group, http-conduit, conduit, http-types, zip-stream, resourcet, MonadRandom, lens-family, unordered-containers, network-uri, optparse-applicative, co-log, regex-tdfa, scientific, country, generics-sop, containers, process, deepseq, template-haskell, diff --git a/src/Poseidon/Core/Utils.hs b/src/Poseidon/Core/Utils.hs index 46a1c5fb..ab13a51a 100644 --- a/src/Poseidon/Core/Utils.hs +++ b/src/Poseidon/Core/Utils.hs @@ -45,8 +45,10 @@ import Control.Monad.Catch (throwM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Reader (ReaderT, asks, runReaderT) import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LB -import Data.Digest.Pure.MD5 (md5) +import qualified Data.ByteString.Lazy as BL +import Crypto.Hash.MD5 as MD5 +import Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Char8 as B8 import Data.List (isSuffixOf) import qualified Data.Set as Set import Data.Text (Text, pack) @@ -301,9 +303,9 @@ getChk :: (MonadIO m) => FilePath -> m String getChk = liftIO . getChecksum getChecksum :: FilePath -> IO String getChecksum f = do - fileContent <- LB.readFile f - let md5Digest = md5 fileContent - return $ show md5Digest + fileContent <- BL.readFile f + let md5Digest = B16.encode $ MD5.hashlazy fileContent + return $ B8.unpack md5Digest -- helper function to check line endings of text files -- only considers the first line: From 3af5327f73e6438ab3307bc42fab1fe8ec811891 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 22:42:08 +0200 Subject: [PATCH 06/20] shortened rectify code --- src/Poseidon/CLI/Trident/Modify.hs | 5 ++-- src/Poseidon/CLI/Trident/Rectify.hs | 46 +++++++++++------------------ 2 files changed, 20 insertions(+), 31 deletions(-) diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index 6a57c89e..f420dd2b 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -77,7 +77,6 @@ runModify (ModifyOptions allPackages <- readPoseidonPackageCollection pacReadOpts {_readOptIgnorePosVersion = ignorePosVer} baseDirs - logInfo "Starting per-package update procedure" mapM_ modifyOnePackage allPackages logInfo "Done" where @@ -178,12 +177,12 @@ updateChecksums checksumSetting pac = do completeAndWritePackage :: Maybe PackageVersionUpdate -> PoseidonPackage -> PoseidonIO () completeAndWritePackage Nothing pac = do - logDebug "Writing rectified POSEIDON.yml file" + logDebug "Writing modified POSEIDON.yml file" liftIO $ writePoseidonPackage pac completeAndWritePackage (Just (PackageVersionUpdate component logText)) pac = do updatedPacPacVer <- updatePackageVersion component pac updatePacChangeLog <- writeOrUpdateChangelogFile logText updatedPacPacVer - logDebug "Writing rectified POSEIDON.yml file" + logDebug "Writing modified POSEIDON.yml file" liftIO $ writePoseidonPackage updatePacChangeLog updatePackageVersion :: VersionComponent -> PoseidonPackage -> PoseidonIO PoseidonPackage diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index d447c032..42290c28 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -51,45 +51,35 @@ runRectify (RectifyOptions baseDirs pacVerUpdate newContributors) = do , _readOptIgnorePosVersion = True } allPackages <- readPoseidonPackageCollection pacReadOpts baseDirs - logInfo "Find packages that need rectification" + logInfo "Searching packages that need rectification" toRectifyPackages <- filterM needsRectification allPackages case toRectifyPackages of - [] -> do - logInfo "Nothing to rectify" - xs -> do - logInfo "Starting per-package update procedure" - mapM_ rectifyOnePackage xs + [] -> logInfo "Nothing to rectify" + xs -> mapM_ rectifyOnePackage xs logInfo "Done" where rectifyOnePackage :: PoseidonPackage -> PoseidonIO () rectifyOnePackage inPac = do logInfo $ "Rectifying package: " ++ renderNameWithVersion inPac - updatedPackage <- updateChecksums ChecksumAll inPac >>= addContributors newContributors - completeAndWritePackage pacVerUpdate updatedPackage + pure inPac >>= + updateChecksums ChecksumAll >>= + addContributors newContributors >>= + completeAndWritePackage pacVerUpdate needsRectification :: PoseidonPackage -> PoseidonIO Bool needsRectification pac = do let d = posPacBaseDir pac - let gFileSpec = genotypeFileSpec . posPacGenotypeData $ pac - chkGeno <- do - logDebug "Checking genotype data checksums" - case gFileSpec of - GenotypeEigenstrat gf gfc sf sfc if_ ifc -> do - and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] - GenotypePlink gf gfc sf sfc if_ ifc -> do - and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] - GenotypeVCF gf gfc -> do - checkChecksum d (Just gf) gfc - chkJanno <- do - logDebug "Checking .janno file checksum" - checkChecksum d (posPacJannoFile pac) (posPacJannoFileChkSum pac) - chkSeqSource <- do - logDebug "Checking .ssf file checksum" - checkChecksum d (posPacSeqSourceFile pac) (posPacSeqSourceFileChkSum pac) - chkBib <- do - logDebug "Checking .bib file checksum" - checkChecksum d (posPacBibFile pac) (posPacBibFileChkSum pac) - return $ and [chkGeno, chkJanno, chkSeqSource, chkBib] + gFileSpec = genotypeFileSpec . posPacGenotypeData $ pac + chkGeno <- case gFileSpec of + GenotypeEigenstrat gf gfc sf sfc if_ ifc -> + and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + GenotypePlink gf gfc sf sfc if_ ifc -> + and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + GenotypeVCF gf gfc -> checkChecksum d (Just gf) gfc + chkJanno <- checkChecksum d (posPacJannoFile pac) (posPacJannoFileChkSum pac) + chkSeqSo <- checkChecksum d (posPacSeqSourceFile pac) (posPacSeqSourceFileChkSum pac) + chkBib <- checkChecksum d (posPacBibFile pac) (posPacBibFileChkSum pac) + return $ and [chkGeno, chkJanno, chkSeqSo, chkBib] checkChecksum :: (MonadIO m) => FilePath -> Maybe FilePath -> Maybe String -> m Bool checkChecksum _ Nothing _ = return True From e389d3998b921c5587de28b87b247ac6499300f4 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 22:43:40 +0200 Subject: [PATCH 07/20] stylish haskell --- src-executables/Main-trident.hs | 4 ++-- src/Poseidon/CLI/Trident/Modify.hs | 4 ++-- .../CLI/Trident/OptparseApplicativeParsers.hs | 2 +- src/Poseidon/CLI/Trident/Rectify.hs | 18 +++++++++++------- src/Poseidon/Core/Utils.hs | 6 +++--- .../GoldenTestsRunCommands.hs | 4 ++-- 6 files changed, 21 insertions(+), 17 deletions(-) diff --git a/src-executables/Main-trident.hs b/src-executables/Main-trident.hs index c10a19d8..7ace23da 100644 --- a/src-executables/Main-trident.hs +++ b/src-executables/Main-trident.hs @@ -15,11 +15,11 @@ import Poseidon.CLI.Trident.Jannocoalesce (JannoCoalesceO runJannocoalesce) import Poseidon.CLI.Trident.List (ListOptions (..), runList) +import Poseidon.CLI.Trident.Modify (ModifyOptions (..), + runModify) import Poseidon.CLI.Trident.OptparseApplicativeParsers import Poseidon.CLI.Trident.Rectify (RectifyOptions (..), runRectify) -import Poseidon.CLI.Trident.Modify (ModifyOptions (..), - runModify) import Poseidon.CLI.Trident.Serve (ServeOptions (..), runServerMainThread) import Poseidon.CLI.Trident.Summarise (SummariseOptions (..), diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index f420dd2b..3c6ad3fb 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -19,8 +19,8 @@ import Poseidon.Core.Package (PackageReadOptions (..), readPoseidonPackageCollection, writePoseidonPackage) import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) -import Poseidon.Core.Utils (PoseidonIO, getChecksum, - logDebug, logInfo, logWarning, getChk) +import Poseidon.Core.Utils (PoseidonIO, getChecksum, getChk, + logDebug, logInfo, logWarning) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) diff --git a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs index 93bb89f1..ad63eb98 100644 --- a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs +++ b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs @@ -8,7 +8,7 @@ import Poseidon.CLI.Trident.Jannocoalesce (CoalesceJannoColumnSpec (.. JannoSourceSpec (..)) import Poseidon.CLI.Trident.List (ListEntity (..), RepoLocationSpec (..)) -import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), +import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), PackageVersionUpdate (..)) import Poseidon.CLI.Trident.Serve (ArchiveConfig (..), ArchiveSpec (..)) diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index 42290c28..d3653702 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -4,6 +4,11 @@ module Poseidon.CLI.Trident.Rectify ( runRectify, RectifyOptions (..) ) where +import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), + PackageVersionUpdate (..), + addContributors, + completeAndWritePackage, + updateChecksums) import Poseidon.Core.Contributor (ContributorSpec (..)) import Poseidon.Core.EntityTypes (HasNameAndVersion (..), PacNameAndVersion (..), @@ -18,14 +23,13 @@ import Poseidon.Core.Package (PackageReadOptions (..), readPoseidonPackageCollection, writePoseidonPackage) import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) -import Poseidon.Core.Utils (PoseidonIO, getChecksum, - logDebug, logInfo, logWarning, getChk) +import Poseidon.Core.Utils (PoseidonIO, getChecksum, getChk, + logDebug, logInfo, logWarning) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) -import Poseidon.CLI.Trident.Modify (PackageVersionUpdate (..), ChecksumsToModify (..), updateChecksums, addContributors, completeAndWritePackage) import Control.DeepSeq ((<$!!>)) -import Control.Monad (when, filterM) +import Control.Monad (filterM, when) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.List (nub) import Data.Maybe (fromJust) @@ -36,9 +40,9 @@ import System.Directory (doesFileExist, removeFile) import System.FilePath (()) data RectifyOptions = RectifyOptions - { _rectifyBaseDirs :: [FilePath] - , _rectifyPackageVersionUpdate :: Maybe PackageVersionUpdate - , _rectifyNewContributors :: Maybe [ContributorSpec] + { _rectifyBaseDirs :: [FilePath] + , _rectifyPackageVersionUpdate :: Maybe PackageVersionUpdate + , _rectifyNewContributors :: Maybe [ContributorSpec] } runRectify :: RectifyOptions -> PoseidonIO () diff --git a/src/Poseidon/Core/Utils.hs b/src/Poseidon/Core/Utils.hs index ab13a51a..a0ac5005 100644 --- a/src/Poseidon/Core/Utils.hs +++ b/src/Poseidon/Core/Utils.hs @@ -44,11 +44,11 @@ import Control.Monad (unless, when) import Control.Monad.Catch (throwM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Reader (ReaderT, asks, runReaderT) +import Crypto.Hash.MD5 as MD5 import qualified Data.ByteString as BS +import Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL -import Crypto.Hash.MD5 as MD5 -import Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Char8 as B8 import Data.List (isSuffixOf) import qualified Data.Set as Set import Data.Text (Text, pack) diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index ace2135a..e977e575 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -20,9 +20,9 @@ import Poseidon.CLI.Trident.List (ListEntity (..), ListOptions (..), RepoLocationSpec (..), runList) -import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), - PackageVersionUpdate (..), +import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), ModifyOptions (..), + PackageVersionUpdate (..), runModify) import Poseidon.CLI.Trident.Serve (ArchiveConfig (..), ArchiveSpec (..), From 2ae9b24c097257c024bea9ebbef9cffc7ce06fae Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Wed, 2 Sep 2026 22:49:19 +0200 Subject: [PATCH 08/20] removed unnecessary imports --- src/Poseidon/CLI/Trident/Modify.hs | 4 +-- src/Poseidon/CLI/Trident/Rectify.hs | 51 ++++++++++------------------- 2 files changed, 20 insertions(+), 35 deletions(-) diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index 3c6ad3fb..517102a6 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -19,8 +19,8 @@ import Poseidon.Core.Package (PackageReadOptions (..), readPoseidonPackageCollection, writePoseidonPackage) import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) -import Poseidon.Core.Utils (PoseidonIO, getChecksum, getChk, - logDebug, logInfo, logWarning) +import Poseidon.Core.Utils (PoseidonIO, getChk, logDebug, + logInfo, logWarning) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index d3653702..9669f41d 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -4,40 +4,25 @@ module Poseidon.CLI.Trident.Rectify ( runRectify, RectifyOptions (..) ) where -import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), - PackageVersionUpdate (..), - addContributors, - completeAndWritePackage, - updateChecksums) -import Poseidon.Core.Contributor (ContributorSpec (..)) -import Poseidon.Core.EntityTypes (HasNameAndVersion (..), - PacNameAndVersion (..), - renderNameWithVersion) -import Poseidon.Core.GenotypeData (GenotypeDataSpec (..), - GenotypeFileSpec (..)) -import Poseidon.Core.Janno (makeJannoHeader, - writeJannoFileWithoutEmptyCols) -import Poseidon.Core.Package (PackageReadOptions (..), - PoseidonPackage (..), - defaultPackageReadOptions, - readPoseidonPackageCollection, - writePoseidonPackage) -import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) -import Poseidon.Core.Utils (PoseidonIO, getChecksum, getChk, - logDebug, logInfo, logWarning) -import Poseidon.Core.Version (VersionComponent (..), - updateThreeComponentVersion) +import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), + PackageVersionUpdate (..), + addContributors, + completeAndWritePackage, + updateChecksums) +import Poseidon.Core.Contributor (ContributorSpec (..)) +import Poseidon.Core.EntityTypes (renderNameWithVersion) +import Poseidon.Core.GenotypeData (GenotypeDataSpec (..), + GenotypeFileSpec (..)) +import Poseidon.Core.Package (PackageReadOptions (..), + PoseidonPackage (..), + defaultPackageReadOptions, + readPoseidonPackageCollection) +import Poseidon.Core.Utils (PoseidonIO, getChk, logInfo) -import Control.DeepSeq ((<$!!>)) -import Control.Monad (filterM, when) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.List (nub) -import Data.Maybe (fromJust) -import Data.Time (UTCTime (..), getCurrentTime) -import Data.Version (Version (..), makeVersion, - showVersion) -import System.Directory (doesFileExist, removeFile) -import System.FilePath (()) +import Control.Monad (filterM) +import Control.Monad.IO.Class (MonadIO, liftIO) +import System.Directory (doesFileExist) +import System.FilePath (()) data RectifyOptions = RectifyOptions { _rectifyBaseDirs :: [FilePath] From 2022564cf4a0056afcf379f2db8a9ab27dd2f844 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Thu, 3 Sep 2026 10:14:44 +0200 Subject: [PATCH 09/20] fixed rectify search logic and an issue with too many opened file handles caused by the new getChecksum --- src/Poseidon/CLI/Trident/Rectify.hs | 24 ++++++++++++------------ src/Poseidon/Core/Utils.hs | 11 ++++++----- 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index 9669f41d..67d89a11 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -59,21 +59,21 @@ needsRectification :: PoseidonPackage -> PoseidonIO Bool needsRectification pac = do let d = posPacBaseDir pac gFileSpec = genotypeFileSpec . posPacGenotypeData $ pac - chkGeno <- case gFileSpec of + goodGeno <- case gFileSpec of GenotypeEigenstrat gf gfc sf sfc if_ ifc -> - and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + and <$> sequence [goodChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] GenotypePlink gf gfc sf sfc if_ ifc -> - and <$> sequence [checkChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] - GenotypeVCF gf gfc -> checkChecksum d (Just gf) gfc - chkJanno <- checkChecksum d (posPacJannoFile pac) (posPacJannoFileChkSum pac) - chkSeqSo <- checkChecksum d (posPacSeqSourceFile pac) (posPacSeqSourceFileChkSum pac) - chkBib <- checkChecksum d (posPacBibFile pac) (posPacBibFileChkSum pac) - return $ and [chkGeno, chkJanno, chkSeqSo, chkBib] + and <$> sequence [goodChecksum d (Just f) c | (f, c) <- zip [gf, sf, if_] [gfc, sfc, ifc]] + GenotypeVCF gf gfc -> goodChecksum d (Just gf) gfc + goodJanno <- goodChecksum d (posPacJannoFile pac) (posPacJannoFileChkSum pac) + goodSeqSo <- goodChecksum d (posPacSeqSourceFile pac) (posPacSeqSourceFileChkSum pac) + goodBib <- goodChecksum d (posPacBibFile pac) (posPacBibFileChkSum pac) + return $ not $ and [goodGeno, goodJanno, goodSeqSo, goodBib] -checkChecksum :: (MonadIO m) => FilePath -> Maybe FilePath -> Maybe String -> m Bool -checkChecksum _ Nothing _ = return True -checkChecksum _ _ Nothing = return True -checkChecksum baseDir (Just file) (Just expectedCheckSum) = do +goodChecksum :: (MonadIO m) => FilePath -> Maybe FilePath -> Maybe String -> m Bool +goodChecksum _ Nothing _ = return True +goodChecksum _ _ Nothing = return True +goodChecksum baseDir (Just file) (Just expectedCheckSum) = do let f = baseDir file exists <- liftIO . doesFileExist $ f if exists diff --git a/src/Poseidon/Core/Utils.hs b/src/Poseidon/Core/Utils.hs index a0ac5005..74f45823 100644 --- a/src/Poseidon/Core/Utils.hs +++ b/src/Poseidon/Core/Utils.hs @@ -38,7 +38,7 @@ import Colog (HasLog (..), LogAction (..), Message, Msg (..), Severity (..), cfilter, cmapM, logTextStderr, msgSeverity, msgText, showSeverity) -import Control.Exception (Exception (..), throwIO) +import Control.Exception (Exception (..), throwIO, evaluate) import Control.Exception.Base (SomeException) import Control.Monad (unless, when) import Control.Monad.Catch (throwM) @@ -302,10 +302,11 @@ checkFile fn maybeChkSum = do getChk :: (MonadIO m) => FilePath -> m String getChk = liftIO . getChecksum getChecksum :: FilePath -> IO String -getChecksum f = do - fileContent <- BL.readFile f - let md5Digest = B16.encode $ MD5.hashlazy fileContent - return $ B8.unpack md5Digest +getChecksum f = + withBinaryFile f ReadMode $ \h -> do + contents <- BL.hGetContents h + digest <- evaluate (MD5.hashlazy contents) + pure $ B8.unpack $ B16.encode digest -- helper function to check line endings of text files -- only considers the first line: From 2a25aa6f848c592d0f2f32dd3e6ad6d77b6df493 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Thu, 3 Sep 2026 10:29:53 +0200 Subject: [PATCH 10/20] more informative command line messages --- src/Poseidon/CLI/Trident/Rectify.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index 67d89a11..95e99153 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -43,14 +43,16 @@ runRectify (RectifyOptions baseDirs pacVerUpdate newContributors) = do logInfo "Searching packages that need rectification" toRectifyPackages <- filterM needsRectification allPackages case toRectifyPackages of - [] -> logInfo "Nothing to rectify" - xs -> mapM_ rectifyOnePackage xs + [] -> logInfo "No packages need rectification" + xs -> do + logInfo $ show (length xs) ++ " packages need rectification" + mapM_ rectifyOnePackage xs logInfo "Done" where rectifyOnePackage :: PoseidonPackage -> PoseidonIO () - rectifyOnePackage inPac = do - logInfo $ "Rectifying package: " ++ renderNameWithVersion inPac - pure inPac >>= + rectifyOnePackage pac = do + logInfo $ "Rectifying package: " ++ renderNameWithVersion pac + pure pac >>= updateChecksums ChecksumAll >>= addContributors newContributors >>= completeAndWritePackage pacVerUpdate @@ -68,7 +70,9 @@ needsRectification pac = do goodJanno <- goodChecksum d (posPacJannoFile pac) (posPacJannoFileChkSum pac) goodSeqSo <- goodChecksum d (posPacSeqSourceFile pac) (posPacSeqSourceFileChkSum pac) goodBib <- goodChecksum d (posPacBibFile pac) (posPacBibFileChkSum pac) - return $ not $ and [goodGeno, goodJanno, goodSeqSo, goodBib] + let needsRect = not $ and [goodGeno, goodJanno, goodSeqSo, goodBib] + logInfo $ (if needsRect then "CHANGED " else "OK ") ++ renderNameWithVersion pac + return needsRect goodChecksum :: (MonadIO m) => FilePath -> Maybe FilePath -> Maybe String -> m Bool goodChecksum _ Nothing _ = return True From 378aa3a7c4d4e5c04cd49cf0bc9954a0f6c0deff Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Thu, 3 Sep 2026 10:48:30 +0200 Subject: [PATCH 11/20] stylish haskell --- src/Poseidon/Core/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Poseidon/Core/Utils.hs b/src/Poseidon/Core/Utils.hs index 74f45823..1a4a1fb3 100644 --- a/src/Poseidon/Core/Utils.hs +++ b/src/Poseidon/Core/Utils.hs @@ -38,7 +38,7 @@ import Colog (HasLog (..), LogAction (..), Message, Msg (..), Severity (..), cfilter, cmapM, logTextStderr, msgSeverity, msgText, showSeverity) -import Control.Exception (Exception (..), throwIO, evaluate) +import Control.Exception (Exception (..), evaluate, throwIO) import Control.Exception.Base (SomeException) import Control.Monad (unless, when) import Control.Monad.Catch (throwM) From 1150ea04b68d2e0e147fe9d57e21e5ab2f2b9d62 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Thu, 3 Sep 2026 11:19:15 +0200 Subject: [PATCH 12/20] version bump --- poseidon-hs.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/poseidon-hs.cabal b/poseidon-hs.cabal index 394a1230..0b4e1cc0 100644 --- a/poseidon-hs.cabal +++ b/poseidon-hs.cabal @@ -1,5 +1,5 @@ name: poseidon-hs -version: 2.2.1.0 +version: 2.3.0.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 From b43d0c835a853c33e1eed6705c12a72c5da36c85 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Sat, 5 Sep 2026 15:37:00 +0200 Subject: [PATCH 13/20] check for modify to not run on more than one package without the new option --force --- src-executables/Main-trident.hs | 1 + src/Poseidon/CLI/Trident/Modify.hs | 23 +++++++++++++++---- .../CLI/Trident/OptparseApplicativeParsers.hs | 6 ++--- .../GoldenTestsRunCommands.hs | 4 ++++ 4 files changed, 26 insertions(+), 8 deletions(-) diff --git a/src-executables/Main-trident.hs b/src-executables/Main-trident.hs index 423c4293..27fc70d6 100644 --- a/src-executables/Main-trident.hs +++ b/src-executables/Main-trident.hs @@ -263,6 +263,7 @@ modifyOptParser = ModifyOptions <$> parseBasePaths <*> parseMaybeContributors <*> parseJannoRemoveEmptyCols <*> parseOnlyLatest + <*> parseForce validateOptParser :: OP.Parser ValidateOptions validateOptParser = ValidateOptions <$> parseValidatePlan diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index 517102a6..0cc81850 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -20,7 +20,7 @@ import Poseidon.Core.Package (PackageReadOptions (..), writePoseidonPackage) import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) import Poseidon.Core.Utils (PoseidonIO, getChk, logDebug, - logInfo, logWarning) + logInfo, logWarning, logError) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) @@ -34,6 +34,7 @@ import Data.Version (Version (..), makeVersion, showVersion) import System.Directory (doesFileExist, removeFile) import System.FilePath (()) +import System.Exit (exitFailure) data ModifyOptions = ModifyOptions { _modifyBaseDirs :: [FilePath] @@ -44,6 +45,7 @@ data ModifyOptions = ModifyOptions , _modifyNewContributors :: Maybe [ContributorSpec] , _modifyJannoRemoveEmptyCols :: Bool , _modifyOnlyLatest :: Bool + , _modifyForce :: Bool } data PackageVersionUpdate = PackageVersionUpdate @@ -66,7 +68,7 @@ runModify (ModifyOptions baseDirs ignorePosVer newPosVer pacVerUpdate checksumUpdate newContributors jannoRemoveEmptyCols - onlyLatest + onlyLatest force ) = do let pacReadOpts = defaultPackageReadOptions { _readOptIgnoreChecksums = True @@ -77,8 +79,21 @@ runModify (ModifyOptions allPackages <- readPoseidonPackageCollection pacReadOpts {_readOptIgnorePosVersion = ignorePosVer} baseDirs - mapM_ modifyOnePackage allPackages - logInfo "Done" + case allPackages of + [] -> return () + [x] -> do + modifyOnePackage x + logInfo "Done" + xs -> if force + then do + mapM_ modifyOnePackage allPackages + logInfo "Done" + else do + logError $ show (length xs) ++ + " packages selected for modification.\ + \ Run modify with --force if you really want to edit\ + \ all of them." + liftIO exitFailure where modifyOnePackage :: PoseidonPackage -> PoseidonIO () modifyOnePackage inPac = do diff --git a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs index 0911333b..2f28e0f2 100644 --- a/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs +++ b/src/Poseidon/CLI/Trident/OptparseApplicativeParsers.hs @@ -278,10 +278,8 @@ parseLog = OP.strOption ( parseForce :: OP.Parser Bool parseForce = OP.switch ( OP.long "force" <> - OP.help "Normally the POSEIDON.yml files are only changed if the \ - \poseidonVersion is adjusted or any of the checksums change. \ - \With --force a package version update can be triggered even \ - \if this is not the case." + OP.help "To prevent accidental changes to many packages, modify does not run when it is applied \ + \to more than one package. --force allows to overwrite this safeguard." ) -- this will also parse an empty list, which means "forge everything". diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index 770b4349..6fd637f9 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -656,6 +656,7 @@ testPipelineModify testDir checkFilePath = do , _modifyNewContributors = Nothing , _modifyJannoRemoveEmptyCols = False , _modifyOnlyLatest = False + , _modifyForce = False } let action1 = testLog (runModify modifyOpts1) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") runAndChecksumFiles checkFilePath testDir action1 "modify" [ @@ -671,6 +672,7 @@ testPipelineModify testDir checkFilePath = do , _modifyNewContributors = Nothing , _modifyJannoRemoveEmptyCols = False , _modifyOnlyLatest = False + , _modifyForce = False } let action2 = testLog (runModify modifyOpts2) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") runAndChecksumFiles checkFilePath testDir action2 "modify" [ @@ -689,6 +691,7 @@ testPipelineModify testDir checkFilePath = do ] , _modifyJannoRemoveEmptyCols = False , _modifyOnlyLatest = False + , _modifyForce = False } let action3 = testLog (runModify modifyOpts3) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") runAndChecksumFiles checkFilePath testDir action3 "modify" [ @@ -704,6 +707,7 @@ testPipelineModify testDir checkFilePath = do , _modifyNewContributors = Nothing , _modifyJannoRemoveEmptyCols = True , _modifyOnlyLatest = False + , _modifyForce = False } let action4 = testLog (runModify modifyOpts4) >> patchLastModified testDir ("init" "Schiffels" "POSEIDON.yml") runAndChecksumFiles checkFilePath testDir action4 "modify" [ From c74819c105971b5a75913994c8475e43e4d758ba Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Sat, 5 Sep 2026 16:22:35 +0200 Subject: [PATCH 14/20] added a golden test for rectify --- .../GoldenTestCheckSumFile.txt | 6 ++- .../chronicle/Wang_2020/POSEIDON.yml | 14 +++++-- .../Wang_2020-0.1.0/POSEIDON.yml | 14 +++++-- .../rectify/Schiffels_2016/CHANGELOG.md | 2 + .../rectify/Schiffels_2016/POSEIDON.yml | 32 ++++++++++++++ .../rectify/Schiffels_2016/README.md | 1 + .../Schiffels_2016/Schiffels_2016.janno | 11 +++++ .../rectify/Schiffels_2016/ena_table.ssf | 5 +++ .../rectify/Schiffels_2016/geno.txt | 9 ++++ .../rectify/Schiffels_2016/ind.txt | 10 +++++ .../rectify/Schiffels_2016/snp.txt | 9 ++++ .../rectify/Schiffels_2016/sources.bib | 12 ++++++ .../rectify/Wang_2020/POSEIDON.yml | 23 ++++++++++ .../rectify/Wang_2020/Wang_2020.bed | 1 + .../rectify/Wang_2020/Wang_2020.bim | 7 ++++ .../rectify/Wang_2020/Wang_2020.fam | 5 +++ .../rectify/Wang_2020/Wang_2020.janno | 6 +++ .../rectify/Wang_2020/Wang_2020.ssf | 2 + .../rectify/Wang_2020/sources.bib | 11 +++++ .../timetravel/Wang_2020-0.1.0/POSEIDON.yml | 14 +++++-- .../GoldenTestsRunCommands.hs | 42 +++++++++++++++++++ .../ancient/Wang_2020/POSEIDON.yml | 14 +++++-- 22 files changed, 233 insertions(+), 17 deletions(-) create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/CHANGELOG.md create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/POSEIDON.yml create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/README.md create mode 100755 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/Schiffels_2016.janno create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ena_table.ssf create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/geno.txt create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ind.txt create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/snp.txt create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/sources.bib create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/POSEIDON.yml create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bed create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bim create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.fam create mode 100755 test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.janno create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.ssf create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/sources.bib diff --git a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt index 3550d12a..bc073cc4 100644 --- a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt +++ b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt @@ -58,6 +58,10 @@ a9fcb59cb933d8f183f3c3f6fbf2e213 genoconvert init_vcf/Schiffels_vcf/geno.fam 3c38f40efe215a047c02f4e98e0390da genoconvert genoconvert/zip_roundtrip/Schiffels_2016.bed 8538ffd971ebb12cf5ef6e338da27970 genoconvert genoconvert/zip_roundtrip/Schiffels_2016.bim a9fcb59cb933d8f183f3c3f6fbf2e213 genoconvert genoconvert/zip_roundtrip/Schiffels_2016.fam +581fac2d8df63a48cd00fe0a80cfaba8 rectify rectify/Schiffels_2016/POSEIDON.yml +ffe2b8832ad21fbd44faff1f0b9075de rectify rectify/Schiffels_2016/CHANGELOG.md +2e0fe6d764926dff57f2fa421bf295c9 rectify rectify/Schiffels_2016/sources.bib +e234a2511ce81ff2002b670c5d931b94 rectify rectify/Wang_2020/POSEIDON.yml 57c109be74d7c596bcb76aae03b2d124 modify init/Schiffels/POSEIDON.yml 4aeae97cfc44b55b2a8005425d786148 modify init/Schiffels/CHANGELOG.md 174375c685f2e1b7432172e6075f1f2f modify init/Schiffels/POSEIDON.yml @@ -154,7 +158,7 @@ ebf0b456d5e09686ee7131db06848104 timetravel timetravel/Schiffels-1.1.1/POSEIDON. ea9d00246c9064ea8f1f35d4b30acb49 fetch fetch/by_package/Schmid_2028-1.0.0/Schmid_2028.janno 70547a0bdb20d07dc8e708a1a8f055e4 fetch fetch/by_package/Schmid_2028-1.0.0/geno.txt b43da4d5734371c0648553120f812466 fetch fetch/by_package/Lamnidis_2018-1.0.0/POSEIDON.yml -32c0c39ad05a40c13828e92cd2062a46 fetch fetch/by_individual/Wang_2020-0.1.0/POSEIDON.yml +e234a2511ce81ff2002b670c5d931b94 fetch fetch/by_individual/Wang_2020-0.1.0/POSEIDON.yml 1ab24c45ef3a13e0fb34afac7a21dca8 fetch fetch/by_individual/Schmid_2028-1.0.0/POSEIDON.yml b43da4d5734371c0648553120f812466 fetch fetch/by_individual/Lamnidis_2018-1.0.0/POSEIDON.yml b43da4d5734371c0648553120f812466 fetch fetch/multi_packages_1/Lamnidis_2018-1.0.0/POSEIDON.yml diff --git a/test/PoseidonGoldenTests/GoldenTestData/chronicle/Wang_2020/POSEIDON.yml b/test/PoseidonGoldenTests/GoldenTestData/chronicle/Wang_2020/POSEIDON.yml index 1e137405..e7ff75a1 100644 --- a/test/PoseidonGoldenTests/GoldenTestData/chronicle/Wang_2020/POSEIDON.yml +++ b/test/PoseidonGoldenTests/GoldenTestData/chronicle/Wang_2020/POSEIDON.yml @@ -2,16 +2,22 @@ poseidonVersion: 2.7.1 title: Wang_2020 description: Genetic data published in Wang et al. 2020, Plink test contributor: - - name: Ke Wang - email: wang@institute.org +- name: Ke Wang + email: wang@institute.org packageVersion: 0.1.0 lastModified: 2020-05-20 -bibFile: sources.bib genotypeData: format: PLINK genoFile: Wang_2020.bed + genoFileChkSum: ae66d851301f4a761b819f97ec28fa55 snpFile: Wang_2020.bim + snpFileChkSum: f96ea12084830fb43b3a24fd867f0ba7 indFile: Wang_2020.fam + indFileChkSum: 575ea54b293e297b5f354c910fe1610d snpSet: Other jannoFile: Wang_2020.janno -sequencingSourceFile: Wang_2020.ssf \ No newline at end of file +jannoFileChkSum: d271413712cf63767fc12dc3761de2e4 +sequencingSourceFile: Wang_2020.ssf +sequencingSourceFileChkSum: 76f24988a5440fea474308f9151548a3 +bibFile: sources.bib +bibFileChkSum: 67a9340931939f6d49fefe132c6ae984 diff --git a/test/PoseidonGoldenTests/GoldenTestData/fetch/by_individual/Wang_2020-0.1.0/POSEIDON.yml b/test/PoseidonGoldenTests/GoldenTestData/fetch/by_individual/Wang_2020-0.1.0/POSEIDON.yml index 1e137405..e7ff75a1 100644 --- a/test/PoseidonGoldenTests/GoldenTestData/fetch/by_individual/Wang_2020-0.1.0/POSEIDON.yml +++ b/test/PoseidonGoldenTests/GoldenTestData/fetch/by_individual/Wang_2020-0.1.0/POSEIDON.yml @@ -2,16 +2,22 @@ poseidonVersion: 2.7.1 title: Wang_2020 description: Genetic data published in Wang et al. 2020, Plink test contributor: - - name: Ke Wang - email: wang@institute.org +- name: Ke Wang + email: wang@institute.org packageVersion: 0.1.0 lastModified: 2020-05-20 -bibFile: sources.bib genotypeData: format: PLINK genoFile: Wang_2020.bed + genoFileChkSum: ae66d851301f4a761b819f97ec28fa55 snpFile: Wang_2020.bim + snpFileChkSum: f96ea12084830fb43b3a24fd867f0ba7 indFile: Wang_2020.fam + indFileChkSum: 575ea54b293e297b5f354c910fe1610d snpSet: Other jannoFile: Wang_2020.janno -sequencingSourceFile: Wang_2020.ssf \ No newline at end of file +jannoFileChkSum: d271413712cf63767fc12dc3761de2e4 +sequencingSourceFile: Wang_2020.ssf +sequencingSourceFileChkSum: 76f24988a5440fea474308f9151548a3 +bibFile: sources.bib +bibFileChkSum: 67a9340931939f6d49fefe132c6ae984 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/CHANGELOG.md b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/CHANGELOG.md new file mode 100644 index 00000000..bbaa5b48 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/CHANGELOG.md @@ -0,0 +1,2 @@ +- V 2.0.0: rectify test +V 1.0.1: not specified diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/POSEIDON.yml b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/POSEIDON.yml new file mode 100644 index 00000000..cd64ad52 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/POSEIDON.yml @@ -0,0 +1,32 @@ +poseidonVersion: 2.7.1 +title: Schiffels_2016 +description: Genetic data published in Schiffels et al. 2016 +contributor: +- name: Stephan Schiffels + email: schiffels@institute.org +- name: Josiah Carberry + email: carberry@brown.edu + orcid: 0000-0002-1825-0097 +- name: rectify + email: rectify@example.org +packageVersion: 2.0.0 +lastModified: 1970-01-01 +genotypeData: + format: EIGENSTRAT + genoFile: geno.txt + genoFileChkSum: 0332344057c0c4dce2ff7176f8e1103d + snpFile: snp.txt + snpFileChkSum: d76e3e7a8fc0f1f5e435395424b5aeab + indFile: ind.txt + indFileChkSum: f77dc756666dbfef3bb35191ae15a167 + snpSet: Other + referenceGenomeAssembly: GRCh37 + referenceGenomeAssemblyURL: https://www.ncbi.nlm.nih.gov/datasets/genome/GCA_000001405.14 +jannoFile: Schiffels_2016.janno +jannoFileChkSum: 09e65688bbb0d315648ccc7de0bf03e8 +sequencingSourceFile: ena_table.ssf +sequencingSourceFileChkSum: 05c2e7c8163bd2ed81ca888696c00cb1 +bibFile: sources.bib +bibFileChkSum: 2e0fe6d764926dff57f2fa421bf295c9 +readmeFile: README.md +changelogFile: CHANGELOG.md diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/README.md b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/README.md new file mode 100644 index 00000000..af27ff49 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/README.md @@ -0,0 +1 @@ +This is a test file. \ No newline at end of file diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/Schiffels_2016.janno b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/Schiffels_2016.janno new file mode 100755 index 00000000..69d7e0cd --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/Schiffels_2016.janno @@ -0,0 +1,11 @@ +Poseidon_ID Group_Name Genetic_Sex Publication AddCol1 AddCol2 +XXX001 POP1 M Schiffels2016 v1 v2 +XXX002 POP2 F Schiffels2016 v1 v2 +XXX003 POP1 M Schiffels2016 v1 v2 +XXX004 POP2 F Schiffels2016 v1 v2 +XXX005 POP2 M Schiffels2016;TestPaper1 v1 v2 +XXX006 POP2 F Schiffels2016;TestPaper1 v1 v2 +XXX007 POP1 M Schiffels2016;TestBook1 v1 v2 +XXX008 POP3 F Schiffels2016;TestBook1 v1 v2 +XXX009 POP1 F Schiffels2016;TestPaper1;TestBook1 v1 v2 +XXX010 POP3 M Schiffels2016;TestPaper1;TestBook1 v1 v2 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ena_table.ssf b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ena_table.ssf new file mode 100644 index 00000000..4bde27b8 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ena_table.ssf @@ -0,0 +1,5 @@ +poseidon_IDs run_accession other_info_1 other_info_2 +XXX001;XXX002 ERR3518150 A B +XXX002;XXX004;XXX005 ERR3518151 C D +XXX003 ERR3518152 E F +XXX001 ERR3518153 G H diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/geno.txt b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/geno.txt new file mode 100644 index 00000000..e001a769 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/geno.txt @@ -0,0 +1,9 @@ +2000000100 +2022221222 +0000910000 +0110100000 +1121901201 +2222222222 +2292221221 +2201221220 +2292122212 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ind.txt b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ind.txt new file mode 100644 index 00000000..4dd63386 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/ind.txt @@ -0,0 +1,10 @@ +XXX001 M POP1 +XXX002 F POP2 +XXX003 M POP1 +XXX004 F POP2 +XXX005 M POP2 +XXX006 F POP2 +XXX007 M POP1 +XXX008 F POP3 +XXX009 F POP1 +XXX010 M POP3 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/snp.txt b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/snp.txt new file mode 100644 index 00000000..6a56b243 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/snp.txt @@ -0,0 +1,9 @@ +1_752566 1 0.020130 752566 G A +1_842013 1 0.022518 842013 T G +1_891021 1 0.024116 891021 G A +1_949654 1 0.025727 949654 A G +2_1018704 2 0.026288 1018704 A G +2_1045331 2 0.026665 1045331 G A +2_1048955 2 0.026674 1048955 A G +2_1061166 2 0.026711 1061166 T C +2_1108637 2 0.028311 1108637 G A diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/sources.bib b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/sources.bib new file mode 100644 index 00000000..f5cbdd99 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schiffels_2016/sources.bib @@ -0,0 +1,12 @@ +@article{Schiffels2016, + title = Test +} + +@article{TestPaper1, + title = TestPaper +} + +@book{TestBook1, + title = TestBook +} + diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/POSEIDON.yml b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/POSEIDON.yml new file mode 100644 index 00000000..e7ff75a1 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/POSEIDON.yml @@ -0,0 +1,23 @@ +poseidonVersion: 2.7.1 +title: Wang_2020 +description: Genetic data published in Wang et al. 2020, Plink test +contributor: +- name: Ke Wang + email: wang@institute.org +packageVersion: 0.1.0 +lastModified: 2020-05-20 +genotypeData: + format: PLINK + genoFile: Wang_2020.bed + genoFileChkSum: ae66d851301f4a761b819f97ec28fa55 + snpFile: Wang_2020.bim + snpFileChkSum: f96ea12084830fb43b3a24fd867f0ba7 + indFile: Wang_2020.fam + indFileChkSum: 575ea54b293e297b5f354c910fe1610d + snpSet: Other +jannoFile: Wang_2020.janno +jannoFileChkSum: d271413712cf63767fc12dc3761de2e4 +sequencingSourceFile: Wang_2020.ssf +sequencingSourceFileChkSum: 76f24988a5440fea474308f9151548a3 +bibFile: sources.bib +bibFileChkSum: 67a9340931939f6d49fefe132c6ae984 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bed b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bed new file mode 100644 index 00000000..b75a5356 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bed @@ -0,0 +1 @@ +lê«‹¨èª/¨è«¯ª « \ No newline at end of file diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bim b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bim new file mode 100644 index 00000000..d6fa8180 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.bim @@ -0,0 +1,7 @@ +11 rs0000 0.000000 0 A C +11 rs1111 0.001000 100000 A G +11 rs2222 0.002000 200000 A T +11 rs3333 0.003000 300000 C A +11 rs4444 0.004000 400000 G A +11 rs5555 0.005000 500000 T A +11 rs6666 0.006000 600000 G T diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.fam b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.fam new file mode 100644 index 00000000..a8e0dbb7 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.fam @@ -0,0 +1,5 @@ + 1 SAMPLE0 0 0 2 2 + 2 SAMPLE1 0 0 1 2 + 3 SAMPLE2 0 0 2 1 + 4 SAMPLE3 0 0 1 1 + 5 SAMPLE4 0 0 2 1 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.janno b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.janno new file mode 100755 index 00000000..28ef9e1e --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.janno @@ -0,0 +1,6 @@ +Poseidon_ID Group_Name Genetic_Sex Publication +SAMPLE0 1 F n/a +SAMPLE1 2 M TestPaper1 +SAMPLE2 3 F Wang2020;TestPaper1 +SAMPLE3 4 M Wang2020;TestBook2 +SAMPLE4 5 F Wang2020;TestPaper1;TestBook2 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.ssf b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.ssf new file mode 100644 index 00000000..06b2766c --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/Wang_2020.ssf @@ -0,0 +1,2 @@ +poseidon_IDs run_accession other_info_1 other_info_2 +SAMPLE1 ERR3518154 A B diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/sources.bib b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/sources.bib new file mode 100644 index 00000000..93693fbf --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Wang_2020/sources.bib @@ -0,0 +1,11 @@ +@article{Wang2020, + title = Test +} + +@article{TestPaper1, + title = TestPaper +} + +@book{TestBook2, + title = TestBook +} diff --git a/test/PoseidonGoldenTests/GoldenTestData/timetravel/Wang_2020-0.1.0/POSEIDON.yml b/test/PoseidonGoldenTests/GoldenTestData/timetravel/Wang_2020-0.1.0/POSEIDON.yml index 1e137405..e7ff75a1 100644 --- a/test/PoseidonGoldenTests/GoldenTestData/timetravel/Wang_2020-0.1.0/POSEIDON.yml +++ b/test/PoseidonGoldenTests/GoldenTestData/timetravel/Wang_2020-0.1.0/POSEIDON.yml @@ -2,16 +2,22 @@ poseidonVersion: 2.7.1 title: Wang_2020 description: Genetic data published in Wang et al. 2020, Plink test contributor: - - name: Ke Wang - email: wang@institute.org +- name: Ke Wang + email: wang@institute.org packageVersion: 0.1.0 lastModified: 2020-05-20 -bibFile: sources.bib genotypeData: format: PLINK genoFile: Wang_2020.bed + genoFileChkSum: ae66d851301f4a761b819f97ec28fa55 snpFile: Wang_2020.bim + snpFileChkSum: f96ea12084830fb43b3a24fd867f0ba7 indFile: Wang_2020.fam + indFileChkSum: 575ea54b293e297b5f354c910fe1610d snpSet: Other jannoFile: Wang_2020.janno -sequencingSourceFile: Wang_2020.ssf \ No newline at end of file +jannoFileChkSum: d271413712cf63767fc12dc3761de2e4 +sequencingSourceFile: Wang_2020.ssf +sequencingSourceFileChkSum: 76f24988a5440fea474308f9151548a3 +bibFile: sources.bib +bibFileChkSum: 67a9340931939f6d49fefe132c6ae984 diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index 6fd637f9..d42944b5 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -20,6 +20,8 @@ import Poseidon.CLI.Trident.List (ListEntity (..), ListOptions (..), RepoLocationSpec (..), runList) +import Poseidon.CLI.Trident.Rectify (RectifyOptions (..), + runRectify) import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), ModifyOptions (..), PackageVersionUpdate (..), @@ -237,6 +239,8 @@ runCLICommands interactive testDir checkFilePath = do testPipelineSurvey testDir checkFilePath hPutStrLn stderr "--- genoconvert" testPipelineGenoconvert testDir checkFilePath + hPutStrLn stderr "--- rectify" + testPipelineRectify testDir checkFilePath hPutStrLn stderr "--- modify" testPipelineModify testDir checkFilePath hPutStrLn stderr "--- forge" @@ -645,6 +649,44 @@ testPipelineGenoconvert testDir checkFilePath = do } testLog $ runGenoconvert genoconvertOpts7 +testPipelineRectify :: FilePath -> FilePath -> IO () +testPipelineRectify testDir checkFilePath = do + let rectifyDir = testDir "rectify" + changedPac = rectifyDir "Schiffels_2016" + unchangedPac = rectifyDir "Wang_2020" + changedYaml = changedPac "POSEIDON.yml" + unchangedYaml = unchangedPac "POSEIDON.yml" + copyDirectoryRecursive (testPacsDir "Schiffels_2016") changedPac + copyDirectoryRecursive (testPacsDir "Wang_2020") unchangedPac + -- keep the bibliography syntactically valid while invalidating its checksum + -- this should make Schiffels_2016 the only package selected for rectification + appendFile (changedPac "sources.bib") "\n" + unchangedYamlBefore <- getChecksum unchangedYaml + let rectifyOpts = RectifyOptions { + _rectifyBaseDirs = [rectifyDir] + , _rectifyPackageVersionUpdate = Just (PackageVersionUpdate Major (Just "rectify test")) + , _rectifyNewContributors = Just [ContributorSpec "rectify" "rectify@example.org" Nothing] + } + action = do + -- first run: rectify Schiffels_2016, leave Wang_2020 untouched + testLog $ runRectify rectifyOpts + patchLastModified testDir ("rectify" "Schiffels_2016" "POSEIDON.yml") + unchangedYamlAfter <- getChecksum unchangedYaml + unless (unchangedYamlBefore == unchangedYamlAfter) $ + fail "rectify modified a package with valid checksums" + -- second run: leave Schiffels_2016 also untouched + changedYamlAfterFirstRun <- getChecksum changedYaml + testLog $ runRectify rectifyOpts + changedYamlAfterSecondRun <- getChecksum changedYaml + unless (changedYamlAfterFirstRun == changedYamlAfterSecondRun) $ + fail "rectify was not idempotent after repairing checksums" + runAndChecksumFiles checkFilePath testDir action "rectify" [ + "rectify" "Schiffels_2016" "POSEIDON.yml" + , "rectify" "Schiffels_2016" "CHANGELOG.md" + , "rectify" "Schiffels_2016" "sources.bib" + , "rectify" "Wang_2020" "POSEIDON.yml" + ] + testPipelineModify :: FilePath -> FilePath -> IO () testPipelineModify testDir checkFilePath = do let modifyOpts1 = ModifyOptions { diff --git a/test/testDat/testPackages/ancient/Wang_2020/POSEIDON.yml b/test/testDat/testPackages/ancient/Wang_2020/POSEIDON.yml index 1e137405..e7ff75a1 100644 --- a/test/testDat/testPackages/ancient/Wang_2020/POSEIDON.yml +++ b/test/testDat/testPackages/ancient/Wang_2020/POSEIDON.yml @@ -2,16 +2,22 @@ poseidonVersion: 2.7.1 title: Wang_2020 description: Genetic data published in Wang et al. 2020, Plink test contributor: - - name: Ke Wang - email: wang@institute.org +- name: Ke Wang + email: wang@institute.org packageVersion: 0.1.0 lastModified: 2020-05-20 -bibFile: sources.bib genotypeData: format: PLINK genoFile: Wang_2020.bed + genoFileChkSum: ae66d851301f4a761b819f97ec28fa55 snpFile: Wang_2020.bim + snpFileChkSum: f96ea12084830fb43b3a24fd867f0ba7 indFile: Wang_2020.fam + indFileChkSum: 575ea54b293e297b5f354c910fe1610d snpSet: Other jannoFile: Wang_2020.janno -sequencingSourceFile: Wang_2020.ssf \ No newline at end of file +jannoFileChkSum: d271413712cf63767fc12dc3761de2e4 +sequencingSourceFile: Wang_2020.ssf +sequencingSourceFileChkSum: 76f24988a5440fea474308f9151548a3 +bibFile: sources.bib +bibFileChkSum: 67a9340931939f6d49fefe132c6ae984 From 89a6fb1c16b00f84edb91545a980c966a62c0912 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Sat, 5 Sep 2026 16:23:57 +0200 Subject: [PATCH 15/20] stylish haskell --- src/Poseidon/CLI/Trident/Modify.hs | 4 ++-- test/PoseidonGoldenTests/GoldenTestsRunCommands.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index 0cc81850..6fa082a5 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -20,7 +20,7 @@ import Poseidon.Core.Package (PackageReadOptions (..), writePoseidonPackage) import Poseidon.Core.PoseidonVersion (PoseidonVersion (..)) import Poseidon.Core.Utils (PoseidonIO, getChk, logDebug, - logInfo, logWarning, logError) + logError, logInfo, logWarning) import Poseidon.Core.Version (VersionComponent (..), updateThreeComponentVersion) @@ -33,8 +33,8 @@ import Data.Time (UTCTime (..), getCurrentTime) import Data.Version (Version (..), makeVersion, showVersion) import System.Directory (doesFileExist, removeFile) +import System.Exit (exitFailure) import System.FilePath (()) -import System.Exit (exitFailure) data ModifyOptions = ModifyOptions { _modifyBaseDirs :: [FilePath] diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index d42944b5..5405ebba 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -20,12 +20,12 @@ import Poseidon.CLI.Trident.List (ListEntity (..), ListOptions (..), RepoLocationSpec (..), runList) -import Poseidon.CLI.Trident.Rectify (RectifyOptions (..), - runRectify) import Poseidon.CLI.Trident.Modify (ChecksumsToModify (..), ModifyOptions (..), PackageVersionUpdate (..), runModify) +import Poseidon.CLI.Trident.Rectify (RectifyOptions (..), + runRectify) import Poseidon.CLI.Trident.Serve (ArchiveConfig (..), ArchiveSpec (..), ServeOptions (..), From 972b50a9a5ab746517a8850c240becfcffe70840 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Sat, 5 Sep 2026 16:32:04 +0200 Subject: [PATCH 16/20] better message for the empty case --- src/Poseidon/CLI/Trident/Modify.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Poseidon/CLI/Trident/Modify.hs b/src/Poseidon/CLI/Trident/Modify.hs index 6fa082a5..93fa42fb 100644 --- a/src/Poseidon/CLI/Trident/Modify.hs +++ b/src/Poseidon/CLI/Trident/Modify.hs @@ -80,7 +80,9 @@ runModify (ModifyOptions pacReadOpts {_readOptIgnorePosVersion = ignorePosVer} baseDirs case allPackages of - [] -> return () + [] -> do + logWarning "No packages found." + logInfo "Done" [x] -> do modifyOnePackage x logInfo "Done" From 8e50a54800511c6ac52aa2c0132f5dd676381880 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Tue, 29 Sep 2026 11:03:17 +0200 Subject: [PATCH 17/20] version bump --- CHANGELOG.md | 4 +++- poseidon-hs.cabal | 4 ---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6549e1ed..fd713c63 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,7 @@ +- V 2.3.0.0: + - Split the functionality of `rectify` into a new subcommand `modify` that exactly mirrors the former `rectify`, and a new `rectify` that just adjusts checksums and increments version numbers to make recently changed package pass validation again. - V 2.2.2.2: - - uses newer version of sequence-formats, improving + - Switched to newer version of sequence-formats, improving genotype data parsing error messages. - Changed "PoseidonID" to the correct "Poseidon_ID" in an error message and on the server website. - V 2.2.2.1: - Update of the sequence-formats dependency because of a purely technical build issue on windows, caused by a non-standard directory name. diff --git a/poseidon-hs.cabal b/poseidon-hs.cabal index 34342dbc..6780402a 100644 --- a/poseidon-hs.cabal +++ b/poseidon-hs.cabal @@ -1,9 +1,5 @@ name: poseidon-hs -<<<<<<< HEAD version: 2.3.0.0 -======= -version: 2.2.2.2 ->>>>>>> master 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 From 842d52883c6ec3b1c0017e0f2ee29183b26426f3 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Sat, 26 Sep 2026 18:35:59 +0200 Subject: [PATCH 18/20] changed the behaviour of rectify: missing checksums are now added --- src/Poseidon/CLI/Trident/Rectify.hs | 5 +++- src/Poseidon/Core/Package.hs | 14 ++++++--- .../GoldenTestCheckSumFile.txt | 2 ++ .../rectify/Schmid_2028/CHANGELOG.md | 1 + .../rectify/Schmid_2028/POSEIDON.yml | 22 ++++++++++++++ .../rectify/Schmid_2028/Schmid_2028.janno | 3 ++ .../rectify/Schmid_2028/geno.txt | 9 ++++++ .../rectify/Schmid_2028/ind.txt | 2 ++ .../rectify/Schmid_2028/snp.txt | 9 ++++++ .../GoldenTestsRunCommands.hs | 29 +++++++++++++------ 10 files changed, 82 insertions(+), 14 deletions(-) create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/CHANGELOG.md create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/POSEIDON.yml create mode 100755 test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/Schmid_2028.janno create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/geno.txt create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/ind.txt create mode 100644 test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/snp.txt diff --git a/src/Poseidon/CLI/Trident/Rectify.hs b/src/Poseidon/CLI/Trident/Rectify.hs index 95e99153..3f952a00 100644 --- a/src/Poseidon/CLI/Trident/Rectify.hs +++ b/src/Poseidon/CLI/Trident/Rectify.hs @@ -75,8 +75,11 @@ needsRectification pac = do return needsRect goodChecksum :: (MonadIO m) => FilePath -> Maybe FilePath -> Maybe String -> m Bool +-- no file: ok goodChecksum _ Nothing _ = return True -goodChecksum _ _ Nothing = return True +-- no checksum: not ok +goodChecksum _ _ Nothing = return False +-- file and checksum: is the checksum correct? goodChecksum baseDir (Just file) (Just expectedCheckSum) = do let f = baseDir file exists <- liftIO . doesFileExist $ f diff --git a/src/Poseidon/Core/Package.hs b/src/Poseidon/Core/Package.hs index 467051c4..0c9afed2 100644 --- a/src/Poseidon/Core/Package.hs +++ b/src/Poseidon/Core/Package.hs @@ -11,6 +11,7 @@ module Poseidon.Core.Package ( findAllPoseidonYmlFiles, checkJannoIndConsistency, checkGenoFiles, + readPoseidonYaml, readPoseidonPackageCollection, readPoseidonPackageCollectionWithSkipIndicator, getJointGenotypeData, @@ -431,6 +432,13 @@ readPoseidonPackageCollectionWithSkipIndicator opts baseDirs = do logDebug $ "Package " ++ show numberPackage ++ ": " ++ path try . readPoseidonPackage opts $ path +readPoseidonYaml :: FilePath -> IO PoseidonYamlStruct +readPoseidonYaml path = do + bs <- liftIO $ B.readFile path + case decodeEither' bs of + Left err -> throwM $ PoseidonYamlParseException path err + Right x -> return x + -- | A function to read in a poseidon package from a YAML file. Note that this function calls the addFullPaths function to -- make paths absolute. readPoseidonPackage :: PackageReadOptions @@ -438,12 +446,10 @@ readPoseidonPackage :: PackageReadOptions -> PoseidonIO PoseidonPackage -- ^ the returning package returned in the IO monad. readPoseidonPackage opts ymlPath = do let baseDir = takeDirectory ymlPath - bs <- liftIO $ B.readFile ymlPath -- read yml files - yml@(PoseidonYamlStruct ver tit des con pacVer mod_ lic geno jannoF jannoC seqSourceF seqSourceC bibF bibC readF changeF) <- case decodeEither' bs of - Left err -> throwM $ PoseidonYamlParseException ymlPath err - Right pac -> return pac + yml@(PoseidonYamlStruct ver tit des con pacVer mod_ lic geno jannoF jannoC seqSourceF seqSourceC bibF bibC readF changeF) <- + liftIO $ readPoseidonYaml ymlPath checkYML yml -- file existence and checksum test diff --git a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt index bc073cc4..209b1c8d 100644 --- a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt +++ b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt @@ -58,6 +58,8 @@ a9fcb59cb933d8f183f3c3f6fbf2e213 genoconvert init_vcf/Schiffels_vcf/geno.fam 3c38f40efe215a047c02f4e98e0390da genoconvert genoconvert/zip_roundtrip/Schiffels_2016.bed 8538ffd971ebb12cf5ef6e338da27970 genoconvert genoconvert/zip_roundtrip/Schiffels_2016.bim a9fcb59cb933d8f183f3c3f6fbf2e213 genoconvert genoconvert/zip_roundtrip/Schiffels_2016.fam +f63b7186e18c1c6935312a3ab2b0ac6a rectify rectify/Schmid_2028/POSEIDON.yml +53f3a0f7f8afc56a452c831111fe9f0d rectify rectify/Schmid_2028/CHANGELOG.md 581fac2d8df63a48cd00fe0a80cfaba8 rectify rectify/Schiffels_2016/POSEIDON.yml ffe2b8832ad21fbd44faff1f0b9075de rectify rectify/Schiffels_2016/CHANGELOG.md 2e0fe6d764926dff57f2fa421bf295c9 rectify rectify/Schiffels_2016/sources.bib diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/CHANGELOG.md b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/CHANGELOG.md new file mode 100644 index 00000000..0989962e --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/CHANGELOG.md @@ -0,0 +1 @@ +- V 2.0.0: rectify test diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/POSEIDON.yml b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/POSEIDON.yml new file mode 100644 index 00000000..9cc63f9f --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/POSEIDON.yml @@ -0,0 +1,22 @@ +poseidonVersion: 2.6.0 +title: Schmid_2028 +description: Genetic data that will never be published in Schmid et al. 2028 +contributor: +- name: Clemens Schmid + email: schmid@institute.org +- name: rectify + email: rectify@example.org +packageVersion: 2.0.0 +lastModified: 1970-01-01 +genotypeData: + format: EIGENSTRAT + genoFile: geno.txt + genoFileChkSum: 70547a0bdb20d07dc8e708a1a8f055e4 + snpFile: snp.txt + snpFileChkSum: d76e3e7a8fc0f1f5e435395424b5aeab + indFile: ind.txt + indFileChkSum: f335dfd53eb4db511b08dcaccc81505b + snpSet: Other +jannoFile: Schmid_2028.janno +jannoFileChkSum: ea9d00246c9064ea8f1f35d4b30acb49 +changelogFile: CHANGELOG.md diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/Schmid_2028.janno b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/Schmid_2028.janno new file mode 100755 index 00000000..108642f9 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/Schmid_2028.janno @@ -0,0 +1,3 @@ +Poseidon_ID Group_Name Genetic_Sex +XXX001 POP1 F +XXX002 POP2 F diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/geno.txt b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/geno.txt new file mode 100644 index 00000000..e5e735c6 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/geno.txt @@ -0,0 +1,9 @@ +00 +00 +00 +00 +00 +00 +00 +00 +00 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/ind.txt b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/ind.txt new file mode 100644 index 00000000..5f99068f --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/ind.txt @@ -0,0 +1,2 @@ +XXX001 F POP1 +XXX002 F POP2 diff --git a/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/snp.txt b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/snp.txt new file mode 100644 index 00000000..6a56b243 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/rectify/Schmid_2028/snp.txt @@ -0,0 +1,9 @@ +1_752566 1 0.020130 752566 G A +1_842013 1 0.022518 842013 T G +1_891021 1 0.024116 891021 G A +1_949654 1 0.025727 949654 A G +2_1018704 2 0.026288 1018704 A G +2_1045331 2 0.026665 1045331 G A +2_1048955 2 0.026674 1048955 A G +2_1061166 2 0.026711 1061166 T C +2_1108637 2 0.028311 1108637 G A diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index 5405ebba..9d6f81f8 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -57,6 +57,7 @@ import Poseidon.Core.Utils (LogMode (..), testLog, testLogErr, usePoseidonLogger) import Poseidon.Core.Version (VersionComponent (..)) +import Poseidon.Core.Package (readPoseidonYaml, PoseidonYamlStruct (..)) import Control.Concurrent (forkIO, killThread, newEmptyMVar) @@ -87,6 +88,7 @@ import System.IO (Handle, IOMode (WriteMode), hPutStrLn, openFile, stderr, stdout, withFile) import System.Process (callCommand) +import Data.Maybe (isNothing) -- file paths -- @@ -651,15 +653,18 @@ testPipelineGenoconvert testDir checkFilePath = do testPipelineRectify :: FilePath -> FilePath -> IO () testPipelineRectify testDir checkFilePath = do - let rectifyDir = testDir "rectify" - changedPac = rectifyDir "Schiffels_2016" - unchangedPac = rectifyDir "Wang_2020" - changedYaml = changedPac "POSEIDON.yml" - unchangedYaml = unchangedPac "POSEIDON.yml" + let rectifyDir = testDir "rectify" + noChecksumPac = rectifyDir "Schmid_2028" + changedPac = rectifyDir "Schiffels_2016" + unchangedPac = rectifyDir "Wang_2020" + noChecksumYaml = noChecksumPac "POSEIDON.yml" + changedYaml = changedPac "POSEIDON.yml" + unchangedYaml = unchangedPac "POSEIDON.yml" + copyDirectoryRecursive (testPacsDir "Schmid_2028") noChecksumPac copyDirectoryRecursive (testPacsDir "Schiffels_2016") changedPac copyDirectoryRecursive (testPacsDir "Wang_2020") unchangedPac -- keep the bibliography syntactically valid while invalidating its checksum - -- this should make Schiffels_2016 the only package selected for rectification + -- this should make Schiffels_2016 get selected for rectification appendFile (changedPac "sources.bib") "\n" unchangedYamlBefore <- getChecksum unchangedYaml let rectifyOpts = RectifyOptions { @@ -668,20 +673,26 @@ testPipelineRectify testDir checkFilePath = do , _rectifyNewContributors = Just [ContributorSpec "rectify" "rectify@example.org" Nothing] } action = do - -- first run: rectify Schiffels_2016, leave Wang_2020 untouched + -- first run: rectify Schmid_2028 and Schiffels_2016, leave Wang_2020 untouched + noChecksumYamlStruct <- readPoseidonYaml noChecksumYaml + unless (isNothing $ _posYamlJannoFileChkSum noChecksumYamlStruct) $ + fail "Schmid_2028 seems to have checksums now: that renders this test invalid" testLog $ runRectify rectifyOpts + patchLastModified testDir ("rectify" "Schmid_2028" "POSEIDON.yml") patchLastModified testDir ("rectify" "Schiffels_2016" "POSEIDON.yml") unchangedYamlAfter <- getChecksum unchangedYaml unless (unchangedYamlBefore == unchangedYamlAfter) $ fail "rectify modified a package with valid checksums" - -- second run: leave Schiffels_2016 also untouched + -- second run: leave all untouched changedYamlAfterFirstRun <- getChecksum changedYaml testLog $ runRectify rectifyOpts changedYamlAfterSecondRun <- getChecksum changedYaml unless (changedYamlAfterFirstRun == changedYamlAfterSecondRun) $ fail "rectify was not idempotent after repairing checksums" runAndChecksumFiles checkFilePath testDir action "rectify" [ - "rectify" "Schiffels_2016" "POSEIDON.yml" + "rectify" "Schmid_2028" "POSEIDON.yml" + , "rectify" "Schmid_2028" "CHANGELOG.md" + , "rectify" "Schiffels_2016" "POSEIDON.yml" , "rectify" "Schiffels_2016" "CHANGELOG.md" , "rectify" "Schiffels_2016" "sources.bib" , "rectify" "Wang_2020" "POSEIDON.yml" From f58aa7d5f9adbc28527b24a40f92f4a06cf14d07 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Sat, 26 Sep 2026 18:53:45 +0200 Subject: [PATCH 19/20] stylish haskell --- test/PoseidonGoldenTests/GoldenTestsRunCommands.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index 9d6f81f8..2d2b09c6 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -48,6 +48,8 @@ import Poseidon.Core.GenotypeData (GenoDataSource (..), GenotypeFileSpec (..), GenotypeOutFormatSpec (..), SNPSetSpec (..)) +import Poseidon.Core.Package (PoseidonYamlStruct (..), + readPoseidonYaml) import Poseidon.Core.PoseidonVersion (VersionedFile (..), latestPoseidonVersion) import Poseidon.Core.ServerClient (AddColSpec (..), @@ -57,7 +59,6 @@ import Poseidon.Core.Utils (LogMode (..), testLog, testLogErr, usePoseidonLogger) import Poseidon.Core.Version (VersionComponent (..)) -import Poseidon.Core.Package (readPoseidonYaml, PoseidonYamlStruct (..)) import Control.Concurrent (forkIO, killThread, newEmptyMVar) @@ -66,6 +67,7 @@ import Control.Exception (finally) import Control.Monad (forM_, unless, when) import Data.Either (fromRight) import Data.Function ((&)) +import Data.Maybe (isNothing) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Version (makeVersion) @@ -88,7 +90,6 @@ import System.IO (Handle, IOMode (WriteMode), hPutStrLn, openFile, stderr, stdout, withFile) import System.Process (callCommand) -import Data.Maybe (isNothing) -- file paths -- From c4e87bcbe58334656f155d5fa42fe65453a23115 Mon Sep 17 00:00:00 2001 From: Clemens Schmid Date: Tue, 29 Sep 2026 13:50:53 +0200 Subject: [PATCH 20/20] adjusted changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fd713c63..cf4b13d5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,5 @@ - V 2.3.0.0: - - Split the functionality of `rectify` into a new subcommand `modify` that exactly mirrors the former `rectify`, and a new `rectify` that just adjusts checksums and increments version numbers to make recently changed package pass validation again. + - Split the functionality of `rectify` into a new subcommand `modify` that exactly mirrors the former `rectify`, and a new `rectify` that just adds and adjusts checksums and increments version numbers to make recently changed package pass validation again. - V 2.2.2.2: - Switched to newer version of sequence-formats, improving genotype data parsing error messages. - Changed "PoseidonID" to the correct "Poseidon_ID" in an error message and on the server website.