module Hledger.Cli.Register (
registermode
,register
,postingsReportAsText
,tests_Hledger_Cli_Register
) where
import Data.List
import Data.Maybe
import System.Console.CmdArgs.Explicit
import Test.HUnit
import Text.Printf
import Hledger
import Prelude hiding (putStr)
import Hledger.Utils.UTF8IOCompat (putStr)
import Hledger.Cli.Options
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"
,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show postings' siblings instead"
,flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "set output width to 120, or N (default: 80)"
]
,groupHidden = []
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["reg"]
register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
putStr $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j
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, mdesc, p, b) =
concatTopPadded [date, " ", desc, " ", acct, " ", amt, " ", bal]
where
totalwidth = case widthFromOpts opts of
Left _ -> defaultWidth
Right (TotalWidth (Width w)) -> w
Right (TotalWidth Auto) -> defaultWidth
Right (FieldWidths _) -> defaultWidth
datewidth = 10
amtwidth = 12
balwidth = 12
remaining = totalwidth (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
(descwidth, acctwidth) | even r = (r', r')
| otherwise = (r', r'+1)
where r = remaining 2
r' = r `div` 2
date = maybe (replicate datewidth ' ') (printf ("%-"++show datewidth++"s") . showDate) mdate
desc = maybe (replicate descwidth ' ') (printf ("%-"++show descwidth++"s") . take descwidth . elideRight descwidth) mdesc
acct = printf ("%-"++(show acctwidth)++"s") a
where
a = bracket $ elideAccountName awidth $ paccount p
(bracket, awidth) = case ptype p of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth2)
VirtualPosting -> (\s -> "("++s++")", acctwidth2)
_ -> (id,acctwidth)
amt = padleft amtwidth $ showMixedAmountWithoutPrice $ pamount p
bal = padleft balwidth $ showMixedAmountWithoutPrice b
tests_Hledger_Cli_Register :: Test
tests_Hledger_Cli_Register = TestList
tests_postingsReportAsText