try to simplify FilterPatterns a bit
This commit is contained in:
		
							parent
							
								
									66050fd248
								
							
						
					
					
						commit
						8c6d93701b
					
				
							
								
								
									
										24
									
								
								Ledger.hs
									
									
									
									
									
								
							
							
						
						
									
										24
									
								
								Ledger.hs
									
									
									
									
									
								
							| @ -62,31 +62,37 @@ cacheLedger pats l = | |||||||
|     in |     in | ||||||
|       Ledger l' ant amap lprecision |       Ledger l' ant amap lprecision | ||||||
| 
 | 
 | ||||||
| -- | filter entries by description and whether any transactions match account patterns | -- | keep only entries whose description matches one of the | ||||||
|  | -- | description patterns, if any, and which have at least one | ||||||
|  | -- | transaction matching one of the account patterns, if any. | ||||||
|  | -- | No description or account patterns implies match all. | ||||||
| filterLedgerEntries :: FilterPatterns -> LedgerFile -> LedgerFile | filterLedgerEntries :: FilterPatterns -> LedgerFile -> LedgerFile | ||||||
| filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es f) =  | filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es f) =  | ||||||
|     LedgerFile ms ps (filter matchdesc $ filter (any matchtxn . etransactions) es) f |     LedgerFile ms ps filteredentries f | ||||||
|     where |     where | ||||||
|       matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of |       filteredentries :: [LedgerEntry] | ||||||
|  |       filteredentries = (filter matchdesc $ filter (any matchtxn . etransactions) es) | ||||||
|  |       matchtxn :: LedgerTransaction -> Bool | ||||||
|  |       matchtxn t = case matchRegex acctpat (taccount t) of | ||||||
|                      Nothing -> False |                      Nothing -> False | ||||||
|                      otherwise -> True |                      otherwise -> True | ||||||
|       matchdesc e = case matchRegex (wilddefault descpat) (edescription e) of |       matchdesc :: LedgerEntry -> Bool | ||||||
|  |       matchdesc e = case matchRegex descpat (edescription e) of | ||||||
|                       Nothing -> False |                       Nothing -> False | ||||||
|                       otherwise -> True |                       otherwise -> True | ||||||
| 
 | 
 | ||||||
| -- | filter transactions in each ledger entry by account patterns | -- | in each ledger entry, filter out transactions which do not match | ||||||
| -- this may unbalance entries | -- | the account patterns, if any.  (Entries are no longer balanced | ||||||
|  | -- | after this.) | ||||||
| filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile | filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile | ||||||
| filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es f) =  | filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es f) =  | ||||||
|     LedgerFile ms ps (map filterentrytxns es) f |     LedgerFile ms ps (map filterentrytxns es) f | ||||||
|     where |     where | ||||||
|       filterentrytxns l@(LedgerEntry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts} |       filterentrytxns l@(LedgerEntry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts} | ||||||
|       matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of |       matchtxn t = case matchRegex acctpat (taccount t) of | ||||||
|                      Nothing -> False |                      Nothing -> False | ||||||
|                      otherwise -> True |                      otherwise -> True | ||||||
| 
 | 
 | ||||||
| wilddefault = fromMaybe (mkRegex ".*") |  | ||||||
| 
 |  | ||||||
| accountnames :: Ledger -> [AccountName] | accountnames :: Ledger -> [AccountName] | ||||||
| accountnames l = flatten $ accountnametree l | accountnames l = flatten $ accountnametree l | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										21
									
								
								Options.hs
									
									
									
									
									
								
							
							
						
						
									
										21
									
								
								Options.hs
									
									
									
									
									
								
							| @ -72,17 +72,20 @@ tildeExpand ('~':'/':xs) =  getHomeDirectory >>= return . (++ ('/':xs)) | |||||||
| tildeExpand xs           =  return xs | tildeExpand xs           =  return xs | ||||||
| -- -- courtesy of allberry_b | -- -- courtesy of allberry_b | ||||||
| 
 | 
 | ||||||
| -- | ledger pattern args are 0 or more account patterns optionally followed | -- | ledger pattern arguments are: 0 or more account patterns | ||||||
| -- by -- and 0 or more description patterns | -- | optionally followed by -- and 0 or more description patterns. | ||||||
|  | -- | Here we convert the arguments, if any, to FilterPatterns, | ||||||
|  | -- | which is a pair of maybe regexps. | ||||||
| parsePatternArgs :: [String] -> FilterPatterns | parsePatternArgs :: [String] -> FilterPatterns | ||||||
| parsePatternArgs args = argpats as ds'  | parsePatternArgs args = (regexFor as, regexFor ds') | ||||||
|     where (as, ds) = break (=="--") args |     where (as, ds) = break (=="--") args | ||||||
|           ds' = dropWhile (=="--") ds |           ds' = dropWhile (=="--") ds | ||||||
| 
 | 
 | ||||||
| argpats :: [String] -> [String] -> FilterPatterns | -- | convert a list of strings to a regular expression matching any of them, | ||||||
| argpats as ds = (regexify as, regexify ds) | -- | or a wildcard if there are none. | ||||||
|     where | regexFor :: [String] -> Regex | ||||||
|       regexify :: [String] -> Maybe Regex | regexFor [] = wildcard | ||||||
|       regexify [] = Nothing | regexFor ss = mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")" | ||||||
|       regexify ss = Just $ mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")" |  | ||||||
| 
 | 
 | ||||||
|  | wildcard :: Regex | ||||||
|  | wildcard = mkRegex ".*" | ||||||
							
								
								
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -284,7 +284,7 @@ ledger7 = LedgerFile | |||||||
|           ] |           ] | ||||||
|           "" |           "" | ||||||
| 
 | 
 | ||||||
| l7 = cacheLedger (argpats [] []) ledger7 | l7 = cacheLedger (parsePatternArgs []) ledger7 | ||||||
| 
 | 
 | ||||||
| timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n" | timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n" | ||||||
| timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger" | timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger" | ||||||
| @ -375,7 +375,7 @@ test_ledgerAccountNames = | |||||||
|     (rawLedgerAccountNames ledger7) |     (rawLedgerAccountNames ledger7) | ||||||
| 
 | 
 | ||||||
| test_cacheLedger = | test_cacheLedger = | ||||||
|     assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (argpats [] []) ledger7) |     assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (parsePatternArgs []) ledger7) | ||||||
| 
 | 
 | ||||||
| test_showLedgerAccounts =  | test_showLedgerAccounts =  | ||||||
|     assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1) |     assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1) | ||||||
|  | |||||||
							
								
								
									
										4
									
								
								Types.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Types.hs
									
									
									
									
									
								
							| @ -6,8 +6,8 @@ where | |||||||
| import Utils | import Utils | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
| 
 | 
 | ||||||
| -- | account and description-matching patterns | -- | account and description-matching patterns, see 'Options.parsePatternArgs'. | ||||||
| type FilterPatterns = (Maybe Regex, Maybe Regex) | type FilterPatterns = (Regex, Regex) | ||||||
|                         |                         | ||||||
| type Date = String | type Date = String | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										11
									
								
								hledger.hs
									
									
									
									
									
								
							
							
						
						
									
										11
									
								
								hledger.hs
									
									
									
									
									
								
							| @ -98,25 +98,28 @@ balance opts pats = do | |||||||
|               where  |               where  | ||||||
|                 showsubs = (ShowSubs `elem` opts) |                 showsubs = (ShowSubs `elem` opts) | ||||||
|                 depth = case (pats, showsubs) of |                 depth = case (pats, showsubs) of | ||||||
|                           ((Nothing,_), False) -> 1 |                           -- when there are no account patterns and no -s, | ||||||
|  |                           -- show only to depth 1. (This was clearer and more | ||||||
|  |                           -- correct when FilterPatterns used maybe.) | ||||||
|  |                           ((wildcard,_), False) -> 1 | ||||||
|                           otherwise  -> 9999 |                           otherwise  -> 9999 | ||||||
| 
 | 
 | ||||||
| -- helpers for interacting in ghci | -- helpers for interacting in ghci | ||||||
| 
 | 
 | ||||||
| -- | return a Ledger parsed from the file your LEDGER environment variable | -- | return a Ledger parsed from the file your LEDGER environment variable | ||||||
| -- points to or (WARNING:) an empty one if there was a problem. | -- points to or (WARNING) an empty one if there was a problem. | ||||||
| myledger :: IO Ledger | myledger :: IO Ledger | ||||||
| myledger = do | myledger = do | ||||||
|   parsed <- ledgerFilePath [] >>= parseLedgerFile |   parsed <- ledgerFilePath [] >>= parseLedgerFile | ||||||
|   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed |   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed | ||||||
|   return $ cacheLedger (argpats [] []) ledgerfile |   return $ cacheLedger (parsePatternArgs []) ledgerfile | ||||||
| 
 | 
 | ||||||
| -- | return a Ledger parsed from the given file path | -- | return a Ledger parsed from the given file path | ||||||
| ledgerfromfile :: String -> IO Ledger | ledgerfromfile :: String -> IO Ledger | ||||||
| ledgerfromfile f = do | ledgerfromfile f = do | ||||||
|   parsed <- ledgerFilePath [File f] >>= parseLedgerFile |   parsed <- ledgerFilePath [File f] >>= parseLedgerFile | ||||||
|   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed |   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed | ||||||
|   return $ cacheLedger (argpats [] []) ledgerfile |   return $ cacheLedger (parsePatternArgs []) ledgerfile | ||||||
| 
 | 
 | ||||||
| accountnamed :: AccountName -> IO Account | accountnamed :: AccountName -> IO Account | ||||||
| accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts) | accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts) | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user