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