balance, lib: clarify --format implementation

The --format option's OutputFormat type was named confusingly like the
--output-format option.  It has been renamed StringFormat to distinguish
it from StorageFormat (aka the data file format, referenced by
--output-format). Related code and types have been consolidated.
Also the (single-column) balance report's item rendering has had
some cleanup.

hledger-lib/Hledger/Data/StringFormat.hs

@@ -1,10 +1,15 @@
+-- | Parse format strings provided by --format, with awareness of
+-- hledger's report item fields. Also provides a string formatting
+-- helper.
+
 {-# LANGUAGE FlexibleContexts #-}
-module Hledger.Data.OutputFormat (
+
+module Hledger.Data.StringFormat (
           parseStringFormat
-        , formatsp
+        , formatString
-        , formatValue
+        , StringFormat(..)
-        , OutputFormat(..)
+        , ReportItemField(..)
-        , HledgerFormatField(..)
+        -- , stringformatp
         , tests
         ) where
 
@@ -15,29 +20,49 @@ import Data.Char (isPrint)
 import Data.Maybe
 import Test.HUnit
 import Text.Parsec
-import Text.Printf
+import Text.Printf (printf)
-
-import Hledger.Data.Types
 
 
-formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String
+-- | A format specification/template to use when rendering report line items as text.
-formatValue leftJustified min max value = printf formatS value
+-- These are currently supported by the balance command.
+data StringFormat =
+    FormatLiteral String
+  | FormatField Bool        -- Left justified ?
+                (Maybe Int) -- Min width
+                (Maybe Int) -- Max width
+                ReportItemField       -- Field name
+  deriving (Show, Eq)
+
+-- | An id identifying which report item field to interpolate.  These
+-- are drawn from several hledger report types, so are not all
+-- applicable for a given report.
+data ReportItemField =
+    AccountField
+  | DefaultDateField
+  | DescriptionField
+  | TotalField
+  | DepthSpacerField
+  | FieldNo Int
+    deriving (Show, Eq)
+
+-- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
+formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String
+formatString leftJustified min max s = printf fmt s
     where
       l = if leftJustified then "-" else ""
       min' = maybe "" show min
       max' = maybe "" (\i -> "." ++ (show i)) max
-      formatS = "%" ++ l ++ min' ++ max' ++ "s"
+      fmt = "%" ++ l ++ min' ++ max' ++ "s"
 
-parseStringFormat :: String -> Either String [OutputFormat]
+-- | Parse a string format specification, or return a parse error.
-parseStringFormat input = case (runParser (formatsp <* eof) () "(unknown)") input of
+parseStringFormat :: String -> Either String [StringFormat]
+parseStringFormat input = case (runParser (stringformatp <* eof) () "(unknown)") input of
     Left y -> Left $ show y
     Right x -> Right x
 
-{-
+----------------------------------------------------------------------
-Parsers
--}
 
-field :: Stream [Char] m Char => ParsecT [Char] st m HledgerFormatField
+field :: Stream [Char] m Char => ParsecT [Char] st m ReportItemField
 field = do
         try (string "account" >> return AccountField)
     <|> try (string "depth_spacer" >> return DepthSpacerField)
@@ -46,7 +71,7 @@ field = do
     <|> try (string "total" >> return TotalField)
     <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))
 
-formatField :: Stream [Char] m Char => ParsecT [Char] st m OutputFormat
+formatField :: Stream [Char] m Char => ParsecT [Char] st m StringFormat
 formatField = do
     char '%'
     leftJustified <- optionMaybe (char '-')
@@ -61,7 +86,7 @@ formatField = do
         Just text -> Just m where ((m,_):_) = readDec text
         _ -> Nothing
 
-formatLiteral :: Stream [Char] m Char => ParsecT [Char] st m OutputFormat
+formatLiteral :: Stream [Char] m Char => ParsecT [Char] st m StringFormat
 formatLiteral = do
     s <- many1 c
     return $ FormatLiteral s
@@ -70,22 +95,24 @@ formatLiteral = do
       c =     (satisfy isPrintableButNotPercentage <?> "printable character")
           <|> try (string "%%" >> return '%')
 
-formatp :: Stream [Char] m Char => ParsecT [Char] st m OutputFormat
+formatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormat
 formatp =
         formatField
     <|> formatLiteral
 
-formatsp :: Stream [Char] m Char => ParsecT [Char] st m [OutputFormat]
+stringformatp :: Stream [Char] m Char => ParsecT [Char] st m [StringFormat]
-formatsp = many formatp
+stringformatp = many formatp
 
-testFormat :: OutputFormat -> String -> String -> Assertion
+----------------------------------------------------------------------
+
+testFormat :: StringFormat -> String -> String -> Assertion
 testFormat fs value expected = assertEqual name expected actual
     where
         (name, actual) = case fs of
-            FormatLiteral l -> ("literal", formatValue False Nothing Nothing l)
+            FormatLiteral l -> ("literal", formatString False Nothing Nothing l)
-            FormatField leftJustify min max _ -> ("field", formatValue leftJustify min max value)
+            FormatField leftJustify min max _ -> ("field", formatString leftJustify min max value)
 
-testParser :: String -> [OutputFormat] -> Assertion
+testParser :: String -> [StringFormat] -> Assertion
 testParser s expected = case (parseStringFormat s) of
     Left  error -> assertFailure $ show error
     Right actual -> assertEqual ("Input: " ++ s) expected actual

hledger-lib/Hledger/Data/Types.hs

@@ -265,10 +265,11 @@ instance NFData Journal
 type JournalUpdate = ExceptT String IO (Journal -> Journal)
 
 -- | The id of a data format understood by hledger, eg @journal@ or @csv@.
+-- The --output-format option selects one of these for output.
 type StorageFormat = String
 
--- | A hledger journal reader is a triple of format name, format-detecting
+-- | A hledger journal reader is a triple of storage format name, a
--- predicate, and a parser to Journal.
+-- detector of that format, and a parser from that format to Journal.
 data Reader = Reader {
      -- name of the format this reader handles
      rFormat   :: StorageFormat
@@ -280,26 +281,6 @@ data Reader = Reader {
 
 instance Show Reader where show r = rFormat r ++ " reader"
 
--- format strings
-
-data HledgerFormatField =
-    AccountField
-  | DefaultDateField
-  | DescriptionField
-  | TotalField
-  | DepthSpacerField
-  | FieldNo Int
-    deriving (Show, Eq)
-
-data OutputFormat =
-    FormatLiteral String
-  | FormatField Bool        -- Left justified ?
-                (Maybe Int) -- Min width
-                (Maybe Int) -- Max width
-                HledgerFormatField       -- Field
-  deriving (Show, Eq)
-
-
 -- | An account, with name, balances and links to parent/subaccounts
 -- which let you walk up or down the account tree.
 data Account = Account {
@@ -313,8 +294,6 @@ data Account = Account {
   aboring :: Bool           -- ^ used in the accounts report to label elidable parents
   }
 
-
-
 -- | A Ledger has the journal it derives from, and the accounts
 -- derived from that. Accounts are accessible both list-wise and
 -- tree-wise, since each one knows its parent and subs; the first
@@ -323,3 +302,4 @@ data Ledger = Ledger {
   ljournal :: Journal,
   laccounts :: [Account]
 }
+

hledger-lib/hledger-lib.cabal

@@ -88,7 +88,7 @@ library
       Hledger.Data.Dates
       Hledger.Data.Journal
       Hledger.Data.Ledger
-      Hledger.Data.OutputFormat
+      Hledger.Data.StringFormat
       Hledger.Data.Posting
       Hledger.Data.RawOptions
       Hledger.Data.TimeLog

hledger-lib/package.yaml

@@ -101,7 +101,7 @@ library:
     - Hledger.Data.Dates
     - Hledger.Data.Journal
     - Hledger.Data.Ledger
-    - Hledger.Data.OutputFormat
+    - Hledger.Data.StringFormat
     - Hledger.Data.Posting
     - Hledger.Data.RawOptions
     - Hledger.Data.TimeLog

hledger/Hledger/Cli/Balance.hs

@@ -253,7 +253,7 @@ import Text.Tabular as T
 import Text.Tabular.AsciiArt
 
 import Hledger
-import Hledger.Data.OutputFormat
+import Hledger.Data.StringFormat
 import Hledger.Cli.Options
 import Hledger.Cli.Utils
 
@@ -374,8 +374,8 @@ balanceReportAsText :: ReportOpts -> BalanceReport -> String
 balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t
   where
       lines = case lineFormatFromOpts opts of
-                Right f -> map (balanceReportItemAsText opts f) items
+                Right fmt -> map (balanceReportItemAsText opts fmt) items
-                Left err -> [[err]]
+                Left err  -> [[err]]
       t = if no_total_ opts
            then []
            else ["--------------------"
@@ -409,39 +409,39 @@ This implementation turned out to be a bit convoluted but implements the followi
     b         USD -1  ; Account 'b' has two amounts. The account name is printed on the last line.
 -}
 -- | Render one balance report line item as plain text suitable for console output.
-balanceReportItemAsText :: ReportOpts -> [OutputFormat] -> BalanceReportItem -> [String]
+balanceReportItemAsText :: ReportOpts -> [StringFormat] -> BalanceReportItem -> [String]
-balanceReportItemAsText opts format ((_, accountName, depth), Mixed amounts) =
+balanceReportItemAsText opts fmt ((_, accountName, depth), Mixed amounts) =
     -- 'amounts' could contain several quantities of the same commodity with different price.
     -- In order to combine them into single value (which is expected) we take the first price and
     -- use it for the whole mixed amount. This could be suboptimal. XXX
     let Mixed normAmounts = normaliseMixedAmountSquashPricesForDisplay (Mixed amounts) in
     case normAmounts of
       [] -> []
-      [a] -> [formatBalanceReportItem opts (Just accountName) depth a format]
+      [a] -> [formatBalanceReportItem fmt ((Just accountName'), depth, a)]
       (as) -> multiline as
     where
+      accountName' = maybeAccountNameDrop opts accountName
       multiline :: [Amount] -> [String]
       multiline []     = []
-      multiline [a]    = [formatBalanceReportItem opts (Just accountName) depth a format]
+      multiline [a]    = [formatBalanceReportItem fmt ((Just accountName'), depth, a)]
-      multiline (a:as) = (formatBalanceReportItem opts Nothing depth a format) : multiline as
+      multiline (a:as) = (formatBalanceReportItem fmt (Nothing, depth, a)) : multiline as
 
-formatBalanceReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [OutputFormat] -> String
+formatBalanceReportItem :: [StringFormat] -> (Maybe AccountName, Int, Amount) -> String
-formatBalanceReportItem _ _ _ _ [] = ""
+formatBalanceReportItem [] (_, _, _) = ""
-formatBalanceReportItem opts accountName depth amount (fmt:fmts) =
+formatBalanceReportItem (fmt:fmts) (macctname, depth, amount) =
-  s ++ (formatBalanceReportItem opts accountName depth amount fmts)
+  format fmt (macctname, depth, amount) ++
+  formatBalanceReportItem fmts (macctname, depth, amount)
   where
-    s = case fmt of
+    format :: StringFormat -> (Maybe AccountName, Int, Amount) -> String
-         FormatLiteral l -> l
+    format (FormatLiteral s) _ = s
-         FormatField ljust min max field  -> formatField opts accountName depth amount ljust min max field
+    format (FormatField ljust min max field) (macctname, depth, total) = case field of
-
+      DepthSpacerField -> formatString ljust Nothing max $ replicate d ' '
-formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String
+                          where d = case min of
-formatField opts accountName depth total ljust min max field = case field of
+                                     Just m  -> depth * m
-        AccountField     -> formatValue ljust min max $ maybe "" (maybeAccountNameDrop opts) accountName
+                                     Nothing -> depth
-        DepthSpacerField -> case min of
+      AccountField     -> formatString ljust min max $ fromMaybe "" macctname
-                               Just m  -> formatValue ljust Nothing max $ replicate (depth * m) ' '
+      TotalField       -> formatString ljust min max $ showAmountWithoutPrice total
-                               Nothing -> formatValue ljust Nothing max $ replicate depth ' '
+      _                -> ""
-        TotalField       -> formatValue ljust min max $ showAmountWithoutPrice total
-        _                  -> ""
 
 -- multi-column balance reports
 

hledger/Hledger/Cli/Options.hs

@@ -81,7 +81,7 @@ import Test.HUnit
 import Text.Parsec
 
 import Hledger
-import Hledger.Data.OutputFormat as OutputFormat
+import Hledger.Data.StringFormat as StringFormat
 import Hledger.Cli.Version
 
 
@@ -467,11 +467,11 @@ maybeAccountNameDrop opts a | tree_ opts = a
 
 -- | Parse the format option if provided, possibly returning an error,
 -- otherwise get the default value.
-lineFormatFromOpts :: ReportOpts -> Either String [OutputFormat]
+lineFormatFromOpts :: ReportOpts -> Either String [StringFormat]
 lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_
 
 -- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)"
-defaultBalanceLineFormat :: [OutputFormat]
+defaultBalanceLineFormat :: [StringFormat]
 defaultBalanceLineFormat = [
       FormatField False (Just 20) Nothing TotalField
     , FormatLiteral "  "