lib,cli: Store StringFormat in ReportOpts, rather than unparsed String.

StringFormat now also takes an optional overline width, which is
currently only used by defaultBalanceLineFormat.

hledger-lib/Hledger/Data/StringFormat.hs

@@ -10,19 +10,22 @@ module Hledger.Data.StringFormat (
         , StringFormat(..)
         , StringFormatComponent(..)
         , ReportItemField(..)
+        , overlineWidth
+        , defaultBalanceLineFormat
         , tests_StringFormat
         ) where
 
 import Prelude ()
 import "base-compat-batteries" Prelude.Compat
-import Numeric
+import Numeric (readDec)
 import Data.Char (isPrint)
-import Data.Maybe
+import Data.Default (Default(..))
+import Data.Maybe (isJust)
 -- import qualified Data.Text as T
 import Text.Megaparsec
-import Text.Megaparsec.Char
+import Text.Megaparsec.Char (char, digitChar, string)
 
-import Hledger.Utils.Parse
+import Hledger.Utils.Parse (SimpleStringParser)
 import Hledger.Utils.String (formatString)
 import Hledger.Utils.Test
 
@@ -31,6 +34,7 @@ import Hledger.Utils.Test
 -- A format is a sequence of components; each is either a literal
 -- string, or a hledger report item field with specified width and
 -- justification whose value will be interpolated at render time.
+-- This includes an optional width for any overlines.
 --
 -- A component's value may be a multi-line string (or a
 -- multi-commodity amount), in which case the final string will be
@@ -41,9 +45,9 @@ import Hledger.Utils.Test
 -- mode, which provides a limited StringFormat renderer.
 --
 data StringFormat =
-    OneLine [StringFormatComponent]       -- ^ multi-line values will be rendered on one line, comma-separated
+    OneLine       (Maybe Int) [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated
-  | TopAligned [StringFormatComponent]    -- ^ values will be top-aligned (and bottom-padded to the same height)
+  | TopAligned    (Maybe Int) [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height)
-  | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)
+  | BottomAligned (Maybe Int) [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)
   deriving (Show, Eq)
 
 data StringFormatComponent =
@@ -73,6 +77,21 @@ data ReportItemField =
   | FieldNo Int       -- ^ A report item's nth field. May be unimplemented.
     deriving (Show, Eq)
 
+instance Default StringFormat where def = defaultBalanceLineFormat
+
+overlineWidth :: StringFormat -> Maybe Int
+overlineWidth (OneLine       w _) = w
+overlineWidth (TopAligned    w _) = w
+overlineWidth (BottomAligned w _) = w
+
+-- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)"
+defaultBalanceLineFormat :: StringFormat
+defaultBalanceLineFormat = BottomAligned (Just 20) [
+      FormatField False (Just 20) Nothing TotalField
+    , FormatLiteral "  "
+    , FormatField True (Just 2) Nothing DepthSpacerField
+    , FormatField True Nothing Nothing AccountField
+    ]
 ----------------------------------------------------------------------
 
 -- renderStringFormat :: StringFormat -> Map String String -> String
@@ -93,10 +112,10 @@ stringformatp = do
   alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String))
   let constructor =
         case alignspec of
-          Just '^' -> TopAligned
+          Just '^' -> TopAligned Nothing
-          Just '_' -> BottomAligned
+          Just '_' -> BottomAligned Nothing
-          Just ',' -> OneLine
+          Just ',' -> OneLine Nothing
-          _        -> defaultStringFormatStyle
+          _        -> defaultStringFormatStyle Nothing
   constructor <$> many componentp
 
 componentp :: SimpleStringParser StringFormatComponent
@@ -157,20 +176,20 @@ tests_StringFormat = tests "StringFormat" [
 
   ,let s `gives` expected = test s $ parseStringFormat s @?= Right expected
    in tests "parseStringFormat" [
-      ""                           `gives` (defaultStringFormatStyle [])
+      ""                           `gives` (defaultStringFormatStyle Nothing [])
-    , "D"                          `gives` (defaultStringFormatStyle [FormatLiteral "D"])
+    , "D"                          `gives` (defaultStringFormatStyle Nothing [FormatLiteral "D"])
-    , "%(date)"                    `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField])
+    , "%(date)"                    `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing DescriptionField])
-    , "%(total)"                   `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField])
+    , "%(total)"                   `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing TotalField])
     -- TODO
     -- , "^%(total)"                  `gives` (TopAligned [FormatField False Nothing Nothing TotalField])
     -- , "_%(total)"                  `gives` (BottomAligned [FormatField False Nothing Nothing TotalField])
     -- , ",%(total)"                  `gives` (OneLine [FormatField False Nothing Nothing TotalField])
-    , "Hello %(date)!"             `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])
+    , "Hello %(date)!"             `gives` (defaultStringFormatStyle Nothing [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])
-    , "%-(date)"                   `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField])
+    , "%-(date)"                   `gives` (defaultStringFormatStyle Nothing [FormatField True Nothing Nothing DescriptionField])
-    , "%20(date)"                  `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField])
+    , "%20(date)"                  `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing DescriptionField])
-    , "%.10(date)"                 `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField])
+    , "%.10(date)"                 `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing (Just 10) DescriptionField])
-    , "%20.10(date)"               `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField])
+    , "%20.10(date)"               `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) (Just 10) DescriptionField])
-    , "%20(account) %.10(total)"   `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField
+    , "%20(account) %.10(total)"   `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing AccountField
                                                                              ,FormatLiteral " "
                                                                              ,FormatField False Nothing (Just 10) TotalField
                                                                              ])

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -13,7 +13,6 @@ module Hledger.Reports.ReportOptions (
   BalanceType(..),
   AccountListMode(..),
   ValuationType(..),
-  FormatStr,
   defreportopts,
   rawOptsToReportOpts,
   flat_,
@@ -64,8 +63,6 @@ import Hledger.Query
 import Hledger.Utils
 
 
-type FormatStr = String
-
 -- | Which "balance" is being shown in a balance report.
 data BalanceType = PeriodChange      -- ^ The change of balance in each period.
                  | CumulativeChange  -- ^ The accumulated change across multiple periods.
@@ -101,7 +98,7 @@ data ReportOpts = ReportOpts {
     ,empty_          :: Bool
     ,no_elide_       :: Bool
     ,real_           :: Bool
-    ,format_         :: Maybe FormatStr
+    ,format_         :: StringFormat
     ,query_          :: String -- ^ All query arguments space sepeareted
                                --   and quoted if needed (see 'quoteIfNeeded')
     --
@@ -177,6 +174,12 @@ rawOptsToReportOpts rawopts = do
     no_color <- isJust <$> lookupEnv "NO_COLOR"
     supports_color <- hSupportsANSIColor stdout
     let colorflag = stringopt "color" rawopts
+
+    format <- case parseStringFormat <$> maybestringopt "format" rawopts of
+         Nothing         -> return defaultBalanceLineFormat
+         Just (Right x)  -> return x
+         Just (Left err) -> usageError $ "could not parse format option: " ++ err
+
     return defreportopts{
        today_       = Just d
       ,period_      = periodFromRawOpts d rawopts
@@ -189,7 +192,7 @@ rawOptsToReportOpts rawopts = do
       ,empty_       = boolopt "empty" rawopts
       ,no_elide_    = boolopt "no-elide" rawopts
       ,real_        = boolopt "real" rawopts
-    ,format_      = maybestringopt "format" rawopts -- XXX move to CliOpts or move validation from Cli.CliOptions to here
+      ,format_      = format
       ,query_       = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
       ,average_     = boolopt "average" rawopts
       ,related_     = boolopt "related" rawopts

hledger/Hledger/Cli/CliOptions.hs

@@ -38,10 +38,8 @@ module Hledger.Cli.CliOptions (
   getHledgerCliOpts,
   getHledgerCliOpts',
   rawOptsToCliOpts,
-  checkCliOpts,
   outputFormats,
   defaultOutputFormat,
-  defaultBalanceLineFormat,
   CommandDoc,
 
   -- possibly these should move into argsToCliOpts
@@ -56,8 +54,6 @@ module Hledger.Cli.CliOptions (
   replaceNumericFlags,
   -- | For register:
   registerWidthsFromOpts,
-  -- | For balance:
-  lineFormatFromOpts,
 
   -- * Other utils
   hledgerAddons,
@@ -448,7 +444,7 @@ replaceNumericFlags = map replace
 -- today's date. Parsing failures will raise an error.
 -- Also records the terminal width, if supported.
 rawOptsToCliOpts :: RawOpts -> IO CliOpts
-rawOptsToCliOpts rawopts = checkCliOpts <$> do
+rawOptsToCliOpts rawopts = do
   let iopts = rawOptsToInputOpts rawopts
   ropts <- rawOptsToReportOpts rawopts
   mcolumns <- readMay <$> getEnvSafe "COLUMNS"
@@ -474,16 +470,6 @@ rawOptsToCliOpts rawopts = checkCliOpts <$> do
              ,available_width_ = availablewidth
              }
 
--- | Do final validation of processed opts, raising an error if there is trouble.
-checkCliOpts :: CliOpts -> CliOpts
-checkCliOpts opts =
-  either usageError (const opts) $ do
-    -- XXX move to checkReportOpts or move _format to CliOpts
-    case lineFormatFromOpts $ reportopts_ opts of
-      Left err -> Left $ "could not parse format option: "++err
-      Right _  -> Right ()
-  -- XXX check registerWidthsFromOpts opts
-
 -- | A helper for addon commands: this parses options and arguments from
 -- the current command line using the given hledger-style cmdargs mode,
 -- and returns a CliOpts. Or, with --help or -h present, it prints
@@ -643,22 +629,6 @@ registerWidthsFromOpts CliOpts{width_=Just s}  =
           eof
           return (totalwidth, descwidth)
 
--- for balance, currently:
-
--- | Parse the format option if provided, possibly returning an error,
--- otherwise get the default value.
-lineFormatFromOpts :: ReportOpts -> Either String StringFormat
-lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_
-
--- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)"
-defaultBalanceLineFormat :: StringFormat
-defaultBalanceLineFormat = BottomAligned [
-      FormatField False (Just 20) Nothing TotalField
-    , FormatLiteral "  "
-    , FormatField True (Just 2) Nothing DepthSpacerField
-    , FormatField True Nothing Nothing AccountField
-    ]
-
 -- Other utils
 
 -- | Get the sorted unique canonical names of hledger addon commands

hledger/Hledger/Cli/Commands/Balance.hs

@@ -306,9 +306,6 @@ balancemode = hledgerCommandMode
 balance :: CliOpts -> Journal -> IO ()
 balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
     d <- getCurrentDay
-  case lineFormatFromOpts ropts of
-    Left err -> error' $ unlines [err]  -- PARTIAL:
-    Right _ -> do
     let budget      = boolopt "budget" rawopts
         multiperiod = interval_ /= NoInterval
         fmt         = outputFormatFromOpts opts
@@ -332,7 +329,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
               "csv"  -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
               "html" -> (++"\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts
               "json" -> (++"\n") . TL.unpack . toJsonText
-                _      -> const $ error' $ unsupportedOutputFormatError fmt
+              _      -> const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
         writeOutput opts $ render report
 
       else do  -- single period simple balance report
@@ -341,7 +338,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
               "txt"  -> balanceReportAsText
               "csv"  -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
               "json" -> const $ (++"\n") . TL.unpack . toJsonText
-                _      -> const $ error' $ unsupportedOutputFormatError fmt
+              _      -> const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
         writeOutput opts $ render ropts report
 
 -- rendering single-column balance reports
@@ -358,28 +355,17 @@ balanceReportAsCsv opts (items, total) =
 
 -- | Render a single-column balance report as plain text.
 balanceReportAsText :: ReportOpts -> BalanceReport -> String
-balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t
+balanceReportAsText opts ((items, total)) = unlines $
+    concat lines ++ if no_total_ opts then [] else overline : totallines
   where
-      fmt = lineFormatFromOpts opts
+    lines = map (balanceReportItemAsText opts) items
-      lines = case fmt of
-                Right fmt -> map (balanceReportItemAsText opts fmt) items
-                Left err  -> [[err]]
-      t = if no_total_ opts
-           then []
-           else
-             case fmt of
-               Right fmt ->
-                let
     -- abuse renderBalanceReportItem to render the total with similar format
     acctcolwidth = maximum' [T.length fullname | (fullname, _, _, _) <- items]
-                  totallines = map rstrip $ renderBalanceReportItem opts fmt (T.replicate (acctcolwidth+1) " ", 0, total)
+    totallines = map rstrip $ renderBalanceReportItem opts (T.replicate (acctcolwidth+1) " ", 0, total)
     -- with a custom format, extend the line to the full report width;
     -- otherwise show the usual 20-char line for compatibility
-                  overlinewidth | isJust (format_ opts) = maximum' $ map length $ concat lines
+    overlinewidth = fromMaybe (maximum' . map length $ concat lines) . overlineWidth $ format_ opts
-                                | otherwise             = defaultTotalFieldWidth
     overline   = replicate overlinewidth '-'
-                in overline : totallines
-               Left _ -> []
 
 {-
 :r
@@ -396,28 +382,25 @@ This implementation turned out to be a bit convoluted but implements the followi
 -- whatever string format is specified). Note, prices will not be rendered, and
 -- differently-priced quantities of the same commodity will appear merged.
 -- The output will be one or more lines depending on the format and number of commodities.
-balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String]
+balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> [String]
-balanceReportItemAsText opts fmt (_, accountName, depth, amt) =
+balanceReportItemAsText opts (_, accountName, depth, amt) =
-  renderBalanceReportItem opts fmt (
+  renderBalanceReportItem opts (
     accountName,
     depth,
     normaliseMixedAmountSquashPricesForDisplay amt
     )
 
 -- | Render a balance report item using the given StringFormat, generating one or more lines of text.
-renderBalanceReportItem :: ReportOpts -> StringFormat -> (AccountName, Int, MixedAmount) -> [String]
+renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> [String]
-renderBalanceReportItem opts fmt (acctname, depth, total) =
+renderBalanceReportItem opts (acctname, depth, total) =
-  lines $
+  lines $ case format_ opts of
-  case fmt of
+      OneLine       _ comps -> concatOneLine      $ render1 comps
-    OneLine comps       -> concatOneLine      $ render1 comps
+      TopAligned    _ comps -> concatBottomPadded $ render comps
-    TopAligned comps    -> concatBottomPadded $ render comps
+      BottomAligned _ comps -> concatTopPadded    $ render comps
-    BottomAligned comps -> concatTopPadded    $ render comps
   where
     render1 = map (renderComponent1 opts (acctname, depth, total))
     render  = map (renderComponent opts (acctname, depth, total))
 
-defaultTotalFieldWidth = 20
-
 -- | Render one StringFormat component for a balance report item.
 renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
 renderComponent _ _ (FormatLiteral s) = s