reg: --width/-w option to adjust register overall output width
This commit is contained in:
Simon Michael
parent
58edc161c9
commit
552a15a1ba
@ -755,6 +755,11 @@ summary postings within each interval:
|
||||
$ hledger register --monthly rent
|
||||
$ hledger register --monthly -E food --depth 4
|
||||
|
||||
The `--width`/`-w` option adjusts the width of the output. By default,
|
||||
this is 80 characters. To allow more space for descriptions and account
|
||||
names, use `-w` to increase the width to 120 characters, or `-wN` to set
|
||||
any desired width (at least 50 recommended).
|
||||
|
||||
#### balance
|
||||
|
||||
The balance command displays accounts and their balances, indented to show the account hierarchy.
|
||||
|
||||
@ -38,7 +38,6 @@ module Hledger.Data.Posting (
|
||||
sumPostings,
|
||||
-- * rendering
|
||||
showPosting,
|
||||
showPostingForRegister,
|
||||
-- * misc.
|
||||
showComment,
|
||||
tests_Hledger_Data_Posting
|
||||
@ -95,20 +94,6 @@ showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
|
||||
showComment :: String -> String
|
||||
showComment s = if null s then "" else " ;" ++ s
|
||||
|
||||
-- XXX refactor
|
||||
showPostingForRegister :: Posting -> String
|
||||
showPostingForRegister (Posting{paccount=a,pamount=amt,ptype=t}) =
|
||||
concatTopPadded [showaccountname a ++ " ", showamount amt]
|
||||
where
|
||||
ledger3ishlayout = False
|
||||
acctnamewidth = if ledger3ishlayout then 25 else 22
|
||||
showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width
|
||||
(bracket,width) = case t of
|
||||
BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2)
|
||||
VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)
|
||||
_ -> (id,acctnamewidth)
|
||||
showamount = padleft 12 . showMixedAmountWithoutPrice
|
||||
|
||||
isReal :: Posting -> Bool
|
||||
isReal p = ptype p == RegularPosting
|
||||
|
||||
|
||||
@ -223,8 +223,10 @@ registerFromString :: String -> IO String
|
||||
registerFromString s = do
|
||||
d <- getCurrentDay
|
||||
j <- readJournal' s
|
||||
return $ postingsReportAsText opts $ postingsReport opts (queryFromOpts d opts) j
|
||||
where opts = defreportopts{empty_=True}
|
||||
return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j
|
||||
where
|
||||
ropts = defreportopts{empty_=True}
|
||||
opts = defcliopts{reportopts_=ropts}
|
||||
|
||||
-- | Return a similarity measure, from 0 to 1, for two strings.
|
||||
-- This is Simon White's letter pairs algorithm from
|
||||
|
||||
@ -7,7 +7,7 @@ Command-line options for the hledger program, and option-parsing utilities.
|
||||
|
||||
module Hledger.Cli.Options
|
||||
where
|
||||
import Control.Exception as C
|
||||
import qualified Control.Exception as C
|
||||
import Data.List
|
||||
import Data.List.Split
|
||||
import Data.Maybe
|
||||
@ -19,7 +19,7 @@ import System.Console.CmdArgs.Text
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import Test.HUnit
|
||||
import Text.ParserCombinators.Parsec
|
||||
import Text.ParserCombinators.Parsec as P
|
||||
import Text.Printf
|
||||
|
||||
import Hledger
|
||||
@ -189,7 +189,7 @@ accountsmode = (commandmode ["balance","bal","accounts"]) {
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = [
|
||||
flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
|
||||
,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
|
||||
,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
|
||||
,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
|
||||
,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"
|
||||
,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
|
||||
@ -213,7 +213,9 @@ postingsmode = (commandmode ["register","postings"]) {
|
||||
modeHelp = "(or postings) show matched postings and running total"
|
||||
,modeArgs = ([], Just commandargsflag)
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
groupUnnamed = [
|
||||
flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)"
|
||||
]
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
@ -293,6 +295,7 @@ data CliOpts = CliOpts {
|
||||
,alias_ :: [String]
|
||||
,debug_ :: Bool
|
||||
,no_new_accounts_ :: Bool -- add
|
||||
,width_ :: Maybe String -- register
|
||||
,reportopts_ :: ReportOpts
|
||||
} deriving (Show)
|
||||
|
||||
@ -305,6 +308,7 @@ defcliopts = CliOpts
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
|
||||
instance Default CliOpts where def = defcliopts
|
||||
|
||||
@ -322,6 +326,7 @@ toCliOpts rawopts = do
|
||||
,alias_ = map stripquotes $ listofstringopt "alias" rawopts
|
||||
,debug_ = boolopt "debug" rawopts
|
||||
,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
|
||||
,width_ = maybestringopt "width" rawopts -- register
|
||||
,reportopts_ = defreportopts {
|
||||
begin_ = maybesmartdateopt d "begin" rawopts
|
||||
,end_ = maybesmartdateopt d "end" rawopts
|
||||
@ -441,10 +446,13 @@ checkCliOpts opts@CliOpts{reportopts_=ropts} = do
|
||||
case formatFromOpts ropts of
|
||||
Left err -> optserror $ "could not parse format option: "++err
|
||||
Right _ -> return ()
|
||||
case widthFromOpts opts of
|
||||
Left err -> optserror $ "could not parse width option: "++err
|
||||
Right _ -> return ()
|
||||
return opts
|
||||
|
||||
-- | Parse any format option provided, possibly raising an error, or get
|
||||
-- the default value.
|
||||
-- | Parse the format option if provided, possibly returning an error,
|
||||
-- otherwise get the default value.
|
||||
formatFromOpts :: ReportOpts -> Either String [FormatString]
|
||||
formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_
|
||||
|
||||
@ -457,6 +465,35 @@ defaultBalanceFormatString = [
|
||||
, FormatField True Nothing Nothing AccountField
|
||||
]
|
||||
|
||||
data OutputWidth = TotalWidth Width | FieldWidths [Width] deriving Show
|
||||
data Width = Width Int | Auto deriving Show
|
||||
|
||||
defaultWidth = 80
|
||||
defaultWidthWithFlag = 120
|
||||
|
||||
-- | Parse the width option if provided, possibly returning an error,
|
||||
-- otherwise get the default value.
|
||||
widthFromOpts :: CliOpts -> Either String OutputWidth
|
||||
widthFromOpts CliOpts{width_=Nothing} = Right $ TotalWidth $ Width defaultWidth
|
||||
widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthWithFlag
|
||||
widthFromOpts CliOpts{width_=Just s} = parseWidth s
|
||||
|
||||
parseWidth :: String -> Either String OutputWidth
|
||||
parseWidth s = case (runParser outputwidth () "(unknown)") s of
|
||||
Left e -> Left $ show e
|
||||
Right x -> Right x
|
||||
|
||||
outputwidth :: GenParser Char st OutputWidth
|
||||
outputwidth =
|
||||
try (do w <- width
|
||||
ws <- many1 (char ',' >> width)
|
||||
return $ FieldWidths $ w:ws)
|
||||
<|> TotalWidth `fmap` width
|
||||
|
||||
width :: GenParser Char st Width
|
||||
width = (string "auto" >> return Auto)
|
||||
<|> (Width . read) `fmap` many1 digit
|
||||
|
||||
-- | Get the (tilde-expanded, absolute) journal file path from options, an environment variable, or a default.
|
||||
journalFilePathFromOpts :: CliOpts -> IO String
|
||||
journalFilePathFromOpts opts = do
|
||||
|
||||
@ -24,12 +24,12 @@ import Hledger.Cli.Options
|
||||
|
||||
-- | Print a (posting) register report.
|
||||
register :: CliOpts -> Journal -> IO ()
|
||||
register CliOpts{reportopts_=ropts} j = do
|
||||
register opts@CliOpts{reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
putStr $ postingsReportAsText ropts $ postingsReport ropts (queryFromOpts d ropts) j
|
||||
putStr $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j
|
||||
|
||||
-- | Render a register report as plain text suitable for console output.
|
||||
postingsReportAsText :: ReportOpts -> PostingsReport -> String
|
||||
postingsReportAsText :: CliOpts -> PostingsReport -> String
|
||||
postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd
|
||||
|
||||
tests_postingsReportAsText = [
|
||||
@ -38,32 +38,50 @@ tests_postingsReportAsText = [
|
||||
j <- readJournal'
|
||||
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let opts = defreportopts
|
||||
(postingsReportAsText opts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines
|
||||
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines
|
||||
["2009/01/01 медвежья шкура расходы:покупки 100 100"
|
||||
," актив:наличные -100 0"]
|
||||
]
|
||||
|
||||
-- | Render one register report line item as plain text. Eg:
|
||||
-- | Render one register report line item as plain text. Layout is like so:
|
||||
-- @
|
||||
-- date (10) description (20) account (22) amount (11) balance (12)
|
||||
-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
|
||||
-- ^ displayed for first postings^
|
||||
-- only, otherwise blank
|
||||
-- <----------------------------- width (default: 80) ----------------------------->
|
||||
-- date (10) description (50%) account (50%) amount (12) balance (12)
|
||||
-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaa AAAAAAAAAAAA AAAAAAAAAAAA
|
||||
--
|
||||
-- date and description are shown for the first posting of a transaction only.
|
||||
-- @
|
||||
postingsReportItemAsText :: ReportOpts -> PostingsReportItem -> String
|
||||
postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal]
|
||||
postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String
|
||||
postingsReportItemAsText opts (dd, p, b) =
|
||||
concatTopPadded [date, " ", desc, " ", acct, " ", amt, " ", bal]
|
||||
where
|
||||
datedesc = case dd of Nothing -> replicate datedescwidth ' '
|
||||
Just (da, de) -> printf "%s %s " date desc
|
||||
where
|
||||
date = showDate da
|
||||
desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
|
||||
where
|
||||
descwidth = datedescwidth - datewidth - 2
|
||||
datedescwidth = 32
|
||||
datewidth = 10
|
||||
pstr = showPostingForRegister p
|
||||
bal = padleft 12 (showMixedAmountWithoutPrice b)
|
||||
totalwidth = case widthFromOpts opts of
|
||||
Left _ -> defaultWidth -- shouldn't happen
|
||||
Right (TotalWidth (Width w)) -> w
|
||||
Right (TotalWidth Auto) -> defaultWidth -- XXX
|
||||
Right (FieldWidths _) -> defaultWidth -- XXX
|
||||
datewidth = 10
|
||||
amtwidth = 12
|
||||
balwidth = 12
|
||||
remaining = totalwidth - (datewidth + 2 + 2 + amtwidth + 2 + balwidth)
|
||||
(descwidth, acctwidth) | even r = (r', r')
|
||||
| otherwise = (r', r'+1)
|
||||
where r = remaining - 2
|
||||
r' = r `div` 2
|
||||
(date, desc) = case dd of
|
||||
Just (da, de) -> (printf ("%-"++show datewidth++"s") (showDate da)
|
||||
,printf ("%-"++show descwidth++"s") (take descwidth $ elideRight descwidth de :: String)
|
||||
)
|
||||
Nothing -> (replicate datewidth ' ', replicate descwidth ' ')
|
||||
acct = printf ("%-"++(show acctwidth)++"s") a
|
||||
where
|
||||
a = bracket $ elideAccountName awidth $ paccount p
|
||||
(bracket, awidth) = case ptype p of
|
||||
BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
|
||||
VirtualPosting -> (\s -> "("++s++")", acctwidth-2)
|
||||
_ -> (id,acctwidth)
|
||||
amt = padleft amtwidth $ showMixedAmountWithoutPrice $ pamount p
|
||||
bal = padleft balwidth $ showMixedAmountWithoutPrice b
|
||||
|
||||
-- XXX
|
||||
-- showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b
|
||||
|
||||
Loading…
Reference in New Issue
Block a user