diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,11 @@ For user-visible changes, see the hledger package changelog. +# 1.51.2 2026-01-08 + +- Allow base 4.22 / ghc 9.14. + + # 1.51.1 2025-12-08 @@ -34,6 +39,16 @@ - Hledger.Utils.String: quoteForCommandLine now quotes some additional problem characters, and no longer quotes "7". [#2468] + +API + +- Hledger.Read: + defaultExistingJournalPath + defaultExistingJournalPathSafely + readPossibleJournalFile + +- Hledger.Utils.IO: + expandPathOrGlob # 1.50.4 2025-12-04 diff --git a/Hledger/Data/Journal.hs b/Hledger/Data/Journal.hs --- a/Hledger/Data/Journal.hs +++ b/Hledger/Data/Journal.hs @@ -245,7 +245,7 @@ journalConcat j1 j2 = let f1 = takeFileName $ journalFilePath j1 - f2 = maybe "(unknown)" takeFileName $ headMay $ jincludefilestack j2 -- XXX more accurate than journalFilePath for some reason + f2 = maybe "(unknown)" takeFileName $ fmap fst $ headMay $ jincludefilestack j2 -- XXX more accurate than journalFilePath for some reason in dbgJournalAcctDeclOrder ("journalConcat: " <> f1 <> " <> " <> f2 <> ", acct decls renumbered: ") $ journalRenumberAccountDeclarations $ diff --git a/Hledger/Data/Types.hs b/Hledger/Data/Types.hs --- a/Hledger/Data/Types.hs +++ b/Hledger/Data/Types.hs @@ -633,8 +633,8 @@ ,jparsealiases :: [AccountAlias] -- ^ the current account name aliases in effect, specified by alias directives (& options ?) -- ,jparsetransactioncount :: Integer -- ^ the current count of transactions parsed so far (only journal format txns, currently) ,jparsetimeclockentries :: [TimeclockEntry] -- ^ timeclock sessions which have not been clocked out - ,jincludefilestack :: [FilePath] - -- principal data + ,jincludefilestack :: [(FilePath, FilePath)] -- ^ (absolute path, canonical path) of included files, most recent first +-- principal data ,jdeclaredpayees :: [(Payee,PayeeDeclarationInfo)] -- ^ Payees declared by payee directives, in parse order. ,jdeclaredtags :: [(TagName,TagDeclarationInfo)] -- ^ Tags declared by tag directives, in parse order. ,jdeclaredaccounts :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order. diff --git a/Hledger/Read.hs b/Hledger/Read.hs --- a/Hledger/Read.hs +++ b/Hledger/Read.hs @@ -93,6 +93,8 @@ defaultJournalWithSafely, defaultJournalPath, defaultJournalPathSafely, + defaultExistingJournalPath, + defaultExistingJournalPathSafely, requireJournalFileExists, ensureJournalFileExists, journalEnvVar, @@ -103,6 +105,7 @@ runExceptT, readJournal, readJournalFile, + readPossibleJournalFile, readJournalFiles, readJournalFilesAndLatestDates, @@ -147,27 +150,24 @@ import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Time (Day) -import Safe (headDef, headMay) +import Safe (headDef) import System.Directory (doesFileExist) import System.Environment (getEnv) import System.FilePath ((<.>), (), splitDirectories, splitFileName, takeFileName) import System.Info (os) import System.IO (Handle, hPutStrLn, stderr) +import Text.Printf (printf) import Hledger.Data.Dates (getCurrentDay, parsedate, showDate) +import Hledger.Data.Journal (journalNumberTransactions, nulljournal) +import Hledger.Data.JournalChecks (journalStrictChecks) import Hledger.Data.Types import Hledger.Read.Common import Hledger.Read.InputOptions import Hledger.Read.JournalReader as JournalReader import Hledger.Read.CsvReader (tests_CsvReader) import Hledger.Read.RulesReader (tests_RulesReader) --- import Hledger.Read.TimedotReader (tests_TimedotReader) --- import Hledger.Read.TimeclockReader (tests_TimeclockReader) import Hledger.Utils -import Prelude hiding (getContents, writeFile) -import Hledger.Data.JournalChecks (journalStrictChecks) -import Text.Printf (printf) -import Hledger.Data.Journal (journalNumberTransactions) --- ** doctest setup -- $setup @@ -202,34 +202,29 @@ ,C.Handler (\(e :: C.IOException) -> return $ Left $ show e) ] --- | Get the default journal file path, and check that it exists; or raise an error. +-- | Get the default journal file path - either $LEDGER_FILE or $HOME/.hledger.journal file. -- -- This looks for the LEDGER_FILE environment variable, like Ledger. --- The value should be a file path; ~ at the start is supported, meaning user's home directory. --- The value can also be a glob pattern, for convenience; if so we consider only the first matched file. --- If no such file exists, an error is raised. +-- The value should be a file path, possibly with ~ at the start meaning the current user's home directory. +-- Or the value can be a glob pattern (containing *, ?, [ or {) ), in which case the first matching file path is used. +-- When it's a glob pattern that matches no existing files, an error is raised. -- --- If LEDGER_FILE is unset or set to the empty string, we return a default file path: --- @.hledger.journal@ in the user's home directory. --- Or if we can't find the user's home directory, in the current directory. --- If this default file doesn't exist, an error is raised. +-- If LEDGER_FILE is unset or set to the empty string, this returns a default file path: +-- @.hledger.journal@ in the user's home directory, +-- or if we can't find the user's home directory, in the current directory. -- +-- The referenced file can be nonexistent. +-- defaultJournalPath :: IO String defaultJournalPath = do - ledgerfile <- getEnv journalEnvVar `C.catch` (\(_::C.IOException) -> return "") - if null ledgerfile + p <- getEnv journalEnvVar `C.catch` (\(_::C.IOException) -> return "") + if null p then do homedir <- fromMaybe "" <$> getHomeSafe let defaultfile = homedir journalDefaultFilename - exists <- doesFileExist defaultfile - if exists then return defaultfile - -- else error' $ "LEDGER_FILE is unset and \"" <> defaultfile <> "\" was not found" - else error' $ "neither LEDGER_FILE nor \"" <> defaultfile <> "\" was found" - else do - mf <- headMay <$> expandGlob "." ledgerfile `C.catch` (\(_::C.IOException) -> return []) - case mf of - Just f -> return f - Nothing -> error' $ "LEDGER_FILE points to nonexistent \"" <> ledgerfile <> "\"" + return defaultfile + else + expandPathOrGlob "." p -- | Like defaultJournalPath, but return an error message instead of raising an error. defaultJournalPathSafely :: IO (Either String String) @@ -242,6 +237,24 @@ ,C.Handler (\(e :: C.IOException) -> return $ Left $ show e) ] +-- | Like defaultJournalPath, but also checks that the file exists, and raises an error if it doesn't. +defaultExistingJournalPath :: IO String +defaultExistingJournalPath = do + f <- defaultJournalPath + requireJournalFileExists f + return f + +-- | Like defaultExistingJournalPath, but returns an error message instead of raising an error. +defaultExistingJournalPathSafely :: IO (Either String String) +defaultExistingJournalPathSafely = (do + f <- defaultExistingJournalPath + return $ Right f + ) + `C.catches` [ + C.Handler (\(e :: C.ErrorCall) -> return $ Left $ show e) + ,C.Handler (\(e :: C.IOException) -> return $ Left $ show e) + ] + -- | @readJournal iopts mfile txt@ -- -- Read a Journal from some handle, with strict checks if enabled, @@ -322,7 +335,18 @@ else return (j, Nothing) --- | Read a Journal from each specified file path (using @readJournalFile@) +-- | Like readJournalFile, but if the file does not exist, returns an empty journal +-- with the file path set. This is useful for commands like add and import that +-- need to work with a potentially non-existent journal file. +readPossibleJournalFile :: InputOpts -> PrefixedFilePath -> ExceptT String IO Journal +readPossibleJournalFile iopts prefixedfile = do + let (_, f) = splitReaderPrefix prefixedfile + exists <- liftIO $ doesFileExist f + if exists + then readJournalFile iopts prefixedfile + else return $ nulljournal{jfiles = [(f, "")]} + +-- | Read a Journal from each specified file path (using @readJournalFile@) -- and combine them into one; or return the first error message. -- -- Combining Journals means concatenating them, basically. diff --git a/Hledger/Read/Common.hs b/Hledger/Read/Common.hs --- a/Hledger/Read/Common.hs +++ b/Hledger/Read/Common.hs @@ -151,6 +151,7 @@ import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..)) import Data.Word (Word8) +import System.Directory (canonicalizePath) import System.FilePath (takeFileName) import System.IO (Handle) import Text.Megaparsec @@ -314,11 +315,12 @@ -- Timeclock and Timedot files. initialiseAndParseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal -initialiseAndParseJournal parser iopts f txt = - prettyParseErrors $ runParserT (evalStateT parser initJournal) f txt +initialiseAndParseJournal parser iopts f txt = do + cf <- liftIO $ canonicalizePath f + prettyParseErrors $ runParserT (evalStateT parser (initJournal cf)) f txt where y = first3 . toGregorian $ _ioDay iopts - initJournal = nulljournal{jparsedefaultyear = Just y, jincludefilestack = [f]} + initJournal cf = nulljournal{jparsedefaultyear = Just y, jincludefilestack = [(f, cf)]} -- Flatten parse errors and final parse errors, and output each as a pretty String. prettyParseErrors :: ExceptT FinalParseError IO (Either (ParseErrorBundle Text HledgerParseErrorData) a) -> ExceptT String IO a diff --git a/Hledger/Read/JournalReader.hs b/Hledger/Read/JournalReader.hs --- a/Hledger/Read/JournalReader.hs +++ b/Hledger/Read/JournalReader.hs @@ -388,19 +388,25 @@ -- Make ** also match file name parts like zsh's GLOB_STAR_SHORT. let - expandedglob' = + finalglob = -- ** without a slash is equivalent to **/* case regexReplace (toRegex' $ T.pack "\\*\\*([^/\\])") "**/*\\1" expandedglob of Right s -> s Left _ -> expandedglob -- ignore any error, there should be none -- Compile as a Pattern. Can throw an error. - g <- case tryCompileWith compDefault{errorRecovery=False} expandedglob' of + pat <- case tryCompileWith compDefault{errorRecovery=False} finalglob of Left e -> customFailure $ parseErrorAt off $ "Invalid glob pattern: " ++ e Right x -> pure x -- Find all matched paths. These might include directories or the current file. - paths <- liftIO $ globDir1 g cwd + -- Glob seems to get attributes of all files in a directory, which disturbs build systems + -- which detect dependencies based on filesystem operations (eg tup). + -- So avoid using it if not needed. + paths <- liftIO $ + if isLiteral pat + then return $ if isAbsolute finalglob then [finalglob] else [cwd finalglob] + else globDir1 pat cwd -- Exclude any directories or symlinks to directories, and canonicalise, and sort. files <- liftIO $ @@ -410,12 +416,11 @@ -- Throw an error if one of these files is among the grandparent files, forming a cycle. -- Though, ignore the immediate parent file for convenience. XXX inconsistent - should it ignore all cyclic includes ? - -- We used to store the canonical paths, then switched to non-canonical paths for more useful output, - -- which means for each include directive we must re-canonicalise everything here; noticeable ? XXX + -- Use canonical paths for cycle detection, show nominal absolute paths in error messages. parentj <- get let parentfiles = jincludefilestack parentj - cparentfiles <- liftIO $ mapM canonicalizePath parentfiles - let cparentf = take 1 parentfiles + cparentfiles = map snd parentfiles + cparentf = take 1 cparentfiles files2 <- forM files $ \f -> do cf <- liftIO $ canonicalizePath f if @@ -442,8 +447,9 @@ -- Read the file's content, or throw an error childInput <- lift $ readFilePortably filepath & handleIOError off "failed to read a file" + cfilepath <- liftIO $ canonicalizePath filepath parentj <- get - let initChildj = newJournalWithParseStateFrom filepath parentj + let initChildj = newJournalWithParseStateFrom filepath cfilepath parentj -- Choose a reader based on the file path prefix or file extension, -- defaulting to JournalReader. Duplicating readJournal a bit here. @@ -470,14 +476,14 @@ where childfilename = takeFileName filepath - parentfilename = maybe "(unknown)" takeFileName $ headMay $ jincludefilestack parentj -- XXX more accurate than journalFilePath for some reason + parentfilename = maybe "(unknown)" takeFileName $ fmap fst $ headMay $ jincludefilestack parentj -- XXX more accurate than journalFilePath for some reason -- And update the current parse state. put parentj' where - newJournalWithParseStateFrom :: FilePath -> Journal -> Journal - newJournalWithParseStateFrom filepath j = nulljournal{ + newJournalWithParseStateFrom :: FilePath -> FilePath -> Journal -> Journal + newJournalWithParseStateFrom filepath cfilepath j = nulljournal{ jparsedefaultyear = jparsedefaultyear j ,jparsedefaultcommodity = jparsedefaultcommodity j ,jparseparentaccounts = jparseparentaccounts j @@ -486,7 +492,7 @@ ,jdeclaredcommodities = jdeclaredcommodities j -- ,jparsetransactioncount = jparsetransactioncount j ,jparsetimeclockentries = jparsetimeclockentries j - ,jincludefilestack = filepath : jincludefilestack j + ,jincludefilestack = (filepath, cfilepath) : jincludefilestack j } -- Get the absolute path of the file referenced by this parse position. diff --git a/Hledger/Utils/IO.hs b/Hledger/Utils/IO.hs --- a/Hledger/Utils/IO.hs +++ b/Hledger/Utils/IO.hs @@ -40,6 +40,7 @@ expandHomePath, expandPath, expandGlob, + expandPathOrGlob, sortByModTime, openFileOrStdin, readFileOrStdinPortably, @@ -419,6 +420,26 @@ -- For a more elaborate glob expander, see 'findMatchedFiles' (used by the include directive). expandGlob :: FilePath -> FilePath -> IO [FilePath] expandGlob curdir p = expandPath curdir p >>= glob <&> sort -- PARTIAL: + +-- | Like expandPath, but if the path contains glob metacharacters (* ? [ {), +-- treats it as a glob pattern and expands it, returning the first match. +-- Raises an error if the glob pattern matches no files. +-- If the path contains no glob metacharacters, just expands ~ and returns the path, +-- even if the file doesn't exist yet. +-- This is useful for options like -f and LEDGER_FILE that should: +-- - accept non-existent files (for commands like add/import that create them) +-- - expand glob patterns and error if they don't match anything +expandPathOrGlob :: FilePath -> FilePath -> IO FilePath +expandPathOrGlob curdir p = do + let hasGlobChars = any (`elem` p) ("*?[{" :: [Char]) + if hasGlobChars + then do + matches <- expandGlob curdir p `catch` (\(_::IOException) -> return []) + case headMay matches of + Just f -> return f + Nothing -> error' $ "glob pattern \"" <> p <> "\" matched no files" + else + expandPath curdir p -- | Given a list of existing file paths, sort them by modification time (from oldest to newest). sortByModTime :: [FilePath] -> IO [FilePath] diff --git a/hledger-lib.cabal b/hledger-lib.cabal --- a/hledger-lib.cabal +++ b/hledger-lib.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hledger-lib -version: 1.51.1 +version: 1.51.2 synopsis: A library providing the core functionality of hledger description: This library contains hledger's core functionality. It is used by most hledger* packages so that they support the same @@ -124,7 +124,7 @@ hs-source-dirs: ./ ghc-options: -Wall -Wno-incomplete-uni-patterns -Wno-missing-signatures -Wno-orphans -Wno-type-defaults -Wno-unused-do-bind - cpp-options: -DVERSION="1.51.1" + cpp-options: -DVERSION="1.51.2" build-depends: Decimal >=0.5.1 , Glob >=0.9 @@ -132,7 +132,7 @@ , aeson-pretty , ansi-terminal >=0.9 , array - , base >=4.18 && <4.22 + , base >=4.18 && <4.23 , blaze-html , blaze-markup >=0.5.1 , bytestring @@ -184,7 +184,7 @@ hs-source-dirs: test ghc-options: -Wall -Wno-incomplete-uni-patterns -Wno-missing-signatures -Wno-orphans -Wno-type-defaults -Wno-unused-do-bind - cpp-options: -DVERSION="1.51.1" + cpp-options: -DVERSION="1.51.2" build-depends: Decimal >=0.5.1 , Glob >=0.7 @@ -192,7 +192,7 @@ , aeson-pretty , ansi-terminal >=0.9 , array - , base >=4.18 && <4.22 + , base >=4.18 && <4.23 , blaze-html , blaze-markup >=0.5.1 , bytestring @@ -245,7 +245,7 @@ hs-source-dirs: test ghc-options: -Wall -Wno-incomplete-uni-patterns -Wno-missing-signatures -Wno-orphans -Wno-type-defaults -Wno-unused-do-bind - cpp-options: -DVERSION="1.51.1" + cpp-options: -DVERSION="1.51.2" build-depends: Decimal >=0.5.1 , Glob >=0.9 @@ -253,7 +253,7 @@ , aeson-pretty , ansi-terminal >=0.9 , array - , base >=4.18 && <4.22 + , base >=4.18 && <4.23 , blaze-html , blaze-markup >=0.5.1 , bytestring