slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: clarify the two register types, "posting register" and "account register"

Browse Source 
See the docstrings for details. Possibly temporary names, but at least
make the naming consistent and distinct.
This commit is contained in:
Simon Michael 2011-06-24 02:44:31 +00:00
parent 4637e5b018
commit 33a1c6533b
9 changed files with 119 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-vty/Hledger/Vty/Main.hs
View File

@ -270,7 +270,7 @@ updateData :: Day -> AppState -> AppState
updateData d a@AppState{aopts=opts,ajournal=j} = updateData d a@AppState{aopts=opts,ajournal=j} =
case screen a of case screen a of
BalanceScreen -> a{abuf=balanceReportAsText opts $ balanceReport opts fspec j} BalanceScreen -> a{abuf=balanceReportAsText opts $ balanceReport opts fspec j}
RegisterScreen -> a{abuf=lines $ registerReportAsText opts $ registerReport opts fspec j} RegisterScreen -> a{abuf=lines $ postingRegisterReportAsText opts $ postingRegisterReport opts fspec j}
PrintScreen -> a{abuf=lines $ showTransactions opts fspec j} PrintScreen -> a{abuf=lines $ showTransactions opts fspec j}
where fspec = optsToFilterSpec opts (currentArgs a) d where fspec = optsToFilterSpec opts (currentArgs a) d

2
hledger-web/.hledger/web/templates/registerreport.hamlet → hledger-web/.hledger/web/templates/accountregisterreport.hamlet
View File

@ -6,5 +6,5 @@
<th.amount align=right>Amount <th.amount align=right>Amount
<th.balance align=right>#{balancelabel} <th.balance align=right>#{balancelabel}
$forall i <- numberTransactions items $forall i <- numberAccountRegisterReportItems items
^{itemAsHtml vd i} ^{itemAsHtml vd i}

0
hledger-web/.hledger/web/templates/registerreport2item.hamlet → hledger-web/.hledger/web/templates/accountregisterreportitem.hamlet
View File

2
hledger-web/.hledger/web/templates/registerreport2.hamlet → hledger-web/.hledger/web/templates/postingregisterreport.hamlet
View File

@ -6,5 +6,5 @@
<th.amount align=right>Amount <th.amount align=right>Amount
<th.balance align=right>#{balancelabel} <th.balance align=right>#{balancelabel}
$forall i <- numberRegisterReport2Items items $forall i <- numberPostingRegisterReportItems items
^{itemAsHtml vd i} ^{itemAsHtml vd i}

0
hledger-web/.hledger/web/templates/registerreportitem.hamlet → hledger-web/.hledger/web/templates/postingregisterreportitem.hamlet
View File

77
hledger-web/Handlers.hs
View File

@ -64,8 +64,8 @@ getRegisterR = do
vd@VD{opts=opts,qopts=qopts,m=m,j=j} <- getViewData vd@VD{opts=opts,qopts=qopts,m=m,j=j} <- getViewData
let sidecontent = balanceReportAsHtml opts vd{q=""} $ balanceReport opts nullfilterspec j let sidecontent = balanceReportAsHtml opts vd{q=""} $ balanceReport opts nullfilterspec j
maincontent = maincontent =
case inAccountMatcher qopts of Just m' -> registerReport2AsHtml opts vd $ accountRegisterReport opts j m m' case inAccountMatcher qopts of Just m' -> accountRegisterReportAsHtml opts vd $ accountRegisterReport opts j m m'
Nothing -> registerReportAsHtml opts vd $ registerReport opts nullfilterspec $ filterJournalPostings2 m j Nothing -> postingRegisterReportAsHtml opts vd $ postingRegisterReport opts nullfilterspec $ filterJournalPostings2 m j
editform' = editform vd editform' = editform vd
defaultLayout $ do defaultLayout $ do
setTitle "hledger-web register" setTitle "hledger-web register"
@ -92,18 +92,12 @@ getRegisterOnlyR = do
defaultLayout $ do defaultLayout $ do
setTitle "hledger-web register only" setTitle "hledger-web register only"
addHamlet $ addHamlet $
case inAccountMatcher qopts of Just m' -> registerReport2AsHtml opts vd $ accountRegisterReport opts j m m' case inAccountMatcher qopts of Just m' -> accountRegisterReportAsHtml opts vd $ accountRegisterReport opts j m m'
Nothing -> registerReportAsHtml opts vd $ registerReport opts nullfilterspec $ filterJournalPostings2 m j Nothing -> postingRegisterReportAsHtml opts vd $ postingRegisterReport opts nullfilterspec $ filterJournalPostings2 m j
postRegisterOnlyR :: Handler RepPlain postRegisterOnlyR :: Handler RepPlain
postRegisterOnlyR = handlePost postRegisterOnlyR = handlePost
-- -- temporary helper - use the new account register report when in:ACCT is specified.
-- accountOrJournalRegisterReport :: ViewData -> Journal -> RegisterReport
-- accountOrJournalRegisterReport VD{opts=opts,m=m,qopts=qopts} j =
-- case inAccountMatcher qopts of Just m' -> accountRegisterReport opts j m m'
-- Nothing -> registerReport opts nullfilterspec $ filterJournalPostings2 m j
-- | A simple accounts view, like hledger balance. If the Accept header -- | A simple accounts view, like hledger balance. If the Accept header
-- specifies json, returns the chart of accounts as json. -- specifies json, returns the chart of accounts as json.
getAccountsR :: Handler RepHtmlJson getAccountsR :: Handler RepHtmlJson
@ -155,11 +149,12 @@ journalReportAsHtml _ vd items = $(Settings.hamletFile "journalreport")
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
-- | Render a register report as HTML. -- | Render a register report as HTML.
registerReportAsHtml :: [Opt] -> ViewData -> RegisterReport -> Hamlet AppRoute -- Journal-wide postings register, when no account has focus.
registerReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "registerreport") postingRegisterReportAsHtml :: [Opt] -> ViewData -> PostingRegisterReport -> Hamlet AppRoute
postingRegisterReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "postingregisterreport")
where where
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, RegisterReportItem) -> Hamlet AppRoute itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, PostingRegisterReportItem) -> Hamlet AppRoute
itemAsHtml VD{here=here} (n, newd, newm, newy, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem") itemAsHtml VD{here=here} (n, newd, newm, newy, (ds, posting, b)) = $(Settings.hamletFile "postingregisterreportitem")
where where
evenodd = if even n then "even" else "odd" :: String evenodd = if even n then "even" else "odd" :: String
datetransition -- | newy && n > 1 = "newyear" datetransition -- | newy && n > 1 = "newyear"
@ -171,12 +166,30 @@ registerReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "register
acct = paccount posting acct = paccount posting
accturl = (here, [("q", pack $ accountUrl acct)]) accturl = (here, [("q", pack $ accountUrl acct)])
-- mark II -- Add incrementing transaction numbers to a list of register report items
registerReport2AsHtml :: [Opt] -> ViewData -> RegisterReport2 -> Hamlet AppRoute -- starting at 1. Also add three flags that are true if the date, month,
registerReport2AsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "registerreport2") -- and year is different from the previous item's.
numberPostingRegisterReportItems :: [PostingRegisterReportItem] -> [(Int,Bool,Bool,Bool,PostingRegisterReportItem)]
numberPostingRegisterReportItems [] = []
numberPostingRegisterReportItems is = number 0 nulldate is
where
number :: Int -> Day -> [PostingRegisterReportItem] -> [(Int,Bool,Bool,Bool,PostingRegisterReportItem)]
number _ _ [] = []
number n prevd (i@(Nothing, _, _) :is) = (n,False,False,False,i) :(number n prevd is)
number n prevd (i@(Just (d,_), _, _):is) = (n+1,newday,newmonth,newyear,i):(number (n+1) d is)
where
newday = d/=prevd
newmonth = dm/=prevdm || dy/=prevdy
newyear = dy/=prevdy
(dy,dm,_) = toGregorian d
(prevdy,prevdm,_) = toGregorian prevd
-- Account-specific transaction register, when an account is focussed.
accountRegisterReportAsHtml :: [Opt] -> ViewData -> AccountRegisterReport -> Hamlet AppRoute
accountRegisterReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "accountregisterreport")
where where
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, RegisterReport2Item) -> Hamlet AppRoute itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, AccountRegisterReportItem) -> Hamlet AppRoute
itemAsHtml VD{here=here} (n, newd, newm, newy, (t, acct, amt, bal)) = $(Settings.hamletFile "registerreport2item") itemAsHtml VD{here=here} (n, newd, newm, newy, (t, acct, amt, bal)) = $(Settings.hamletFile "accountregisterreportitem")
where where
evenodd = if even n then "even" else "odd" :: String evenodd = if even n then "even" else "odd" :: String
datetransition | newm = "newmonth" datetransition | newm = "newmonth"
@ -185,11 +198,11 @@ registerReport2AsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "registe
(firstposting, date, desc) = (False, show $ tdate t, tdescription t) (firstposting, date, desc) = (False, show $ tdate t, tdescription t)
accturl = (here, [("q", pack $ accountUrl acct)]) accturl = (here, [("q", pack $ accountUrl acct)])
numberRegisterReport2Items :: [RegisterReport2Item] -> [(Int,Bool,Bool,Bool,RegisterReport2Item)] numberAccountRegisterReportItems :: [AccountRegisterReportItem] -> [(Int,Bool,Bool,Bool,AccountRegisterReportItem)]
numberRegisterReport2Items [] = [] numberAccountRegisterReportItems [] = []
numberRegisterReport2Items is = number 0 nulldate is numberAccountRegisterReportItems is = number 0 nulldate is
where where
number :: Int -> Day -> [RegisterReport2Item] -> [(Int,Bool,Bool,Bool,RegisterReport2Item)] number :: Int -> Day -> [AccountRegisterReportItem] -> [(Int,Bool,Bool,Bool,AccountRegisterReportItem)]
number _ _ [] = [] number _ _ [] = []
number n prevd (i@(Transaction{tdate=d},_,_,_):is) = (n+1,newday,newmonth,newyear,i):(number (n+1) d is) number n prevd (i@(Transaction{tdate=d},_,_,_):is) = (n+1,newday,newmonth,newyear,i):(number (n+1) d is)
where where
@ -483,21 +496,3 @@ getMessageOr mnewmsg = do
numbered = zip [1..] numbered = zip [1..]
-- Add incrementing transaction numbers to a list of register report items
-- starting at 1. Also add three flags that are true if the date, month,
-- and year is different from the previous item's.
numberTransactions :: [RegisterReportItem] -> [(Int,Bool,Bool,Bool,RegisterReportItem)]
numberTransactions [] = []
numberTransactions is = number 0 nulldate is
where
number :: Int -> Day -> [RegisterReportItem] -> [(Int,Bool,Bool,Bool,RegisterReportItem)]
number _ _ [] = []
number n prevd (i@(Nothing, _, _) :is) = (n,False,False,False,i) :(number n prevd is)
number n prevd (i@(Just (d,_), _, _):is) = (n+1,newday,newmonth,newyear,i):(number (n+1) d is)
where
newday = d/=prevd
newmonth = dm/=prevdm || dy/=prevdy
newyear = dy/=prevdy
(dy,dm,_) = toGregorian d
(prevdy,prevdm,_) = toGregorian prevd

26
hledger/Hledger/Cli.hs
View File

@ -338,7 +338,7 @@ tests_Hledger_Cli = TestList
"register report with no args" ~: "register report with no args" ~:
do do
j <- samplejournal j <- samplejournal
(registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] date1) j) `is` unlines (postingRegisterReportAsText [] $ postingRegisterReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
["2008/01/01 income assets:bank:checking $1 $1" ["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0" ," income:salary $-1 0"
,"2008/06/01 gift assets:bank:checking $1 $1" ,"2008/06/01 gift assets:bank:checking $1 $1"
@ -356,7 +356,7 @@ tests_Hledger_Cli = TestList
do do
let opts = [Cleared] let opts = [Cleared]
j <- readJournal' sample_journal_str j <- readJournal' sample_journal_str
(registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` unlines (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
["2008/06/03 eat & shop expenses:food $1 $1" ["2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2" ," expenses:supplies $1 $2"
," assets:cash $-2 0" ," assets:cash $-2 0"
@ -368,7 +368,7 @@ tests_Hledger_Cli = TestList
do do
let opts = [UnCleared] let opts = [UnCleared]
j <- readJournal' sample_journal_str j <- readJournal' sample_journal_str
(registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` unlines (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
["2008/01/01 income assets:bank:checking $1 $1" ["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0" ," income:salary $-1 0"
,"2008/06/01 gift assets:bank:checking $1 $1" ,"2008/06/01 gift assets:bank:checking $1 $1"
@ -388,19 +388,19 @@ tests_Hledger_Cli = TestList
," e 1" ," e 1"
," f" ," f"
] ]
registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] date1) j) `is` ["2008/01/01","2008/02/02"] registerdates (postingRegisterReportAsText [] $ postingRegisterReport [] (optsToFilterSpec [] [] date1) j) `is` ["2008/01/01","2008/02/02"]
,"register report with account pattern" ~: ,"register report with account pattern" ~:
do do
j <- samplejournal j <- samplejournal
(registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] date1) j) `is` unlines (postingRegisterReportAsText [] $ postingRegisterReport [] (optsToFilterSpec [] ["cash"] date1) j) `is` unlines
["2008/06/03 eat & shop assets:cash $-2 $-2" ["2008/06/03 eat & shop assets:cash $-2 $-2"
] ]
,"register report with account pattern, case insensitive" ~: ,"register report with account pattern, case insensitive" ~:
do do
j <- samplejournal j <- samplejournal
(registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] date1) j) `is` unlines (postingRegisterReportAsText [] $ postingRegisterReport [] (optsToFilterSpec [] ["cAsH"] date1) j) `is` unlines
["2008/06/03 eat & shop assets:cash $-2 $-2" ["2008/06/03 eat & shop assets:cash $-2 $-2"
] ]
@ -408,7 +408,7 @@ tests_Hledger_Cli = TestList
do do
j <- samplejournal j <- samplejournal
let gives displayexpr = let gives displayexpr =
(registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is`) (registerdates (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j) `is`)
where opts = [Display displayexpr] where opts = [Display displayexpr]
"d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"]
"d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
@ -421,7 +421,7 @@ tests_Hledger_Cli = TestList
j <- samplejournal j <- samplejournal
let periodexpr `gives` dates = do let periodexpr `gives` dates = do
j' <- samplejournal j' <- samplejournal
registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j') `is` dates registerdates (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j') `is` dates
where opts = [Period periodexpr] where opts = [Period periodexpr]
"" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
"2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
@ -430,7 +430,7 @@ tests_Hledger_Cli = TestList
"monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
"quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
let opts = [Period "yearly"] let opts = [Period "yearly"]
(registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` unlines (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1"
," assets:cash $-2 $-1" ," assets:cash $-2 $-1"
," expenses:food $1 0" ," expenses:food $1 0"
@ -440,9 +440,9 @@ tests_Hledger_Cli = TestList
," liabilities:debts $1 0" ," liabilities:debts $1 0"
] ]
let opts = [Period "quarterly"] let opts = [Period "quarterly"]
registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] registerdates (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]
let opts = [Period "quarterly",Empty] let opts = [Period "quarterly",Empty]
registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] registerdates (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
] ]
@ -450,7 +450,7 @@ tests_Hledger_Cli = TestList
do do
j <- samplejournal j <- samplejournal
let opts = [Depth "2"] let opts = [Depth "2"]
(registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` unlines (postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
["2008/01/01 income assets:bank $1 $1" ["2008/01/01 income assets:bank $1 $1"
," income:salary $-1 0" ," income:salary $-1 0"
,"2008/06/01 gift assets:bank $1 $1" ,"2008/06/01 gift assets:bank $1 $1"
@ -481,7 +481,7 @@ tests_Hledger_Cli = TestList
,"unicode in register layout" ~: do ,"unicode in register layout" ~: do
j <- readJournal' j <- readJournal'
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
(registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] date1) j) `is` unlines (postingRegisterReportAsText [] $ postingRegisterReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100" ["2009/01/01 медвежья шкура расходы:покупки 100 100"
," актив:наличные -100 0"] ," актив:наличные -100 0"]

4
hledger/Hledger/Cli/Add.hs
View File

@ -29,7 +29,7 @@ import qualified Data.Foldable as Foldable (find)
import qualified Data.Set as Set import qualified Data.Set as Set
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Register (registerReport, registerReportAsText) import Hledger.Cli.Register (postingRegisterReport, postingRegisterReportAsText)
import Hledger.Cli.Utils import Hledger.Cli.Utils
import Hledger.Data import Hledger.Data
import Hledger.Read.JournalReader (someamount) import Hledger.Read.JournalReader (someamount)
@ -220,7 +220,7 @@ registerFromString :: String -> IO String
registerFromString s = do registerFromString s = do
d <- getCurrentDay d <- getCurrentDay
j <- readJournal' s j <- readJournal' s
return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] d) j return $ postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts [] d) j
where opts = [Empty] where opts = [Empty]
-- | Return a similarity measure, from 0 to 1, for two strings. -- | Return a similarity measure, from 0 to 1, for two strings.

126
hledger/Hledger/Cli/Register.hs
View File

@ -6,14 +6,14 @@ A ledger-compatible @register@ command.
-} -}
module Hledger.Cli.Register ( module Hledger.Cli.Register (
RegisterReport PostingRegisterReport
,RegisterReportItem ,PostingRegisterReportItem
,RegisterReport2 ,AccountRegisterReport
,RegisterReport2Item ,AccountRegisterReportItem
,register ,register
,registerReport ,postingRegisterReport
,accountRegisterReport ,accountRegisterReport
,registerReportAsText ,postingRegisterReportAsText
,showPostingWithBalanceForVty ,showPostingWithBalanceForVty
,tests_Hledger_Cli_Register ,tests_Hledger_Cli_Register
) where ) where
@ -36,40 +36,42 @@ import Prelude hiding (putStr)
import Hledger.Utils.UTF8 (putStr) import Hledger.Utils.UTF8 (putStr)
-- | A register report is a list of postings to an account or set of -- | A posting register report lists postings to one or more accounts,
-- accounts, with a running total. Postings may be actual postings, or -- with a running total. Postings may be actual postings, or aggregate
-- virtual postings aggregated over a reporting interval. -- postings corresponding to a reporting interval.
-- And also some heading info. type PostingRegisterReport = (String -- label for the running balance column XXX remove
type RegisterReport = (String -- a possibly null label for the running balance column ,[PostingRegisterReportItem] -- line items, one per posting
,[RegisterReportItem] -- line items, one per posting )
)
-- | The data for a single register report line item, representing one posting. -- | A single posting register line item, representing one posting.
type RegisterReportItem = (Maybe (Day, String) -- transaction date and description if this is the first posting type PostingRegisterReportItem = (Maybe (Day, String) -- transaction date and description if this is the first posting
,Posting -- the posting ,Posting -- the posting
,MixedAmount -- balance so far ,MixedAmount -- the running total after this posting
) )
-- | Register report mark II, used in hledger-web's account register (see "accountRegisterReport". -- | An account register report lists transactions to a single account (or
type RegisterReport2 = (String -- a possibly null label for the running balance column -- possibly subs as well), with the accurate running account balance when
,[RegisterReport2Item] -- line items, one per transaction -- possible (otherwise, a running total.)
) type AccountRegisterReport = (String -- label for the balance column, eg "balance" or "total"
-- | A single register report 2 line item, representing one transaction to/from the focussed account. ,[AccountRegisterReportItem] -- line items, one per transaction
type RegisterReport2Item = (Transaction -- the corresponding transaction )
,String -- the (possibly aggregated) account info to display
,MixedAmount -- the (possibly aggregated) amount to display (sum of the other-account postings)
,MixedAmount -- the running balance for the focussed account after this transaction
)
-- | Print a register report. -- | A single account register line item, representing one transaction to/from the focussed account.
type AccountRegisterReportItem = (Transaction -- the corresponding transaction
,String -- the (possibly aggregated) account info to display
,MixedAmount -- the (possibly aggregated) amount to display (sum of the other-account postings)
,MixedAmount -- the running balance for the focussed account after this transaction
)
-- | Print a (posting) register report.
register :: [Opt] -> [String] -> Journal -> IO () register :: [Opt] -> [String] -> Journal -> IO ()
register opts args j = do register opts args j = do
d <- getCurrentDay d <- getCurrentDay
putStr $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts args d) j putStr $ postingRegisterReportAsText opts $ postingRegisterReport opts (optsToFilterSpec opts args d) j
-- | Render a register report as plain text suitable for console output. -- | Render a register report as plain text suitable for console output.
registerReportAsText :: [Opt] -> RegisterReport -> String postingRegisterReportAsText :: [Opt] -> PostingRegisterReport -> String
registerReportAsText opts = unlines . map (registerReportItemAsText opts) . snd postingRegisterReportAsText opts = unlines . map (postingRegisterReportItemAsText opts) . snd
-- | Render one register report line item as plain text. Eg: -- | Render one register report line item as plain text. Eg:
-- @ -- @
@ -78,8 +80,8 @@ registerReportAsText opts = unlines . map (registerReportItemAsText opts) . snd
-- ^ displayed for first postings^ -- ^ displayed for first postings^
-- only, otherwise blank -- only, otherwise blank
-- @ -- @
registerReportItemAsText :: [Opt] -> RegisterReportItem -> String postingRegisterReportItemAsText :: [Opt] -> PostingRegisterReportItem -> String
registerReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal] postingRegisterReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal]
where where
datedesc = case dd of Nothing -> replicate datedescwidth ' ' datedesc = case dd of Nothing -> replicate datedescwidth ' '
Just (da, de) -> printf "%s %s " date desc Just (da, de) -> printf "%s %s " date desc
@ -93,27 +95,31 @@ registerReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", ba
pstr = showPostingForRegister p pstr = showPostingForRegister p
bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
showPostingWithBalanceForVty showtxninfo p b = registerReportItemAsText [] $ mkitem showtxninfo p b showPostingWithBalanceForVty showtxninfo p b = postingRegisterReportItemAsText [] $ mkitem showtxninfo p b
totallabel = "Total" totallabel = "Total"
balancelabel = "Balance" balancelabel = "Balance"
-- | Get an account register report with the specified options for this -- | Get a quicken/gnucash-style account register report, with the
-- journal. An account register report is like the traditional account -- specified options, for the currently focussed account (or possibly the
-- register seen in bank statements and personal finance programs. It is -- focussed account plus sub-accounts.) This differs from
-- focussed on one account only; it shows this account's transactions' -- "postingRegisterReport" in several ways:
-- postings to other accounts; and if there is no transaction filtering in --
-- effect other than a start date, it shows a historically-accurate -- 1. it shows transactions, from the point of view of the focussed
-- running balance for this account. Once additional filters are applied, -- account. The other account's name and posted amount is displayed,
-- the running balance reverts to a running total starting at 0. -- aggregated if there is more than other account posting.
-- Does not handle reporting intervals. --
-- Items are returned most recent first. -- 2. With no transaction filtering in effect other than a start date, it
accountRegisterReport :: [Opt] -> Journal -> Matcher -> Matcher -> RegisterReport2 -- shows the accurate historical running balance for this
-- account. Otherwise it shows a running total starting at 0 like the posting register report.
--
-- 3. Currently this report does not handle reporting intervals.
--
-- 4. Report items will be most recent first.
--
accountRegisterReport :: [Opt] -> Journal -> Matcher -> Matcher -> AccountRegisterReport
accountRegisterReport opts j m thisacctmatcher = (label, items) accountRegisterReport opts j m thisacctmatcher = (label, items)
where where
-- interval == NoInterval = items
-- otherwise = summarisePostingsByInterval interval depth empty filterspan displayps
-- transactions affecting this account, in date order -- transactions affecting this account, in date order
ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctmatcher) $ jtxns j ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctmatcher) $ jtxns j
@ -141,7 +147,7 @@ accountRegisterReport opts j m thisacctmatcher = (label, items)
-- using the provided matcher (postings not matching this will not affect -- using the provided matcher (postings not matching this will not affect
-- the displayed item), starting transaction, starting balance, and -- the displayed item), starting transaction, starting balance, and
-- balance summing function. -- balance summing function.
accountRegisterReportItems :: [Transaction] -> Matcher -> Transaction -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [RegisterReport2Item] accountRegisterReportItems :: [Transaction] -> Matcher -> Transaction -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [AccountRegisterReportItem]
accountRegisterReportItems [] _ _ _ _ = [] accountRegisterReportItems [] _ _ _ _ = []
accountRegisterReportItems (t@Transaction{tpostings=ps}:ts) displaymatcher _ bal sumfn = accountRegisterReportItems (t@Transaction{tpostings=ps}:ts) displaymatcher _ bal sumfn =
case i of Just i' -> i':is case i of Just i' -> i':is
@ -161,12 +167,10 @@ accountRegisterReportItems (t@Transaction{tpostings=ps}:ts) displaymatcher _ bal
bal' = bal `sumfn` amt bal' = bal `sumfn` amt
is = (accountRegisterReportItems ts displaymatcher t bal'' sumfn) is = (accountRegisterReportItems ts displaymatcher t bal'' sumfn)
-- | Get a traditional register report with the specified options for this journal. -- | Get a ledger-style posting register report, with the specified options,
-- This is a journal register report, covering the whole journal like -- for the whole journal. See also "accountRegisterReport".
-- ledger's register command; for an account-specific register see postingRegisterReport :: [Opt] -> FilterSpec -> Journal -> PostingRegisterReport
-- accountRegisterReport. postingRegisterReport opts fspec j = (totallabel,postingRegisterItems ps nullposting startbal (+))
registerReport :: [Opt] -> FilterSpec -> Journal -> RegisterReport
registerReport opts fspec j = (totallabel,postingsToRegisterReportItems ps nullposting startbal (+))
where where
ps | interval == NoInterval = displayableps ps | interval == NoInterval = displayableps
| otherwise = summarisePostingsByInterval interval depth empty filterspan displayableps | otherwise = summarisePostingsByInterval interval depth empty filterspan displayableps
@ -181,10 +185,10 @@ registerReport opts fspec j = (totallabel,postingsToRegisterReportItems ps nullp
filterspan = datespan fspec filterspan = datespan fspec
(interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts) (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
-- | Generate register report line items. -- | Generate posting register report line items.
postingsToRegisterReportItems :: [Posting] -> Posting -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [RegisterReportItem] postingRegisterItems :: [Posting] -> Posting -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingRegisterReportItem]
postingsToRegisterReportItems [] _ _ _ = [] postingRegisterItems [] _ _ _ = []
postingsToRegisterReportItems (p:ps) pprev b sumfn = i:(postingsToRegisterReportItems ps p b' sumfn) postingRegisterItems (p:ps) pprev b sumfn = i:(postingRegisterItems ps p b' sumfn)
where where
i = mkitem isfirst p b' i = mkitem isfirst p b'
isfirst = ptransaction p /= ptransaction pprev isfirst = ptransaction p /= ptransaction pprev
@ -193,7 +197,7 @@ postingsToRegisterReportItems (p:ps) pprev b sumfn = i:(postingsToRegisterReport
-- | Generate one register report line item, from a flag indicating -- | Generate one register report line item, from a flag indicating
-- whether to include transaction info, a posting, and the current running -- whether to include transaction info, a posting, and the current running
-- balance. -- balance.
mkitem :: Bool -> Posting -> MixedAmount -> RegisterReportItem mkitem :: Bool -> Posting -> MixedAmount -> PostingRegisterReportItem
mkitem False p b = (Nothing, p, b) mkitem False p b = (Nothing, p, b)
mkitem True p b = (ds, p, b) mkitem True p b = (ds, p, b)
where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de) where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)