translate report texts to user language using haskell-gettext

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -38,6 +38,7 @@ where
 import Control.Applicative (liftA2)
 #endif
 import Control.Monad (guard)
+import Data.Default (Default, def)
 import Data.Foldable (toList)
 import Data.HashSet qualified as HS
 import Data.List (sortOn)
@@ -115,15 +116,17 @@ multiBalanceReportWith rspec' j priceoracle = report
 
 -- | Generate a compound balance report from a list of CBCSubreportSpec. This
 -- shares postings between the subreports.
-compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec a]
-                      -> CompoundPeriodicReport a MixedAmount
+compoundBalanceReport :: (Default msg)
+                      => ReportSpec -> Journal -> [CBCSubreportSpec msg a]
+                      -> CompoundPeriodicReport msg a MixedAmount
 compoundBalanceReport rspec j = compoundBalanceReportWith rspec j (journalPriceOracle infer j)
   where infer = infer_prices_ $ _rsReportOpts rspec
 
 -- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
-compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
-                          -> [CBCSubreportSpec a]
-                          -> CompoundPeriodicReport a MixedAmount
+compoundBalanceReportWith :: (Default msg)
+                          => ReportSpec -> Journal -> PriceOracle
+                          -> [CBCSubreportSpec msg a]
+                          -> CompoundPeriodicReport msg a MixedAmount
 compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
   where
     -- Queries, report/column dates.
@@ -162,7 +165,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
         subreportTotal (_, sr, increasestotal) =
             (if increasestotal then id else fmap maNegate) $ prTotals sr
 
-    cbr = CompoundPeriodicReport "" (maybeDayPartitionToDateSpans colspans) subreports overalltotals
+    cbr = CompoundPeriodicReport def (maybeDayPartitionToDateSpans colspans) subreports overalltotals
 
 
 -- | Remove any date queries and insert queries from the report span.

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -85,6 +85,7 @@ import Data.List (partition)
 import Data.List.Extra (find, isPrefixOf, nubSort, stripPrefix)
 import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
 import Data.Text qualified as T
+import Data.Gettext (Catalog)
 import Data.Time.Calendar (Day, addDays)
 import Data.Default (Default(..))
 import Safe (lastDef, lastMay, maximumMay, readMay)
@@ -195,6 +196,7 @@ data ReportOpts = ReportOpts {
       --   TERM and existence of NO_COLOR environment variables.
     ,transpose_        :: Bool
     ,layout_           :: Layout
+    ,catalog_          :: Maybe Catalog
     ,period_titles_  :: PeriodTitles
     -- | Explicit --title value if given (possibly empty to
     -- suppress); otherwise Nothing, in which case each report falls
@@ -247,6 +249,7 @@ defreportopts = ReportOpts
     , color_            = False
     , transpose_        = False
     , layout_           = LayoutWide Nothing
+    , catalog_          = Nothing
     , period_titles_  = PTCompact
     , title_   = Nothing
     , subreport_titles_ = Nothing

hledger-lib/Hledger/Reports/ReportTypes.hs

@@ -39,7 +39,6 @@ import Data.Aeson (ToJSON(..))
 import Data.Bifunctor (Bifunctor(..))
 import Data.Decimal (Decimal)
 import Data.Maybe (mapMaybe)
-import Data.Text (Text)
 import GHC.Generics (Generic)
 
 import Hledger.Data
@@ -181,27 +180,27 @@ prrMapMaybeName f row = case f $ prrName row of
 --
 -- It is used in compound balance report commands like balancesheet,
 -- cashflow and incomestatement.
-data CompoundPeriodicReport a b = CompoundPeriodicReport
-  { cbrTitle      :: Text
+data CompoundPeriodicReport msg a b = CompoundPeriodicReport
+  { cbrTitle      :: msg
   , cbrDates      :: [DateSpan]
-  , cbrSubreports :: [(Text, PeriodicReport a b, Bool)]
+  , cbrSubreports :: [(msg, PeriodicReport a b, Bool)]
   , cbrTotals     :: PeriodicReportRow () b
   } deriving (Show, Functor, Generic, ToJSON)
 
-instance HasAmounts b => HasAmounts (CompoundPeriodicReport a b) where
+instance HasAmounts b => HasAmounts (CompoundPeriodicReport msg a b) where
   styleAmounts styles cpr@CompoundPeriodicReport{cbrSubreports, cbrTotals} =
     cpr{
         cbrSubreports = styleAmounts styles cbrSubreports
       , cbrTotals     = styleAmounts styles cbrTotals
       }
 
-instance HasAmounts b => HasAmounts (Text, PeriodicReport a b, Bool) where
+instance HasAmounts b => HasAmounts (msg, PeriodicReport a b, Bool) where
   styleAmounts styles (a,b,c) = (a,styleAmounts styles b,c)
 
 -- | Description of one subreport within a compound balance report.
 -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib.
-data CBCSubreportSpec a = CBCSubreportSpec
-  { cbcsubreporttitle          :: Text                      -- ^ The title to use for the subreport
+data CBCSubreportSpec msg a = CBCSubreportSpec
+  { cbcsubreporttitle          :: msg                       -- ^ The title to use for the subreport
   , cbcsubreportquery          :: Query                     -- ^ The Query to use for the subreport
   , cbcsubreportoptions        :: ReportOpts -> ReportOpts  -- ^ A function to transform the ReportOpts used to produce the subreport
   , cbcsubreporttransform      :: PeriodicReport DisplayName MixedAmount -> PeriodicReport a MixedAmount  -- ^ A function to transform the result of the subreport

hledger-lib/hledger-lib.cabal

@@ -153,6 +153,7 @@ library
     , file-embed >=0.0.10
     , filepath
     , hashtables >=1.2.3.1 && <1.3 || >=1.4.0
+    , haskell-gettext >=0.1.2.0 && <0.2
     , megaparsec >=7.0.0 && <9.8 || >=9.8.1 && <9.9
     , microlens >=0.4
     , microlens-th >=0.4
@@ -215,6 +216,7 @@ test-suite doctest
     , file-embed >=0.0.10
     , filepath
     , hashtables >=1.2.3.1 && <1.3 || >=1.4.0
+    , haskell-gettext >=0.1.2.0 && <0.2
     , megaparsec >=7.0.0 && <9.8 || >=9.8.1 && <9.9
     , microlens >=0.4
     , microlens-th >=0.4
@@ -276,6 +278,7 @@ test-suite unittest
     , file-embed >=0.0.10
     , filepath
     , hashtables >=1.2.3.1 && <1.3 || >=1.4.0
+    , haskell-gettext >=0.1.2.0 && <0.2
     , hledger-lib
     , megaparsec >=7.0.0 && <9.8 || >=9.8.1 && <9.9
     , microlens >=0.4

hledger-lib/package.yaml

@@ -69,6 +69,7 @@ dependencies:
 - file-embed >=0.0.10
 - filepath
 - hashtables >=1.2.3.1 && <1.3 || >=1.4.0
+- haskell-gettext >=0.1.2.0 && <0.2
 - megaparsec >=7.0.0 && <9.8 || >=9.8.1 && <9.9   # avoid https://github.com/mrkkrp/megaparsec/issues/572
 - microlens >=0.4
 - microlens-th >=0.4

hledger/Hledger/Cli/CliOptions.hs

@@ -283,6 +283,7 @@ helpflags = [
  ,flagNone ["man"]      (setboolopt "man")     "show this command's manual with man"
  ,flagNone ["webman"]   (setboolopt "webman")  "show this command's manual on the web"
  ,flagNone ["examples"] (setboolopt "examples") "show examples for this command"
+ ,flagReq  ["catalog"]  (\s opts -> Right $ setopt "catalog" s opts) "CATALOGFILE" "File containing custom translations."
  ,flagNone ["version"]  (setboolopt "version") "show version information"
   -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL] in help.
   -- But flagReq plus special handling in Cli.hs makes the = optional, removing a source of confusion.
@@ -597,6 +598,7 @@ data CliOpts = CliOpts {
     ,reportspec_      :: ReportSpec
     ,output_file_     :: Maybe FilePath
     ,output_format_   :: Maybe String
+    ,catalog_file_    :: Maybe FilePath
     ,pageropt_        :: Maybe Bool     -- ^ --pager
     ,coloropt_        :: Maybe YNA      -- ^ --color. Controls use of ANSI color and ANSI styles.
     ,debug_           :: Int            -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'.
@@ -619,6 +621,7 @@ defcliopts = CliOpts
     , reportspec_      = def
     , output_file_     = Nothing
     , output_format_   = Nothing
+    , catalog_file_    = Nothing
     , pageropt_        = Nothing
     , coloropt_        = Nothing
     , debug_           = 0
@@ -675,6 +678,7 @@ rawOptsToCliOpts rawopts = do
              ,reportspec_      = rspec
              ,output_file_     = maybestringopt "output-file" rawopts
              ,output_format_   = maybestringopt "output-format" rawopts
+             ,catalog_file_    = maybestringopt "catalog" rawopts
              ,pageropt_        = maybeynopt "pager" rawopts
              ,coloropt_        = maybeynaopt "color" rawopts
              ,debug_           = posintopt "debug" rawopts

hledger/Hledger/Cli/Commands/Balance.hs

@@ -301,6 +301,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Builder qualified as TB
+import Data.Gettext (loadCatalog)
 import Data.Time (addDays, fromGregorian)
 import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt)
 import Safe (headMay, maximumMay)
@@ -321,6 +322,7 @@ import Hledger.Write.Spreadsheet (rawTableContent, headerCell,
             addHeaderBorders, addRowSpanHeader, addRowSpanHeaderNE,
             cellFromMixedAmount, cellsFromMixedAmount, cellFromAmount)
 import Hledger.Write.Spreadsheet qualified as Ods
+import Hledger.Cli.Message qualified as Msg
 
 
 -- | Command line options for this command.
@@ -399,7 +401,18 @@ balancemode = hledgerCommandMode
 
 -- | The balance command, prints a balance report.
 balance :: CliOpts -> Journal -> IO ()
-balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of
+balance opts@CliOpts{reportspec_=rspec} j = do
+  let ropts0 = _rsReportOpts rspec
+  maybeCat <- traverse loadCatalog $ catalog_file_ opts
+  let ropts =
+        ropts0 {
+            -- tidy csv is defined externally and must not include totals or averages
+            no_total_ = no_total_ ropts0 || layout_ ropts0 == LayoutTidy,
+            catalog_ = maybeCat
+        }
+  -- Tidy csv/tsv should be consistent between single period and multiperiod reports.
+  let multiperiod = interval_ ropts /= NoInterval || (layout_ ropts == LayoutTidy && delimited)
+  case balancecalc_ ropts of
     CalcBudget -> do  -- single or multi period budget report
       let rspan = fst $ reportSpan j rspec
           budgetreport = styleAmounts styles $ budgetReport rspec (balancingopts_ $ inputopts_ opts) rspan j
@@ -440,14 +453,6 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of
         writeOutputLazyText opts $ render report
   where
     styles = journalCommodityStylesWith HardRounding j
-    ropts =
-        let ropts0 = _rsReportOpts rspec in
-        ropts0 {
-            -- tidy csv is defined externally and must not include totals or averages
-            no_total_ = no_total_ ropts0 || layout_ ropts0 == LayoutTidy
-        }
-    -- Tidy csv/tsv should be consistent between single period and multiperiod reports.
-    multiperiod = interval_ ropts /= NoInterval || (layout_ ropts == LayoutTidy && delimited)
     delimited   = fmt == "csv" || fmt == "tsv"
     fmt         = outputFormatFromOpts opts
 
@@ -491,10 +496,10 @@ budgetAverageClass rc =
 
 -- What to show as heading for the totals row in balance reports ?
 -- Currently nothing in terminal, Total: in HTML, FODS and xSV output.
-totalRowHeadingText        = ""
-totalRowHeadingSpreadsheet = "Total:"
-totalRowHeadingBudgetText  = ""
-totalRowHeadingBudgetCsv   = "Total:"
+totalRowHeadingText        = Msg.None
+totalRowHeadingSpreadsheet = Msg.Total
+totalRowHeadingBudgetText  = Msg.None
+totalRowHeadingBudgetCsv   = Msg.Total
 
 -- Single-column balance reports
 
@@ -719,16 +724,17 @@ balanceReportAsSpreadsheetParts fmt opts (items, total) =
       if no_total_ opts
         then []
         else addTotalBorders $
-          rows Total (totalRowHeadingSpreadsheet, totalRowHeadingSpreadsheet, 0, total))
+          rows Total (msg totalRowHeadingSpreadsheet, msg totalRowHeadingSpreadsheet, 0, total))
   where
     cell = Ods.defaultCell
     hCell cls label = (headerCell label) {Ods.cellClass = Ods.Class cls}
+    msg = Msg.getText (catalog_ opts)
     headers =
       addHeaderBorders $
-      hCell "account" "account" :| case layout_ opts of
+      hCell "account" (msg Msg.Account) :| case layout_ opts of
         LayoutBareWide -> map (hCell "amount") allCommodities
-        LayoutBare -> [headerCell "commodity", hCell "amount" "balance"]
-        _          -> [hCell "amount" "balance"]
+        LayoutBare -> [headerCell $ msg Msg.Commodity, hCell "amount" $ msg Msg.Balance]
+        _          -> [hCell "amount" $ msg Msg.Balance]
     allCommodities =
         S.toAscList $ foldMap (\(_,_,_,ma) -> maCommodities ma) items
     rows ::
@@ -813,9 +819,10 @@ multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..}
               concatMap (Ods.horizontalSpan allCommodities) dateHeaders,
            headers]
       _ -> [headers]
+    msg = Msg.getText catalog_
     headers =
       addHeaderBorders $
-      hCell accountClass "account" :
+      hCell accountClass (msg Msg.Account) :
       case layout_ of
       LayoutTidy -> map headerCell tidyColumnLabels
       LayoutBareWide -> dateHeaders >> map headerCell allCommodities
@@ -826,8 +833,8 @@ multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..}
     amountHeader c = c{Ods.cellClass = amountClass Value}
     dateHeaders =
       (if not summary_only_ then map (amountHeader . headerDateSpanCell period_titles_ balance_base_url_ querystring_) colspans  else [] )++
-      [hCell (rowTotalClass Value) "total" | multiBalanceHasTotalsColumn opts] ++
-      [hCell (rowAverageClass Value) "average" | average_]
+      [hCell (rowTotalClass Value) (msg Msg.Total) | multiBalanceHasTotalsColumn opts] ++
+      [hCell (rowAverageClass Value) (msg Msg.Average) | average_]
     fullRowAsTexts row =
         addRowSpanHeader anchorCell $
         rowAsText Value (dateSpanCell period_titles_ balance_base_url_ querystring_ acctName) row
@@ -838,7 +845,7 @@ multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..}
     totalrows =
       if no_total_
         then []
-        else addRowSpanHeader (accountCell totalRowHeadingSpreadsheet) $
+        else addRowSpanHeader (accountCell $ msg totalRowHeadingSpreadsheet) $
                 rowAsText Total (simpleDateSpanCell period_titles_) tr
     rowAsText rc dsCell =
         map (map (fmap wbToText)) .
@@ -957,8 +964,9 @@ multiBalanceReportAsPartTable
      (Group multiColumnTableInterColumnBorder $ map Header colheadings)
      (concat rows)
   where
+    msg = Msg.getText (catalog_ opts)
     colheadings =
-      ["Commodity" | layout_ opts == LayoutBare]
+      [msg Msg.Commodity | layout_ opts == LayoutBare]
       ++
       case layout_ opts of
           LayoutBareWide ->
@@ -968,8 +976,8 @@ multiBalanceReportAsPartTable
     spanNames =
         (guard (not summary_only_) >>
             map (reportPeriodName (period_titles_ opts) balanceaccum_ spans) spans)
-        ++ ["  Total" | multiBalanceHasTotalsColumn opts]
-        ++ ["Average" | average_]
+        ++ [msg Msg.RightTotal | multiBalanceHasTotalsColumn opts]
+        ++ [msg Msg.RightAverage | average_]
     (accts, rows) = unzip $ fmap fullRowAsTexts items'
       where
         isLeaf rs row = not $ any (\r -> T.isPrefixOf (displayFull (prrName row) <> ":") (displayFull (prrName r))) rs
@@ -984,7 +992,7 @@ multiBalanceReportAsPartTable
       | no_total_ opts = id
       | otherwise =
         let totalrows = multiBalanceRowAsText opts allCommodities tr
-            rowhdrs = Group NoLine $ map Header $ totalRowHeadingText : replicate (length totalrows - 1) ""
+            rowhdrs = Group NoLine $ map Header $ msg totalRowHeadingText : replicate (length totalrows - 1) ""
             colhdrs = Header [] -- unused, concatTables will discard
         in (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows)
     maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals)
@@ -1141,15 +1149,17 @@ budgetReportAsTable ropts@ReportOpts{..} (PeriodicReport spans items totrow) =
       | no_total_ = id
       | otherwise =
         let
-          rowhdrs = Group NoLine $ map Header $ totalRowHeadingBudgetText : replicate (length totalrows - 1) ""
+          rowhdrs = Group NoLine $ map Header $ msg totalRowHeadingBudgetText : replicate (length totalrows - 1) ""
           colhdrs = Header [] -- ignored by concatTables
         in
           (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows)  -- XXX ?
 
-    colheadings = ["Commodity" | layout_ == LayoutBare]
+    msg = Msg.getText catalog_
+
+    colheadings = [msg Msg.Commodity | layout_ == LayoutBare]
                   ++ (if not summary_only_ then map (reportPeriodName period_titles_ balanceaccum_ spans) spans else [])
-                  ++ ["  Total" | row_total_]
-                  ++ ["Average" | average_]
+                  ++ [msg Msg.RightTotal | row_total_]
+                  ++ [msg Msg.RightAverage | average_]
 
     (accts, rows, totalrows) =
       (accts'
@@ -1368,10 +1378,11 @@ budgetReportAsSpreadsheet
 
     -- totals row
     ++ addTotalBorders
-          (concat [ rowAsTexts Total (cell totalRowHeadingBudgetCsv) totrow | not no_total_ ])
+          (concat [ rowAsTexts Total (cell $ msg totalRowHeadingBudgetCsv) totrow | not no_total_ ])
     )
 
   where
+    msg = Msg.getText catalog_
     cell = Ods.defaultCell
     accountCell row =
         let name = prrFullName row in
@@ -1389,13 +1400,13 @@ budgetReportAsSpreadsheet
               leadingHeaders ++ (dateHeaders >> allCommodities)]
       _ -> [addHeaderBorders $ map headerCell $ leadingHeaders ++ dateHeaders]
     leadingHeaders =
-      "Account" : ["Commodity" | layout_ == LayoutBare ]
+      msg Msg.Account : [msg Msg.Commodity | layout_ == LayoutBare ]
     dateHeaders =
       (if not summary_only_
-            then concatMap (\spn -> [renderPeriodHeading period_titles_ spn, "budget"]) colspans
+            then concatMap (\spn -> [renderPeriodHeading period_titles_ spn, msg Msg.Budget]) colspans
             else [])
-       ++ concat [["Total"  ,"budget"] | row_total_]
-       ++ concat [["Average","budget"] | average_]
+       ++ concat [[msg Msg.Total  , msg Msg.Budget] | row_total_]
+       ++ concat [[msg Msg.Average, msg Msg.Budget] | average_]
     allCommodities =
        S.toAscList $
        foldMap (foldMap maCommodities . concatMap (\(change,goal) -> maybeToList change ++ maybeToList goal) . prrAmounts) items