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