rename LedgerTransaction to Transaction
This commit is contained in:
		
							parent
							
								
									39fd143c84
								
							
						
					
					
						commit
						30b83bb105
					
				| @ -35,11 +35,11 @@ add _ args l | |||||||
| -- command-line arguments are used as the first transaction's description. | -- command-line arguments are used as the first transaction's description. | ||||||
| getAndAddTransactions :: Ledger -> [String] -> IO () | getAndAddTransactions :: Ledger -> [String] -> IO () | ||||||
| getAndAddTransactions l args = do | getAndAddTransactions l args = do | ||||||
|   l <- getTransaction l args >>= addTransaction l |   l <- getTransaction l args >>= ledgerAddTransaction l | ||||||
|   getAndAddTransactions l [] |   getAndAddTransactions l [] | ||||||
| 
 | 
 | ||||||
| -- | Read a transaction from the command line, with history-aware prompting. | -- | Read a transaction from the command line, with history-aware prompting. | ||||||
| getTransaction :: Ledger -> [String] -> IO LedgerTransaction | getTransaction :: Ledger -> [String] -> IO Transaction | ||||||
| getTransaction l args = do | getTransaction l args = do | ||||||
|   today <- getCurrentDay |   today <- getCurrentDay | ||||||
|   datestr <- askFor "date"  |   datestr <- askFor "date"  | ||||||
| @ -67,7 +67,7 @@ getTransaction l args = do | |||||||
|             retry = do |             retry = do | ||||||
|               hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:" |               hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:" | ||||||
|               getpostingsandvalidate |               getpostingsandvalidate | ||||||
|         either (const retry) return $ balanceLedgerTransaction t |         either (const retry) return $ balanceTransaction t | ||||||
|   unless (null historymatches)  |   unless (null historymatches)  | ||||||
|        (do |        (do | ||||||
|          hPutStrLn stderr "Similar transactions found, using the first for defaults:\n" |          hPutStrLn stderr "Similar transactions found, using the first for defaults:\n" | ||||||
| @ -125,8 +125,8 @@ askFor prompt def validator = do | |||||||
| -- | Append this transaction to the ledger's file. Also, to the ledger's | -- | Append this transaction to the ledger's file. Also, to the ledger's | ||||||
| -- transaction list, but we don't bother updating the other fields - this | -- transaction list, but we don't bother updating the other fields - this | ||||||
| -- is enough to include new transactions in the history matching. | -- is enough to include new transactions in the history matching. | ||||||
| addTransaction :: Ledger -> LedgerTransaction -> IO Ledger | ledgerAddTransaction :: Ledger -> Transaction -> IO Ledger | ||||||
| addTransaction l t = do | ledgerAddTransaction l t = do | ||||||
|   appendToLedgerFile l $ show t |   appendToLedgerFile l $ show t | ||||||
|   putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l) |   putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l) | ||||||
|   putStrLn =<< registerFromString (show t) |   putStrLn =<< registerFromString (show t) | ||||||
| @ -181,7 +181,7 @@ compareLedgerDescriptions s t = compareStrings s' t' | |||||||
|           t' = simplify t |           t' = simplify t | ||||||
|           simplify = filter (not . (`elem` "0123456789")) |           simplify = filter (not . (`elem` "0123456789")) | ||||||
| 
 | 
 | ||||||
| transactionsSimilarTo :: Ledger -> String -> [(Double,LedgerTransaction)] | transactionsSimilarTo :: Ledger -> String -> [(Double,Transaction)] | ||||||
| transactionsSimilarTo l s = | transactionsSimilarTo l s = | ||||||
|     sortBy compareRelevanceAndRecency |     sortBy compareRelevanceAndRecency | ||||||
|                $ filter ((> threshold).fst) |                $ filter ((> threshold).fst) | ||||||
|  | |||||||
| @ -6,7 +6,7 @@ format, and print it on stdout. See the manual for more details. | |||||||
| module Commands.Convert where | module Commands.Convert where | ||||||
| import Options (Opt(Debug)) | import Options (Opt(Debug)) | ||||||
| import Version (versionstr) | import Version (versionstr) | ||||||
| import Ledger.Types (Ledger,AccountName,LedgerTransaction(..),Posting(..),PostingType(..)) | import Ledger.Types (Ledger,AccountName,Transaction(..),Posting(..),PostingType(..)) | ||||||
| import Ledger.Utils (strip, spacenonewline, restofline) | import Ledger.Utils (strip, spacenonewline, restofline) | ||||||
| import Ledger.Parse (someamount, emptyCtx, ledgeraccountname) | import Ledger.Parse (someamount, emptyCtx, ledgeraccountname) | ||||||
| import Ledger.Amount (nullmixedamt) | import Ledger.Amount (nullmixedamt) | ||||||
| @ -237,7 +237,7 @@ printTxn debug rules rec = do | |||||||
| 
 | 
 | ||||||
| -- csv record conversion | -- csv record conversion | ||||||
| 
 | 
 | ||||||
| transactionFromCsvRecord :: CsvRules -> CsvRecord -> LedgerTransaction | transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction | ||||||
| transactionFromCsvRecord rules fields = | transactionFromCsvRecord rules fields = | ||||||
|   let  |   let  | ||||||
|       date = parsedate $ normaliseDate $ maybe "1900/1/1" (fields !!) (dateField rules) |       date = parsedate $ normaliseDate $ maybe "1900/1/1" (fields !!) (dateField rules) | ||||||
| @ -257,7 +257,7 @@ transactionFromCsvRecord rules fields = | |||||||
|                   | otherwise = "expenses:unknown" |                   | otherwise = "expenses:unknown" | ||||||
|       (acct,newdesc) = identify (accountRules rules) unknownacct desc |       (acct,newdesc) = identify (accountRules rules) unknownacct desc | ||||||
|   in |   in | ||||||
|     LedgerTransaction { |     Transaction { | ||||||
|               ltdate=date, |               ltdate=date, | ||||||
|               lteffectivedate=Nothing, |               lteffectivedate=Nothing, | ||||||
|               ltstatus=status, |               ltstatus=status, | ||||||
|  | |||||||
| @ -14,10 +14,10 @@ import System.IO.UTF8 | |||||||
| 
 | 
 | ||||||
| -- | Print ledger transactions in standard format. | -- | Print ledger transactions in standard format. | ||||||
| print' :: [Opt] -> [String] -> Ledger -> IO () | print' :: [Opt] -> [String] -> Ledger -> IO () | ||||||
| print' opts args = putStr . showLedgerTransactions opts args | print' opts args = putStr . showTransactions opts args | ||||||
| 
 | 
 | ||||||
| showLedgerTransactions :: [Opt] -> [String] -> Ledger -> String | showTransactions :: [Opt] -> [String] -> Ledger -> String | ||||||
| showLedgerTransactions opts args l = concatMap (showLedgerTransactionForPrint effective) txns | showTransactions opts args l = concatMap (showTransactionForPrint effective) txns | ||||||
|     where  |     where  | ||||||
|       txns = sortBy (comparing ltdate) $ |       txns = sortBy (comparing ltdate) $ | ||||||
|                ledger_txns $  |                ledger_txns $  | ||||||
|  | |||||||
| @ -221,7 +221,7 @@ updateData a@AppState{aopts=opts,aargs=args,aledger=l} = | |||||||
|     case screen a of |     case screen a of | ||||||
|       BalanceScreen  -> a{abuf=lines $ showBalanceReport opts [] l, aargs=[]} |       BalanceScreen  -> a{abuf=lines $ showBalanceReport opts [] l, aargs=[]} | ||||||
|       RegisterScreen -> a{abuf=lines $ showRegisterReport opts args l} |       RegisterScreen -> a{abuf=lines $ showRegisterReport opts args l} | ||||||
|       PrintScreen    -> a{abuf=lines $ showLedgerTransactions opts args l} |       PrintScreen    -> a{abuf=lines $ showTransactions opts args l} | ||||||
| 
 | 
 | ||||||
| backout :: AppState -> AppState | backout :: AppState -> AppState | ||||||
| backout a | screen a == BalanceScreen = a | backout a | screen a == BalanceScreen = a | ||||||
| @ -231,9 +231,9 @@ drilldown :: AppState -> AppState | |||||||
| drilldown a = | drilldown a = | ||||||
|     case screen a of |     case screen a of | ||||||
|       BalanceScreen  -> enter RegisterScreen a{aargs=[currentAccountName a]} |       BalanceScreen  -> enter RegisterScreen a{aargs=[currentAccountName a]} | ||||||
|       RegisterScreen -> scrollToLedgerTransaction e $ enter PrintScreen a |       RegisterScreen -> scrollToTransaction e $ enter PrintScreen a | ||||||
|       PrintScreen   -> a |       PrintScreen   -> a | ||||||
|     where e = currentLedgerTransaction a |     where e = currentTransaction a | ||||||
| 
 | 
 | ||||||
| -- | Get the account name currently highlighted by the cursor on the | -- | Get the account name currently highlighted by the cursor on the | ||||||
| -- balance screen. Results undefined while on other screens. | -- balance screen. Results undefined while on other screens. | ||||||
| @ -260,10 +260,10 @@ accountNameAt buf lineno = accountNameFromComponents anamecomponents | |||||||
| 
 | 
 | ||||||
| -- | If on the print screen, move the cursor to highlight the specified entry | -- | If on the print screen, move the cursor to highlight the specified entry | ||||||
| -- (or a reasonable guess). Doesn't work. | -- (or a reasonable guess). Doesn't work. | ||||||
| scrollToLedgerTransaction :: LedgerTransaction -> AppState -> AppState | scrollToTransaction :: Transaction -> AppState -> AppState | ||||||
| scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a | scrollToTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a | ||||||
|     where |     where | ||||||
|       entryfirstline = head $ lines $ showLedgerTransaction e |       entryfirstline = head $ lines $ showTransaction e | ||||||
|       halfph = pageHeight a `div` 2 |       halfph = pageHeight a `div` 2 | ||||||
|       y = fromMaybe 0 $ findIndex (== entryfirstline) buf |       y = fromMaybe 0 $ findIndex (== entryfirstline) buf | ||||||
|       sy = max 0 $ y - halfph |       sy = max 0 $ y - halfph | ||||||
| @ -272,8 +272,8 @@ scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy | |||||||
| -- | Get the entry containing the transaction currently highlighted by the | -- | Get the entry containing the transaction currently highlighted by the | ||||||
| -- cursor on the register screen (or best guess). Results undefined while | -- cursor on the register screen (or best guess). Results undefined while | ||||||
| -- on other screens. Doesn't work. | -- on other screens. Doesn't work. | ||||||
| currentLedgerTransaction :: AppState -> LedgerTransaction | currentTransaction :: AppState -> Transaction | ||||||
| currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t | currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t | ||||||
|     where |     where | ||||||
|       t = safehead nulltxn $ filter ismatch $ ledgerLedgerPostings l |       t = safehead nulltxn $ filter ismatch $ ledgerLedgerPostings l | ||||||
|       ismatch t = tdate t == parsedate (take 10 datedesc) |       ismatch t = tdate t == parsedate (take 10 datedesc) | ||||||
| @ -286,7 +286,7 @@ currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingL | |||||||
| 
 | 
 | ||||||
| -- | Get the entry which contains the given transaction. | -- | Get the entry which contains the given transaction. | ||||||
| -- Will raise an error if there are problems. | -- Will raise an error if there are problems. | ||||||
| transactionContainingLedgerPosting :: AppState -> LedgerPosting -> LedgerTransaction | transactionContainingLedgerPosting :: AppState -> LedgerPosting -> Transaction | ||||||
| transactionContainingLedgerPosting AppState{aledger=l} t = ledger_txns (journal l) !! tnum t | transactionContainingLedgerPosting AppState{aledger=l} t = ledger_txns (journal l) !! tnum t | ||||||
| 
 | 
 | ||||||
| -- renderers | -- renderers | ||||||
|  | |||||||
| @ -36,7 +36,7 @@ import qualified Hack.Contrib.Request (inputs, params, path) | |||||||
| import qualified Hack.Contrib.Response (redirect) | import qualified Hack.Contrib.Response (redirect) | ||||||
| -- import qualified Text.XHtml.Strict as H | -- import qualified Text.XHtml.Strict as H | ||||||
| 
 | 
 | ||||||
| import Commands.Add (addTransaction) | import Commands.Add (ledgerAddTransaction) | ||||||
| import Commands.Balance | import Commands.Balance | ||||||
| import Commands.Histogram | import Commands.Histogram | ||||||
| import Commands.Print | import Commands.Print | ||||||
| @ -131,7 +131,7 @@ server opts args l = | |||||||
|           get  "/balance"   $ command [] showBalanceReport   -- String -> ReaderT Env (StateT Response IO) () -> State Loli () |           get  "/balance"   $ command [] showBalanceReport   -- String -> ReaderT Env (StateT Response IO) () -> State Loli () | ||||||
|           get  "/register"  $ command [] showRegisterReport |           get  "/register"  $ command [] showRegisterReport | ||||||
|           get  "/histogram" $ command [] showHistogram |           get  "/histogram" $ command [] showHistogram | ||||||
|           get  "/transactions"   $ ledgerpage [] l'' (showLedgerTransactions opts' args') |           get  "/transactions"   $ ledgerpage [] l'' (showTransactions opts' args') | ||||||
|           post "/transactions"   $ handleAddform l'' |           post "/transactions"   $ handleAddform l'' | ||||||
|           get  "/env"       $ getenv >>= (text . show) |           get  "/env"       $ getenv >>= (text . show) | ||||||
|           get  "/params"    $ getenv >>= (text . show . Hack.Contrib.Request.params) |           get  "/params"    $ getenv >>= (text . show . Hack.Contrib.Request.params) | ||||||
| @ -280,7 +280,7 @@ handleAddform l = do | |||||||
|   d <- io getCurrentDay |   d <- io getCurrentDay | ||||||
|   handle $ validate env d |   handle $ validate env d | ||||||
|   where |   where | ||||||
|     validate :: Hack.Env -> Day -> Failing LedgerTransaction |     validate :: Hack.Env -> Day -> Failing Transaction | ||||||
|     validate env today = |     validate env today = | ||||||
|         let inputs = Hack.Contrib.Request.inputs env |         let inputs = Hack.Contrib.Request.inputs env | ||||||
|             date  = fromMaybe "" $ lookup "date"  inputs |             date  = fromMaybe "" $ lookup "date"  inputs | ||||||
| @ -302,7 +302,7 @@ handleAddform l = do | |||||||
|             validateAmt2 _   = [] |             validateAmt2 _   = [] | ||||||
|             amt1' = either (const missingamt) id $ parse someamount "" amt1 |             amt1' = either (const missingamt) id $ parse someamount "" amt1 | ||||||
|             amt2' = either (const missingamt) id $ parse someamount "" amt2 |             amt2' = either (const missingamt) id $ parse someamount "" amt2 | ||||||
|             t = LedgerTransaction { |             t = Transaction { | ||||||
|                             ltdate = parsedate $ fixSmartDateStr today date |                             ltdate = parsedate $ fixSmartDateStr today date | ||||||
|                            ,lteffectivedate=Nothing |                            ,lteffectivedate=Nothing | ||||||
|                            ,ltstatus=False |                            ,ltstatus=False | ||||||
| @ -315,7 +315,7 @@ handleAddform l = do | |||||||
|                             ] |                             ] | ||||||
|                            ,ltpreceding_comment_lines="" |                            ,ltpreceding_comment_lines="" | ||||||
|                            } |                            } | ||||||
|             (t', berr) = case balanceLedgerTransaction t of |             (t', berr) = case balanceTransaction t of | ||||||
|                            Right t'' -> (t'', []) |                            Right t'' -> (t'', []) | ||||||
|                            Left e -> (t, [e]) |                            Left e -> (t, [e]) | ||||||
|             errs = concat [ |             errs = concat [ | ||||||
| @ -331,10 +331,10 @@ handleAddform l = do | |||||||
|           False -> Failure errs |           False -> Failure errs | ||||||
|           True  -> Success t' |           True  -> Success t' | ||||||
| 
 | 
 | ||||||
|     handle :: Failing LedgerTransaction -> AppUnit |     handle :: Failing Transaction -> AppUnit | ||||||
|     handle (Failure errs) = hsp errs addform  |     handle (Failure errs) = hsp errs addform  | ||||||
|     handle (Success t)    = do |     handle (Success t)    = do | ||||||
|                     io $ addTransaction l t >> reload l |                     io $ ledgerAddTransaction l t >> reload l | ||||||
|                     ledgerpage [msg] l (showLedgerTransactions [] []) |                     ledgerpage [msg] l (showTransactions [] []) | ||||||
|        where msg = printf "Added transaction:\n%s" (show t) |        where msg = printf "Added transaction:\n%s" (show t) | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -13,7 +13,7 @@ module Ledger ( | |||||||
|                module Ledger.Commodity, |                module Ledger.Commodity, | ||||||
|                module Ledger.Dates, |                module Ledger.Dates, | ||||||
|                module Ledger.IO, |                module Ledger.IO, | ||||||
|                module Ledger.LedgerTransaction, |                module Ledger.Transaction, | ||||||
|                module Ledger.Ledger, |                module Ledger.Ledger, | ||||||
|                module Ledger.Parse, |                module Ledger.Parse, | ||||||
|                module Ledger.Journal, |                module Ledger.Journal, | ||||||
| @ -30,7 +30,7 @@ import Ledger.Amount | |||||||
| import Ledger.Commodity | import Ledger.Commodity | ||||||
| import Ledger.Dates | import Ledger.Dates | ||||||
| import Ledger.IO | import Ledger.IO | ||||||
| import Ledger.LedgerTransaction | import Ledger.Transaction | ||||||
| import Ledger.Ledger | import Ledger.Ledger | ||||||
| import Ledger.Parse | import Ledger.Parse | ||||||
| import Ledger.Journal | import Ledger.Journal | ||||||
|  | |||||||
| @ -13,7 +13,7 @@ import Ledger.Utils | |||||||
| import Ledger.Types | import Ledger.Types | ||||||
| import Ledger.AccountName | import Ledger.AccountName | ||||||
| import Ledger.Amount | import Ledger.Amount | ||||||
| import Ledger.LedgerTransaction (ledgerTransactionWithDate) | import Ledger.Transaction (ledgerTransactionWithDate) | ||||||
| import Ledger.LedgerPosting | import Ledger.LedgerPosting | ||||||
| import Ledger.Posting | import Ledger.Posting | ||||||
| import Ledger.TimeLog | import Ledger.TimeLog | ||||||
| @ -40,8 +40,8 @@ journalEmpty = Journal { modifier_txns = [] | |||||||
|                            , filereadtime = TOD 0 0 |                            , filereadtime = TOD 0 0 | ||||||
|                            } |                            } | ||||||
| 
 | 
 | ||||||
| addLedgerTransaction :: LedgerTransaction -> Journal -> Journal | addTransaction :: Transaction -> Journal -> Journal | ||||||
| addLedgerTransaction t l0 = l0 { ledger_txns = t : ledger_txns l0 } | addTransaction t l0 = l0 { ledger_txns = t : ledger_txns l0 } | ||||||
| 
 | 
 | ||||||
| addModifierTransaction :: ModifierTransaction -> Journal -> Journal | addModifierTransaction :: ModifierTransaction -> Journal -> Journal | ||||||
| addModifierTransaction mt l0 = l0 { modifier_txns = mt : modifier_txns l0 } | addModifierTransaction mt l0 = l0 { modifier_txns = mt : modifier_txns l0 } | ||||||
| @ -57,7 +57,7 @@ addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries | |||||||
| 
 | 
 | ||||||
| journalLedgerPostings :: Journal -> [LedgerPosting] | journalLedgerPostings :: Journal -> [LedgerPosting] | ||||||
| journalLedgerPostings = txnsof . ledger_txns | journalLedgerPostings = txnsof . ledger_txns | ||||||
|     where txnsof ts = concatMap flattenLedgerTransaction $ zip ts [1..] |     where txnsof ts = concatMap flattenTransaction $ zip ts [1..] | ||||||
| 
 | 
 | ||||||
| journalAccountNamesUsed :: Journal -> [AccountName] | journalAccountNamesUsed :: Journal -> [AccountName] | ||||||
| journalAccountNamesUsed = accountNamesFromLedgerPostings . journalLedgerPostings | journalAccountNamesUsed = accountNamesFromLedgerPostings . journalLedgerPostings | ||||||
| @ -75,20 +75,20 @@ filterJournal :: DateSpan -> [String] -> Maybe Bool -> Bool -> Journal -> Journa | |||||||
| filterJournal span pats clearedonly realonly = | filterJournal span pats clearedonly realonly = | ||||||
|     filterJournalPostingsByRealness realonly . |     filterJournalPostingsByRealness realonly . | ||||||
|     filterJournalPostingsByClearedStatus clearedonly . |     filterJournalPostingsByClearedStatus clearedonly . | ||||||
|     filterJournalLedgerTransactionsByDate span . |     filterJournalTransactionsByDate span . | ||||||
|     filterJournalLedgerTransactionsByDescription pats |     filterJournalTransactionsByDescription pats | ||||||
| 
 | 
 | ||||||
| -- | Keep only ledger transactions whose description matches the description patterns. | -- | Keep only ledger transactions whose description matches the description patterns. | ||||||
| filterJournalLedgerTransactionsByDescription :: [String] -> Journal -> Journal | filterJournalTransactionsByDescription :: [String] -> Journal -> Journal | ||||||
| filterJournalLedgerTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = | filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = | ||||||
|     Journal ms ps (filter matchdesc ts) tls hs f fp ft |     Journal ms ps (filter matchdesc ts) tls hs f fp ft | ||||||
|     where matchdesc = matchpats pats . ltdescription |     where matchdesc = matchpats pats . ltdescription | ||||||
| 
 | 
 | ||||||
| -- | Keep only ledger transactions which fall between begin and end dates. | -- | Keep only ledger transactions which fall between begin and end dates. | ||||||
| -- We include transactions on the begin date and exclude transactions on the end | -- We include transactions on the begin date and exclude transactions on the end | ||||||
| -- date, like ledger.  An empty date string means no restriction. | -- date, like ledger.  An empty date string means no restriction. | ||||||
| filterJournalLedgerTransactionsByDate :: DateSpan -> Journal -> Journal | filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal | ||||||
| filterJournalLedgerTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = | filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = | ||||||
|     Journal ms ps (filter matchdate ts) tls hs f fp ft |     Journal ms ps (filter matchdate ts) tls hs f fp ft | ||||||
|     where |     where | ||||||
|       matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end |       matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end | ||||||
| @ -106,14 +106,14 @@ filterJournalPostingsByRealness :: Bool -> Journal -> Journal | |||||||
| filterJournalPostingsByRealness False l = l | filterJournalPostingsByRealness False l = l | ||||||
| filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) = | filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) = | ||||||
|     Journal mts pts (map filtertxns ts) tls hs f fp ft |     Journal mts pts (map filtertxns ts) tls hs f fp ft | ||||||
|     where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps} |     where filtertxns t@Transaction{ltpostings=ps} = t{ltpostings=filter isReal ps} | ||||||
| 
 | 
 | ||||||
| -- | Strip out any postings to accounts deeper than the specified depth | -- | Strip out any postings to accounts deeper than the specified depth | ||||||
| -- (and any ledger transactions which have no postings as a result). | -- (and any ledger transactions which have no postings as a result). | ||||||
| filterJournalPostingsByDepth :: Int -> Journal -> Journal | filterJournalPostingsByDepth :: Int -> Journal -> Journal | ||||||
| filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) = | filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) = | ||||||
|     Journal mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp ft |     Journal mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp ft | ||||||
|     where filtertxns t@LedgerTransaction{ltpostings=ps} = |     where filtertxns t@Transaction{ltpostings=ps} = | ||||||
|               t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} |               t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} | ||||||
| 
 | 
 | ||||||
| -- | Keep only ledger transactions which affect accounts matched by the account patterns. | -- | Keep only ledger transactions which affect accounts matched by the account patterns. | ||||||
| @ -138,7 +138,7 @@ journalSelectingDate EffectiveDate rl = | |||||||
| canonicaliseAmounts :: Bool -> Journal -> Journal | canonicaliseAmounts :: Bool -> Journal -> Journal | ||||||
| canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft | canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft | ||||||
|     where |     where | ||||||
|       fixledgertransaction (LedgerTransaction d ed s c de co ts pr) = LedgerTransaction d ed s c de co (map fixrawposting ts) pr |       fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr | ||||||
|           where |           where | ||||||
|             fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t |             fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t | ||||||
|             fixmixedamount (Mixed as) = Mixed $ map fixamount as |             fixmixedamount (Mixed as) = Mixed $ map fixamount as | ||||||
|  | |||||||
| @ -2,7 +2,7 @@ | |||||||
| 
 | 
 | ||||||
| A compound data type for efficiency. A 'Ledger' caches information derived | A compound data type for efficiency. A 'Ledger' caches information derived | ||||||
| from a 'Journal' for easier querying. Also it typically has had | from a 'Journal' for easier querying. Also it typically has had | ||||||
| uninteresting 'LedgerTransaction's and 'Posting's filtered out. It | uninteresting 'Transaction's and 'Posting's filtered out. It | ||||||
| contains: | contains: | ||||||
| 
 | 
 | ||||||
| - the original unfiltered 'Journal' | - the original unfiltered 'Journal' | ||||||
|  | |||||||
| @ -1,7 +1,7 @@ | |||||||
| {-| | {-| | ||||||
| 
 | 
 | ||||||
| A compound data type for efficiency. A 'LedgerPosting' is a 'Posting' with | A compound data type for efficiency. A 'LedgerPosting' is a 'Posting' with | ||||||
| its parent 'LedgerTransaction' \'s date and description attached. The | its parent 'Transaction' \'s date and description attached. The | ||||||
| \"transaction\" term is pretty ingrained in the code, docs and with users, | \"transaction\" term is pretty ingrained in the code, docs and with users, | ||||||
| so we've kept it. These are what we work with most of the time when doing | so we've kept it. These are what we work with most of the time when doing | ||||||
| reports. | reports. | ||||||
| @ -13,7 +13,7 @@ where | |||||||
| import Ledger.Dates | import Ledger.Dates | ||||||
| import Ledger.Utils | import Ledger.Utils | ||||||
| import Ledger.Types | import Ledger.Types | ||||||
| import Ledger.LedgerTransaction (showAccountName) | import Ledger.Transaction (showAccountName) | ||||||
| import Ledger.Amount | import Ledger.Amount | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| @ -25,11 +25,11 @@ showLedgerPosting (LedgerPosting _ stat d desc a amt ttype) = | |||||||
|     where s = if stat then " *" else "" |     where s = if stat then " *" else "" | ||||||
|           a' = showAccountName Nothing ttype a |           a' = showAccountName Nothing ttype a | ||||||
| 
 | 
 | ||||||
| -- | Convert a 'LedgerTransaction' to two or more 'LedgerPosting's. An id number | -- | Convert a 'Transaction' to two or more 'LedgerPosting's. An id number | ||||||
| -- is attached to the transactions to preserve their grouping - it should | -- is attached to the transactions to preserve their grouping - it should | ||||||
| -- be unique per entry. | -- be unique per entry. | ||||||
| flattenLedgerTransaction :: (LedgerTransaction, Int) -> [LedgerPosting] | flattenTransaction :: (Transaction, Int) -> [LedgerPosting] | ||||||
| flattenLedgerTransaction (LedgerTransaction d _ s _ desc _ ps _, n) =  | flattenTransaction (Transaction d _ s _ desc _ ps _, n) =  | ||||||
|     [LedgerPosting n s d desc (paccount p) (pamount p) (ptype p) | p <- ps] |     [LedgerPosting n s d desc (paccount p) (pamount p) (ptype p) | p <- ps] | ||||||
| 
 | 
 | ||||||
| accountNamesFromLedgerPostings :: [LedgerPosting] -> [AccountName] | accountNamesFromLedgerPostings :: [LedgerPosting] -> [AccountName] | ||||||
|  | |||||||
| @ -18,7 +18,7 @@ import Ledger.Types | |||||||
| import Ledger.Dates | import Ledger.Dates | ||||||
| import Ledger.AccountName (accountNameFromComponents,accountNameComponents) | import Ledger.AccountName (accountNameFromComponents,accountNameComponents) | ||||||
| import Ledger.Amount | import Ledger.Amount | ||||||
| import Ledger.LedgerTransaction | import Ledger.Transaction | ||||||
| import Ledger.Posting | import Ledger.Posting | ||||||
| import Ledger.Journal | import Ledger.Journal | ||||||
| import System.FilePath(takeDirectory,combine) | import System.FilePath(takeDirectory,combine) | ||||||
| @ -86,7 +86,7 @@ ledgerFile = do items <- many ledgerItem | |||||||
|       -- character, excepting transactions versus empty (blank or |       -- character, excepting transactions versus empty (blank or | ||||||
|       -- comment-only) lines, can use choice w/o try |       -- comment-only) lines, can use choice w/o try | ||||||
|       ledgerItem = choice [ ledgerDirective |       ledgerItem = choice [ ledgerDirective | ||||||
|                           , liftM (return . addLedgerTransaction) ledgerTransaction |                           , liftM (return . addTransaction) ledgerTransaction | ||||||
|                           , liftM (return . addModifierTransaction) ledgerModifierTransaction |                           , liftM (return . addModifierTransaction) ledgerModifierTransaction | ||||||
|                           , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction |                           , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction | ||||||
|                           , liftM (return . addHistoricalPrice) ledgerHistoricalPrice |                           , liftM (return . addHistoricalPrice) ledgerHistoricalPrice | ||||||
| @ -307,7 +307,7 @@ ledgerDefaultYear = do | |||||||
| 
 | 
 | ||||||
| -- | Try to parse a ledger entry. If we successfully parse an entry, ensure it is balanced, | -- | Try to parse a ledger entry. If we successfully parse an entry, ensure it is balanced, | ||||||
| -- and if we cannot, raise an error. | -- and if we cannot, raise an error. | ||||||
| ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction | ledgerTransaction :: GenParser Char LedgerFileCtx Transaction | ||||||
| ledgerTransaction = do | ledgerTransaction = do | ||||||
|   date <- ledgerdate <?> "transaction" |   date <- ledgerdate <?> "transaction" | ||||||
|   edate <- try (ledgereffectivedate <?> "effective date") <|> return Nothing |   edate <- try (ledgereffectivedate <?> "effective date") <|> return Nothing | ||||||
| @ -317,8 +317,8 @@ ledgerTransaction = do | |||||||
|   comment <- ledgercomment <|> return "" |   comment <- ledgercomment <|> return "" | ||||||
|   restofline |   restofline | ||||||
|   postings <- ledgerpostings |   postings <- ledgerpostings | ||||||
|   let t = LedgerTransaction date edate status code description comment postings "" |   let t = Transaction date edate status code description comment postings "" | ||||||
|   case balanceLedgerTransaction t of |   case balanceTransaction t of | ||||||
|     Right t' -> return t' |     Right t' -> return t' | ||||||
|     Left err -> fail err |     Left err -> fail err | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -1,7 +1,7 @@ | |||||||
| {-| | {-| | ||||||
| 
 | 
 | ||||||
| A 'Posting' represents a 'MixedAmount' being added to or subtracted from a | A 'Posting' represents a 'MixedAmount' being added to or subtracted from a | ||||||
| single 'Account'.  Each 'LedgerTransaction' contains two or more postings | single 'Account'.  Each 'Transaction' contains two or more postings | ||||||
| which should add up to 0.   | which should add up to 0.   | ||||||
| 
 | 
 | ||||||
| Generally, we use these with the ledger transaction's date and description | Generally, we use these with the ledger transaction's date and description | ||||||
|  | |||||||
| @ -2,7 +2,7 @@ | |||||||
| 
 | 
 | ||||||
| A 'TimeLogEntry' is a clock-in, clock-out, or other directive in a timelog | A 'TimeLogEntry' is a clock-in, clock-out, or other directive in a timelog | ||||||
| file (see timeclock.el or the command-line version). These can be | file (see timeclock.el or the command-line version). These can be | ||||||
| converted to 'LedgerTransactions' and queried like a ledger. | converted to 'Transactions' and queried like a ledger. | ||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
| @ -12,7 +12,7 @@ import Ledger.Utils | |||||||
| import Ledger.Types | import Ledger.Types | ||||||
| import Ledger.Dates | import Ledger.Dates | ||||||
| import Ledger.Commodity | import Ledger.Commodity | ||||||
| import Ledger.LedgerTransaction | import Ledger.Transaction | ||||||
| 
 | 
 | ||||||
| instance Show TimeLogEntry where  | instance Show TimeLogEntry where  | ||||||
|     show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t) |     show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t) | ||||||
| @ -35,7 +35,7 @@ instance Read TimeLogCode where | |||||||
| -- | Convert time log entries to ledger transactions. When there is no | -- | Convert time log entries to ledger transactions. When there is no | ||||||
| -- clockout, add one with the provided current time. Sessions crossing | -- clockout, add one with the provided current time. Sessions crossing | ||||||
| -- midnight are split into days to give accurate per-day totals. | -- midnight are split into days to give accurate per-day totals. | ||||||
| entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [LedgerTransaction] | entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Transaction] | ||||||
| entriesFromTimeLogEntries _ [] = [] | entriesFromTimeLogEntries _ [] = [] | ||||||
| entriesFromTimeLogEntries now [i] | entriesFromTimeLogEntries now [i] | ||||||
|     | odate > idate = entryFromTimeLogInOut i o' : entriesFromTimeLogEntries now [i',o] |     | odate > idate = entryFromTimeLogInOut i o' : entriesFromTimeLogEntries now [i',o] | ||||||
| @ -59,13 +59,13 @@ entriesFromTimeLogEntries now (i:o:rest) | |||||||
| -- | Convert a timelog clockin and clockout entry to an equivalent ledger | -- | Convert a timelog clockin and clockout entry to an equivalent ledger | ||||||
| -- entry, representing the time expenditure. Note this entry is  not balanced, | -- entry, representing the time expenditure. Note this entry is  not balanced, | ||||||
| -- since we omit the \"assets:time\" transaction for simpler output. | -- since we omit the \"assets:time\" transaction for simpler output. | ||||||
| entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> LedgerTransaction | entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction | ||||||
| entryFromTimeLogInOut i o | entryFromTimeLogInOut i o | ||||||
|     | otime >= itime = t |     | otime >= itime = t | ||||||
|     | otherwise =  |     | otherwise =  | ||||||
|         error $ "clock-out time less than clock-in time in:\n" ++ showLedgerTransaction t |         error $ "clock-out time less than clock-in time in:\n" ++ showTransaction t | ||||||
|     where |     where | ||||||
|       t = LedgerTransaction { |       t = Transaction { | ||||||
|             ltdate         = idate, |             ltdate         = idate, | ||||||
|             lteffectivedate = Nothing, |             lteffectivedate = Nothing, | ||||||
|             ltstatus       = True, |             ltstatus       = True, | ||||||
|  | |||||||
| @ -1,11 +1,11 @@ | |||||||
| {-| | {-| | ||||||
| 
 | 
 | ||||||
| A 'LedgerTransaction' represents a regular transaction in the ledger | A 'Transaction' represents a regular transaction in the ledger | ||||||
| file. It normally contains two or more balanced 'Posting's. | file. It normally contains two or more balanced 'Posting's. | ||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
| module Ledger.LedgerTransaction | module Ledger.Transaction | ||||||
| where | where | ||||||
| import Ledger.Utils | import Ledger.Utils | ||||||
| import Ledger.Types | import Ledger.Types | ||||||
| @ -14,7 +14,7 @@ import Ledger.Posting | |||||||
| import Ledger.Amount | import Ledger.Amount | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| instance Show LedgerTransaction where show = showLedgerTransactionUnelided | instance Show Transaction where show = showTransactionUnelided | ||||||
| 
 | 
 | ||||||
| instance Show ModifierTransaction where  | instance Show ModifierTransaction where  | ||||||
|     show t = "= " ++ mtvalueexpr t ++ "\n" ++ unlines (map show (mtpostings t)) |     show t = "= " ++ mtvalueexpr t ++ "\n" ++ unlines (map show (mtpostings t)) | ||||||
| @ -22,8 +22,8 @@ instance Show ModifierTransaction where | |||||||
| instance Show PeriodicTransaction where  | instance Show PeriodicTransaction where  | ||||||
|     show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) |     show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) | ||||||
| 
 | 
 | ||||||
| nullledgertxn :: LedgerTransaction | nullledgertxn :: Transaction | ||||||
| nullledgertxn = LedgerTransaction { | nullledgertxn = Transaction { | ||||||
|               ltdate=parsedate "1900/1/1",  |               ltdate=parsedate "1900/1/1",  | ||||||
|               lteffectivedate=Nothing,  |               lteffectivedate=Nothing,  | ||||||
|               ltstatus=False,  |               ltstatus=False,  | ||||||
| @ -50,17 +50,17 @@ pamtwidth     = 11 | |||||||
| pcommentwidth = no limit -- 22 | pcommentwidth = no limit -- 22 | ||||||
| @ | @ | ||||||
| -} | -} | ||||||
| showLedgerTransaction :: LedgerTransaction -> String | showTransaction :: Transaction -> String | ||||||
| showLedgerTransaction = showLedgerTransaction' True False | showTransaction = showTransaction' True False | ||||||
| 
 | 
 | ||||||
| showLedgerTransactionUnelided :: LedgerTransaction -> String | showTransactionUnelided :: Transaction -> String | ||||||
| showLedgerTransactionUnelided = showLedgerTransaction' False False | showTransactionUnelided = showTransaction' False False | ||||||
| 
 | 
 | ||||||
| showLedgerTransactionForPrint :: Bool -> LedgerTransaction -> String | showTransactionForPrint :: Bool -> Transaction -> String | ||||||
| showLedgerTransactionForPrint effective = showLedgerTransaction' False effective | showTransactionForPrint effective = showTransaction' False effective | ||||||
| 
 | 
 | ||||||
| showLedgerTransaction' :: Bool -> Bool -> LedgerTransaction -> String | showTransaction' :: Bool -> Bool -> Transaction -> String | ||||||
| showLedgerTransaction' elide effective t = | showTransaction' elide effective t = | ||||||
|     unlines $ [description] ++ showpostings (ltpostings t) ++ [""] |     unlines $ [description] ++ showpostings (ltpostings t) ++ [""] | ||||||
|     where |     where | ||||||
|       description = concat [date, status, code, desc, comment] |       description = concat [date, status, code, desc, comment] | ||||||
| @ -73,7 +73,7 @@ showLedgerTransaction' elide effective t = | |||||||
|       showdate = printf "%-10s" . showDate |       showdate = printf "%-10s" . showDate | ||||||
|       showedate = printf "=%s" . showdate |       showedate = printf "=%s" . showdate | ||||||
|       showpostings ps |       showpostings ps | ||||||
|           | elide && length ps > 1 && isLedgerTransactionBalanced t |           | elide && length ps > 1 && isTransactionBalanced t | ||||||
|               = map showposting (init ps) ++ [showpostingnoamt (last ps)] |               = map showposting (init ps) ++ [showpostingnoamt (last ps)] | ||||||
|           | otherwise = map showposting ps |           | otherwise = map showposting ps | ||||||
|           where |           where | ||||||
| @ -97,8 +97,8 @@ showAccountName w = fmt | |||||||
|       parenthesise s = "("++s++")" |       parenthesise s = "("++s++")" | ||||||
|       bracket s = "["++s++"]" |       bracket s = "["++s++"]" | ||||||
| 
 | 
 | ||||||
| isLedgerTransactionBalanced :: LedgerTransaction -> Bool | isTransactionBalanced :: Transaction -> Bool | ||||||
| isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) =  | isTransactionBalanced (Transaction {ltpostings=ps}) =  | ||||||
|     all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount) |     all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount) | ||||||
|             [filter isReal ps, filter isBalancedVirtual ps] |             [filter isReal ps, filter isBalancedVirtual ps] | ||||||
| 
 | 
 | ||||||
| @ -107,10 +107,10 @@ isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) = | |||||||
| -- transaction without an amount. The auto-filled balance will be | -- transaction without an amount. The auto-filled balance will be | ||||||
| -- converted to cost basis if possible. If the entry can not be balanced, | -- converted to cost basis if possible. If the entry can not be balanced, | ||||||
| -- return an error message instead. | -- return an error message instead. | ||||||
| balanceLedgerTransaction :: LedgerTransaction -> Either String LedgerTransaction | balanceTransaction :: Transaction -> Either String Transaction | ||||||
| balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps} | balanceTransaction t@Transaction{ltpostings=ps} | ||||||
|     | length missingamounts' > 1 = Left $ printerr "could not balance this transaction, too many missing amounts" |     | length missingamounts' > 1 = Left $ printerr "could not balance this transaction, too many missing amounts" | ||||||
|     | not $ isLedgerTransactionBalanced t' = Left $ printerr nonzerobalanceerror |     | not $ isTransactionBalanced t' = Left $ printerr nonzerobalanceerror | ||||||
|     | otherwise = Right t' |     | otherwise = Right t' | ||||||
|     where |     where | ||||||
|       (withamounts, missingamounts) = partition hasAmount $ filter isReal ps |       (withamounts, missingamounts) = partition hasAmount $ filter isReal ps | ||||||
| @ -122,12 +122,12 @@ balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps} | |||||||
|             balance p | isReal p && not (hasAmount p) = p{pamount = costOfMixedAmount (-otherstotal)} |             balance p | isReal p && not (hasAmount p) = p{pamount = costOfMixedAmount (-otherstotal)} | ||||||
|                       | otherwise = p |                       | otherwise = p | ||||||
|                       where otherstotal = sum $ map pamount withamounts |                       where otherstotal = sum $ map pamount withamounts | ||||||
|       printerr s = printf "%s:\n%s" s (showLedgerTransactionUnelided t) |       printerr s = printf "%s:\n%s" s (showTransactionUnelided t) | ||||||
| 
 | 
 | ||||||
| nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero" | nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero" | ||||||
| 
 | 
 | ||||||
| -- | Convert the primary date to either the actual or effective date. | -- | Convert the primary date to either the actual or effective date. | ||||||
| ledgerTransactionWithDate :: WhichDate -> LedgerTransaction -> LedgerTransaction | ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction | ||||||
| ledgerTransactionWithDate ActualDate t = t | ledgerTransactionWithDate ActualDate t = t | ||||||
| ledgerTransactionWithDate EffectiveDate t = t{ltdate=fromMaybe (ltdate t) (lteffectivedate t)} | ledgerTransactionWithDate EffectiveDate t = t{ltdate=fromMaybe (ltdate t) (lteffectivedate t)} | ||||||
|      |      | ||||||
| @ -6,11 +6,11 @@ Here is an overview of the hledger data model as of 0.8: | |||||||
| 
 | 
 | ||||||
|  Ledger              -- hledger's ledger, a journal file plus various cached data |  Ledger              -- hledger's ledger, a journal file plus various cached data | ||||||
|   Journal            -- representation of the journal file |   Journal            -- representation of the journal file | ||||||
|    [Transaction] (LedgerTransaction)     -- journal transactions, with date, description and.. |    [Transaction]     -- journal transactions, with date, description and.. | ||||||
|     [Posting]        -- one or more journal postings |     [Posting]        -- one or more journal postings | ||||||
|   [LedgerPosting]    -- all postings combined with their transaction info |   [LedgerPosting]    -- all postings combined with their transaction info | ||||||
|   Tree AccountName   -- the tree of all account names |   Tree AccountName   -- the tree of all account names | ||||||
|   Map AccountName AccountInfo -- account info in a map for easy lookup by name |   Map AccountName Account -- per-account ledger postings and balances for easy lookup | ||||||
| 
 | 
 | ||||||
| For more detailed documentation on each type, see the corresponding modules. | For more detailed documentation on each type, see the corresponding modules. | ||||||
| 
 | 
 | ||||||
| @ -87,7 +87,7 @@ data PeriodicTransaction = PeriodicTransaction { | |||||||
|       ptpostings :: [Posting] |       ptpostings :: [Posting] | ||||||
|     } deriving (Eq) |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| data LedgerTransaction = LedgerTransaction { | data Transaction = Transaction { | ||||||
|       ltdate :: Day, |       ltdate :: Day, | ||||||
|       lteffectivedate :: Maybe Day, |       lteffectivedate :: Maybe Day, | ||||||
|       ltstatus :: Bool, |       ltstatus :: Bool, | ||||||
| @ -115,7 +115,7 @@ data HistoricalPrice = HistoricalPrice { | |||||||
| data Journal = Journal { | data Journal = Journal { | ||||||
|       modifier_txns :: [ModifierTransaction], |       modifier_txns :: [ModifierTransaction], | ||||||
|       periodic_txns :: [PeriodicTransaction], |       periodic_txns :: [PeriodicTransaction], | ||||||
|       ledger_txns :: [LedgerTransaction], |       ledger_txns :: [Transaction], | ||||||
|       open_timelog_entries :: [TimeLogEntry], |       open_timelog_entries :: [TimeLogEntry], | ||||||
|       historical_prices :: [HistoricalPrice], |       historical_prices :: [HistoricalPrice], | ||||||
|       final_comment_lines :: String, |       final_comment_lines :: String, | ||||||
|  | |||||||
							
								
								
									
										82
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										82
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -306,20 +306,20 @@ tests = [ | |||||||
| 
 | 
 | ||||||
|    ] |    ] | ||||||
| 
 | 
 | ||||||
|   ,"balanceLedgerTransaction" ~: do |   ,"balanceTransaction" ~: do | ||||||
|      assertBool "detect unbalanced entry, sign error" |      assertBool "detect unbalanced entry, sign error" | ||||||
|                     (isLeft $ balanceLedgerTransaction |                     (isLeft $ balanceTransaction | ||||||
|                            (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" "" |                            (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" | ||||||
|                             [Posting False "a" (Mixed [dollars 1]) "" RegularPosting,  |                             [Posting False "a" (Mixed [dollars 1]) "" RegularPosting,  | ||||||
|                              Posting False "b" (Mixed [dollars 1]) "" RegularPosting |                              Posting False "b" (Mixed [dollars 1]) "" RegularPosting | ||||||
|                             ] "")) |                             ] "")) | ||||||
|      assertBool "detect unbalanced entry, multiple missing amounts" |      assertBool "detect unbalanced entry, multiple missing amounts" | ||||||
|                     (isLeft $ balanceLedgerTransaction |                     (isLeft $ balanceTransaction | ||||||
|                            (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" "" |                            (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" | ||||||
|                             [Posting False "a" missingamt "" RegularPosting,  |                             [Posting False "a" missingamt "" RegularPosting,  | ||||||
|                              Posting False "b" missingamt "" RegularPosting |                              Posting False "b" missingamt "" RegularPosting | ||||||
|                             ] "")) |                             ] "")) | ||||||
|      let e = balanceLedgerTransaction (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" "" |      let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" | ||||||
|                            [Posting False "a" (Mixed [dollars 1]) "" RegularPosting,  |                            [Posting False "a" (Mixed [dollars 1]) "" RegularPosting,  | ||||||
|                             Posting False "b" missingamt "" RegularPosting |                             Posting False "b" missingamt "" RegularPosting | ||||||
|                            ] "") |                            ] "") | ||||||
| @ -404,46 +404,46 @@ tests = [ | |||||||
|     "assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True |     "assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True | ||||||
|     "my assets" `isAccountNamePrefixOf` "assets:bank" `is` False |     "my assets" `isAccountNamePrefixOf` "assets:bank" `is` False | ||||||
| 
 | 
 | ||||||
|   ,"isLedgerTransactionBalanced" ~: do |   ,"isTransactionBalanced" ~: do | ||||||
|      assertBool "detect balanced" |      assertBool "detect balanced" | ||||||
|         (isLedgerTransactionBalanced |         (isTransactionBalanced | ||||||
|         (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" |         (Transaction (parsedate "2009/01/01") Nothing False "" "a" "" | ||||||
|          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting |          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting | ||||||
|          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting |          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
|      assertBool "detect unbalanced" |      assertBool "detect unbalanced" | ||||||
|         (not $ isLedgerTransactionBalanced |         (not $ isTransactionBalanced | ||||||
|         (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" |         (Transaction (parsedate "2009/01/01") Nothing False "" "a" "" | ||||||
|          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting |          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting | ||||||
|          ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting |          ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
|      assertBool "detect unbalanced, one posting" |      assertBool "detect unbalanced, one posting" | ||||||
|         (not $ isLedgerTransactionBalanced |         (not $ isTransactionBalanced | ||||||
|         (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" |         (Transaction (parsedate "2009/01/01") Nothing False "" "a" "" | ||||||
|          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting |          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
|      assertBool "one zero posting is considered balanced for now" |      assertBool "one zero posting is considered balanced for now" | ||||||
|         (isLedgerTransactionBalanced |         (isTransactionBalanced | ||||||
|         (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" |         (Transaction (parsedate "2009/01/01") Nothing False "" "a" "" | ||||||
|          [Posting False "b" (Mixed [dollars 0]) "" RegularPosting |          [Posting False "b" (Mixed [dollars 0]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
|      assertBool "virtual postings don't need to balance" |      assertBool "virtual postings don't need to balance" | ||||||
|         (isLedgerTransactionBalanced |         (isTransactionBalanced | ||||||
|         (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" |         (Transaction (parsedate "2009/01/01") Nothing False "" "a" "" | ||||||
|          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting |          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting | ||||||
|          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting |          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting | ||||||
|          ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting |          ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting | ||||||
|          ] "")) |          ] "")) | ||||||
|      assertBool "balanced virtual postings need to balance among themselves" |      assertBool "balanced virtual postings need to balance among themselves" | ||||||
|         (not $ isLedgerTransactionBalanced |         (not $ isTransactionBalanced | ||||||
|         (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" |         (Transaction (parsedate "2009/01/01") Nothing False "" "a" "" | ||||||
|          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting |          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting | ||||||
|          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting |          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting | ||||||
|          ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting |          ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting | ||||||
|          ] "")) |          ] "")) | ||||||
|      assertBool "balanced virtual postings need to balance among themselves (2)" |      assertBool "balanced virtual postings need to balance among themselves (2)" | ||||||
|         (isLedgerTransactionBalanced |         (isTransactionBalanced | ||||||
|         (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" |         (Transaction (parsedate "2009/01/01") Nothing False "" "a" "" | ||||||
|          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting |          [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting | ||||||
|          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting |          ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting | ||||||
|          ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting |          ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting | ||||||
| @ -508,7 +508,7 @@ tests = [ | |||||||
|    do  |    do  | ||||||
|     let args = ["expenses"] |     let args = ["expenses"] | ||||||
|     l <- sampleledgerwithopts [] args |     l <- sampleledgerwithopts [] args | ||||||
|     showLedgerTransactions [] args l `is` unlines  |     showTransactions [] args l `is` unlines  | ||||||
|      ["2008/06/03 * eat & shop" |      ["2008/06/03 * eat & shop" | ||||||
|      ,"    expenses:food                $1" |      ,"    expenses:food                $1" | ||||||
|      ,"    expenses:supplies            $1" |      ,"    expenses:supplies            $1" | ||||||
| @ -519,7 +519,7 @@ tests = [ | |||||||
|   , "print report with depth arg" ~: |   , "print report with depth arg" ~: | ||||||
|    do  |    do  | ||||||
|     l <- sampleledger |     l <- sampleledger | ||||||
|     showLedgerTransactions [Depth "2"] [] l `is` unlines |     showTransactions [Depth "2"] [] l `is` unlines | ||||||
|       ["2008/01/01 income" |       ["2008/01/01 income" | ||||||
|       ,"    income:salary           $-1" |       ,"    income:salary           $-1" | ||||||
|       ,"" |       ,"" | ||||||
| @ -670,7 +670,7 @@ tests = [ | |||||||
| 
 | 
 | ||||||
|   ,"show hours" ~: show (hours 1) ~?= "1.0h" |   ,"show hours" ~: show (hours 1) ~?= "1.0h" | ||||||
| 
 | 
 | ||||||
|   ,"showLedgerTransaction" ~: do |   ,"showTransaction" ~: do | ||||||
|      assertEqual "show a balanced transaction, eliding last amount" |      assertEqual "show a balanced transaction, eliding last amount" | ||||||
|        (unlines |        (unlines | ||||||
|         ["2007/01/28 coopportunity" |         ["2007/01/28 coopportunity" | ||||||
| @ -678,8 +678,8 @@ tests = [ | |||||||
|         ,"    assets:checking" |         ,"    assets:checking" | ||||||
|         ,"" |         ,"" | ||||||
|         ]) |         ]) | ||||||
|        (showLedgerTransaction |        (showTransaction | ||||||
|         (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" |         (Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||||
|          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting |          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting | ||||||
|          ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting |          ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
| @ -690,8 +690,8 @@ tests = [ | |||||||
|         ,"    assets:checking               $-47.18" |         ,"    assets:checking               $-47.18" | ||||||
|         ,"" |         ,"" | ||||||
|         ]) |         ]) | ||||||
|        (showLedgerTransactionUnelided |        (showTransactionUnelided | ||||||
|         (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" |         (Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||||
|          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting |          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting | ||||||
|          ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting |          ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
| @ -703,8 +703,8 @@ tests = [ | |||||||
|         ,"    assets:checking               $-47.19" |         ,"    assets:checking               $-47.19" | ||||||
|         ,"" |         ,"" | ||||||
|         ]) |         ]) | ||||||
|        (showLedgerTransaction |        (showTransaction | ||||||
|         (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" |         (Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||||
|          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting |          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting | ||||||
|          ,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting |          ,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
| @ -714,8 +714,8 @@ tests = [ | |||||||
|         ,"    expenses:food:groceries        $47.18" |         ,"    expenses:food:groceries        $47.18" | ||||||
|         ,"" |         ,"" | ||||||
|         ]) |         ]) | ||||||
|        (showLedgerTransaction |        (showTransaction | ||||||
|         (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" |         (Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||||
|          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting |          [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
|      assertEqual "show a transaction with one posting and a missing amount" |      assertEqual "show a transaction with one posting and a missing amount" | ||||||
| @ -724,8 +724,8 @@ tests = [ | |||||||
|         ,"    expenses:food:groceries              " |         ,"    expenses:food:groceries              " | ||||||
|         ,"" |         ,"" | ||||||
|         ]) |         ]) | ||||||
|        (showLedgerTransaction |        (showTransaction | ||||||
|         (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" |         (Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||||
|          [Posting False "expenses:food:groceries" missingamt "" RegularPosting |          [Posting False "expenses:food:groceries" missingamt "" RegularPosting | ||||||
|          ] "")) |          ] "")) | ||||||
| 
 | 
 | ||||||
| @ -916,7 +916,7 @@ entry1_str = unlines | |||||||
|  ] |  ] | ||||||
| 
 | 
 | ||||||
| entry1 = | entry1 = | ||||||
|     LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" |     Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||||
|      [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting,  |      [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting,  | ||||||
|       Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "" |       Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "" | ||||||
| 
 | 
 | ||||||
| @ -1064,7 +1064,7 @@ journal7 = Journal | |||||||
|           []  |           []  | ||||||
|           []  |           []  | ||||||
|           [ |           [ | ||||||
|            LedgerTransaction { |            Transaction { | ||||||
|              ltdate=parsedate "2007/01/01",  |              ltdate=parsedate "2007/01/01",  | ||||||
|              lteffectivedate=Nothing, |              lteffectivedate=Nothing, | ||||||
|              ltstatus=False,  |              ltstatus=False,  | ||||||
| @ -1090,7 +1090,7 @@ journal7 = Journal | |||||||
|              ltpreceding_comment_lines="" |              ltpreceding_comment_lines="" | ||||||
|            } |            } | ||||||
|           , |           , | ||||||
|            LedgerTransaction { |            Transaction { | ||||||
|              ltdate=parsedate "2007/02/01",  |              ltdate=parsedate "2007/02/01",  | ||||||
|              lteffectivedate=Nothing, |              lteffectivedate=Nothing, | ||||||
|              ltstatus=False,  |              ltstatus=False,  | ||||||
| @ -1116,7 +1116,7 @@ journal7 = Journal | |||||||
|              ltpreceding_comment_lines="" |              ltpreceding_comment_lines="" | ||||||
|            } |            } | ||||||
|           , |           , | ||||||
|            LedgerTransaction { |            Transaction { | ||||||
|              ltdate=parsedate "2007/01/02",  |              ltdate=parsedate "2007/01/02",  | ||||||
|              lteffectivedate=Nothing, |              lteffectivedate=Nothing, | ||||||
|              ltstatus=False,  |              ltstatus=False,  | ||||||
| @ -1142,7 +1142,7 @@ journal7 = Journal | |||||||
|              ltpreceding_comment_lines="" |              ltpreceding_comment_lines="" | ||||||
|            } |            } | ||||||
|           , |           , | ||||||
|            LedgerTransaction { |            Transaction { | ||||||
|              ltdate=parsedate "2007/01/03",  |              ltdate=parsedate "2007/01/03",  | ||||||
|              lteffectivedate=Nothing, |              lteffectivedate=Nothing, | ||||||
|              ltstatus=False,  |              ltstatus=False,  | ||||||
| @ -1168,7 +1168,7 @@ journal7 = Journal | |||||||
|              ltpreceding_comment_lines="" |              ltpreceding_comment_lines="" | ||||||
|            } |            } | ||||||
|           , |           , | ||||||
|            LedgerTransaction { |            Transaction { | ||||||
|              ltdate=parsedate "2007/01/03",  |              ltdate=parsedate "2007/01/03",  | ||||||
|              lteffectivedate=Nothing, |              lteffectivedate=Nothing, | ||||||
|              ltstatus=False,  |              ltstatus=False,  | ||||||
| @ -1194,7 +1194,7 @@ journal7 = Journal | |||||||
|              ltpreceding_comment_lines="" |              ltpreceding_comment_lines="" | ||||||
|            } |            } | ||||||
|           , |           , | ||||||
|            LedgerTransaction { |            Transaction { | ||||||
|              ltdate=parsedate "2007/01/03",  |              ltdate=parsedate "2007/01/03",  | ||||||
|              lteffectivedate=Nothing, |              lteffectivedate=Nothing, | ||||||
|              ltstatus=False,  |              ltstatus=False,  | ||||||
|  | |||||||
| @ -50,7 +50,7 @@ library | |||||||
|                   Ledger.Commodity |                   Ledger.Commodity | ||||||
|                   Ledger.Dates |                   Ledger.Dates | ||||||
|                   Ledger.IO |                   Ledger.IO | ||||||
|                   Ledger.LedgerTransaction |                   Ledger.Transaction | ||||||
|                   Ledger.Journal |                   Ledger.Journal | ||||||
|                   Ledger.Ledger |                   Ledger.Ledger | ||||||
|                   Ledger.Posting |                   Ledger.Posting | ||||||
| @ -89,7 +89,7 @@ executable hledger | |||||||
|                   Ledger.Commodity |                   Ledger.Commodity | ||||||
|                   Ledger.Dates |                   Ledger.Dates | ||||||
|                   Ledger.IO |                   Ledger.IO | ||||||
|                   Ledger.LedgerTransaction |                   Ledger.Transaction | ||||||
|                   Ledger.Ledger |                   Ledger.Ledger | ||||||
|                   Ledger.Parse |                   Ledger.Parse | ||||||
|                   Ledger.Journal |                   Ledger.Journal | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user