diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,8 @@ For user-visible changes, see the hledger package changelog. +# 1.50.4 2025-12-04 + # 1.50.3 2025-11-18 # 1.50.2 2025-09-26 diff --git a/Hledger/Read/JournalReader.hs b/Hledger/Read/JournalReader.hs --- a/Hledger/Read/JournalReader.hs +++ b/Hledger/Read/JournalReader.hs @@ -32,6 +32,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiWayIf #-} --- ** exports module Hledger.Read.JournalReader ( @@ -72,13 +73,14 @@ --- ** imports import Control.Exception qualified as C -import Control.Monad (forM_, when, void, unless, filterM) +import Control.Monad (forM_, when, void, unless, filterM, forM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Except (ExceptT(..), runExceptT) import Control.Monad.State.Strict (evalStateT,get,modify',put) import Control.Monad.Trans.Class (lift) import Data.Char (toLower) import Data.Either (isRight, lefts) +import Data.Functor ((<&>)) import Data.Map.Strict qualified as M import Data.Text (Text) import Data.String @@ -91,6 +93,7 @@ import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char import Text.Printf +import System.Directory (canonicalizePath, doesFileExist, makeAbsolute) import System.FilePath import "Glob" System.FilePath.Glob hiding (match) -- import "filepattern" System.FilePattern.Directory @@ -103,8 +106,6 @@ import Hledger.Read.RulesReader qualified as RulesReader (reader) import Hledger.Read.TimeclockReader qualified as TimeclockReader (reader) import Hledger.Read.TimedotReader qualified as TimedotReader (reader) -import System.Directory (canonicalizePath, doesFileExist) -import Data.Functor ((<&>)) --- ** doctest setup -- $setup @@ -304,21 +305,26 @@ -- save the position at start of include directive, for error messages eoff <- getOffset pos <- getSourcePos + let errorNoArg = customFailure $ parseErrorAt eoff "include needs a file path or glob pattern argument" -- parse the directive string "include" - lift skipNonNewlineSpaces1 - prefixedglob <- rstrip . T.unpack <$> takeWhileP Nothing (`notElem` [';','\n']) - lift followingcommentp + -- notFollowedBy newline "a file path or glob pattern argument" + prefixedglob <- (do + lift skipNonNewlineSpaces1 + prefixedglob <- rstrip . T.unpack <$> takeWhileP Nothing (`notElem` [';','\n']) + lift followingcommentp + return prefixedglob + ) <|> errorNoArg + let (mprefix,glb) = splitReaderPrefix prefixedglob parentf <- sourcePosFilePath pos -- a little slow, don't do too often - when (null $ dbg6 (parentf <> " include: glob pattern") glb) $ - customFailure $ parseErrorAt eoff $ "include needs a file path or glob pattern argument" + when (null $ dbg6 (parentf <> " include: glob pattern") glb) errorNoArg -- Find the file or glob-matched files (just the ones from this include directive), with some IO error checking. + paths <- findMatchedFiles eoff parentf glb -- Also report whether a glob pattern was used, and not just a literal file path. -- (paths, isglob) <- findMatchedFiles off pos glb - paths <- findMatchedFiles eoff parentf glb -- XXX worth the trouble ? no -- Comprehensively exclude files already processed. Some complexities here: @@ -336,7 +342,7 @@ Just fmt -> map ((show fmt++":")++) paths -- Parse each one, as if inlined here. - forM_ prefixedpaths $ parseIncludedFile iopts eoff + forM_ prefixedpaths $ parseIncludedFile iopts where @@ -348,12 +354,8 @@ -- Converts ** without a slash to **/*, like zsh's GLOB_STAR_SHORT, so ** also matches file name parts. -- Checks if any matched paths are directories and excludes those. -- Converts all matched paths to their canonical form. - -- - -- Glob patterns never match dot files or files under dot directories, - -- even if it seems like they should; this is a workaround for Glob bug #49. - -- This workaround is disabled if the --old-glob flag is present in the command line - -- (detected with unsafePerformIO; it's not worth a ton of boilerplate). - -- In that case, be aware ** recursive globs will search intermediate dot directories. + -- Note * and ** mostly won't implicitly match dot files or dot directories, + -- but ** will implicitly search non-top-level dot directories (see #2498, Glob#49). findMatchedFiles :: (MonadIO m) => Int -> FilePath -> FilePath -> JournalParser m [FilePath] findMatchedFiles off parentf globpattern = do @@ -369,8 +371,8 @@ -- * at the start of a file name ignores dot-named files and directories, by default. -- ** (or zero or more consecutive *'s) not followed by slash is equivalent to *. -- A **/ component matches any number of directory parts. - -- A **/ ignores dot-named directories in its starting and ending directories, by default. - -- But **/ does search intermediate dot-named directories. Eg it can find a/.b/c. + -- A **/ does not implicitly search top-level dot directories or implicitly match do files, + -- but it does search non-top-level dot directories. Eg ** will find the c file in a/.b/c. -- expand a tilde at the start of the glob pattern, or throw an error expandedglob <- lift $ expandHomePath globpattern `orRethrowIOError` "failed to expand ~" @@ -394,7 +396,6 @@ g <- case tryCompileWith compDefault{errorRecovery=False} expandedglob' of Left e -> customFailure $ parseErrorAt off $ "Invalid glob pattern: " ++ e Right x -> pure x - let isglob = not $ isLiteral g -- Find all matched paths. These might include directories or the current file. paths <- liftIO $ globDir1 g cwd @@ -402,49 +403,44 @@ -- Exclude any directories or symlinks to directories, and canonicalise, and sort. files <- liftIO $ filterM doesFileExist paths - >>= mapM canonicalizePath + >>= mapM makeAbsolute <&> sort - -- Work around a Glob bug with dot dirs: while **/ ignores dot dirs in the starting and ending dirs, - -- it does search dot dirs in between those two (Glob #49). - -- This could be inconvenient, eg making it hard to avoid VCS directories in a source tree. - -- We work around as follows: when any glob was used, paths involving dot dirs are excluded in post processing. - -- Unfortunately this means valid globs like .dotdir/* can't be used; only literal paths can match - -- things in dot dirs. An --old-glob command line flag disables this workaround, for backward compatibility. - oldglobflag <- liftIO $ getFlag ["old-glob"] - let - files2 = (if isglob && not oldglobflag then filter (not.hasdotdir) else id) files - where - hasdotdir p = any isdotdir $ splitPath p - where - isdotdir c = "." `isPrefixOf` c && "/" `isSuffixOf` c + -- 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 + parentj <- get + let parentfiles = jincludefilestack parentj + cparentfiles <- liftIO $ mapM canonicalizePath parentfiles + let cparentf = take 1 parentfiles + files2 <- forM files $ \f -> do + cf <- liftIO $ canonicalizePath f + if + | [cf] == cparentf -> return cf -- current file - return canonicalised, will be excluded later + | cf `elem` drop 1 cparentfiles -> customFailure $ parseErrorAt off $ "This included file forms a cycle: " ++ f + | otherwise -> return f -- Throw an error if no files were matched. - when (null files2) $ - customFailure $ parseErrorAt off $ "No files were matched by glob pattern: " ++ globpattern + when (null files2) $ customFailure $ parseErrorAt off $ "No files were matched by: " ++ globpattern - -- If a glob was used, exclude the current file, for convenience. + -- If the current file got included, ignore it (last, to avoid triggering the error above). let files3 = - dbg6 (parentf <> " include: matched files" <> if isglob then " (excluding current file)" else "") $ - (if isglob then filter (/= parentf) else id) files2 + dbg6 (parentf <> " include: matched files (excluding current file)") $ + filter (not.(`elem` cparentf)) files2 return files3 -- Parse the given included file (and any deeper includes, recursively) as if it was inlined in the current (parent) file. -- The offset of the start of the include directive in the parent file is provided for error messages. - parseIncludedFile :: MonadIO m => InputOpts -> Int -> PrefixedFilePath -> ErroringJournalParser m () - parseIncludedFile iopts1 eoff prefixedpath = do + parseIncludedFile :: MonadIO m => InputOpts -> PrefixedFilePath -> ErroringJournalParser m () + parseIncludedFile iopts1 prefixedpath = do let (_mprefix,filepath) = splitReaderPrefix prefixedpath - -- Throw an error if a cycle is detected - parentj <- get - let parentfilestack = jincludefilestack parentj - when (dbg7 "parseIncludedFile: reading" filepath `elem` parentfilestack) $ - customFailure $ parseErrorAt eoff $ "This included file forms a cycle: " ++ filepath - -- Read the file's content, or throw an error childInput <- lift $ readFilePortably filepath `orRethrowIOError` "failed to read a file" + parentj <- get let initChildj = newJournalWithParseStateFrom filepath parentj -- Choose a reader based on the file path prefix or file extension, @@ -491,13 +487,11 @@ ,jincludefilestack = filepath : jincludefilestack j } --- Get the canonical path of the file referenced by this parse position. --- Symbolic links will be dereferenced. This probably will always succeed --- (since the parse file's path is probably always absolute). +-- Get the absolute path of the file referenced by this parse position. +-- (Symbolic links will not be dereferenced.) +-- This probably will always succeed, since the parse file's path is probably always absolute. sourcePosFilePath :: (MonadIO m) => SourcePos -> m FilePath -sourcePosFilePath = liftIO . canonicalizePath . sourceName --- "canonicalizePath is a very big hammer. If you only need an absolute path, makeAbsolute is sufficient" --- but we only do this once per include directive, seems ok to leave it as is. +sourcePosFilePath = liftIO . makeAbsolute . sourceName -- | Lift an IO action into the exception monad, rethrowing any IO -- error with the given message prepended. @@ -1258,8 +1252,8 @@ assertParse ignoredpricecommoditydirectivep "N $\n" ,testGroup "includedirectivep" [ - testCase "include" $ assertParseErrorE (includedirectivep definputopts) "include nosuchfile\n" "No files were matched by glob pattern: nosuchfile" - ,testCase "glob" $ assertParseErrorE (includedirectivep definputopts) "include nosuchfile*\n" "No files were matched by glob pattern: nosuchfile*" + testCase "include" $ assertParseErrorE (includedirectivep definputopts) "include nosuchfile\n" "No files were matched by: nosuchfile" + ,testCase "glob" $ assertParseErrorE (includedirectivep definputopts) "include nosuchfile*\n" "No files were matched by: nosuchfile*" ] ,testCase "marketpricedirectivep" $ assertParseEq marketpricedirectivep 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.50.3 +version: 1.50.4 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