support --real/-R flag
This commit is contained in:
		
							parent
							
								
									57603db7b9
								
							
						
					
					
						commit
						17ab6cb0ab
					
				@ -14,6 +14,7 @@ import Ledger.AccountName
 | 
				
			|||||||
import Ledger.Amount
 | 
					import Ledger.Amount
 | 
				
			||||||
import Ledger.Entry
 | 
					import Ledger.Entry
 | 
				
			||||||
import Ledger.Transaction
 | 
					import Ledger.Transaction
 | 
				
			||||||
 | 
					import Ledger.RawTransaction
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
negativepatternchar = '-'
 | 
					negativepatternchar = '-'
 | 
				
			||||||
@ -43,9 +44,10 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
-- | Remove ledger entries we are not interested in.
 | 
					-- | Remove ledger entries we are not interested in.
 | 
				
			||||||
-- Keep only those which fall between the begin and end dates, and match
 | 
					-- Keep only those which fall between the begin and end dates, and match
 | 
				
			||||||
-- the description pattern, and match the cleared flag.
 | 
					-- the description pattern, and are cleared or real if those options are active.
 | 
				
			||||||
filterRawLedger :: String -> String -> [String] -> Bool -> RawLedger -> RawLedger
 | 
					filterRawLedger :: String -> String -> [String] -> Bool -> Bool -> RawLedger -> RawLedger
 | 
				
			||||||
filterRawLedger begin end pats clearedonly = 
 | 
					filterRawLedger begin end pats clearedonly realonly = 
 | 
				
			||||||
 | 
					    filterRawLedgerTransactionsByRealness realonly .
 | 
				
			||||||
    filterRawLedgerEntriesByClearedStatus clearedonly .
 | 
					    filterRawLedgerEntriesByClearedStatus clearedonly .
 | 
				
			||||||
    filterRawLedgerEntriesByDate begin end .
 | 
					    filterRawLedgerEntriesByDate begin end .
 | 
				
			||||||
    filterRawLedgerEntriesByDescription pats
 | 
					    filterRawLedgerEntriesByDescription pats
 | 
				
			||||||
@ -75,6 +77,14 @@ filterRawLedgerEntriesByClearedStatus False l = l
 | 
				
			|||||||
filterRawLedgerEntriesByClearedStatus True  (RawLedger ms ps es f) =
 | 
					filterRawLedgerEntriesByClearedStatus True  (RawLedger ms ps es f) =
 | 
				
			||||||
    RawLedger ms ps (filter estatus es) f
 | 
					    RawLedger ms ps (filter estatus es) f
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					-- | Strip out any (virtual transactions), if the flag is true, otherwise
 | 
				
			||||||
 | 
					-- do no filtering.
 | 
				
			||||||
 | 
					filterRawLedgerTransactionsByRealness :: Bool -> RawLedger -> RawLedger
 | 
				
			||||||
 | 
					filterRawLedgerTransactionsByRealness False l = l
 | 
				
			||||||
 | 
					filterRawLedgerTransactionsByRealness True (RawLedger ms ps es f) =
 | 
				
			||||||
 | 
					    RawLedger ms ps (map filtertxns es) f
 | 
				
			||||||
 | 
					    where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Check if a set of ledger account/description patterns matches the
 | 
					-- | Check if a set of ledger account/description patterns matches the
 | 
				
			||||||
-- given account name or entry description, applying ledger's special
 | 
					-- given account name or entry description, applying ledger's special
 | 
				
			||||||
-- cases.  
 | 
					-- cases.  
 | 
				
			||||||
 | 
				
			|||||||
@ -25,7 +25,8 @@ options = [
 | 
				
			|||||||
 Option ['f'] ["file"]         (ReqArg File "FILE")        "ledger file; - means use standard input",
 | 
					 Option ['f'] ["file"]         (ReqArg File "FILE")        "ledger file; - means use standard input",
 | 
				
			||||||
 Option ['b'] ["begin"]        (ReqArg Begin "YYYY/MM/DD") "report on entries on or after this date",
 | 
					 Option ['b'] ["begin"]        (ReqArg Begin "YYYY/MM/DD") "report on entries on or after this date",
 | 
				
			||||||
 Option ['e'] ["end"]          (ReqArg End "YYYY/MM/DD")   "report on entries prior to this date",
 | 
					 Option ['e'] ["end"]          (ReqArg End "YYYY/MM/DD")   "report on entries prior to this date",
 | 
				
			||||||
 Option ['C'] ["cleared"]        (NoArg  Cleared)          "report only on cleared transactions",
 | 
					 Option ['C'] ["cleared"]      (NoArg  Cleared)            "report only on cleared entries",
 | 
				
			||||||
 | 
					 Option ['R'] ["real"]         (NoArg  Real)               "report only on real (non-virtual) transactions",
 | 
				
			||||||
 Option ['s'] ["showsubs"]     (NoArg  ShowSubs)           "in the balance report, include subaccounts",
 | 
					 Option ['s'] ["showsubs"]     (NoArg  ShowSubs)           "in the balance report, include subaccounts",
 | 
				
			||||||
 Option ['h'] ["help","usage"] (NoArg  Help)               "show this help",
 | 
					 Option ['h'] ["help","usage"] (NoArg  Help)               "show this help",
 | 
				
			||||||
 Option ['V'] ["version"]      (NoArg  Version)            "show version"
 | 
					 Option ['V'] ["version"]      (NoArg  Version)            "show version"
 | 
				
			||||||
@ -37,6 +38,7 @@ data Opt =
 | 
				
			|||||||
    Begin String | 
 | 
					    Begin String | 
 | 
				
			||||||
    End String | 
 | 
					    End String | 
 | 
				
			||||||
    Cleared | 
 | 
					    Cleared | 
 | 
				
			||||||
 | 
					    Real | 
 | 
				
			||||||
    ShowSubs |
 | 
					    ShowSubs |
 | 
				
			||||||
    Help |
 | 
					    Help |
 | 
				
			||||||
    Version
 | 
					    Version
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										4
									
								
								Utils.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Utils.hs
									
									
									
									
									
								
							@ -21,7 +21,7 @@ rawledgerfromfile f = do
 | 
				
			|||||||
ledgerfromfile :: FilePath -> IO Ledger
 | 
					ledgerfromfile :: FilePath -> IO Ledger
 | 
				
			||||||
ledgerfromfile f = do
 | 
					ledgerfromfile f = do
 | 
				
			||||||
  l  <- rawledgerfromfile f
 | 
					  l  <- rawledgerfromfile f
 | 
				
			||||||
  return $ cacheLedger $ filterRawLedger "" "" [] False l
 | 
					  return $ cacheLedger $ filterRawLedger "" "" [] False False l
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | get a RawLedger from the file your LEDGER environment variable
 | 
					-- | get a RawLedger from the file your LEDGER environment variable
 | 
				
			||||||
-- variable points to or (WARNING) an empty one if there was a problem.
 | 
					-- variable points to or (WARNING) an empty one if there was a problem.
 | 
				
			||||||
@ -35,7 +35,7 @@ myrawledger = do
 | 
				
			|||||||
myledger :: IO Ledger
 | 
					myledger :: IO Ledger
 | 
				
			||||||
myledger = do
 | 
					myledger = do
 | 
				
			||||||
  l <- myrawledger
 | 
					  l <- myrawledger
 | 
				
			||||||
  return $ cacheLedger $ filterRawLedger "" "" [] False l
 | 
					  return $ cacheLedger $ filterRawLedger "" "" [] False False l
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | get a named account from your ledger file
 | 
					-- | get a named account from your ledger file
 | 
				
			||||||
myaccount :: AccountName -> IO Account
 | 
					myaccount :: AccountName -> IO Account
 | 
				
			||||||
 | 
				
			|||||||
@ -70,9 +70,10 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ())
 | 
				
			|||||||
parseLedgerAndDo opts args cmd = 
 | 
					parseLedgerAndDo opts args cmd = 
 | 
				
			||||||
    ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
 | 
					    ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
 | 
				
			||||||
    where
 | 
					    where
 | 
				
			||||||
      runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats cleared
 | 
					      runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats cleared real
 | 
				
			||||||
      begin = beginDateFromOpts opts
 | 
					      begin = beginDateFromOpts opts
 | 
				
			||||||
      end = endDateFromOpts opts
 | 
					      end = endDateFromOpts opts
 | 
				
			||||||
      cleared = Cleared `elem` opts
 | 
					      cleared = Cleared `elem` opts
 | 
				
			||||||
 | 
					      real = Real `elem` opts
 | 
				
			||||||
      descpats = snd $ parseAccountDescriptionArgs args
 | 
					      descpats = snd $ parseAccountDescriptionArgs args
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user