diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -13,11 +13,25 @@ --> -Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. +API/developer-ish changes in hledger-lib. For user-visible changes, see the hledger package changelog. -# 1.50.5 2025-12-08 +# 1.51 2025-12-05 + +Breaking changes + +- Hledger.Data.Balancing: balanceTransaction -> balanceSingleTransaction +- Hledger.Utils.IO: + - inputToHandle -> textToHandle; set utf8 not utf8_bom + - readHandlePortably, readHandlePortably' -> hGetContentsPortably + +Improvements + +- Hledger.Utils.String: + quoteForCommandLine now quotes some additional problem characters, and no longer quotes "7". + [#2468] + # 1.50.4 2025-12-04 diff --git a/Hledger/Data/Balancing.hs b/Hledger/Data/Balancing.hs --- a/Hledger/Data/Balancing.hs +++ b/Hledger/Data/Balancing.hs @@ -16,7 +16,7 @@ , defbalancingopts -- * transaction balancing , isTransactionBalanced -, balanceTransaction +, balanceSingleTransaction , balanceTransactionHelper -- * assertion validation , transactionCheckAssertions @@ -173,32 +173,21 @@ Right _ -> Right t Left e -> Left e --- | Balance this transaction, ensuring that its postings +-- | Balance this isolated transaction, ensuring that its postings -- (and its balanced virtual postings) sum to 0, -- by inferring a missing amount or conversion price(s) if needed. -- Or if balancing is not possible, because the amounts don't sum to 0 or -- because there's more than one missing amount, return an error message. -- --- Transactions with balance assignments can have more than one --- missing amount; to balance those you should use the more powerful --- journalBalanceTransactions. --- --- The "sum to 0" test is done using commodity display precisions, --- if provided, so that the result agrees with the numbers users can see. --- -balanceTransaction :: - BalancingOpts - -> Transaction - -> Either String Transaction -balanceTransaction bopts = fmap fst . balanceTransactionHelper bopts +-- Note this is not as accurate as @balanceTransactionInJournal@, +-- which considers the whole journal when calculating balance assignments and balance assertions. +balanceSingleTransaction :: BalancingOpts -> Transaction -> Either String Transaction +balanceSingleTransaction bopts = fmap fst . balanceTransactionHelper bopts --- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; +-- | Helper used by balanceSingleTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; -- use one of those instead. -- It also returns a list of accounts and amounts that were inferred. -balanceTransactionHelper :: - BalancingOpts - -> Transaction - -> Either String (Transaction, [(AccountName, MixedAmount)]) +balanceTransactionHelper :: BalancingOpts -> Transaction -> Either String (Transaction, [(AccountName, MixedAmount)]) balanceTransactionHelper bopts t = do let lbl = lbl_ "balanceTransactionHelper" (t', inferredamtsandaccts) <- t @@ -411,7 +400,7 @@ -- journalBalanceTransactions -- runST -- runExceptT --- balanceTransaction (Transaction.hs) +-- balanceSingleTransaction (Transaction.hs) -- balanceTransactionHelper -- runReaderT -- balanceTransactionAndCheckAssertionsB @@ -422,7 +411,7 @@ -- journalCheckBalanceAssertions -- journalBalanceTransactions -- transactionWizard, postingsBalanced (Add.hs), tests (Transaction.hs) --- balanceTransaction (Transaction.hs) XXX hledger add won't allow balance assignments + missing amount ? +-- balanceSingleTransaction (Transaction.hs) XXX hledger add won't allow balance assignments + missing amount ? -- | Monad used for statefully balancing/amount-inferring/assertion-checking -- a sequence of transactions. @@ -532,7 +521,7 @@ -- postponing those which do until later. The balanced ones are split into their postings, -- keeping these and the not-yet-balanced transactions in the same relative order. psandts :: [Either Posting Transaction] <- fmap concat $ forM ts $ \case - t | null $ assignmentPostings t -> case balanceTransaction bopts t of + t | null $ assignmentPostings t -> case balanceSingleTransaction bopts t of Left e -> throwError e Right t' -> do lift $ writeArray balancedtxns (tindex t') t' @@ -810,10 +799,10 @@ (fst <$> transactionInferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]} - , testGroup "balanceTransaction" [ + , testGroup "balanceSingleTransaction" [ testCase "detect unbalanced entry, sign error" $ assertLeft - (balanceTransaction defbalancingopts + (balanceSingleTransaction defbalancingopts (Transaction 0 "" @@ -828,7 +817,7 @@ [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}])) ,testCase "detect unbalanced entry, multiple missing amounts" $ assertLeft $ - balanceTransaction defbalancingopts + balanceSingleTransaction defbalancingopts (Transaction 0 "" @@ -845,7 +834,7 @@ ]) ,testCase "one missing amount is inferred" $ (pamount . last . tpostings <$> - balanceTransaction defbalancingopts + balanceSingleTransaction defbalancingopts (Transaction 0 "" @@ -861,7 +850,7 @@ Right (mixedAmount $ usd (-1)) ,testCase "conversion price is inferred" $ (pamount . headErr . tpostings <$> -- PARTIAL headErr succeeds because non-null postings list - balanceTransaction defbalancingopts + balanceSingleTransaction defbalancingopts (Transaction 0 "" @@ -877,9 +866,9 @@ , posting {paccount = "b", pamount = mixedAmount (eur (-1))} ])) @?= Right (mixedAmount $ usd 1.35 @@ eur 1) - ,testCase "balanceTransaction balances based on cost if there are unit prices" $ + ,testCase "balanceSingleTransaction balances based on cost if there are unit prices" $ assertRight $ - balanceTransaction defbalancingopts + balanceSingleTransaction defbalancingopts (Transaction 0 "" @@ -894,9 +883,9 @@ [ posting {paccount = "a", pamount = mixedAmount $ usd 1 `at` eur 2} , posting {paccount = "a", pamount = mixedAmount $ usd (-2) `at` eur 1} ]) - ,testCase "balanceTransaction balances based on cost if there are total prices" $ + ,testCase "balanceSingleTransaction balances based on cost if there are total prices" $ assertRight $ - balanceTransaction defbalancingopts + balanceSingleTransaction defbalancingopts (Transaction 0 "" diff --git a/Hledger/Data/Journal.hs b/Hledger/Data/Journal.hs --- a/Hledger/Data/Journal.hs +++ b/Hledger/Data/Journal.hs @@ -1153,6 +1153,7 @@ -- "comm" and "cur" are accepted as synonyms meaning the commodity symbol. -- Pivoting on an unknown field or tag, or on commodity when there are multiple commodities, returns "". -- Pivoting on a tag when there are multiple values for that tag, returns the first value. +-- Pivoting on the "type" tag normalises type values to their short spelling. pivotComponent :: Text -> Posting -> Text pivotComponent fieldortagname p | fieldortagname == "code", Just t <- ptransaction p = tcode t @@ -1164,7 +1165,10 @@ | fieldortagname `elem` commnames = case map acommodity $ amounts $ pamount p of [s] -> s; _ -> unknown | fieldortagname == "amt" = case amounts $ pamount p of [a] -> T.pack $ show $ aquantity a; _ -> unknown | fieldortagname == "cost" = case amounts $ pamount p of [a@Amount{acost=Just _}] -> T.pack $ lstrip $ showAmountCost a; _ -> unknown - | Just (_, tagvalue) <- postingFindTag fieldortagname p = tagvalue + | Just (_, tagvalue) <- postingFindTag fieldortagname p = + if fieldortagname == "type" + then either (const tagvalue) (T.pack . show) $ parseAccountType True tagvalue + else tagvalue | otherwise = unknown where descnames = ["desc", "description"] -- allow "description" for hledger <=1.30 compat diff --git a/Hledger/Read.hs b/Hledger/Read.hs --- a/Hledger/Read.hs +++ b/Hledger/Read.hs @@ -133,7 +133,7 @@ --- ** imports import Control.Exception qualified as C -import Control.Monad (unless, when, forM, (<=<)) +import Control.Monad (unless, when, forM, (>=>)) import "mtl" Control.Monad.Except (ExceptT(..), runExceptT, liftEither) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Default (def) @@ -361,7 +361,7 @@ -- | An even easier version of readJournal' which takes a 'Text' instead of a 'Handle'. readJournal'' :: Text -> IO Journal -readJournal'' = readJournal' <=< inputToHandle +readJournal'' = textToHandle >=> readJournal' -- | An easy version of 'readJournalFile' which assumes default options, and fails -- in the IO monad. diff --git a/Hledger/Read/Common.hs b/Hledger/Read/Common.hs --- a/Hledger/Read/Common.hs +++ b/Hledger/Read/Common.hs @@ -262,7 +262,7 @@ handleReadFnToTextReadFn :: (InputOpts -> FilePath -> Text -> ExceptT String IO Journal) -> InputOpts -> FilePath -> Handle -> ExceptT String IO Journal handleReadFnToTextReadFn p iopts fp = - p iopts fp <=< lift . readHandlePortably + p iopts fp <=< lift . hGetContentsPortably Nothing -- | Get the date span from --forecast's PERIODEXPR argument, if any. -- This will fail with a usage error if the period expression cannot be parsed, diff --git a/Hledger/Read/CsvReader.hs b/Hledger/Read/CsvReader.hs --- a/Hledger/Read/CsvReader.hs +++ b/Hledger/Read/CsvReader.hs @@ -63,7 +63,7 @@ parse sep iopts f h = do rules <- readRules $ getRulesFile f (mrules_file_ iopts) mencoding <- rulesEncoding rules - csvtext <- lift $ readHandlePortably' mencoding h + csvtext <- lift $ hGetContentsPortably mencoding h readJournalFromCsv rules f csvtext (Just sep) -- apply any command line account aliases. Can fail with a bad replacement pattern. >>= liftEither . journalApplyAliases (aliasesFromOpts iopts) diff --git a/Hledger/Read/JournalReader.hs b/Hledger/Read/JournalReader.hs --- a/Hledger/Read/JournalReader.hs +++ b/Hledger/Read/JournalReader.hs @@ -318,7 +318,7 @@ ) <|> errorNoArg let (mprefix,glb) = splitReaderPrefix prefixedglob - parentf <- sourcePosFilePath pos + parentf <- sourcePosFilePath pos -- a little slow, don't do too often 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. @@ -378,8 +378,7 @@ expandedglob <- lift $ expandHomePath globpattern `orRethrowIOError` "failed to expand ~" -- get the directory of the including file - -- need to canonicalise a symlink parentf so takeDirectory works correctly [#2503] - cwd <- fmap takeDirectory <$> liftIO $ canonicalizePath parentf + let cwd = takeDirectory parentf -- Don't allow 3 or more stars. when ("***" `isInfixOf` expandedglob) $ diff --git a/Hledger/Read/RulesReader.hs b/Hledger/Read/RulesReader.hs --- a/Hledger/Read/RulesReader.hs +++ b/Hledger/Read/RulesReader.hs @@ -235,7 +235,7 @@ (_, Just f, mc) -> do -- trace "file found" $ mencoding <- rulesEncoding rules liftIO $ do - raw <- openFileOrStdin f >>= readHandlePortably' mencoding + raw <- openFileOrStdin f >>= hGetContentsPortably mencoding maybe (return raw) (\c -> runCommandAsFilter rulesfile (dbg0Msg ("running: "++c) c) raw) mc -- no file pattern, but a data generating command diff --git a/Hledger/Utils/IO.hs b/Hledger/Utils/IO.hs --- a/Hledger/Utils/IO.hs +++ b/Hledger/Utils/IO.hs @@ -46,10 +46,9 @@ readFileOrStdinPortably', readFileStrictly, readFilePortably, - readHandlePortably, - readHandlePortably', + hGetContentsPortably, -- hereFileRelative, - inputToHandle, + textToHandle, -- * Command line parsing progArgs, @@ -154,7 +153,7 @@ import System.FilePath (isRelative, ()) import "Glob" System.FilePath.Glob (glob) import System.Info (os) -import System.IO (Handle, IOMode (..), hClose, hGetEncoding, hIsTerminalDevice, hPutStr, hPutStrLn, hSetNewlineMode, hSetEncoding, openFile, stderr, stdin, stdout, universalNewlineMode, utf8_bom) +import System.IO (Handle, IOMode (..), hClose, hGetEncoding, hIsTerminalDevice, hPutStr, hPutStrLn, hSetNewlineMode, hSetEncoding, openFile, stderr, stdin, stdout, universalNewlineMode, utf8_bom, utf8) import System.IO.Encoding qualified as Enc import System.IO.Unsafe (unsafePerformIO) import System.Process (CreateProcess(..), StdStream(CreatePipe), createPipe, shell, waitForProcess, withCreateProcess) @@ -417,6 +416,7 @@ -- | Like expandPath, but treats the expanded path as a glob, and returns -- zero or more matched absolute file paths, alphabetically sorted. -- Can raise an error. +-- 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: @@ -435,7 +435,7 @@ -- using the system locale's text encoding, -- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8. readFilePortably :: FilePath -> IO T.Text -readFilePortably f = openFile f ReadMode >>= readHandlePortably +readFilePortably f = openFile f ReadMode >>= hGetContentsPortably Nothing -- | Like readFilePortably, but read from standard input if the path is "-". readFileOrStdinPortably :: String -> IO T.Text @@ -443,7 +443,7 @@ -- | Like readFileOrStdinPortably, but take an optional converter. readFileOrStdinPortably' :: Maybe DynEncoding -> String -> IO T.Text -readFileOrStdinPortably' c f = openFileOrStdin f >>= readHandlePortably' c +readFileOrStdinPortably' c f = openFileOrStdin f >>= hGetContentsPortably c -- | Open a file for reading, using the standard System.IO.openFile. -- This opens the handle in text mode, using the initial system locale's text encoding. @@ -451,32 +451,27 @@ openFileOrStdin "-" = return stdin openFileOrStdin f' = openFile f' ReadMode --- readHandlePortably' with no text encoding specified. -readHandlePortably :: Handle -> IO T.Text -readHandlePortably = readHandlePortably' Nothing - --- | Read text from a handle with a specified encoding, using the encoding package. --- Or if no encoding is specified, it uses the handle's current encoding, --- after first changing it to UTF-8BOM if it was UTF-8, to allow a Byte Order Mark at the start. +-- | Read text from a handle, perhaps using a specified encoding from the encoding package. +-- Or if no encoding is specified, using the handle's current encoding, +-- changing it to UTF-8BOM if it was UTF-8, to ignore any Byte Order Mark at the start. -- Also it converts Windows line endings to newlines. -- If decoding fails, this throws an IOException (or possibly a UnicodeException or something else from the encoding package). -readHandlePortably' :: Maybe DynEncoding -> Handle -> IO T.Text -readHandlePortably' Nothing h = do +hGetContentsPortably :: Maybe DynEncoding -> Handle -> IO T.Text +hGetContentsPortably Nothing h = do hSetNewlineMode h universalNewlineMode menc <- hGetEncoding h when (fmap show menc == Just "UTF-8") $ hSetEncoding h utf8_bom T.hGetContents h -readHandlePortably' (Just e) h = +hGetContentsPortably (Just e) h = -- convert newlines manually, because Enc.hGetContents uses bytestring's hGetContents T.replace "\r\n" "\n" . T.pack <$> let ?enc = e in Enc.hGetContents h --- | Create a handle from which the given text can be read. --- Its encoding will be UTF-8BOM. -inputToHandle :: T.Text -> IO Handle -inputToHandle t = do +-- | Create a handle from which the given text can be read. Its encoding will be UTF-8. +textToHandle :: T.Text -> IO Handle +textToHandle t = do (r, w) <- createPipe - hSetEncoding r utf8_bom - hSetEncoding w utf8_bom + hSetEncoding r utf8 + hSetEncoding w utf8 -- use a separate thread so that we don't deadlock if we can't write all of the text at once forkIO $ T.hPutStr w t >> hClose w return r 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.5 +version: 1.51 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 @@ -46,7 +46,7 @@ location: https://github.com/simonmichael/hledger flag debug - description: Build with GHC 9.10+'s stack traces enabled + description: Build with GHC 9.10+ stack traces enabled manual: True default: False @@ -57,9 +57,11 @@ Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount + Hledger.Data.BalanceData Hledger.Data.Balancing Hledger.Data.Currency Hledger.Data.Dates + Hledger.Data.DayPartition Hledger.Data.Errors Hledger.Data.Journal Hledger.Data.JournalChecks @@ -68,10 +70,11 @@ Hledger.Data.Json Hledger.Data.Ledger Hledger.Data.Period + Hledger.Data.PeriodData Hledger.Data.PeriodicTransaction - Hledger.Data.StringFormat Hledger.Data.Posting Hledger.Data.RawOptions + Hledger.Data.StringFormat Hledger.Data.Timeclock Hledger.Data.Transaction Hledger.Data.TransactionModifier @@ -84,26 +87,17 @@ Hledger.Read.InputOptions Hledger.Read.JournalReader Hledger.Read.RulesReader - Hledger.Read.TimedotReader Hledger.Read.TimeclockReader - Hledger.Write.Beancount - Hledger.Write.Csv - Hledger.Write.Ods - Hledger.Write.Html - Hledger.Write.Html.Attribute - Hledger.Write.Html.Blaze - Hledger.Write.Html.Lucid - Hledger.Write.Html.HtmlCommon - Hledger.Write.Spreadsheet + Hledger.Read.TimedotReader Hledger.Reports - Hledger.Reports.ReportOptions - Hledger.Reports.ReportTypes Hledger.Reports.AccountTransactionsReport Hledger.Reports.BalanceReport Hledger.Reports.BudgetReport Hledger.Reports.EntriesReport Hledger.Reports.MultiBalanceReport Hledger.Reports.PostingsReport + Hledger.Reports.ReportOptions + Hledger.Reports.ReportTypes Hledger.Utils Hledger.Utils.Debug Hledger.Utils.IO @@ -112,18 +106,25 @@ Hledger.Utils.String Hledger.Utils.Test Hledger.Utils.Text + Hledger.Write.Beancount + Hledger.Write.Csv + Hledger.Write.Html + Hledger.Write.Html.Attribute + Hledger.Write.Html.Blaze + Hledger.Write.Html.HtmlCommon + Hledger.Write.Html.Lucid + Hledger.Write.Ods + Hledger.Write.Spreadsheet Text.Tabular.AsciiWide Text.WideString other-modules: - Hledger.Data.BalanceData - Hledger.Data.DayPartition - Hledger.Data.PeriodData Paths_hledger_lib autogen-modules: Paths_hledger_lib 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" build-depends: Decimal >=0.5.1 , Glob >=0.9 @@ -183,6 +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" build-depends: Decimal >=0.5.1 , Glob >=0.7 @@ -236,8 +238,6 @@ default-language: GHC2021 if (flag(debug)) cpp-options: -DDEBUG - if impl(ghc >= 9.0) && impl(ghc < 9.2) - buildable: False test-suite unittest type: exitcode-stdio-1.0 @@ -245,6 +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" build-depends: Decimal >=0.5.1 , Glob >=0.9