51 lines
		
	
	
		
			1.9 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			51 lines
		
	
	
		
			1.9 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| {-| 
 | |
| 
 | |
| A ledger-compatible @register@ command.
 | |
| 
 | |
| -}
 | |
| 
 | |
| module RegisterCommand
 | |
| where
 | |
| import Ledger
 | |
| import Options
 | |
| 
 | |
| 
 | |
| registercommandtests = TestList [
 | |
|                        ]
 | |
| 
 | |
| -- | Print a register report.
 | |
| printregister :: [Opt] -> [String] -> Ledger -> IO ()
 | |
| printregister opts args l = putStr $ showTransactionsWithBalances opts args l
 | |
| 
 | |
| showTransactionsWithBalances :: [Opt] -> [String] -> Ledger -> String
 | |
| showTransactionsWithBalances opts args l =
 | |
|     unlines $ showTransactionsWithBalances' ts nulltxn startingbalance
 | |
|         where
 | |
|           ts = filter matchtxn $ ledgerTransactions l
 | |
|           matchtxn (Transaction _ _ desc acct _) = (containsRegex (regexFor apats) acct)
 | |
|           pats@(apats,dpats) = parseAccountDescriptionArgs args
 | |
|           startingbalance = nullamt{precision=lprecision l}
 | |
|           showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String]
 | |
|           showTransactionsWithBalances' [] _ _ = []
 | |
|           showTransactionsWithBalances' (t:ts) tprev b =
 | |
|               (if sameentry t tprev
 | |
|                then [showTransactionAndBalance t b']
 | |
|                else [showTransactionDescriptionAndBalance t b'])
 | |
|               ++ (showTransactionsWithBalances' ts t b')
 | |
|                   where 
 | |
|                     b' = b + (amount t)
 | |
|                     sameentry (Transaction e1 _ _ _ _) (Transaction e2 _ _ _ _) = e1 == e2
 | |
| 
 | |
| showTransactionDescriptionAndBalance :: Transaction -> Amount -> String
 | |
| showTransactionDescriptionAndBalance t b =
 | |
|     (showEntryDescription $ Entry (date t) False "" (description t) "" [] "") 
 | |
|     ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
 | |
| 
 | |
| showTransactionAndBalance :: Transaction -> Amount -> String
 | |
| showTransactionAndBalance t b =
 | |
|     (replicate 32 ' ') ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
 | |
| 
 | |
| showBalance :: Amount -> String
 | |
| showBalance b = printf " %12s" (showAmountRoundedOrZero b)
 | |
| 
 |