{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Aregister (
aregistermode
,aregister
,tests_Aregister
) where
import Control.Monad (when)
import Data.Aeson (toJSON)
import Data.Aeson.Text (encodeToLazyText)
import Data.List
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time (addDays)
import Safe (headDef)
import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
aregistermode = hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Aregister.txt")
([
flagNone ["txn-dates"] (setboolopt "txn-dates")
"filter strictly by transaction date, not posting date. Warning: this can show a wrong running balance."
,flagNone ["no-elide"] (setboolopt "no-elide") "don't limit amount commodities shown to 2"
,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."
)
,outputFormatFlag ["txt","csv","json"]
,outputFileFlag
])
[generalflagsgroup1]
hiddenflags
([], Just $ argsFlag "ACCTPAT [QUERY]")
aregister :: CliOpts -> Journal -> IO ()
aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay
let args' = listofstringopt "args" rawopts
when (null args') $ error' "aregister needs an account, please provide an account name or pattern"
let
(apat:queryargs) = args'
acct = headDef (error' $ show apat++" did not match any account")
. filterAccts $ journalAccountNames j
filterAccts = case toRegexCI apat of
Right re -> filter (regexMatch re . T.unpack)
Left _ -> const []
inclusive = True
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
ropts' = ropts{
query_=unwords $ map quoteIfNeeded $ queryargs
,depth_=Nothing
,balancetype_= HistoricalBalance
}
reportq = And [queryFromOpts d ropts', excludeforecastq (isJust $ forecast_ ropts)]
where
excludeforecastq True = Any
excludeforecastq False =
And [
Not (Date $ DateSpan (Just $ addDays 1 d) Nothing)
,Not generatedTransactionTag
]
(balancelabel,items) = accountTransactionsReport ropts' j reportq thisacctq
items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $
reverse items
render | fmt=="json" = (++"\n") . T.unpack . TL.toStrict . encodeToLazyText . toJSON
| fmt=="csv" = (++"\n") . printCSV . accountTransactionsReportAsCsv reportq thisacctq
| fmt=="txt" = accountTransactionsReportAsText opts reportq thisacctq
| otherwise = const $ error' $ unsupportedOutputFormatError fmt
where
fmt = outputFormatFromOpts opts
writeOutput opts $ render (balancelabel,items')
accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv reportq thisacctq (_,is) =
["txnidx","date","code","description","otheraccounts","change","balance"]
: map (accountTransactionsReportItemAsCsvRecord reportq thisacctq) is
accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransactionsReportItem -> CsvRecord
accountTransactionsReportItemAsCsvRecord
reportq thisacctq
(t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance)
= [idx,date,code,desc,otheracctsstr,amt,bal]
where
idx = show tindex
date = showDate $ transactionRegisterDate reportq thisacctq t
code = T.unpack tcode
desc = T.unpack tdescription
amt = showMixedAmountOneLineWithoutPrice False change
bal = showMixedAmountOneLineWithoutPrice False balance
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String
accountTransactionsReportAsText
copts@CliOpts{reportopts_=ReportOpts{no_elide_}} reportq thisacctq (_balancelabel,items)
= unlines $ title :
map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items
where
amtwidth = maximumStrict $ 12 : map (strWidth . showamt . itemamt) items
balwidth = maximumStrict $ 12 : map (strWidth . showamt . itembal) items
showamt
| no_elide_ = showMixedAmountOneLineWithoutPrice False
| otherwise = showMixedAmountElided False
itemamt (_,_,_,_,a,_) = a
itembal (_,_,_,_,_,a) = a
title = T.unpack $ maybe "" (("Transactions in "<>).(<>" and subaccounts:")) macct
where
macct = case filterQuery queryIsAcct thisacctq of
Acct r -> Just . T.drop 1 . T.dropEnd 5 . T.pack $ reString r
_ -> Nothing
accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String
accountTransactionsReportItemAsText
copts@CliOpts{reportopts_=ReportOpts{color_,no_elide_}}
reportq thisacctq preferredamtwidth preferredbalwidth
(t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance)
= 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 accts
," "
,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 copts
(datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t)
(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) = (w, remaining - 2 - w)
where
w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
desc = T.unpack tdescription
accts =
otheracctsstr
showamt
| no_elide_ = showMixedAmountOneLineWithoutPrice color_
| otherwise = showMixedAmountElided color_
amt = showamt change
bal = showamt balance
(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_Aregister = tests "Aregister" [
]