From cb1d6a71a663576e788e9b78e63b697d650db75e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 14 Aug 2025 18:15:44 +0100 Subject: [PATCH] dev:import:archive: fix bugs in new code Too hard to rebase --- hledger-lib/Hledger/Read/RulesReader.hs | 48 ++++++++++++++----------- hledger/Hledger/Cli/Commands/Import.hs | 6 +--- 2 files changed, 28 insertions(+), 26 deletions(-) diff --git a/hledger-lib/Hledger/Read/RulesReader.hs b/hledger-lib/Hledger/Read/RulesReader.hs index 2da1af9f5..ce19ee9f5 100644 --- a/hledger-lib/Hledger/Read/RulesReader.hs +++ b/hledger-lib/Hledger/Read/RulesReader.hs @@ -137,12 +137,13 @@ parse iopts rulesfile h = do -- XXX How can we know when the command is import, and if it's a dry run ? In a hacky way, currently. args = progArgs cmd = headDef "" $ dropWhile ((=="-").take 1) args - importcmd = cmd `elem` ["import", "imp"] - dryrun = any (`elem` args) ["--dry-run", "--dry"] - importing = importcmd && not dryrun - archiving = importing && isJust (getDirective "import" rules) - rulesdir = takeDirectory rulesfile - archivedir = rulesdir "data" + importcmd = dbg7 "importcmd" $ cmd `elem` ["import", "imp"] + dryrun = dbg7 "dryrun" $ any (`elem` args) ["--dry-run", "--dry"] + importing = dbg7 "importing" $ importcmd && not dryrun + archive = dbg7 "archive" $ isJust (getDirective "archive" rules) + archiving = dbg7 "archiving" $ importing && archive + rulesdir = dbg7 "rulesdir" $ takeDirectory rulesfile + archivedir = dbg7 "archivedir" $ rulesdir "data" mdatafile <- liftIO $ do dldir <- getDownloadDir -- look here for the data file if it's specified without a directory @@ -152,10 +153,11 @@ parse iopts rulesfile h = do where err = error' $ "could not infer a data file for " <> rulesfile Just glb -> do let (dir,desc) = if isFileName glb then (dldir," in download directory") else (rulesdir,"") - globmatches <- expandGlob dir (dbg4 "source" glb) >>= sortByModTime <&> dbg4 ("matched files"<>desc<>", oldest first") + globmatches <- expandGlob dir (dbg4 "source rule" glb) >>= sortByModTime <&> dbg4 ("matched files"<>desc<>", oldest first") case globmatches of -- if the source rule matched no files, and we are reading not importing, use the most recent archive file - [] | not importcmd -> archivesFor archivedir rulesfile <&> take 1 + [] | archive && not importcmd -> do + archivesFor archivedir rulesfile <&> take 1 <&> dbg4 "latest file in archive directory" _ -> return globmatches return $ case datafiles of [] -> Nothing @@ -183,28 +185,28 @@ parse iopts rulesfile h = do . journalReverse >>= journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} rulesfile "" >>= \j -> do - when archiving $ liftIO $ archiveTo datafile archivedir + when archiving $ liftIO $ archiveTo rulesfile datafile archivedir return j -- | Move a file to the given directory, creating the directory (and parents) if needed, -- showing informational output on stderr. -archiveTo :: FilePath -> FilePath -> IO () -archiveTo datafile archivedir = do +archiveTo :: FilePath -> FilePath -> FilePath -> IO () +archiveTo rulesfile datafile archivedir = do createDirectoryIfMissing True archivedir hPutStrLn stderr $ "archiving " <> datafile - fname <- archiveFileName datafile + fname <- archiveFileName rulesfile datafile let archivefile = archivedir fname hPutStrLn stderr $ " as " <> archivefile renameFile datafile archivefile --- | Figure out the file name to use when archiving the given file path. --- Basically, add the file's modification date before the extension.\ -archiveFileName :: FilePath -> IO String -archiveFileName f = do - moddate <- (show . utctDay) <$> getModificationTime f - return $ takeBaseName f <.> moddate <.> takeExtension f +-- | Figure out the file name to use when archiving, for the given rules file, the given data file. +-- That is, "RULESFILEBASENAME.DATAFILEMODDATE.DATAFILEEXT". +archiveFileName :: FilePath -> FilePath -> IO String +archiveFileName rulesfile datafile = do + moddate <- (show . utctDay) <$> getModificationTime datafile + return $ takeBaseName rulesfile <.> moddate <.> takeExtension datafile --- | In the given archive directory, if it exists, find the data file versions saved for the given rules file. +-- | In the given archive directory, if it exists, find the paths of data files saved for the given rules file. -- They will be reverse sorted by name, ie newest first, assuming normal archive file names. -- -- We don't know which extension the data files use, but we look for file names beginning with @@ -217,8 +219,12 @@ archivesFor archivedir rulesfile = do else do let prefix = takeBaseName rulesfile <> "." fs <- listDirectory archivedir - return $ sortBy (comparing Down) - [ f | f <- fs, prefix `isPrefixOf` f, isJust $ parsedate $ drop (length prefix) f ] + return $ map (archivedir ) $ sortBy (comparing Down) + [f | f <- fs, + prefix `isPrefixOf` f, + let nextpart = takeWhile (/= '.') $ drop (length prefix) f, + isJust $ parsedate nextpart + ] --- ** reading rules files --- *** rules utilities diff --git a/hledger/Hledger/Cli/Commands/Import.hs b/hledger/Hledger/Cli/Commands/Import.hs index 536901af8..18b46f0e2 100644 --- a/hledger/Hledger/Cli/Commands/Import.hs +++ b/hledger/Hledger/Cli/Commands/Import.hs @@ -60,11 +60,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do Left err -> error' err Right (newj, latestdatesforfiles) -> case sortOn tdate $ jtxns newj of - -- with --dry-run the output should be valid journal format, so messages have ; prepended - [] -> do - -- in this case, we vary the output depending on --dry-run, which is a bit awkward - let semicolon = if dryrun then "; " else "" :: String - hPrintf stderr "%sno new transactions found in %s\n\n" semicolon inputstr + [] -> hPrintf stderr "no new transactions found in %s\n\n" inputstr newts | catchup -> if dryrun