print command
This commit is contained in:
		
							parent
							
								
									eccc932258
								
							
						
					
					
						commit
						42ba85c4e1
					
				| @ -1,7 +1,5 @@ | |||||||
| module Account | module Account | ||||||
| where | where | ||||||
| import qualified Data.Map as Map |  | ||||||
| 
 |  | ||||||
| import Utils | import Utils | ||||||
| import Types | import Types | ||||||
| import AccountName | import AccountName | ||||||
| @ -9,7 +7,6 @@ import Amount | |||||||
| import Entry | import Entry | ||||||
| import Transaction | import Transaction | ||||||
| import EntryTransaction | import EntryTransaction | ||||||
| import RawLedger |  | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| instance Show Account where | instance Show Account where | ||||||
|  | |||||||
							
								
								
									
										54
									
								
								Entry.hs
									
									
									
									
									
								
							
							
						
						
									
										54
									
								
								Entry.hs
									
									
									
									
									
								
							| @ -4,22 +4,25 @@ where | |||||||
| import Utils | import Utils | ||||||
| import Types | import Types | ||||||
| import Transaction | import Transaction | ||||||
|  | import Amount | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| instance Show Entry where show = showEntry | instance Show Entry where show = showEntryDescription | ||||||
| 
 | 
 | ||||||
|  | -- for register report | ||||||
|  | -- | ||||||
| -- a register entry is displayed as two or more lines like this: | -- a register entry is displayed as two or more lines like this: | ||||||
| -- date       description          account                 amount       balance | -- date       description          account                 amount       balance | ||||||
| -- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA | -- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA | ||||||
| --                                 aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA | --                                 aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA | ||||||
| --                                 ...                     ...         ... | --                                 ...                     ...         ... | ||||||
| -- dateWidth = 10 | -- datewidth = 10 | ||||||
| -- descWidth = 20 | -- descwidth = 20 | ||||||
| -- acctWidth = 22 | -- acctwidth = 22 | ||||||
| -- amtWidth  = 11 | -- amtwidth  = 11 | ||||||
| -- balWidth  = 12 | -- balwidth  = 12 | ||||||
| 
 | 
 | ||||||
| showEntry e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " " | showEntryDescription e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " " | ||||||
| showDate d = printf "%-10s" d | showDate d = printf "%-10s" d | ||||||
| showDescription s = printf "%-20s" (elideRight 20 s) | showDescription s = printf "%-20s" (elideRight 20 s) | ||||||
| 
 | 
 | ||||||
| @ -31,6 +34,43 @@ autofillEntry e = | |||||||
|     Entry (edate e) (estatus e) (ecode e) (edescription e) |     Entry (edate e) (estatus e) (ecode e) (edescription e) | ||||||
|               (autofillTransactions (etransactions e)) |               (autofillTransactions (etransactions e)) | ||||||
| 
 | 
 | ||||||
|  | -- the print command shows cleaned up ledger file entries, something like: | ||||||
|  | -- | ||||||
|  | -- yyyy/mm/dd[ *][ CODE] description.........          [  ; comment.............] | ||||||
|  | --     account name 1.....................  ...$amount1[  ; comment.............] | ||||||
|  | --     account name 2.....................  ..$-amount1[  ; comment.............] | ||||||
|  | -- | ||||||
|  | -- codewidth    = 10 | ||||||
|  | -- descwidth    = 20 | ||||||
|  | -- acctwidth    = 35 | ||||||
|  | -- amtwidth     = 11 | ||||||
|  | -- commentwidth = 20 | ||||||
|  | 
 | ||||||
|  | showEntry :: Entry -> String | ||||||
|  | showEntry e =  | ||||||
|  |     unlines $ ["", description] ++ (showtxns $ etransactions e) | ||||||
|  |     where | ||||||
|  |       description = concat [date, status, code, desc] | ||||||
|  |       date = showDate $ edate e | ||||||
|  |       status = if estatus e then " *" else "" | ||||||
|  |       code = if (length $ ecode e) > 0 then " "++(printf "%-10s" $ ecode e) else "" | ||||||
|  |       desc = " " ++ (elideRight 20 $ edescription e) | ||||||
|  |       showtxns (t1:t2:[]) = [showtxn t1, showtxnnoamt t2] | ||||||
|  |       showtxns ts = map showtxn ts | ||||||
|  |       showtxn t = showacct t ++ "  " ++ (showamount $ tamount t) | ||||||
|  |       showtxnnoamt t = showacct t ++ "             " | ||||||
|  |       showacct t = "    " ++ (showaccountname $ taccount t) | ||||||
|  |       showamount = printf "%11s" . showAmountRounded | ||||||
|  |       showaccountname = printf "%-35s" . elideRight 35 | ||||||
|  | 
 | ||||||
|  | showEntries :: [Entry] -> String | ||||||
|  | showEntries = concatMap showEntry | ||||||
|  | 
 | ||||||
|  | entrySetPrecision :: Int -> Entry -> Entry | ||||||
|  | entrySetPrecision p (Entry d s c desc ts) =  | ||||||
|  |     Entry d s c desc $ map (transactionSetPrecision p) ts | ||||||
|  |                  | ||||||
|  | 
 | ||||||
| -- modifier & periodic entries | -- modifier & periodic entries | ||||||
| 
 | 
 | ||||||
| instance Show ModifierEntry where  | instance Show ModifierEntry where  | ||||||
|  | |||||||
| @ -46,6 +46,8 @@ matchTransactionDescription r t = | |||||||
|       Nothing -> False |       Nothing -> False | ||||||
|       otherwise -> True |       otherwise -> True | ||||||
| 
 | 
 | ||||||
|  | -- for register command  | ||||||
|  | 
 | ||||||
| showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String | showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String | ||||||
| showTransactionsWithBalances [] _ = [] | showTransactionsWithBalances [] _ = [] | ||||||
| showTransactionsWithBalances ts b = | showTransactionsWithBalances ts b = | ||||||
| @ -62,7 +64,7 @@ showTransactionsWithBalances ts b = | |||||||
| 
 | 
 | ||||||
| showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String | showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String | ||||||
| showTransactionDescriptionAndBalance t b = | showTransactionDescriptionAndBalance t b = | ||||||
|     (showEntry $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) |     (showEntryDescription $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) | ||||||
| 
 | 
 | ||||||
| showTransactionAndBalance :: EntryTransaction -> Amount -> String | showTransactionAndBalance :: EntryTransaction -> Amount -> String | ||||||
| showTransactionAndBalance t b = | showTransactionAndBalance t b = | ||||||
| @ -77,4 +79,3 @@ transactionsWithAccountName a ts = [t | t <- ts, account t == a] | |||||||
| transactionsWithOrBelowAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] | transactionsWithOrBelowAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] | ||||||
| transactionsWithOrBelowAccountName a ts =  | transactionsWithOrBelowAccountName a ts =  | ||||||
|     [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)] |     [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)] | ||||||
|      |  | ||||||
|  | |||||||
							
								
								
									
										15
									
								
								Ledger.hs
									
									
									
									
									
								
							
							
						
						
									
										15
									
								
								Ledger.hs
									
									
									
									
									
								
							| @ -11,6 +11,19 @@ import EntryTransaction | |||||||
| import RawLedger | import RawLedger | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
|  | rawLedgerTransactions :: RawLedger -> [EntryTransaction] | ||||||
|  | rawLedgerTransactions l = entryTransactionsFrom $ entries l | ||||||
|  | 
 | ||||||
|  | rawLedgerAccountNamesUsed :: RawLedger -> [AccountName] | ||||||
|  | rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l | ||||||
|  | 
 | ||||||
|  | rawLedgerAccountNames :: RawLedger -> [AccountName] | ||||||
|  | rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed | ||||||
|  | 
 | ||||||
|  | rawLedgerAccountNameTree :: RawLedger -> Tree AccountName | ||||||
|  | rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
| instance Show Ledger where | instance Show Ledger where | ||||||
|     show l = printf "Ledger with %d entries, %d accounts" |     show l = printf "Ledger with %d entries, %d accounts" | ||||||
|              ((length $ entries $ rawledger l) + |              ((length $ entries $ rawledger l) + | ||||||
| @ -18,6 +31,8 @@ instance Show Ledger where | |||||||
|               (length $ periodic_entries $ rawledger l)) |               (length $ periodic_entries $ rawledger l)) | ||||||
|              (length $ accountnames l) |              (length $ accountnames l) | ||||||
| 
 | 
 | ||||||
|  | -- at startup, we augment the parsed ledger entries with an account map | ||||||
|  | -- and other things useful for performance | ||||||
| cacheLedger :: RawLedger -> Ledger | cacheLedger :: RawLedger -> Ledger | ||||||
| cacheLedger l =  | cacheLedger l =  | ||||||
|     let  |     let  | ||||||
|  | |||||||
							
								
								
									
										4
									
								
								Makefile
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Makefile
									
									
									
									
									
								
							| @ -6,7 +6,7 @@ TIME=`date +"%Y%m%d%H%M"` | |||||||
| build: Tags | build: Tags | ||||||
| 	$(BUILD) | 	$(BUILD) | ||||||
| 
 | 
 | ||||||
| buildopt: clean | buildopt opt: clean | ||||||
| 	$(BUILDOPT) | 	$(BUILDOPT) | ||||||
| 
 | 
 | ||||||
| profile: build | profile: build | ||||||
| @ -28,8 +28,10 @@ compare: | |||||||
| 	rm -f 1 2 | 	rm -f 1 2 | ||||||
| 	ledger -s balance >1 | 	ledger -s balance >1 | ||||||
| 	ledger register >>1 | 	ledger register >>1 | ||||||
|  | 	ledger print >>1 | ||||||
| 	./hledger.hs -s balance >2 | 	./hledger.hs -s balance >2 | ||||||
| 	./hledger.hs register >>2 | 	./hledger.hs register >>2 | ||||||
|  | 	./hledger.hs print >>2 | ||||||
| 	diff 1 2 | 	diff 1 2 | ||||||
| 
 | 
 | ||||||
| haddock: | haddock: | ||||||
|  | |||||||
							
								
								
									
										6
									
								
								NOTES
									
									
									
									
									
								
							
							
						
						
									
										6
									
								
								NOTES
									
									
									
									
									
								
							| @ -5,6 +5,7 @@ hledger project notes | |||||||
| *** rename EntryTransaction/Transaction | *** rename EntryTransaction/Transaction | ||||||
| ** ledger features | ** ledger features | ||||||
| *** print command | *** print command | ||||||
|  | **** need to save & print comments | ||||||
| *** handle mixed amounts, non-money currencies | *** handle mixed amounts, non-money currencies | ||||||
| **** handle precision per currency | **** handle precision per currency | ||||||
| *** handle time logs | *** handle time logs | ||||||
| @ -23,8 +24,8 @@ hledger project notes | |||||||
| *** read gnucash files | *** read gnucash files | ||||||
| *** other ledger args, directives | *** other ledger args, directives | ||||||
| ** new features | ** new features | ||||||
| *** simpler timelog format | *** alternate timelog format | ||||||
| *** auto-generate missing clock-out | *** infer clock-out | ||||||
| *** graph automation | *** graph automation | ||||||
| *** entry and smart data entry | *** entry and smart data entry | ||||||
| *** incorporate timeclock features | *** incorporate timeclock features | ||||||
| @ -40,6 +41,7 @@ hledger project notes | |||||||
| *** differences | *** differences | ||||||
| **** ledger shows comments after descriptions as part of description | **** ledger shows comments after descriptions as part of description | ||||||
| **** ledger does not sort register by date | **** ledger does not sort register by date | ||||||
|  | **** ledger does not support -f- (no space) | ||||||
| ** marketing | ** marketing | ||||||
| *** set up as a cabal/hackage project following wiki howto  | *** set up as a cabal/hackage project following wiki howto  | ||||||
|      http://en.wikibooks.org/wiki/Haskell/Packaging |      http://en.wikibooks.org/wiki/Haskell/Packaging | ||||||
|  | |||||||
| @ -9,7 +9,7 @@ import Utils | |||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| usagehdr       = "Usage: hledger [OPTIONS] "++commands++" [ACCTPATTERNS] [-- DESCPATTERNS]\nOptions:" | usagehdr       = "Usage: hledger [OPTIONS] "++commands++" [ACCTPATTERNS] [-- DESCPATTERNS]\nOptions:" | ||||||
| commands       = "register|balance" | commands       = "register|balance|print" | ||||||
| defaultcmd     = "register" | defaultcmd     = "register" | ||||||
| 
 | 
 | ||||||
| options :: [OptDescr Flag] | options :: [OptDescr Flag] | ||||||
|  | |||||||
							
								
								
									
										16
									
								
								RawLedger.hs
									
									
									
									
									
								
							
							
						
						
									
										16
									
								
								RawLedger.hs
									
									
									
									
									
								
							| @ -6,7 +6,6 @@ import Utils | |||||||
| import Types | import Types | ||||||
| import AccountName | import AccountName | ||||||
| import Entry | import Entry | ||||||
| import EntryTransaction |  | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| instance Show RawLedger where | instance Show RawLedger where | ||||||
| @ -14,18 +13,3 @@ instance Show RawLedger where | |||||||
|              ((length $ entries l) + |              ((length $ entries l) + | ||||||
|               (length $ modifier_entries l) + |               (length $ modifier_entries l) + | ||||||
|               (length $ periodic_entries l)) |               (length $ periodic_entries l)) | ||||||
| 
 |  | ||||||
| rawLedgerTransactions :: RawLedger -> [EntryTransaction] |  | ||||||
| rawLedgerTransactions l = entryTransactionsFrom $ entries l |  | ||||||
| 
 |  | ||||||
| rawLedgerAccountNamesUsed :: RawLedger -> [AccountName] |  | ||||||
| rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l |  | ||||||
| 
 |  | ||||||
| rawLedgerAccountNames :: RawLedger -> [AccountName] |  | ||||||
| rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed |  | ||||||
| 
 |  | ||||||
| rawLedgerAccountNameTree :: RawLedger -> Tree AccountName |  | ||||||
| rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
|  | |||||||
| @ -33,3 +33,5 @@ autofillTransactions ts = | |||||||
| sumTransactions :: [Transaction] -> Amount | sumTransactions :: [Transaction] -> Amount | ||||||
| sumTransactions = sum . map tamount | sumTransactions = sum . map tamount | ||||||
| 
 | 
 | ||||||
|  | transactionSetPrecision :: Int -> Transaction -> Transaction | ||||||
|  | transactionSetPrecision p (Transaction a amt) = Transaction a amt{precision=p} | ||||||
|  | |||||||
							
								
								
									
										17
									
								
								hledger.hs
									
									
									
									
									
								
							
							
						
						
									
										17
									
								
								hledger.hs
									
									
									
									
									
								
							| @ -28,6 +28,7 @@ main = do | |||||||
|             | Help `elem` opts            = putStr usage |             | Help `elem` opts            = putStr usage | ||||||
|             | cmd `isPrefixOf` "register" = register opts acctpats descpats |             | cmd `isPrefixOf` "register" = register opts acctpats descpats | ||||||
|             | cmd `isPrefixOf` "balance"  = balance opts acctpats descpats |             | cmd `isPrefixOf` "balance"  = balance opts acctpats descpats | ||||||
|  |             | cmd `isPrefixOf` "print"    = printcmd opts | ||||||
|             | cmd `isPrefixOf` "test"     = test |             | cmd `isPrefixOf` "test"     = test | ||||||
|             | otherwise                   = putStr usage |             | otherwise                   = putStr usage | ||||||
| 
 | 
 | ||||||
| @ -41,18 +42,26 @@ test = do | |||||||
| 
 | 
 | ||||||
| register :: [Flag] -> [String] -> [String] -> IO () | register :: [Flag] -> [String] -> [String] -> IO () | ||||||
| register opts acctpats descpats = do  | register opts acctpats descpats = do  | ||||||
|   doWithLedger opts printRegister |   doWithLedger opts printregister | ||||||
|     where  |     where  | ||||||
|       printRegister l =  |       printregister l =  | ||||||
|           putStr $ showTransactionsWithBalances  |           putStr $ showTransactionsWithBalances  | ||||||
|                      (sortBy (comparing date) (ledgerTransactionsMatching (acctpats,descpats) l)) |                      (sortBy (comparing date) (ledgerTransactionsMatching (acctpats,descpats) l)) | ||||||
|                      nullamt{precision=lprecision l} |                      nullamt{precision=lprecision l} | ||||||
| 
 | 
 | ||||||
|  | printcmd :: [Flag] -> IO () | ||||||
|  | printcmd opts = do  | ||||||
|  |   doWithLedger opts printentries | ||||||
|  |     where | ||||||
|  |       printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l | ||||||
|  |           where | ||||||
|  |             setprecision = map (entrySetPrecision (lprecision l)) | ||||||
|  | 
 | ||||||
| balance :: [Flag] -> [String] -> [String] -> IO () | balance :: [Flag] -> [String] -> [String] -> IO () | ||||||
| balance opts acctpats _ = do  | balance opts acctpats _ = do  | ||||||
|   doWithLedger opts printBalance |   doWithLedger opts printbalance | ||||||
|     where |     where | ||||||
|       printBalance l = |       printbalance l = | ||||||
|           putStr $ showLedgerAccounts l acctpats showsubs maxdepth |           putStr $ showLedgerAccounts l acctpats showsubs maxdepth | ||||||
|               where  |               where  | ||||||
|                 showsubs = (ShowSubs `elem` opts) |                 showsubs = (ShowSubs `elem` opts) | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user