Adding basic ledger FORMAT parser.

This commit is contained in:
Trygve Laugstol 2011-06-20 21:33:26 +00:00
parent c582b45bf6
commit 28dbb8864f
13 changed files with 330 additions and 25 deletions

View File

@ -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:

View File

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

View File

@ -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

View File

@ -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 расходы:покупки"
,"--------------------"

View File

@ -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 opts (items,total) =
unlines $
map (balanceReportItemAsText opts) items
++
if NoTotal `elem` opts
balanceReportAsText :: [Opt] -> BalanceReport -> [String]
balanceReportAsText opts (items, total) = concat lines ++ t
where
lines = map (balanceReportItemAsText opts format) items
format = formatFromOpts 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 opts (a, adisplay, aindent, abal) = concatTopPadded [amt, " ", name]
balanceReportItemAsText :: [Opt] -> [FormatString] -> BalanceReportItem -> [String]
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
name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a
| otherwise = indentspacer ++ adisplay
indentspacer = replicate (indentperlevel * aindent) ' '
indentperlevel = 2
asText :: [Amount] -> [String]
asText [] = []
asText [a] = [formatBalanceReportItem opts (Just accountName) depth a format]
asText (a:as) = (formatBalanceReportItem opts Nothing depth a format) : asText as
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

View File

@ -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"
]
]

View File

@ -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

View File

@ -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

View File

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

View File

@ -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

View File

@ -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

View File

@ -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