imp:print:beancount: don't add account tags to postings

When print is generating beancount output, turn off the usual
inheritance of account tags by postings; it would generate excessive
metadata in the journal. Beancount can do or not do that kind of
inheritance itself.

hledger-lib/Hledger/Read/Common.hs

@@ -192,8 +192,8 @@ instance Show (Reader m) where show r = show (rFormat r) ++ " reader"
 
 -- | Parse an InputOpts from a RawOpts and a provided date.
 -- This will fail with a usage error if the forecast period expression cannot be parsed.
-rawOptsToInputOpts :: Day -> Bool -> RawOpts -> InputOpts
+rawOptsToInputOpts :: Day -> Bool -> Bool -> RawOpts -> InputOpts
-rawOptsToInputOpts day usecoloronstdout rawopts =
+rawOptsToInputOpts day usecoloronstdout postingaccttags rawopts =
 
     let noinferbalancingcosts = boolopt "strict" rawopts || stringopt "args" rawopts == "balanced"
 
@@ -216,6 +216,7 @@ rawOptsToInputOpts day usecoloronstdout rawopts =
       ,new_save_          = True
       ,pivot_             = stringopt "pivot" rawopts
       ,forecast_          = forecastPeriodFromRawOpts day rawopts
+      ,posting_account_tags_ = postingaccttags
       ,verbose_tags_      = boolopt "verbose-tags" rawopts
       ,reportspan_        = DateSpan (Exact <$> queryStartDate False datequery) (Exact <$> queryEndDate False datequery)
       ,auto_              = boolopt "auto" rawopts
@@ -326,13 +327,14 @@ initialiseAndParseJournal parser iopts f txt =
 -- Others (commodities, accounts..) are done later by journalStrictChecks.
 --
 journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
-journalFinalise iopts@InputOpts{auto_,balancingopts_,infer_costs_,infer_equity_,strict_,verbose_tags_,_ioDay} f txt pj = do
+journalFinalise iopts@InputOpts{auto_,balancingopts_,infer_costs_,infer_equity_,strict_,posting_account_tags_,verbose_tags_,_ioDay} f txt pj = do
   let
     BalancingOpts{commodity_styles_, ignore_assertions_} = balancingopts_
     fname = "journalFinalise " <> takeFileName f
     lbl = lbl_ fname
+    -- Some not so pleasant hacks
     -- We want to know when certain checks have been explicitly requested with the check command,
-    -- but it does not run until later. For now, hackily inspect the command line with unsafePerformIO.
+    -- but it does not run until later. For now, inspect the command line with unsafePerformIO.
     checking checkname = "check" `elem` args && checkname `elem` args where args = progArgs
     -- We will check ordered dates when "check ordereddates" is used.
     checkordereddates = checking "ordereddates"
@@ -349,7 +351,7 @@ journalFinalise iopts@InputOpts{auto_,balancingopts_,infer_costs_,infer_equity_,
             -- XXX does not see conversion accounts generated by journalInferEquityFromCosts below, requiring a workaround in journalCheckAccounts. Do it later ?
       &   journalStyleAmounts                            -- Infer and apply commodity styles (but don't round) - should be done early
       <&> journalAddForecast verbose_tags_ (forecastPeriod iopts pj)   -- Add forecast transactions if enabled
-      <&> journalPostingsAddAccountTags                  -- Add account tags to postings, so they can be matched by auto postings.
+      <&> (if posting_account_tags_ then journalPostingsAddAccountTags else id)     -- Propagate account tags to postings - unless printing a beancount journal
       >>= journalTagCostsAndEquityAndMaybeInferCosts verbose_tags_ False   -- Tag equity conversion postings and redundant costs, to help journalBalanceTransactions ignore them.
       >>= (if auto_ && not (null $ jtxnmodifiers pj)
             then journalAddAutoPostings verbose_tags_ _ioDay balancingopts_  -- Add auto postings if enabled, and account tags if needed. Does preliminary transaction balancing.

hledger-lib/Hledger/Read/InputOptions.hs

@@ -34,6 +34,7 @@ data InputOpts = InputOpts {
     ,new_save_          :: Bool                 -- ^ save latest new transactions state for next time ?
     ,pivot_             :: String               -- ^ use the given field's value as the account name
     ,forecast_          :: Maybe DateSpan       -- ^ span in which to generate forecast transactions
+    ,posting_account_tags_  :: Bool             -- ^ propagate account tags to postings ?
     ,verbose_tags_      :: Bool                 -- ^ add user-visible tags when generating/modifying transactions & postings ?
     ,reportspan_        :: DateSpan             -- ^ a dirty hack keeping the query dates in InputOpts. This rightfully lives in ReportSpec, but is duplicated here.
     ,auto_              :: Bool                 -- ^ generate extra postings according to auto posting rules ?
@@ -55,6 +56,7 @@ definputopts = InputOpts
     , new_save_          = True
     , pivot_             = ""
     , forecast_          = Nothing
+    , posting_account_tags_ = False
     , verbose_tags_      = False
     , reportspan_        = nulldatespan
     , auto_              = False

hledger-web/Hledger/Web/Test.hs

@@ -129,7 +129,7 @@ hledgerWebTest = do
   usecolor <- useColorOnStdout
   let
     rawopts = [("forecast","")]
-    iopts = rawOptsToInputOpts d usecolor $ mkRawOpts rawopts
+    iopts = rawOptsToInputOpts d usecolor True $ mkRawOpts rawopts
     f = "fake"  -- need a non-null filename so forecast transactions get index 0
   pj <- readJournal' (T.pack $ unlines  -- PARTIAL: readJournal' should not fail
     ["~ monthly"

hledger/Hledger/Cli/CliOptions.hs

@@ -603,12 +603,16 @@ ensureDebugFlagHasVal as = case break (=="--debug") as of
 rawOptsToCliOpts :: RawOpts -> IO CliOpts
 rawOptsToCliOpts rawopts = do
   currentDay <- getCurrentDay
-  let day = case maybestringopt "today" rawopts of
+  let
-              Nothing -> currentDay
+    day = case maybestringopt "today" rawopts of
-              Just d  -> either (const err) fromEFDay $ fixSmartDateStrEither' currentDay (T.pack d)
+            Nothing -> currentDay
-                where err = error' $ "Unable to parse date \"" ++ d ++ "\""
+            Just d  -> either (const err) fromEFDay $ fixSmartDateStrEither' currentDay (T.pack d)
+              where err = error' $ "Unable to parse date \"" ++ d ++ "\""
+    command = stringopt "command" rawopts
+    moutputformat = maybestringopt "output-format" rawopts
+    postingaccttags = not $ command == "print" && moutputformat == Just "beancount"
   usecolor <- useColorOnStdout
-  let iopts = rawOptsToInputOpts day usecolor rawopts
+  let iopts = rawOptsToInputOpts day usecolor postingaccttags rawopts
   rspec <- either error' pure $ rawOptsToReportSpec day usecolor rawopts  -- PARTIAL:
   mcolumns <- readMay <$> getEnvSafe "COLUMNS"
   mtermwidth <-
@@ -621,12 +625,12 @@ rawOptsToCliOpts rawopts = do
   let availablewidth = NE.head $ NE.fromList $ catMaybes [mcolumns, mtermwidth, Just defaultWidth]  -- PARTIAL: fromList won't fail because non-null list
   return defcliopts {
               rawopts_         = rawopts
-             ,command_         = stringopt "command" rawopts
+             ,command_         = command
              ,file_            = listofstringopt "file" rawopts
              ,inputopts_       = iopts
              ,reportspec_      = rspec
              ,output_file_     = maybestringopt "output-file" rawopts
-             ,output_format_   = maybestringopt "output-format" rawopts
+             ,output_format_   = moutputformat
              ,pageropt_        = maybeynopt "pager" rawopts
              ,coloropt_        = maybeynaopt "color" rawopts
              ,debug_           = posintopt "debug" rawopts

hledger/hledger.m4.md

@@ -869,18 +869,15 @@ Beancount doesn't allow [virtual postings](#virtual-postings); if you have any,
 
 #### Beancount metadata
 
-hledger tags are converted to Beancount [metadata](https://beancount.github.io/docs/beancount_language_syntax.html#metadata-1) lines attached to transactions and postings.
+hledger tags will be converted to [Beancount metadata](https://beancount.github.io/docs/beancount_language_syntax.html#metadata-1)
-Metadata names and values are adjusted to be Beancount-compatible as needed.
+(except for tags whose name begins with `_`).
-(Names will begin with a lowercase letter, will be at least two characters long, and unsupported characters will be encoded.
+Metadata names will be adjusted to be Beancount-compatible: beginning with a lowercase letter,
-Values will use Beancount's string type.)
+at least two characters long, and with unsupported characters encoded.
-Internal or user-created tags whose names begin with `_` will not be converted.
+Metadata values will use Beancount's string type.
 
-Unlike normal print output, postings will explicitly show any tags inherited from their account, currently.
+In hledger, objects can have the same tag repeated with multiple values.
-This is perhaps correct, but over-verbose (and somewhat inconsistent).
+Eg an `assets:cash` account might have both `type:Asset` and `type:Cash` tags.
-
+For Beancount these will be combined into one, with the values combined, comma separated. Eg: `type: "Asset, Cash"`.
-Note that in hledger, objects can have the same tag with multiple values.
-Eg an `assets:cash` account might have both `type:C` and `type:A` tags.
-In such cases, the values will be combined into one, separated by commas.
 
 #### Beancount costs
 

hledger/test/print/beancount.test

@@ -163,7 +163,6 @@ $ hledger -f- print -O beancount
 2000-01-02 * "posting tags"  ; a: ttag
     ma: "ttag"
     Assets:Cash             0 C  ; a: ptag
-      ma:   "ptag"
+      ma: "ptag"
-      type: "A, C"
 
 >=