diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index 593ed2fd136..cb7d19c45df 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -21,7 +21,7 @@ import Text.Printf import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount -import Hledger.Data.Posting (post, commentAddTagNextLine) +import Hledger.Data.Posting (post) import Hledger.Data.Transaction import Hledger.Utils.UTF8IOCompat (error') import Hledger.Utils.Debug @@ -87,107 +87,84 @@ instance Show PeriodicTransaction where -- -- >>> _ptgen "monthly from 2017/1 to 2017/4" -- 2017/01/01 --- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/02/01 --- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/03/01 --- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 -- a $1.00 -- -- -- >>> _ptgen "monthly from 2017/1 to 2017/5" -- 2017/01/01 --- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/02/01 --- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/03/01 --- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/04/01 --- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- -- >>> _ptgen "every 2nd day of month from 2017/02 to 2017/04" -- 2017/01/02 --- ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- 2017/02/02 --- ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- 2017/03/02 --- ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- -- >>> _ptgen "every 30th day of month from 2017/1 to 2017/5" -- 2016/12/30 --- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/01/30 --- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/02/28 --- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/03/30 --- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/04/30 --- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- -- >>> _ptgen "every 2nd Thursday of month from 2017/1 to 2017/4" -- 2016/12/08 --- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/01/12 --- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/02/09 --- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/03/09 --- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- -- >>> _ptgen "every nov 29th from 2017 to 2019" -- 2016/11/29 --- ; generated-transaction: ~ every nov 29th from 2017 to 2019 -- a $1.00 -- -- 2017/11/29 --- ; generated-transaction: ~ every nov 29th from 2017 to 2019 -- a $1.00 -- -- 2018/11/29 --- ; generated-transaction: ~ every nov 29th from 2017 to 2019 -- a $1.00 -- -- -- >>> _ptgen "2017/1" -- 2017/01/01 --- ; generated-transaction: ~ 2017/1 -- a $1.00 -- -- @@ -214,21 +191,17 @@ instance Show PeriodicTransaction where -- -- >>> _ptgenspan "every 3 months from 2019-05" (mkdatespan "2020-02-01" "2020-03-01") -- 2020/02/01 --- ; generated-transaction: ~ every 3 months from 2019-05 -- a $1.00 -- -- >>> _ptgenspan "every 3 days from 2018" (mkdatespan "2018-01-01" "2018-01-05") -- 2018/01/01 --- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 -- -- 2018/01/04 --- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 -- -- >>> _ptgenspan "every 3 days from 2018" (mkdatespan "2018-01-02" "2018-01-05") -- 2018/01/04 --- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 -- @@ -240,10 +213,8 @@ runPeriodicTransaction PeriodicTransaction{..} requestedspan = tstatus = ptstatus ,tcode = ptcode ,tdescription = ptdescription - ,tcomment = ptcomment - `commentAddTagNextLine` ("generated-transaction",period) + ,tcomment = ptcomment <> "\n" -- force all further comments on new lines ,ttags = ("_generated-transaction",period) : - ("generated-transaction" ,period) : pttags ,tpostings = ptpostings } diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 6b9122c4c57..075ea4a767d 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -375,6 +375,7 @@ commentJoin c1 c2 -- A space is inserted following the colon, before the value. commentAddTag :: Text -> Tag -> Text commentAddTag c (t,v) + | "\n" `T.isSuffixOf` c = c <> tag -- never chomp last new-line | T.null c' = tag | otherwise = c' `commentJoin` tag where diff --git a/hledger-lib/Hledger/Data/Testing.hs b/hledger-lib/Hledger/Data/Testing.hs new file mode 100644 index 00000000000..7f1ab12d28f --- /dev/null +++ b/hledger-lib/Hledger/Data/Testing.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hledger.Data.Testing +where + +import Data.Char +import Data.Text (Text) +import qualified Data.Text as T + +import Test.QuickCheck + +import Hledger.Data.Types + +newtype ArbTag = ArbTag Tag deriving (Show) + +instance Arbitrary ArbTag where + arbitrary = do + -- See https://hledger.org/journal.html#tags + let arbNonSpace = (:[]) <$> (arbitraryPrintableChar `suchThat` (/= ',') `suchThat` (not . isSpace)) + tagName <- T.pack <$> listOf1 (arbitrary `suchThat` (\c -> isAlphaNum c || c `elem` ['-', '_'])) + tagValue <- T.pack <$> oneof [ + arbNonSpace + , do + lead <- arbNonSpace + middle <- listOf (arbitraryPrintableChar `suchThat` (`notElem` ['\n', ','])) + trail <- arbNonSpace + return (lead ++ middle ++ trail) + ] + return $ ArbTag (tagName, tagValue) + + +newtype ArbComment = ArbComment Text deriving (Show) + +instance Arbitrary ArbComment where + arbitrary = ArbComment <$> oneof [ + T.pack <$> arbitrary + , do + cmnt <- T.pack <$> arbitrary + ArbTag (tagName, tagValue) <- arbitrary + return $ cmnt <> "\n" <> tagName <> ": " <> tagValue + ] + -- TODO: support tagless comment diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 3c47426a3a4..096e9113b00 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -187,7 +187,7 @@ showTransactionHelper onelineamounts t = -- The first line (unless empty) will have leading space, subsequent lines will have a larger indent. renderCommentLines :: Text -> [String] renderCommentLines t = - case lines $ T.unpack t of + case lines $ T.unpack (T.stripEnd t) of [] -> [] [l] -> [(commentSpace . comment) l] -- single-line comment ("":ls) -> "" : map (lineIndent . comment) ls -- multi-line comment with empty first line @@ -576,10 +576,10 @@ tests_Transaction = in postingAsLines False False [p] p @?= [ " * a $1.00 ; pcomment1" , " ; pcomment2" - , " ; tag3: val3 " + , " ; tag3: val3" , " * a 2.00h ; pcomment1" , " ; pcomment2" - , " ; tag3: val3 " + , " ; tag3: val3" ] ] diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 9b5d1a0af5f..2a0b748d23b 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -24,7 +24,7 @@ import Hledger.Data.Dates import Hledger.Data.Amount import Hledger.Data.Transaction import Hledger.Query -import Hledger.Data.Posting (commentJoin, commentAddTag) +import Hledger.Data.Posting (commentJoin) import Hledger.Utils.UTF8IOCompat (error') import Hledger.Utils.Debug @@ -43,9 +43,7 @@ modifyTransactions tmods = map applymods t' = foldr (flip (.) . transactionModifierToFunction) id tmods t taggedt' -- PERF: compares txns to see if any modifier had an effect, inefficient ? - | t' /= t = t'{tcomment = tcomment t' `commentAddTag` ("modified","") - ,ttags = ("modified","") : ttags t' - } + | t' /= t = t'{ttags = ("_modified","") : ttags t'} | otherwise = t' -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function, @@ -57,7 +55,7 @@ modifyTransactions tmods = map applymods -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} -- 0000/01/01 -- ping $1.00 --- pong $2.00 ; generated-posting: = +-- pong $2.00 -- -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} -- 0000/01/01 @@ -66,7 +64,7 @@ modifyTransactions tmods = map applymods -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "ping" ["pong" `post` amount{aismultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]} -- 0000/01/01 -- ping $2.00 --- pong $6.00 ; generated-posting: = ping +-- pong $6.00 -- -- transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction) @@ -106,9 +104,7 @@ tmPostingRuleToFunction querytxt pr = { pdate = pdate pr <|> pdate p , pdate2 = pdate2 pr <|> pdate2 p , pamount = amount' p - , pcomment = pcomment pr `commentAddTag` ("generated-posting",qry) - , ptags = ("generated-posting", qry) : - ("_generated-posting",qry) : + , ptags = ("_generated-posting",qry) : ptags pr } where diff --git a/hledger-lib/Hledger/Processing/Common.hs b/hledger-lib/Hledger/Processing/Common.hs new file mode 100644 index 00000000000..a3a4927bd58 --- /dev/null +++ b/hledger-lib/Hledger/Processing/Common.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase, ViewPatterns #-} + +module Hledger.Processing.Common ( + syncTxn +) +where + +import Data.List +import Data.Text (Text) +import qualified Data.Text as T + +import Hledger.Data.Types +import Hledger.Data.Transaction +import Hledger.Data.Posting +import Hledger.Read.Common + +-- $setup +-- >>> import Hledger.Data.Testing +-- >>> :set -XOverloadedStrings +-- >>> includes xs = all (`elem` xs) + +-- | Synchronize some 'Transaction' metadata backso 'showTransaction' will show it. +syncTxn :: Transaction -> Transaction +syncTxn = txnTieKnot . syncTxnComments + +-- | Get 'Transaction' and its 'Posting' comments updated if needed. +-- Note that current behavior is limited only to adding missing tags +syncTxnComments t = t' where + t' = t { tcomment = ttags t `addMissingTags` tcomment t + , tpostings = map syncPostingComments $ tpostings t + } + +-- | Get 'Posting' comments updated if needed. +-- Note that current behavior is limited only to adding missing tags +syncPostingComments p = p' where + p' = p { pcomment = ptags p `addMissingTags` pcomment p } + +-- | Ensure that comment contains all tags +-- +-- New tag included in updated comment: +-- prop> \(ArbComment cmnt) (ArbTag tag') -> isDynamicTag tag' || tag' `elem` scanTags (addMissingTags [tag'] cmnt) +-- +-- All tags from original comment preserved: +-- prop> \(ArbComment cmnt) (ArbTag tag') -> scanTags (addMissingTags [tag'] cmnt) `includes` scanTags cmnt +-- +-- Adding existing tags have no effect: +-- prop> \(ArbComment cmnt) -> scanTags (addMissingTags (scanTags cmnt) cmnt) == cmnt +-- prop> \(ArbTag tag) -> let cmnt = addMissingTags [tag] "" in addMissingTags [tag] cmnt == cmnt +addMissingTags :: [Tag] -> Text -> Text +addMissingTags (nub -> tags) cmnt = foldr (flip commentAddTag) cmnt tags' + where + tags' = filter isMissing . filter (not . isDynamicTag) $ tags + tags0 = scanTags cmnt + isMissing = not . (`elem` tags0) + +isDynamicTag :: Tag -> Bool +isDynamicTag = T.isPrefixOf "_" . fst + +-- | Get tags from comment +-- +-- >>> scanTags "abc def\nghi" +-- [] +-- >>> scanTags "abc:" +-- [("abc","")] +-- >>> scanTags "abc def:" +-- [("def","")] +-- >>> scanTags "def:, abc: g hi, z" +-- [("def",""),("abc","g hi")] +scanTags :: Text -> [Tag] +scanTags = concatMap scanLine . T.lines where + scanLine = either (const []) id . runTextParser commenttagsp diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 36043c20cf6..594f38d7f9e 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -87,6 +87,9 @@ module Hledger.Read.Common ( transactioncommentp, postingcommentp, + -- ** tags + commenttagsp, + -- ** bracketed dates bracketeddatetagsp, diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index afc626bbd28..e97e274e3ce 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 3228f8dbb178d427e76291b5e60b3dee1eb4d2e5f9ab803ce8e3fe85e79f25ad +-- hash: 917b342b9c8ed55fc97be614d3864e5715e0738f000ad1c47dbb9a57f151ad39 name: hledger-lib version: 1.16 @@ -65,6 +65,7 @@ library Hledger.Data.StringFormat Hledger.Data.Posting Hledger.Data.RawOptions + Hledger.Data.Testing Hledger.Data.Timeclock Hledger.Data.Transaction Hledger.Data.TransactionModifier @@ -77,6 +78,7 @@ library Hledger.Read.JournalReader Hledger.Read.TimedotReader Hledger.Read.TimeclockReader + Hledger.Processing.Common Hledger.Reports Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes @@ -107,6 +109,7 @@ library build-depends: Decimal , Glob >=0.9 + , QuickCheck >=2.11 , ansi-terminal >=0.6.2.3 , array , base >=4.9 && <4.14 @@ -158,6 +161,7 @@ test-suite doctest build-depends: Decimal , Glob >=0.7 + , QuickCheck >=2.11 , ansi-terminal >=0.6.2.3 , array , base >=4.9 && <4.14 @@ -213,6 +217,7 @@ test-suite unittest build-depends: Decimal , Glob >=0.9 + , QuickCheck >=2.11 , ansi-terminal >=0.6.2.3 , array , base >=4.9 && <4.14 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index cd57ac0bb07..2ca560fd880 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -82,6 +82,7 @@ dependencies: - utf8-string >=0.3.5 - extra >=1.6.3 - Glob >= 0.9 +- QuickCheck >= 2.11 # for ledger-parse: #- parsers >=0.5 #- system-filepath @@ -115,6 +116,7 @@ library: - Hledger.Data.StringFormat - Hledger.Data.Posting - Hledger.Data.RawOptions + - Hledger.Data.Testing - Hledger.Data.Timeclock - Hledger.Data.Transaction - Hledger.Data.TransactionModifier @@ -128,6 +130,7 @@ library: # - Hledger.Read.LedgerReader - Hledger.Read.TimedotReader - Hledger.Read.TimeclockReader + - Hledger.Processing.Common - Hledger.Reports - Hledger.Reports.ReportOptions - Hledger.Reports.ReportTypes diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index a8c15407cf1..d538907bd44 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -4,23 +4,28 @@ A ledger-compatible @print@ command. -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, LambdaCase, ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-} module Hledger.Cli.Commands.Print ( printmode + ,txnflags ,print' -- ,entriesReportAsText - ,originalTransaction + ,modPostings + ,prepareTxnFromOpts ) where +import Data.Maybe (catMaybes) +import Data.List (nub) import Data.Text (Text) import qualified Data.Text as T import System.Console.CmdArgs.Explicit import Hledger.Read.CsvReader (CSV, printCSV) import Hledger +import Hledger.Processing.Common import Hledger.Cli.CliOptions import Hledger.Cli.Utils import Hledger.Cli.Commands.Add ( transactionsSimilarTo ) @@ -31,15 +36,27 @@ printmode = hledgerCommandMode ([let arg = "STR" in flagReq ["match","m"] (\s opts -> Right $ setopt "match" s opts) arg ("show the transaction whose description is most similar to "++arg++", and is most recent") - ,flagNone ["explicit","x"] (setboolopt "explicit") - "show all amounts explicitly" ,flagNone ["new"] (setboolopt "new") "show only newer-dated transactions added in each file since last run" - ] ++ outputflags) + ] ++ txnflags ++ outputflags) [generalflagsgroup1] hiddenflags ([], Just $ argsFlag "[QUERY]") +-- | Common flags between all commands that print parsable transactions +txnflags = + [ flagNone ["explicit","x"] (setboolopt "explicit") + "show all amounts explicitly" + , flagNone ["dynamic-tags"] (setboolopt "dynamic-tags") + "include dynamic tags as normal ones" + ] + +enrichDynamicTags :: ([Tag] -> [Tag]) +enrichDynamicTags tags = nub $ tags ++ catMaybes (map enrichedMay tags) where + enrichedMay = \case + ((T.stripPrefix "_" -> Just tag), value) -> Just (tag, value) + _ -> Nothing + -- | Print journal transactions in standard format. print' :: CliOpts -> Journal -> IO () print' opts j = do @@ -59,21 +76,33 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do writeOutput opts $ render $ entriesReport ropts' q j entriesReportAsText :: CliOpts -> EntriesReport -> String -entriesReportAsText opts = concatMap (showTransaction . gettxn) +entriesReportAsText opts = concatMap (showTransaction . syncTxn . prepareTxnFromOpts opts) + +-- | Create transaction update +prepareTxnFromOpts :: CliOpts -> Transaction -> Transaction +prepareTxnFromOpts opts = + (if boolopt "dynamic-tags" (rawopts_ opts) then modTags enrichDynamicTags else id). + (if useexplicittxn then id -- use fully inferred amounts & txn prices + else modPostings originalPostingAmounts) -- use original as-written amounts/txn prices where - gettxn | useexplicittxn = id -- use fully inferred amounts & txn prices - | otherwise = originalTransaction -- use original as-written amounts/txn prices -- Original vs inferred transactions/postings were causing problems here, disabling -B (#551). -- Use the explicit one if -B or -x are active. -- This passes tests; does it also mean -B sometimes shows missing amounts unnecessarily ? useexplicittxn = boolopt "explicit" (rawopts_ opts) || (valuationTypeIsCost $ reportopts_ opts) --- Replace this transaction's postings with the original postings if any, but keep the --- current possibly rewritten account names. -originalTransaction t = t { tpostings = map originalPostingPreservingAccount $ tpostings t } +-- | Update postings of transaction +-- Note that you still need to call 'txnTieKnot' +modPostings mod t = t { tpostings = map mod $ tpostings t } + +-- | Update tags of transaction and postings +-- Note that you still need to call 'txnTieKnot' +modTags :: ([Tag] -> [Tag]) -> Transaction -> Transaction +modTags f t = t { ttags = f $ ttags t, tpostings = map modPosting $ tpostings t } where + modPosting p = p { ptags = f $ ptags p } --- Get the original posting if any, but keep the current possibly rewritten account name. -originalPostingPreservingAccount p = (originalPosting p) { paccount = paccount p } +-- Get the original amounts preserving everything else +originalPostingAmounts p = p { pamount = pamount p0, pbalanceassertion = pbalanceassertion p0 } + where p0 = originalPosting p -- XXX -- tests_showTransactions = [ @@ -162,7 +191,7 @@ printMatch CliOpts{reportopts_=ropts} j desc = do let q = queryFromOpts d ropts case similarTransaction' j q desc of Nothing -> putStrLn "no matches found." - Just t -> putStr $ showTransaction t + Just t -> putStr . showTransaction $ syncTxn t where -- Identify the closest recent match for this description in past transactions. diff --git a/hledger/Hledger/Cli/Commands/Printunique.hs b/hledger/Hledger/Cli/Commands/Printunique.hs index d17761c1507..a5301a1199f 100755 --- a/hledger/Hledger/Cli/Commands/Printunique.hs +++ b/hledger/Hledger/Cli/Commands/Printunique.hs @@ -13,13 +13,13 @@ import Hledger.Cli.Commands.Print printuniquemode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Printunique.txt") - [] + txnflags [generalflagsgroup1] hiddenflags ([], Nothing) printunique opts j@Journal{jtxns=ts} = do - print' opts j{jtxns=uniquify ts} + print' opts j{jtxns=prepareTxnFromOpts opts <$> uniquify ts} where uniquify = nubBy (\t1 t2 -> thingToCompare t1 == thingToCompare t2) . sortOn thingToCompare thingToCompare = tdescription diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index f29634f6193..3e9a096c80d 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -15,6 +15,7 @@ import Data.Functor.Identity import Data.List (sortOn, foldl') import qualified Data.Text as T import Hledger +import Hledger.Processing.Common import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Print import System.Console.CmdArgs.Explicit @@ -24,10 +25,10 @@ import qualified Data.Algorithm.Diff as D rewritemode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Rewrite.txt") - [flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'" + ([flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'" "add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR." ,flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool" - ] + ] ++ txnflags) [generalflagsgroup1] hiddenflags ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...") @@ -39,7 +40,7 @@ rewritemode = hledgerCommandMode rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do -- rewrite matched transactions let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j - let j' = j{jtxns=modifyTransactions modifiers ts} + let j' = j{jtxns=prepareTxnFromOpts opts <$> modifyTransactions modifiers ts} -- run the print command, showing all transactions, or show diffs printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j' @@ -66,6 +67,10 @@ diffOutput j j' = do let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t'] putStr $ renderPatch $ map (uncurry $ diffTxn j) changed +-- | Replace this transaction's postings with the original postings if any +-- It is used for building correct diff +originalTransaction = modPostings originalPosting + type Chunk = (GenericSourcePos, [DiffLine String]) -- XXX doctests, update needed: @@ -132,7 +137,7 @@ diffTxn j t t' = diffs = map mapDiff $ D.getDiff source changed' source | Just contents <- lookup fp $ jfiles j = map T.unpack . drop (line-1) . take line' $ T.lines contents | otherwise = [] - changed = lines $ showTransaction t' + changed = lines . showTransaction $ syncTxn t' changed' | null changed = changed | null $ last changed = init changed | otherwise = changed diff --git a/tests/forecast.test b/tests/forecast.test index 608c59b35a8..14ba6f436d0 100644 --- a/tests/forecast.test +++ b/tests/forecast.test @@ -51,7 +51,6 @@ hledger print -b 2016-11 -e 2017-02 -f - --forecast assets:cash 2017/01/01 * marked cleared, and with a description - ; generated-transaction: ~ monthly from 2016/1 income $-1000 expenses:food $20 expenses:leisure $15 @@ -118,7 +117,6 @@ Y 2000 >>> 2000/02/01 forecast - ; generated-transaction: ~ 2/1 >>>2 >>>=0 @@ -135,7 +133,6 @@ Y 2000 >>> 2000/01/15 forecast - ; generated-transaction: ~ 15 >>>2 >>>=0 @@ -152,7 +149,35 @@ Y 2000 >>> 2000/02/01 forecast - ; generated-transaction: ~ next month + +>>>2 +>>>=0 + +# 8. print forecasted transactions with dynamic tags +hledger print -b 2016-11 -e 2017-02 -f - --forecast --dynamic-tags +<<< +2016/12/31 + expenses:housing $600 + assets:cash + +~ monthly from 2016/1 * marked cleared, and with a description + income $-1000 + expenses:food $20 + expenses:leisure $15 + expenses:grocery $30 + assets:cash +>>> +2016/12/31 + expenses:housing $600 + assets:cash + +2017/01/01 * marked cleared, and with a description + ; generated-transaction: ~ monthly from 2016/1 + income $-1000 + expenses:food $20 + expenses:leisure $15 + expenses:grocery $30 + assets:cash >>>2 >>>=0 diff --git a/tests/journal/auto-postings.test b/tests/journal/auto-postings.test index 9dd99eeafbb..bc5e28a9514 100644 --- a/tests/journal/auto-postings.test +++ b/tests/journal/auto-postings.test @@ -14,12 +14,14 @@ assets:bank # 1. print -$ hledger print -f- --auto +$ hledger print -f- --auto --dynamic-tags 2016/01/01 paycheck ; modified: income:remuneration $-100 - (liabilities:tax) $-33 ; income tax, generated-posting: = ^income + (liabilities:tax) $-33 ; income tax + ; generated-posting: = ^income income:donations $-15 - (liabilities:tax) $-5 ; income tax, generated-posting: = ^income + (liabilities:tax) $-5 ; income tax + ; generated-posting: = ^income assets:bank 2016/01/01 withdraw @@ -80,10 +82,10 @@ $ hledger register -f- --auto # 5. $ hledger print -f- --auto -2018/10/07 * MARKET ; modified: +2018/10/07 * MARKET expenses:groceries:food - [budget:groceries] $-20 ; generated-posting: = ^expenses:groceries - [assets:bank:checking] $20 ; generated-posting: = ^expenses:groceries + [budget:groceries] $-20 + [assets:bank:checking] $20 assets:bank:checking $-20 >= @@ -99,10 +101,10 @@ $ hledger print -f- --auto # 6. $ hledger -f- print --auto -x -2018/01/01 ; modified: +2018/01/01 (assets:billable:client1) 0.50h @ $90 - assets:receivable:client1 50.00h @ $90 ; generated-posting: = assets:billable:client1 - revenues:client1 $-4500 ; generated-posting: = assets:billable:client1 + assets:receivable:client1 50.00h @ $90 + revenues:client1 $-4500 >= @@ -117,10 +119,10 @@ $ hledger -f- print --auto -x # 7. $ hledger -f- print --auto -x -2018/01/01 ; modified: +2018/01/01 (assets:billable:client1) 0.50h - assets:receivable:client1 $50 ; generated-posting: = assets:billable:client1 - revenues:client1 $-50 ; generated-posting: = assets:billable:client1 + assets:receivable:client1 $50 + revenues:client1 $-50 >= @@ -135,10 +137,10 @@ $ hledger -f- print --auto -x # 8. $ hledger -f- print --auto -x -2018/01/01 ; modified: +2018/01/01 (assets:billable:client1) 0.50h @ $90 - assets:receivable:client1 0.50 "Client1 Hours" @ $100.00 ; generated-posting: = assets:billable:client1 - revenues:client1 $-50.00 ; generated-posting: = assets:billable:client1 + assets:receivable:client1 0.50 "Client1 Hours" @ $100.00 + revenues:client1 $-50.00 >= @@ -180,11 +182,11 @@ $ hledger print -f- --auto # 10. $ hledger -f- print --auto -2018/01/01 ; modified: +2018/01/01 Expenses:Joint:Widgets $100.00 @ £0.50 - Expenses:Joint $-100.00 @ £0.50 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bob $50.00 @ £0.50 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bill $50.00 @ £0.50 ; generated-posting: = ^Expenses:Joint + Expenses:Joint $-100.00 @ £0.50 + Liabilities:Joint:Bob $50.00 @ £0.50 + Liabilities:Joint:Bill $50.00 @ £0.50 Assets:Joint:Bank £-50.00 >=0 @@ -202,11 +204,11 @@ $ hledger -f- print --auto # 11. $ hledger -f- print --auto -2018/01/01 ; modified: +2018/01/01 Expenses:Joint:Widgets $100.00 @@ £50 - Expenses:Joint $-100.00 @@ £50 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bob $50.00 @@ £25 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bill $50.00 @@ £25 ; generated-posting: = ^Expenses:Joint + Expenses:Joint $-100.00 @@ £50 + Liabilities:Joint:Bob $50.00 @@ £25 + Liabilities:Joint:Bill $50.00 @@ £25 Assets:Joint:Bank £-50.00 >=0 @@ -231,11 +233,11 @@ $ hledger -f- print --auto # 12. $ hledger -f- print --auto -2018/01/01 ; modified: +2018/01/01 Expenses:Joint:Widgets $100.00 - Expenses:Joint $-100.00 @@ £50 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bob $50.00 @@ £25 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bill $50.00 @@ £25 ; generated-posting: = ^Expenses:Joint + Expenses:Joint $-100.00 @@ £50 + Liabilities:Joint:Bob $50.00 @@ £25 + Liabilities:Joint:Bill $50.00 @@ £25 Assets:Joint:Bank £-50.00 >=0 @@ -264,11 +266,10 @@ $ hledger print -f- --auto --forecast -b 2016-01 -e 2016-03 assets:bank 2016/02/01 paycheck - ; generated-transaction: ~ monthly from 2016-01, modified: income:remuneration $-100 - (liabilities:tax) $-33 ; income tax, generated-posting: = ^income + (liabilities:tax) $-33 ; income tax income:donations $-15 - (liabilities:tax) $-5 ; income tax, generated-posting: = ^income + (liabilities:tax) $-5 ; income tax assets:bank >= @@ -280,7 +281,6 @@ $ hledger print -f- --forecast -b 2016-01 -e 2016-03 assets:bank 2016/02/01 paycheck - ; generated-transaction: ~ monthly from 2016-01 income:remuneration $-100 income:donations $-15 assets:bank @@ -293,7 +293,7 @@ $ hledger print -f- --forecast -b 2016-01 -e 2016-03 [budget:groceries] *-1 [assets:bank:checking] *1 -10/7 * MARKET +10/7 * MARKET ; :tasty: expenses:groceries:food assets:bank:checking $-20 @@ -305,6 +305,17 @@ $ hledger -f- register --auto assets:bank:checking $-20 0 >= +# 16. print-unique also can show dynamic tags +$ hledger print-unique -f- --auto --dynamic-tags +2019/10/07 * MARKET ; :tasty: + ; modified: + expenses:groceries:food + [budget:groceries] $-20 ; generated-posting: = ^expenses:groceries + [assets:bank:checking] $20 ; generated-posting: = ^expenses:groceries + assets:bank:checking $-20 + +>= + # #893b, https://github.com/simonmichael/hledger/issues/893#issuecomment-459125266 < = tag:tax20 @@ -314,7 +325,7 @@ $ hledger -f- register --auto a EUR -10.00 ; :tax20: b EUR 12.00 -# 16. Transaction balancing sees auto postings ? +# 17. Transaction balancing sees auto postings ? # $ hledger -f- print -x --auto # 2018/12/18 # a EUR -10.00 ; :tax20: @@ -323,7 +334,8 @@ $ hledger -f- register --auto # # >= -# 16. No, transaction must be balanced both with and without auto postings. +# 17. No, transaction must be balanced both with and without auto postings. $ hledger -f- print -x --auto >2 /could not balance/ >=1 + diff --git a/tests/journal/default-commodity.test b/tests/journal/default-commodity.test index 4a75b394e19..754f2bbee57 100644 --- a/tests/journal/default-commodity.test +++ b/tests/journal/default-commodity.test @@ -85,9 +85,9 @@ D $1000. (a) €1 >>> -2018/01/01 ; modified: +2018/01/01 (a) €1 - (b) €2 ; generated-posting: = a + (b) €2 >>>= diff --git a/tests/rewrite.test b/tests/rewrite.test index 93e058fb5e6..38da4314750 100644 --- a/tests/rewrite.test +++ b/tests/rewrite.test @@ -10,11 +10,11 @@ hledger rewrite -f- ^income --add-posting '(liabilities:tax) *.33 ; income tax assets:cash $20 assets:bank >>> -2016/01/01 paycheck ; modified: +2016/01/01 paycheck income:remuneration $-100 - (liabilities:tax) $-33 ; income tax, generated-posting: = ^income + (liabilities:tax) $-33 ; income tax income:donations $-15 - (liabilities:tax) $-5 ; income tax, generated-posting: = ^income + (liabilities:tax) $-5 ; income tax assets:bank 2016/01/01 withdraw @@ -40,10 +40,10 @@ hledger rewrite -f- expenses:gifts --add-posting '(budget:gifts) *-1' assets:cash $20 assets:bank -2016/01/01 gift ; modified: +2016/01/01 gift assets:cash $-15 expenses:gifts ; [1/2] - (budget:gifts) $-15 ; [2016/01/02], generated-posting: = expenses:gifts + (budget:gifts) $-15 ; [2016/01/02] >>>2 >>>=0 @@ -67,17 +67,17 @@ hledger rewrite -f- = ^assets:unbilled:client2 (assets:to bill:client2) *150.00 CAD >>> -2017/04/24 * 09:00-09:25 ; modified: +2017/04/24 * 09:00-09:25 (assets:unbilled:client1) 0.42h - (assets:to bill:client1) 42.00 CAD ; generated-posting: = ^assets:unbilled:client1 + (assets:to bill:client1) 42.00 CAD -2017/04/25 * 10:00-11:15 ; modified: +2017/04/25 * 10:00-11:15 (assets:unbilled:client1) 1.25h - (assets:to bill:client1) 125.00 CAD ; generated-posting: = ^assets:unbilled:client1 + (assets:to bill:client1) 125.00 CAD -2017/04/25 * 14:00-15:32 ; modified: +2017/04/25 * 14:00-15:32 (assets:unbilled:client2) 1.54h - (assets:to bill:client2) 231.00 CAD ; generated-posting: = ^assets:unbilled:client2 + (assets:to bill:client2) 231.00 CAD >>>2 >>>=0 @@ -104,20 +104,20 @@ hledger rewrite -f- -B assets:to bill:client2 *1.00 hours @ $150.00 income:consulting:client2 >>> -2017/04/24 * 09:00-09:25 ; modified: +2017/04/24 * 09:00-09:25 (assets:unbilled:client1) 0.42h - assets:to bill:client1 $42.00 ; generated-posting: = ^assets:unbilled:client1 - income:consulting:client1 ; generated-posting: = ^assets:unbilled:client1 + assets:to bill:client1 $42.00 + income:consulting:client1 -2017/04/25 * 10:00-11:15 ; modified: +2017/04/25 * 10:00-11:15 (assets:unbilled:client1) 1.25h - assets:to bill:client1 $125.00 ; generated-posting: = ^assets:unbilled:client1 - income:consulting:client1 ; generated-posting: = ^assets:unbilled:client1 + assets:to bill:client1 $125.00 + income:consulting:client1 -2017/04/25 * 14:00-15:32 ; modified: +2017/04/25 * 14:00-15:32 (assets:unbilled:client2) 1.54h - assets:to bill:client2 $231.00 ; generated-posting: = ^assets:unbilled:client2 - income:consulting:client2 ; generated-posting: = ^assets:unbilled:client2 + assets:to bill:client2 $231.00 + income:consulting:client2 >>>2 >>>=0 @@ -139,17 +139,17 @@ hledger rewrite -f- assets:bank and 'amt:<0' --add-posting 'expenses:fee $5' - # income:remuneration $-100 # assets:bank >>> -2016/01/01 withdraw ; modified: +2016/01/01 withdraw assets:cash $20 assets:bank - expenses:fee $5 ; generated-posting: = assets:bank and amt:<0 - assets:bank $-5 ; generated-posting: = assets:bank and amt:<0 + expenses:fee $5 + assets:bank $-5 -2016/01/02 withdraw ; modified: +2016/01/02 withdraw assets:cash assets:bank $-30 - expenses:fee $5 ; generated-posting: = assets:bank and amt:<0 - assets:bank $-5 ; generated-posting: = assets:bank and amt:<0 + expenses:fee $5 + assets:bank $-5 >>>2 >>>=0 @@ -188,32 +188,32 @@ hledger rewrite -f- date:2017/1 --add-posting 'Here comes Santa $0' = ^expenses not:housing not:grocery not:food (budget:misc) *-1 >>> -2016/12/31 ; modified: +2016/12/31 expenses:housing $600.00 - (budget:housing) $-600.00 ; generated-posting: = ^expenses:housing + (budget:housing) $-600.00 assets:cash -2017/01/01 ; modified: +2017/01/01 expenses:food $20.00 - (budget:food) $-20.00 ; generated-posting: = ^expenses:grocery ^expenses:food - Here comes Santa 0 ; generated-posting: = date:2017/1 + (budget:food) $-20.00 + Here comes Santa 0 expenses:leisure $15.00 - (budget:misc) $-15.00 ; generated-posting: = ^expenses not:housing not:grocery not:food - Here comes Santa 0 ; generated-posting: = date:2017/1 + (budget:misc) $-15.00 + Here comes Santa 0 expenses:grocery $30.00 - (budget:food) $-30.00 ; generated-posting: = ^expenses:grocery ^expenses:food - Here comes Santa 0 ; generated-posting: = date:2017/1 + (budget:food) $-30.00 + Here comes Santa 0 assets:cash - Here comes Santa 0 ; generated-posting: = date:2017/1 + Here comes Santa 0 -2017/01/02 ; modified: +2017/01/02 assets:cash $200.00 - Here comes Santa 0 ; generated-posting: = date:2017/1 + Here comes Santa 0 assets:bank - assets:bank $-1.60 ; generated-posting: = ^assets:bank$ date:2017/1 amt:<0 - expenses:fee $1.60 ; cash withdraw fee, generated-posting: = ^assets:bank$ date:2017/1 amt:<0 - (budget:misc) $-1.60 ; generated-posting: = ^expenses not:housing not:grocery not:food - Here comes Santa 0 ; generated-posting: = date:2017/1 + assets:bank $-1.60 + expenses:fee $1.60 ; cash withdraw fee + (budget:misc) $-1.60 + Here comes Santa 0 2017/02/01 assets:cash $100.00 @@ -236,18 +236,43 @@ hledger rewrite --diff -f- assets:bank and 'amt:<0' --add-posting 'expenses:fee --- - +++ - @@ -1,3 +1,5 @@ --2016/01/01 withdraw -+2016/01/01 withdraw ; modified: + 2016/01/01 withdraw assets:cash $20 assets:bank -+ expenses:fee $5 ; generated-posting: = assets:bank and amt:<0 -+ assets:bank $-5 ; generated-posting: = assets:bank and amt:<0 ++ expenses:fee $5 ++ assets:bank $-5 @@ -5,3 +7,5 @@ --2016/01/02 withdraw -+2016/01/02 withdraw ; modified: + 2016/01/02 withdraw assets:cash assets:bank $-30 -+ expenses:fee $5 ; generated-posting: = assets:bank and amt:<0 -+ assets:bank $-5 ; generated-posting: = assets:bank and amt:<0 ++ expenses:fee $5 ++ assets:bank $-5 +>>>2 +>>>=0 + + +# 8. Print dynamic tags +hledger rewrite --dynamic-tags -f- assets:bank and 'amt:<0' --add-posting 'expenses:fee $5' --add-posting 'assets:bank $-5' +<<< +2016/01/01 withdraw + assets:cash $20 + assets:bank + +2016/01/02 withdraw + assets:cash + assets:bank $-30 +>>> +2016/01/01 withdraw ; modified: + assets:cash $20 + assets:bank + expenses:fee $5 ; generated-posting: = assets:bank and amt:<0 + assets:bank $-5 ; generated-posting: = assets:bank and amt:<0 + +2016/01/02 withdraw ; modified: + assets:cash + assets:bank $-30 + expenses:fee $5 ; generated-posting: = assets:bank and amt:<0 + assets:bank $-5 ; generated-posting: = assets:bank and amt:<0 + >>>2 >>>=0