dev:import:archive: fix bugs in new code

Too hard to rebase
This commit is contained in:
Simon Michael 2025-08-14 18:15:44 +01:00
parent 7dfe2d84e7
commit cb1d6a71a6
2 changed files with 28 additions and 26 deletions

View File

@ -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. -- XXX How can we know when the command is import, and if it's a dry run ? In a hacky way, currently.
args = progArgs args = progArgs
cmd = headDef "" $ dropWhile ((=="-").take 1) args cmd = headDef "" $ dropWhile ((=="-").take 1) args
importcmd = cmd `elem` ["import", "imp"] importcmd = dbg7 "importcmd" $ cmd `elem` ["import", "imp"]
dryrun = any (`elem` args) ["--dry-run", "--dry"] dryrun = dbg7 "dryrun" $ any (`elem` args) ["--dry-run", "--dry"]
importing = importcmd && not dryrun importing = dbg7 "importing" $ importcmd && not dryrun
archiving = importing && isJust (getDirective "import" rules) archive = dbg7 "archive" $ isJust (getDirective "archive" rules)
rulesdir = takeDirectory rulesfile archiving = dbg7 "archiving" $ importing && archive
archivedir = rulesdir </> "data" rulesdir = dbg7 "rulesdir" $ takeDirectory rulesfile
archivedir = dbg7 "archivedir" $ rulesdir </> "data"
mdatafile <- liftIO $ do mdatafile <- liftIO $ do
dldir <- getDownloadDir -- look here for the data file if it's specified without a directory 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 where err = error' $ "could not infer a data file for " <> rulesfile
Just glb -> do Just glb -> do
let (dir,desc) = if isFileName glb then (dldir," in download directory") else (rulesdir,"") 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 case globmatches of
-- if the source rule matched no files, and we are reading not importing, use the most recent archive file -- 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 globmatches
return $ case datafiles of return $ case datafiles of
[] -> Nothing [] -> Nothing
@ -183,28 +185,28 @@ parse iopts rulesfile h = do
. journalReverse . journalReverse
>>= journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} rulesfile "" >>= journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} rulesfile ""
>>= \j -> do >>= \j -> do
when archiving $ liftIO $ archiveTo datafile archivedir when archiving $ liftIO $ archiveTo rulesfile datafile archivedir
return j return j
-- | Move a file to the given directory, creating the directory (and parents) if needed, -- | Move a file to the given directory, creating the directory (and parents) if needed,
-- showing informational output on stderr. -- showing informational output on stderr.
archiveTo :: FilePath -> FilePath -> IO () archiveTo :: FilePath -> FilePath -> FilePath -> IO ()
archiveTo datafile archivedir = do archiveTo rulesfile datafile archivedir = do
createDirectoryIfMissing True archivedir createDirectoryIfMissing True archivedir
hPutStrLn stderr $ "archiving " <> datafile hPutStrLn stderr $ "archiving " <> datafile
fname <- archiveFileName datafile fname <- archiveFileName rulesfile datafile
let archivefile = archivedir </> fname let archivefile = archivedir </> fname
hPutStrLn stderr $ " as " <> archivefile hPutStrLn stderr $ " as " <> archivefile
renameFile datafile archivefile renameFile datafile archivefile
-- | Figure out the file name to use when archiving the given file path. -- | Figure out the file name to use when archiving, for the given rules file, the given data file.
-- Basically, add the file's modification date before the extension.\ -- That is, "RULESFILEBASENAME.DATAFILEMODDATE.DATAFILEEXT".
archiveFileName :: FilePath -> IO String archiveFileName :: FilePath -> FilePath -> IO String
archiveFileName f = do archiveFileName rulesfile datafile = do
moddate <- (show . utctDay) <$> getModificationTime f moddate <- (show . utctDay) <$> getModificationTime datafile
return $ takeBaseName f <.> moddate <.> takeExtension f 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. -- 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 -- 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 else do
let prefix = takeBaseName rulesfile <> "." let prefix = takeBaseName rulesfile <> "."
fs <- listDirectory archivedir fs <- listDirectory archivedir
return $ sortBy (comparing Down) return $ map (archivedir </>) $ sortBy (comparing Down)
[ f | f <- fs, prefix `isPrefixOf` f, isJust $ parsedate $ drop (length prefix) f ] [f | f <- fs,
prefix `isPrefixOf` f,
let nextpart = takeWhile (/= '.') $ drop (length prefix) f,
isJust $ parsedate nextpart
]
--- ** reading rules files --- ** reading rules files
--- *** rules utilities --- *** rules utilities

View File

@ -60,11 +60,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do
Left err -> error' err Left err -> error' err
Right (newj, latestdatesforfiles) -> Right (newj, latestdatesforfiles) ->
case sortOn tdate $ jtxns newj of case sortOn tdate $ jtxns newj of
-- with --dry-run the output should be valid journal format, so messages have ; prepended [] -> hPrintf stderr "no new transactions found in %s\n\n" inputstr
[] -> 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
newts | catchup -> newts | catchup ->
if dryrun if dryrun