{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Register (
registermode
,register
,postingsReportAsText
,postingsReportItemAsText
,tests_Register
) where
import Data.List
import Data.Maybe
import qualified Data.Text as T
import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, Record, printCSV)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
registermode = hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Register.txt")
([flagNone ["cumulative"] (setboolopt "change")
"show running total from report start date (default)"
,flagNone ["historical","H"] (setboolopt "historical")
"show historical running total/balance (includes postings before report start date)\n "
,flagNone ["average","A"] (setboolopt "average")
"show running average of posting amounts instead of total (implies --empty)"
,flagNone ["related","r"] (setboolopt "related") "show postings' siblings instead"
,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign"
,flagReq ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N"
("set output width (default: " ++
#ifdef mingw32_HOST_OS
show defaultWidth
#else
"terminal width"
#endif
++ " or $COLUMNS). -wN,M sets description width as well."
)
] ++ outputflags)
[generalflagsgroup1]
hiddenflags
([], Just $ argsFlag "[QUERY]")
register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts@ReportOpts{..}} j = do
d <- getCurrentDay
let fmt = outputFormatFromOpts opts
render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| fmt=="html" = const $ error' "Sorry, HTML output is not yet implemented for this kind of report."
| otherwise = postingsReportAsText
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv (_,is) =
["txnidx","date","code","description","account","amount","total"]
:
map postingsReportItemAsCsvRecord is
postingsReportItemAsCsvRecord :: PostingsReportItem -> Record
postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal]
where
idx = show $ maybe 0 tindex $ ptransaction p
date = showDate $ postingDate p
code = maybe "" (T.unpack . tcode) $ ptransaction p
desc = T.unpack $ maybe "" tdescription $ ptransaction p
acct = bracket $ T.unpack $ paccount p
where
bracket = case ptype p of
BalancedVirtualPosting -> (\s -> "["++s++"]")
VirtualPosting -> (\s -> "("++s++")")
_ -> id
amt = showMixedAmountOneLineWithoutPrice $ pamount p
bal = showMixedAmountOneLineWithoutPrice b
postingsReportAsText :: CliOpts -> PostingsReport -> String
postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText opts amtwidth balwidth) items
where
amtwidth = maximumStrict $ 12 : map (strWidth . showMixedAmount . itemamt) items
balwidth = maximumStrict $ 12 : map (strWidth . showMixedAmount . itembal) items
itemamt (_,_,_,Posting{pamount=a},_) = a
itembal (_,_,_,_,a) = a
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> String
postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
intercalate "\n" $
concat [fitString (Just datewidth) (Just datewidth) True True date
," "
,fitString (Just descwidth) (Just descwidth) True True desc
," "
,fitString (Just acctwidth) (Just acctwidth) True True acct
," "
,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline
," "
,fitString (Just balwidth) (Just balwidth) True False balfirstline
]
:
[concat [spacer
,fitString (Just amtwidth) (Just amtwidth) True False a
," "
,fitString (Just balwidth) (Just balwidth) True False b
]
| (a,b) <- zip amtrest balrest
]
where
(totalwidth,mdescwidth) = registerWidthsFromOpts opts
(datewidth, date) = case (mdate,menddate) of
(Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate))
(Nothing, Just _) -> (21, "")
(Just d, Nothing) -> (10, showDate d)
_ -> (10, "")
(amtwidth, balwidth)
| shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
| otherwise = (adjustedamtwidth, adjustedbalwidth)
where
mincolwidth = 2
maxamtswidth = max 0 (totalwidth - (datewidth + 1 + mincolwidth + 2 + mincolwidth + 2 + 2))
shortfall = (preferredamtwidth + preferredbalwidth) - maxamtswidth
amtwidthproportion = fromIntegral preferredamtwidth / fromIntegral (preferredamtwidth + preferredbalwidth)
adjustedamtwidth = round $ amtwidthproportion * fromIntegral maxamtswidth
adjustedbalwidth = maxamtswidth - adjustedamtwidth
remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
(descwidth, acctwidth)
| hasinterval = (0, remaining - 2)
| otherwise = (w, remaining - 2 - w)
where
hasinterval = isJust menddate
w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
desc = fromMaybe "" mdesc
acct = parenthesise $ T.unpack $ elideAccountName awidth $ paccount p
where
(parenthesise, awidth) =
case ptype p of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
VirtualPosting -> (\s -> "("++s++")", acctwidth-2)
_ -> (id,acctwidth)
showamt | color_ (reportopts_ opts) = cshowMixedAmountWithoutPrice
| otherwise = showMixedAmountWithoutPrice
amt = showamt $ pamount p
bal = showamt b
(amtlines, ballines) = (lines amt, lines bal)
(amtlen, ballen) = (length amtlines, length ballines)
numlines = max 1 (max amtlen ballen)
(amtfirstline:amtrest) = take numlines $ amtlines ++ repeat ""
(balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines
spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' '
tests_Register = tests "Register" [
tests "postingsReportAsText" [
test "unicode in register layout" $ do
j <- io $ 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"]
]
]