Adding basic ledger FORMAT parser.

MANUAL.md

@@ -167,6 +167,7 @@ Some of these are discussed more in [other features](#other-features):
       -M       --monthly          register, stats: report by month
       -Q       --quarterly        register, stats: report by quarter
       -Y       --yearly           register, stats: report by year
+      -F STR   --format=STR       use STR as the format
       -v       --verbose          show more verbose output
                --debug            show extra debug output; implies verbose
                --binary-filename  show the download filename for this hledger build
@@ -1006,6 +1007,80 @@ To record time logs, ie to clock in and clock out, you could:
 - or the old "ti" and "to" scripts in the [c++ ledger 2.x repository](https://github.com/jwiegley/ledger/tree/maint/scripts).
   These rely on a "timeclock" executable which I think is just the ledger 2 executable renamed.
 
+### Output formatting
+
+Hledger supports custom formatting the output from the balance
+command. The format string can contain either literal text which is
+written directly to the output or formatting of particular fields.
+
+#### Format specification
+
+The format is similar to the one used by C's `printf` and `strftime`,
+with the exception that the field name are enclosed in parentheses:
+
+    %[-][MIN][.MAX]([FIELD])
+
+If the minus sign is given, the text is left justified. The `MIN` field
+specified a minimum number of characters in width. After the value is
+injected into the string, spaces is added to make sure the string is at
+least as long as `MIN`. Similary, the `MAX` field specifies the maximum
+number of characters. The string will be cut if the injected string is
+too long.
+
+- `%-(total)   ` the total of an account, left justified
+- `%20(total)  ` The same, right justified, at least 20 chars wide
+- `%.20(total) ` The same, no more than 20 chars wide
+- `%-.20(total)` Left justified, maximum twenty chars wide
+
+#### Supported fields
+
+Currently three fields can be used in a formatting string:
+
+- `account` Inserts the account name
+- `depth_spacer` Inserts a space for each level of an account's
+  depth. That is, if an account has two parents, this construct will
+  insert two spaces. If a minimum width is specified, that much space
+  is inserted for each level of depth. Thus `%5_`, for an account
+  with four parents, will insert twenty spaces.
+- `total` Inserts the total for the account
+
+##### Examples
+
+If you want the account before the total you can use this format:
+
+    $ hledger balance --format "%20(account) %-(total)"
+                  assets $-1
+             bank:saving $1
+                    cash $-2
+                expenses $2
+                    food $1
+                supplies $1
+                  income $-2
+                   gifts $-1
+                  salary $-1
+       liabilities:debts $1
+    --------------------
+                       0
+
+Or, if you'd like to export the balance sheet:
+
+    $ hledger balance --format "%(total);%(account)" --no-total
+    $-1;assets
+    $1;bank:saving
+    $-2;cash
+    $2;expenses
+    $1;food
+    $1;supplies
+    $-2;income
+    $-1;gifts
+    $-1;salary
+    $1;liabilities:debts
+
+The default output format is `%20(total)  %2(depth_spacer)%-(account)`
+
+Note: output formatting is only available for the [balance](#balance)
+command.
+
 ## Compatibility with c++ ledger
 
 hledger mimics a subset of ledger 3.x, and adds some features of its own
@@ -1021,12 +1096,13 @@ hledger mimics a subset of ledger 3.x, and adds some features of its own
 - print, register & balance commands
 - period expressions quite similar to ledger's
 - display expressions containing just a simple date predicate
+- basic support (read: incomplete) for display formatting
 
 We do not support:
 
 - periodic and modifier transactions
 - fluctuating prices
-- display formats
+- display formats (actually, a small subset is supported)
 - budget reports
 
 And we add some features:

hledger-lib/Hledger/Data/Amount.hs

@@ -62,6 +62,7 @@ module Hledger.Data.Amount (
                             setAmountPrecision,
                             setMixedAmountPrecision,
                             showAmountDebug,
+                            showAmountWithoutPrice,
                             showMixedAmount,
                             showMixedAmountDebug,
                             showMixedAmountOrZero,

hledger-vty/Hledger/Vty/Main.hs

@@ -5,7 +5,7 @@ Copyright (c) 2007-2011 Simon Michael <simon@joyful.com>
 Released under GPL version 3 or later.
 -}
 
-module Hledger.Vty.Main where
+module Hledger.Vty.Main (main) where
 
 import Control.Monad
 import Data.List
@@ -270,7 +270,7 @@ resetTrailAndEnter d scr a = enter d scr (aargs a) $ clearLocs a
 updateData :: Day -> AppState -> AppState
 updateData d a@AppState{aopts=opts,ajournal=j} =
     case screen a of
-      BalanceScreen  -> a{abuf=lines $ balanceReportAsText opts $ balanceReport opts fspec j}
+      BalanceScreen  -> a{abuf=balanceReportAsText opts $ balanceReport opts fspec j}
       RegisterScreen -> a{abuf=lines $ registerReportAsText opts $ registerReport opts fspec j}
       PrintScreen    -> a{abuf=lines $ showTransactions opts fspec j}
     where fspec = optsToFilterSpec opts (currentArgs a) d

hledger/Hledger/Cli.hs

@@ -97,7 +97,7 @@ tests_Hledger_Cli = TestList
    let (opts,args) `gives` es = do 
         j <- samplejournal
         d <- getCurrentDay
-        balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args d) j) `is` unlines es
+        balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args d) j) `is` es
    in TestList
    [
 
@@ -234,7 +234,6 @@ tests_Hledger_Cli = TestList
              ]) >>= either error' return
       let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
       balanceReportAsText [] (balanceReport [] nullfilterspec j') `is`
-       unlines
         ["                $500  a:b"
         ,"               $-500  c:d"
         ,"--------------------"
@@ -249,7 +248,6 @@ tests_Hledger_Cli = TestList
               ,"  test:b"
               ])
       balanceReportAsText [] (balanceReport [] nullfilterspec j) `is`
-       unlines
         ["                   1  test:a"
         ,"                  -1  test:b"
         ,"--------------------"
@@ -459,7 +457,7 @@ tests_Hledger_Cli = TestList
   ,"unicode in balance layout" ~: do
     j <- readJournal'
       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
-    balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
+    balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] date1) j) `is`
       ["                -100  актив:наличные"
       ,"                 100  расходы:покупки"
       ,"--------------------"

hledger/Hledger/Cli/Balance.hs

@@ -109,6 +109,8 @@ import Data.Maybe
 import Data.Tree
 import Test.HUnit
 
+import Hledger.Cli.Format
+import qualified Hledger.Cli.Format as Format
 import Hledger.Cli.Options
 import Hledger.Cli.Utils
 import Hledger.Data
@@ -133,29 +135,65 @@ type BalanceReportItem = (AccountName  -- full account name
 balance :: [Opt] -> [String] -> Journal -> IO ()
 balance opts args j = do
   d <- getCurrentDay
-  putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args d) j
+  let lines = case parseFormatFromOpts opts of
+            Left err -> [err]
+            Right _ -> balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args d) j
+  putStr $ unlines lines
 
 -- | Render a balance report as plain text suitable for console output.
-balanceReportAsText :: [Opt] -> BalanceReport -> String
+balanceReportAsText :: [Opt] -> BalanceReport -> [String]
-balanceReportAsText opts (items,total) =
+balanceReportAsText opts (items, total) = concat lines ++ t
-    unlines $
+    where
-            map (balanceReportItemAsText opts) items
+      lines = map (balanceReportItemAsText opts format) items
-            ++
+      format = formatFromOpts opts
-            if NoTotal `elem` opts
+      t = if NoTotal `elem` opts
              then []
              else ["--------------------"
-                  ,padleft 20 $ showMixedAmountWithoutPrice total
+                    -- TODO: This must use the format somehow
+                  , padleft 20 $ showMixedAmountWithoutPrice total
                   ]
 
+{-
+This implementation turned out to be a bit convoluted but implements the following algorithm for formatting:
+
+- If there is a single amount, print it with the account name directly:
+- Otherwise, only print the account name on the last line.
+
+    a         USD 1   ; Account 'a' has a single amount
+              EUR -1
+    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.
-balanceReportItemAsText :: [Opt] -> BalanceReportItem -> String
+balanceReportItemAsText :: [Opt] -> [FormatString] -> BalanceReportItem -> [String]
-balanceReportItemAsText opts (a, adisplay, aindent, abal) = concatTopPadded [amt, "  ", name]
+balanceReportItemAsText opts format (_, accountName, depth, Mixed amounts) =
+    case amounts of
+      [] -> []
+      [a] -> [formatBalanceReportItem opts (Just accountName) depth a format]
+      (as) -> asText as
     where
-      amt = padleft 20 $ showMixedAmountWithoutPrice abal
+      asText :: [Amount] -> [String]
-      name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a
+      asText []     = []
-           | otherwise        = indentspacer ++ adisplay
+      asText [a]    = [formatBalanceReportItem opts (Just accountName) depth a format]
-      indentspacer = replicate (indentperlevel * aindent) ' '
+      asText (a:as) = (formatBalanceReportItem opts Nothing depth a format) : asText as
-      indentperlevel = 2
+
+formatBalanceReportItem :: [Opt] -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String
+formatBalanceReportItem _ _ _ _ [] = ""
+formatBalanceReportItem opts accountName depth amount (f:fs) = s ++ (formatBalanceReportItem opts accountName depth amount fs)
+  where
+    s = case f of
+            FormatLiteral l -> l
+            FormatField leftJustified min max field  -> formatAccount opts accountName depth amount leftJustified min max field
+
+formatAccount :: [Opt] -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String
+formatAccount opts accountName depth balance leftJustified min max field = case field of
+        Format.Account  -> formatValue leftJustified min max a
+        DepthSpacer     -> case min of
+                               Just m  -> formatValue leftJustified Nothing max $ replicate (depth * m) ' '
+                               Nothing -> formatValue leftJustified Nothing max $ replicate depth ' '
+        Total           -> formatValue leftJustified min max $ showAmountWithoutPrice balance
+        _	        -> ""
+    where
+      a = maybe "" (accountNameDrop (dropFromOpts opts)) accountName
 
 -- | Get a balance report with the specified options for this journal.
 balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReport

hledger/Hledger/Cli/Format.hs

@@ -0,0 +1,136 @@
+module Hledger.Cli.Format (
+          parseFormatString
+        , formatValue
+        , FormatString(..)
+        , Field(..)
+        , tests
+        ) where
+
+import Numeric
+import Data.Maybe
+import Test.HUnit
+import Text.ParserCombinators.Parsec
+import Text.Printf
+
+{-
+%[-][MIN WIDTH][.MAX WIDTH]EXPR
+
+%-P     a transaction's payee, left justified
+%20P    The same, right justified, at least 20 chars wide
+%.20P   The same, no more than 20 chars wide
+%-.20P  Left justified, maximum twenty chars wide
+-}
+
+data Field =
+    Account
+  | DefaultDate
+  | Description
+  | Total
+  | DepthSpacer
+    deriving (Show, Eq)
+
+data FormatString =
+    FormatLiteral String
+  | FormatField 
+    Bool            -- Left justified 
+    (Maybe Int)     -- Min width
+    (Maybe Int)     -- Max width
+    Field           -- Field
+    deriving (Show, Eq)
+
+formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String
+formatValue leftJustified min max value = printf formatS value
+    where
+      l = if leftJustified then "-" else ""
+      min' = maybe "" show min
+      max' = maybe "" (\i -> "." ++ (show i)) max
+      formatS = "%" ++ l ++ min' ++ max' ++ "s"
+
+parseFormatString :: String -> Either String [FormatString]
+parseFormatString input = case parse formatStrings "(unknown)" input of
+    Left y -> Left $ show y
+    Right x -> Right x
+
+{-
+Parsers
+-}
+
+field :: Parser Field
+field = do
+        try (string "account" >> return Account)
+--    <|> try (string "date" >> return DefaultDate)
+--    <|> try (string "description" >> return Description)
+    <|> try (string "depth_spacer" >> return DepthSpacer)
+    <|> try (string "total" >> return Total)
+
+formatField :: Parser FormatString
+formatField = do
+    char '%'
+    leftJustified <- optionMaybe (char '-')
+    minWidth <- optionMaybe (many1 $ digit)
+    maxWidth <- optionMaybe (do char '.'; many1 $ digit)
+    char '('
+    field <- field
+    char ')'
+    return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) field
+    where
+      parseDec s = case s of
+        Just text -> Just m where ((m,_):_) = readDec text
+        _ -> Nothing
+
+formatLiteral :: Parser FormatString
+formatLiteral = do
+    s <- many1 c
+    return $ FormatLiteral s
+    where
+      c =     noneOf "%"
+          <|> try (string "%%" >> return '%')
+
+formatString :: Parser FormatString
+formatString =
+        formatField
+    <|> formatLiteral
+
+formatStrings = many formatString
+
+testFormat :: FormatString -> 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)
+            FormatField leftJustify min max _ -> ("field", formatValue leftJustify min max value)
+
+testParser :: String -> [FormatString] -> Assertion
+testParser s expected = case (parseFormatString s) of
+    Left  error -> assertFailure $ show error
+    Right actual -> assertEqual ("Input: " ++ s) expected actual
+
+tests = test [ formattingTests ++ parserTests ]
+
+formattingTests = [
+      testFormat (FormatLiteral " ")                                ""            " "
+    , testFormat (FormatField False Nothing Nothing Description)    "description" "description"
+    , testFormat (FormatField False (Just 20) Nothing Description)  "description" "         description"
+    , testFormat (FormatField False Nothing (Just 20) Description)  "description" "description"
+    , testFormat (FormatField True Nothing (Just 20) Description)   "description" "description"
+    , testFormat (FormatField True (Just 20) Nothing Description)   "description" "description         "
+    , testFormat (FormatField True (Just 20) (Just 20) Description) "description" "description         "
+    , testFormat (FormatField True Nothing (Just 3) Description)    "description" "des"
+    ]
+
+parserTests = [
+      testParser ""                             []
+    , testParser "D"                            [FormatLiteral "D"]
+    , testParser "%(date)"                      [FormatField False Nothing Nothing Description]
+    , testParser "%(total)"                     [FormatField False Nothing Nothing Total]
+    , testParser "Hello %(date)!"               [FormatLiteral "Hello ", FormatField False Nothing Nothing Description, FormatLiteral "!"]
+    , testParser "%-(date)"                     [FormatField True Nothing Nothing Description]
+    , testParser "%20(date)"                    [FormatField False (Just 20) Nothing Description]
+    , testParser "%.10(date)"                   [FormatField False Nothing (Just 10) Description]
+    , testParser "%20.10(date)"                 [FormatField False (Just 20) (Just 10) Description]
+    , testParser "%20(account) %.10(total)\n"   [ FormatField False (Just 20) Nothing Account
+                                                , FormatLiteral " "
+                                                , FormatField False Nothing (Just 10) Total
+                                                , FormatLiteral "\n"
+                                                ]
+  ]

hledger/Hledger/Cli/Main.hs

@@ -45,11 +45,17 @@ import Hledger.Cli
 import Hledger.Cli.Tests
 import Hledger.Cli.Version (progversionstr, binaryfilename)
 import Prelude hiding (putStr, putStrLn)
+import Hledger.Utils (error')
 import Hledger.Utils.UTF8 (putStr, putStrLn)
 
 main :: IO ()
 main = do
   (opts, args) <- parseArgumentsWith options_cli
+  case validateOpts opts of
+    Just err -> error' err
+    Nothing -> run opts args
+
+run opts args =
   run opts args
     where
       run opts _
@@ -67,3 +73,9 @@ main = do
        | cmd `isPrefixOf` "stats"     = withJournalDo opts args cmd stats
        | cmd `isPrefixOf` "test"      = runtests opts args >> return ()
        | otherwise                    = argsError $ "command "++cmd++" is unrecognized."
+
+validateOpts :: [Opt] -> Maybe String
+validateOpts opts =
+  case parseFormatFromOpts opts of
+    Left err -> Just $ unlines ["Invalid format", err]
+    Right _ -> Nothing

hledger/Hledger/Cli/Options.hs

@@ -13,6 +13,7 @@ import System.Environment
 import Test.HUnit
 
 import Hledger.Data
+import Hledger.Cli.Format as Format
 import Hledger.Read (myJournalPath, myTimelogPath)
 import Hledger.Utils
 
@@ -83,6 +84,7 @@ options_cli = [
  ,Option "Q" ["quarterly"]    (NoArg  QuarterlyOpt)  "register, stats: report by quarter"
  ,Option "Y" ["yearly"]       (NoArg  YearlyOpt)     "register, stats: report by year"
  ,Option "r" ["rules"]        (ReqArg RulesFile "FILE") "convert, rules file to use"
+ ,Option "F" ["format"]       (ReqArg ReportFormat "STR") "use STR as the format"
  ,Option "v" ["verbose"]      (NoArg  Verbose)       "show more verbose output"
  ,Option ""  ["debug"]        (NoArg  Debug)         "show extra debug output; implies verbose"
  ,Option ""  ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"
@@ -115,6 +117,7 @@ data Opt =
     | QuarterlyOpt
     | YearlyOpt
     | RulesFile   {value::String}
+    | ReportFormat {value::String}
     | Help
     | Verbose
     | Version
@@ -153,6 +156,9 @@ optValuesForConstructors fs opts = concatMap get opts
 parseArgumentsWith :: [OptDescr Opt] -> IO ([Opt], [String])
 parseArgumentsWith options = do
   rawargs <- map fromPlatformString `fmap` getArgs
+  parseArgumentsWith' options rawargs
+
+parseArgumentsWith' options rawargs = do
   let (opts,args,errs) = getOpt Permute options rawargs
   opts' <- fixOptDates opts
   let opts'' = if Debug `elem` opts' then Verbose:opts' else opts'
@@ -219,6 +225,29 @@ rulesFileFromOpts opts = listtomaybe $ optValuesForConstructor RulesFile opts
       listtomaybe [] = Nothing
       listtomaybe vs = Just $ head vs
 
+-- | Default balance format string: "%20(total)  %2(depth_spacer)%-(account)"
+defaultBalanceFormatString :: [FormatString]
+defaultBalanceFormatString = [
+      FormatField False (Just 20) Nothing Total
+    , FormatLiteral "  "
+    , FormatField True (Just 2) Nothing DepthSpacer
+    , FormatField True Nothing Nothing Format.Account
+    ]
+
+-- | Parses the --format string to either an error message or a format string.
+parseFormatFromOpts :: [Opt] -> Either String [FormatString]
+parseFormatFromOpts opts = listtomaybe $ optValuesForConstructor ReportFormat opts
+    where
+      listtomaybe :: [String] -> Either String [FormatString]
+      listtomaybe [] = Right defaultBalanceFormatString
+      listtomaybe vs = parseFormatString $ head vs
+
+-- | Returns the format string. If the string can't be parsed it fails with error'.
+formatFromOpts :: [Opt] -> [FormatString]
+formatFromOpts opts = case parseFormatFromOpts opts of
+    Left err -> error' err
+    Right format -> format
+
 -- | Get the value of the (last) depth option, if any.
 depthFromOpts :: [Opt] -> Maybe Int
 depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts

hledger/hledger.cabal

@@ -42,6 +42,7 @@ library
   exposed-modules:
                   Hledger.Cli
                   Hledger.Cli.Main
+                  Hledger.Cli.Format
                   Hledger.Cli.Options
                   Hledger.Cli.Tests
                   Hledger.Cli.Utils

tests/balance-custom-format.test

@@ -0,0 +1,14 @@
+bin/hledger -f data/sample.journal --format="%30(account) %-.20(total)" balance
+>>>
+                        assets $-1
+                   bank:saving $1
+                          cash $-2
+                      expenses $2
+                          food $1
+                      supplies $1
+                        income $-2
+                         gifts $-1
+                        salary $-1
+             liabilities:debts $1
+--------------------
+                   0

tests/convert-with-in-and-out-fields.test

@@ -1,5 +1,5 @@
 # Conversion from CSV to Ledger with in-field and out-field
-printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules ; touch unused.journal ; bin/hledger -f unused.journal convert --rules convert.rules - ; rm -rf unused.journal convert.rules
+rm -rf unused.journal convert.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules ; touch unused.journal ; bin/hledger -f unused.journal convert --rules convert.rules - ; rm -rf unused.journal convert.rules
 <<<
 10/2009/09,Flubber Co,50,
 11/2009/09,Flubber Co,,50

tests/convert.test

@@ -1,5 +1,5 @@
 # Conversion from CSV to Ledger
-printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' >input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv ; touch unused.journal ; bin/hledger -f unused.journal convert input.csv ; rm -rf unused.journal input.rules input.csv
+rm -rf unused.journal input.csv input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv ; touch unused.journal ; bin/hledger -f unused.journal convert input.csv ; rm -rf unused.journal input.csv input.rules
 >>>
 2009/09/10 Flubber Co
     income:unknown            $-50