1{-|
2
3The @aregister@ command lists a single account's transactions,
4like the account register in hledger-ui and hledger-web,
5and unlike the register command which lists postings across multiple accounts.
6
7-}
8
9{-# LANGUAGE CPP #-}
10{-# LANGUAGE NamedFieldPuns #-}
11{-# LANGUAGE OverloadedStrings #-}
12{-# LANGUAGE RecordWildCards #-}
13{-# LANGUAGE TemplateHaskell #-}
14
15module Hledger.Cli.Commands.Aregister (
16  aregistermode
17 ,aregister
18 -- ,showPostingWithBalanceForVty
19 ,tests_Aregister
20) where
21
22import Control.Monad (when)
23import Data.Aeson (toJSON)
24import Data.Aeson.Text (encodeToLazyText)
25import Data.List
26import Data.Maybe
27#if !(MIN_VERSION_base(4,11,0))
28import Data.Semigroup ((<>))
29#endif
30import qualified Data.Text as T
31import qualified Data.Text.Lazy as TL
32import Data.Time (addDays)
33import Safe (headDef)
34import System.Console.CmdArgs.Explicit
35import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
36
37import Hledger
38import Hledger.Cli.CliOptions
39import Hledger.Cli.Utils
40
41aregistermode = hledgerCommandMode
42  $(embedFileRelative "Hledger/Cli/Commands/Aregister.txt")
43  ([
44   flagNone ["txn-dates"] (setboolopt "txn-dates")
45     "filter strictly by transaction date, not posting date. Warning: this can show a wrong running balance."
46   ,flagNone ["no-elide"] (setboolopt "no-elide") "don't limit amount commodities shown to 2"
47  --  flagNone ["cumulative"] (setboolopt "change")
48  --    "show running total from report start date (default)"
49  -- ,flagNone ["historical","H"] (setboolopt "historical")
50  --    "show historical running total/balance (includes postings before report start date)\n "
51  -- ,flagNone ["average","A"] (setboolopt "average")
52  --    "show running average of posting amounts instead of total (implies --empty)"
53  -- ,flagNone ["related","r"] (setboolopt "related") "show postings' siblings instead"
54  -- ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign"
55  ,flagReq  ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N"
56     ("set output width (default: " ++
57#ifdef mingw32_HOST_OS
58      show defaultWidth
59#else
60      "terminal width"
61#endif
62      ++ " or $COLUMNS). -wN,M sets description width as well."
63     )
64  ,outputFormatFlag ["txt","csv","json"]
65  ,outputFileFlag
66  ])
67  [generalflagsgroup1]
68  hiddenflags
69  ([], Just $ argsFlag "ACCTPAT [QUERY]")
70
71-- based on Hledger.UI.RegisterScreen:
72
73-- | Print an account register report for a specified account.
74aregister :: CliOpts -> Journal -> IO ()
75aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
76  d <- getCurrentDay
77  -- the first argument specifies the account, any remaining arguments are a filter query
78  let args' = listofstringopt "args" rawopts
79  when (null args') $ error' "aregister needs an account, please provide an account name or pattern"  -- PARTIAL:
80  let
81    (apat:queryargs) = args'
82    acct = headDef (error' $ show apat++" did not match any account")   -- PARTIAL:
83           . filterAccts $ journalAccountNames j
84    filterAccts = case toRegexCI apat of
85        Right re -> filter (regexMatch re . T.unpack)
86        Left  _  -> const []
87    -- gather report options
88    inclusive = True  -- tree_ ropts
89    thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
90    ropts' = ropts{
91       query_=unwords $ map quoteIfNeeded $ queryargs
92       -- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX
93      ,depth_=Nothing
94       -- always show historical balance
95      ,balancetype_= HistoricalBalance
96      }
97    reportq = And [queryFromOpts d ropts', excludeforecastq (isJust $ forecast_ ropts)]
98      where
99        -- As in RegisterScreen, why ? XXX
100        -- Except in forecast mode, exclude future/forecast transactions.
101        excludeforecastq True = Any
102        excludeforecastq False =  -- not:date:tomorrow- not:tag:generated-transaction
103          And [
104             Not (Date $ DateSpan (Just $ addDays 1 d) Nothing)
105            ,Not generatedTransactionTag
106          ]
107    -- run the report
108    -- TODO: need to also pass the queries so we can choose which date to render - move them into the report ?
109    (balancelabel,items) = accountTransactionsReport ropts' j reportq thisacctq
110    items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $
111             reverse items
112    -- select renderer
113    render | fmt=="json" = (++"\n") . T.unpack . TL.toStrict . encodeToLazyText . toJSON
114           | fmt=="csv"  = (++"\n") . printCSV . accountTransactionsReportAsCsv reportq thisacctq
115           | fmt=="txt"  = accountTransactionsReportAsText opts reportq thisacctq
116           | otherwise   = const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
117      where
118        fmt = outputFormatFromOpts opts
119
120  writeOutput opts $ render (balancelabel,items')
121
122accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV
123accountTransactionsReportAsCsv reportq thisacctq (_,is) =
124  ["txnidx","date","code","description","otheraccounts","change","balance"]
125  : map (accountTransactionsReportItemAsCsvRecord reportq thisacctq) is
126
127accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransactionsReportItem -> CsvRecord
128accountTransactionsReportItemAsCsvRecord
129  reportq thisacctq
130  (t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance)
131  = [idx,date,code,desc,otheracctsstr,amt,bal]
132  where
133    idx  = show tindex
134    date = showDate $ transactionRegisterDate reportq thisacctq t
135    code = T.unpack tcode
136    desc = T.unpack tdescription
137    amt  = showMixedAmountOneLineWithoutPrice False change
138    bal  = showMixedAmountOneLineWithoutPrice False balance
139
140-- | Render a register report as plain text suitable for console output.
141accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String
142accountTransactionsReportAsText
143  copts@CliOpts{reportopts_=ReportOpts{no_elide_}} reportq thisacctq (_balancelabel,items)
144  = unlines $ title :
145    map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items
146  where
147    amtwidth = maximumStrict $ 12 : map (strWidth . showamt . itemamt) items
148    balwidth = maximumStrict $ 12 : map (strWidth . showamt . itembal) items
149    showamt
150      | no_elide_ = showMixedAmountOneLineWithoutPrice False -- color_
151      | otherwise = showMixedAmountElided False
152    itemamt (_,_,_,_,a,_) = a
153    itembal (_,_,_,_,_,a) = a
154    -- show a title indicating which account was picked, which can be confusing otherwise
155    title = T.unpack $ maybe "" (("Transactions in "<>).(<>" and subaccounts:")) macct
156      where
157        -- XXX temporary hack ? recover the account name from the query
158        macct = case filterQuery queryIsAcct thisacctq of
159                  Acct r -> Just . T.drop 1 . T.dropEnd 5 . T.pack $ reString r  -- Acct "^JS:expenses(:|$)"
160                  _      -> Nothing  -- shouldn't happen
161
162-- | Render one account register report line item as plain text. Layout is like so:
163-- @
164-- <---------------- width (specified, terminal width, or 80) -------------------->
165-- date (10)  description           other accounts       change (12)   balance (12)
166-- DDDDDDDDDD dddddddddddddddddddd  aaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
167-- @
168-- If description's width is specified, account will use the remaining space.
169-- Otherwise, description and account divide up the space equally.
170--
171-- Returns a string which can be multi-line, eg if the running balance
172-- has multiple commodities.
173--
174accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String
175accountTransactionsReportItemAsText
176  copts@CliOpts{reportopts_=ReportOpts{color_,no_elide_}}
177  reportq thisacctq preferredamtwidth preferredbalwidth
178  (t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance)
179    -- Transaction -- the transaction, unmodified
180    -- Transaction -- the transaction, as seen from the current account
181    -- Bool        -- is this a split (more than one posting to other accounts) ?
182    -- String      -- a display string describing the other account(s), if any
183    -- MixedAmount -- the amount posted to the current account(s) (or total amount posted)
184    -- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction
185
186  = intercalate "\n" $
187    concat [fitString (Just datewidth) (Just datewidth) True True date
188           ," "
189           ,fitString (Just descwidth) (Just descwidth) True True desc
190           ,"  "
191           ,fitString (Just acctwidth) (Just acctwidth) True True accts
192           ,"  "
193           ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline
194           ,"  "
195           ,fitString (Just balwidth) (Just balwidth) True False balfirstline
196           ]
197    :
198    [concat [spacer
199            ,fitString (Just amtwidth) (Just amtwidth) True False a
200            ,"  "
201            ,fitString (Just balwidth) (Just balwidth) True False b
202            ]
203     | (a,b) <- zip amtrest balrest
204     ]
205    where
206      -- calculate widths
207      (totalwidth,mdescwidth) = registerWidthsFromOpts copts
208      (datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t)
209      (amtwidth, balwidth)
210        | shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
211        | otherwise      = (adjustedamtwidth, adjustedbalwidth)
212        where
213          mincolwidth = 2 -- columns always show at least an ellipsis
214          maxamtswidth = max 0 (totalwidth - (datewidth + 1 + mincolwidth + 2 + mincolwidth + 2 + 2))
215          shortfall = (preferredamtwidth + preferredbalwidth) - maxamtswidth
216          amtwidthproportion = fromIntegral preferredamtwidth / fromIntegral (preferredamtwidth + preferredbalwidth)
217          adjustedamtwidth = round $ amtwidthproportion * fromIntegral maxamtswidth
218          adjustedbalwidth = maxamtswidth - adjustedamtwidth
219
220      remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
221      (descwidth, acctwidth) = (w, remaining - 2 - w)
222        where
223          w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
224
225      -- gather content
226      desc = T.unpack tdescription
227      accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
228              otheracctsstr
229      showamt
230        | no_elide_ = showMixedAmountOneLineWithoutPrice color_
231        | otherwise = showMixedAmountElided color_
232      amt = showamt change
233      bal = showamt balance
234      -- alternate behaviour, show null amounts as 0 instead of blank
235      -- amt = if null amt' then "0" else amt'
236      -- bal = if null bal' then "0" else bal'
237      (amtlines, ballines) = (lines amt, lines bal)
238      (amtlen, ballen) = (length amtlines, length ballines)
239      numlines = max 1 (max amtlen ballen)
240      (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat "" -- posting amount is top-aligned
241      (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned
242      spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' '
243
244-- tests
245
246tests_Aregister = tests "Aregister" [
247
248 ]
249