module Hledger.Cli.Register (
registermode
,register
,postingsReportAsText
,tests_Hledger_Cli_Register
) where
import Data.List
import Data.Maybe
import System.Console.CmdArgs.Explicit
import Text.CSV
import Test.HUnit
import Text.Printf
import Hledger
import Hledger.Cli.Options
import Hledger.Cli.Utils
registermode = (defCommandMode $ ["register"] ++ aliases) {
modeHelp = "show postings and running total" `withAliases` aliases
,modeGroupFlags = Group {
groupUnnamed = [
flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "include prior postings in the running total"
,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a running average instead of the running total (implies --empty)"
,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show postings' siblings instead"
,flagReq ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N"
(unlines
["set output width (default:"
#ifdef mingw32_HOST_OS
,(show defaultWidth)
#else
,"terminal width"
#endif
,"or COLUMNS. -wN,M sets description width as well)"
])
]
++ outputflags
,groupHidden = []
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["reg"]
register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let fmt = outputFormatFromOpts opts
render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| otherwise = postingsReportAsText
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv (_,is) =
["date","description","account","amount","running total or balance"]
:
map postingsReportItemAsCsvRecord is
postingsReportItemAsCsvRecord :: PostingsReportItem -> Record
postingsReportItemAsCsvRecord (_, _, _, p, b) = [date,desc,acct,amt,bal]
where
date = showDate $ postingDate p
desc = maybe "" tdescription $ ptransaction p
acct = bracket $ paccount p
where
bracket = case ptype p of
BalancedVirtualPosting -> (\s -> "["++s++"]")
VirtualPosting -> (\s -> "("++s++")")
_ -> id
amt = showMixedAmountOneLineWithoutPrice $ pamount p
bal = showMixedAmountOneLineWithoutPrice b
postingsReportAsText :: CliOpts -> PostingsReport -> String
postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd
tests_postingsReportAsText = [
"postingsReportAsText" ~: do
j <- readJournal'
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100"
," актив:наличные -100 0"]
]
postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String
postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) =
intercalate "\n" $
[printf ("%-"++datew++"s %-"++descw++"s %-"++acctw++"s %"++amtw++"s %"++balw++"s")
date desc acct amtfirstline balfirstline]
++
[printf (spacer ++ "%"++amtw++"s %"++balw++"s") a b | (a,b) <- zip amtrest balrest ]
where
(totalwidth,mdescwidth) = registerWidthsFromOpts opts
amtwidth = 12
balwidth = 12
(datewidth, date) = case (mdate,menddate) of
(Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate))
(Nothing, Just _) -> (21, "")
(Just d, Nothing) -> (10, showDate d)
_ -> (10, "")
remaining = totalwidth (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
(descwidth, acctwidth)
| hasinterval = (0, remaining 2)
| otherwise = (w, remaining 2 w)
where
hasinterval = isJust menddate
w = fromMaybe ((remaining 2) `div` 2) mdescwidth
[datew,descw,acctw,amtw,balw] = map show [datewidth,descwidth,acctwidth,amtwidth,balwidth]
desc = maybe "" (take descwidth . elideRight descwidth) mdesc
acct = parenthesise $ elideAccountName awidth $ paccount p
where
(parenthesise, awidth) = case ptype p of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth2)
VirtualPosting -> (\s -> "("++s++")", acctwidth2)
_ -> (id,acctwidth)
amt = showMixedAmountWithoutPrice $ pamount p
bal = showMixedAmountWithoutPrice b
(amtlines, ballines) = (lines amt, lines bal)
(amtlen, ballen) = (length amtlines, length ballines)
numlines = max 1 (max amtlen ballen)
(amtfirstline:amtrest) = take numlines $ amtlines ++ repeat ""
(balfirstline:balrest) = take numlines $ replicate (numlines ballen) "" ++ ballines
spacer = replicate (totalwidth (amtwidth + 2 + balwidth)) ' '
tests_Hledger_Cli_Register :: Test
tests_Hledger_Cli_Register = TestList
tests_postingsReportAsText