1{-|
2
3A ledger-compatible @register@ command.
4
5-}
6
7{-# LANGUAGE CPP #-}
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE RecordWildCards #-}
10{-# LANGUAGE TemplateHaskell #-}
11
12module Hledger.Cli.Commands.Register (
13  registermode
14 ,register
15 ,postingsReportAsText
16 ,postingsReportItemAsText
17 -- ,showPostingWithBalanceForVty
18 ,tests_Register
19) where
20
21import Data.List
22import Data.Maybe
23-- import Data.Text (Text)
24import qualified Data.Text as T
25import qualified Data.Text.Lazy as TL
26import Data.Time (fromGregorian)
27import System.Console.CmdArgs.Explicit
28import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
29
30import Hledger
31import Hledger.Cli.CliOptions
32import Hledger.Cli.Utils
33
34registermode = hledgerCommandMode
35  $(embedFileRelative "Hledger/Cli/Commands/Register.txt")
36  ([flagNone ["cumulative"] (setboolopt "change")
37     "show running total from report start date (default)"
38  ,flagNone ["historical","H"] (setboolopt "historical")
39     "show historical running total/balance (includes postings before report start date)\n "
40  ,flagNone ["average","A"] (setboolopt "average")
41     "show running average of posting amounts instead of total (implies --empty)"
42  ,flagNone ["related","r"] (setboolopt "related") "show postings' siblings instead"
43  ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign"
44  ,flagReq  ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N"
45     ("set output width (default: " ++
46#ifdef mingw32_HOST_OS
47      show defaultWidth
48#else
49      "terminal width"
50#endif
51      ++ " or $COLUMNS). -wN,M sets description width as well."
52     )
53  ,outputFormatFlag ["txt","csv","json"]
54  ,outputFileFlag
55  ])
56  [generalflagsgroup1]
57  hiddenflags
58  ([], Just $ argsFlag "[QUERY]")
59
60-- | Print a (posting) register report.
61register :: CliOpts -> Journal -> IO ()
62register opts@CliOpts{reportopts_=ropts} j = do
63  d <- getCurrentDay
64  let fmt = outputFormatFromOpts opts
65      render | fmt=="txt"  = postingsReportAsText
66             | fmt=="csv"  = const ((++"\n") . printCSV . postingsReportAsCsv)
67             | fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
68             | otherwise   = const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
69  writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
70
71postingsReportAsCsv :: PostingsReport -> CSV
72postingsReportAsCsv (_,is) =
73  ["txnidx","date","code","description","account","amount","total"]
74  :
75  map postingsReportItemAsCsvRecord is
76
77postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
78postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal]
79  where
80    idx  = show $ maybe 0 tindex $ ptransaction p
81    date = showDate $ postingDate p -- XXX csv should show date2 with --date2
82    code = maybe "" (T.unpack . tcode) $ ptransaction p
83    desc = T.unpack $ maybe "" tdescription $ ptransaction p
84    acct = bracket $ T.unpack $ paccount p
85      where
86        bracket = case ptype p of
87                             BalancedVirtualPosting -> (\s -> "["++s++"]")
88                             VirtualPosting -> (\s -> "("++s++")")
89                             _ -> id
90    amt = showMixedAmountOneLineWithoutPrice False $ pamount p
91    bal = showMixedAmountOneLineWithoutPrice False b
92
93-- | Render a register report as plain text suitable for console output.
94postingsReportAsText :: CliOpts -> PostingsReport -> String
95postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText opts amtwidth balwidth) items
96  where
97    amtwidth = maximumStrict $ 12 : map (strWidth . showMixedAmount . itemamt) items
98    balwidth = maximumStrict $ 12 : map (strWidth . showMixedAmount . itembal) items
99    itemamt (_,_,_,Posting{pamount=a},_) = a
100    itembal (_,_,_,_,a) = a
101
102-- | Render one register report line item as plain text. Layout is like so:
103-- @
104-- <---------------- width (specified, terminal width, or 80) -------------------->
105-- date (10)  description           account              amount (12)   balance (12)
106-- DDDDDDDDDD dddddddddddddddddddd  aaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
107-- @
108-- If description's width is specified, account will use the remaining space.
109-- Otherwise, description and account divide up the space equally.
110--
111-- With a report interval, the layout is like so:
112-- @
113-- <---------------- width (specified, terminal width, or 80) -------------------->
114-- date (21)              account                        amount (12)   balance (12)
115-- DDDDDDDDDDDDDDDDDDDDD  aaaaaaaaaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
116-- @
117--
118-- date and description are shown for the first posting of a transaction only.
119--
120-- Returns a string which can be multi-line, eg if the running balance
121-- has multiple commodities. Does not yet support formatting control
122-- like balance reports.
123--
124postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> String
125postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
126  -- use elide*Width to be wide-char-aware
127  -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
128  intercalate "\n" $
129    concat [fitString (Just datewidth) (Just datewidth) True True date
130           ," "
131           ,fitString (Just descwidth) (Just descwidth) True True desc
132           ,"  "
133           ,fitString (Just acctwidth) (Just acctwidth) True True acct
134           ,"  "
135           ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline
136           ,"  "
137           ,fitString (Just balwidth) (Just balwidth) True False balfirstline
138           ]
139    :
140    [concat [spacer
141            ,fitString (Just amtwidth) (Just amtwidth) True False a
142            ,"  "
143            ,fitString (Just balwidth) (Just balwidth) True False b
144            ]
145     | (a,b) <- zip amtrest balrest
146     ]
147    where
148      -- calculate widths
149      (totalwidth,mdescwidth) = registerWidthsFromOpts opts
150      (datewidth, date) = case (mdate,menddate) of
151                            (Just _, Just _)   -> (21, showDateSpan (DateSpan mdate menddate))
152                            (Nothing, Just _)  -> (21, "")
153                            (Just d, Nothing)  -> (10, showDate d)
154                            _                  -> (10, "")
155      (amtwidth, balwidth)
156        | shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
157        | otherwise      = (adjustedamtwidth, adjustedbalwidth)
158        where
159          mincolwidth = 2 -- columns always show at least an ellipsis
160          maxamtswidth = max 0 (totalwidth - (datewidth + 1 + mincolwidth + 2 + mincolwidth + 2 + 2))
161          shortfall = (preferredamtwidth + preferredbalwidth) - maxamtswidth
162          amtwidthproportion = fromIntegral preferredamtwidth / fromIntegral (preferredamtwidth + preferredbalwidth)
163          adjustedamtwidth = round $ amtwidthproportion * fromIntegral maxamtswidth
164          adjustedbalwidth = maxamtswidth - adjustedamtwidth
165
166      remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
167      (descwidth, acctwidth)
168        | hasinterval = (0, remaining - 2)
169        | otherwise   = (w, remaining - 2 - w)
170        where
171            hasinterval = isJust menddate
172            w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
173
174      -- gather content
175      desc = fromMaybe "" mdesc
176      acct = parenthesise $ T.unpack $ elideAccountName awidth $ paccount p
177         where
178          (parenthesise, awidth) =
179            case ptype p of
180              BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
181              VirtualPosting         -> (\s -> "("++s++")", acctwidth-2)
182              _                      -> (id,acctwidth)
183      showamt = showMixedAmountWithoutPrice (color_ $ reportopts_ opts)
184      amt = showamt $ pamount p
185      bal = showamt b
186      -- alternate behaviour, show null amounts as 0 instead of blank
187      -- amt = if null amt' then "0" else amt'
188      -- bal = if null bal' then "0" else bal'
189      (amtlines, ballines) = (lines amt, lines bal)
190      (amtlen, ballen) = (length amtlines, length ballines)
191      numlines = max 1 (max amtlen ballen)
192      (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat "" -- posting amount is top-aligned
193      (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned
194      spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' '
195
196-- tests
197
198tests_Register = tests "Register" [
199
200   tests "postingsReportAsText" [
201    test "unicode in register layout" $ do
202      j <- readJournal' "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
203      let opts = defreportopts
204      (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j)
205        @?=
206        unlines
207        ["2009-01-01 медвежья шкура       расходы:покупки                100           100"
208        ,"                                актив:наличные                -100             0"]
209   ]
210
211 ]
212