drop regex-pcre dependency, and try to clarify convert rule parser
This commit is contained in:
		
							parent
							
								
									6c6eb2691e
								
							
						
					
					
						commit
						3ebc4cca48
					
				| @ -46,7 +46,7 @@ import System (getArgs) | |||||||
| import System.IO (stderr, hPutStrLn) | import System.IO (stderr, hPutStrLn) | ||||||
| import Text.CSV (parseCSVFromFile, Record) | import Text.CSV (parseCSVFromFile, Record) | ||||||
| import Text.Printf (printf) | import Text.Printf (printf) | ||||||
| import Text.Regex.PCRE ((=~)) | import Text.RegexPR (matchRegexPR) | ||||||
| import Data.Maybe | import Data.Maybe | ||||||
| import Ledger.Dates (firstJust, showDate) | import Ledger.Dates (firstJust, showDate) | ||||||
| import Locale (defaultTimeLocale) | import Locale (defaultTimeLocale) | ||||||
| @ -67,17 +67,24 @@ convert opts args l = do | |||||||
|   mapM_ (print_ledger_txn (Debug `elem` opts) (baseacct,fieldpositions,rules)) records |   mapM_ (print_ledger_txn (Debug `elem` opts) (baseacct,fieldpositions,rules)) records | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| type Rule = ([[String]]   -- list of [pattern,replacement]. replacement may or may not be present. | type Rule = ( | ||||||
|             ,AccountName) -- account name to use for a transaction matching this rule |    [(String, Maybe String)] -- list of patterns and optional replacements | ||||||
|  |   ,AccountName              -- account name to use for a matched transaction | ||||||
|  |   ) | ||||||
| 
 | 
 | ||||||
| parseRules :: String -> IO ([Int],[Rule]) | parseRules :: String -> IO ([Int],[Rule]) | ||||||
| parseRules s = do | parseRules s = do | ||||||
|   let ls = map strip $ lines s |   let ls = map strip $ lines s | ||||||
|   let paras = splitOn [""] ls |   let paras = splitOn [""] ls | ||||||
|   let fieldpositions = map read $ splitOn "," $ head $ head paras |   let fieldpositions = map read $ splitOn "," $ head $ head paras | ||||||
|   let rules = [(map (splitOn "=") $ init p, last p) | p <- tail paras] |   let rules = [(map parsePatRepl $ init ls, last ls) | ls <- tail paras] | ||||||
|   return (fieldpositions,rules) |   return (fieldpositions,rules) | ||||||
| 
 | 
 | ||||||
|  | parsePatRepl :: String -> (String, Maybe String) | ||||||
|  | parsePatRepl l = case splitOn "=" l of | ||||||
|  |                    (p:r:_) -> (p, Just r) | ||||||
|  |                    (p:_)   -> (p, Nothing) | ||||||
|  | 
 | ||||||
| print_ledger_txn debug (baseacct,fieldpositions,rules) record@(a:b:c:d:e) = do | print_ledger_txn debug (baseacct,fieldpositions,rules) record@(a:b:c:d:e) = do | ||||||
|   let [date,cleared,number,description,amount] = map (record !!) fieldpositions |   let [date,cleared,number,description,amount] = map (record !!) fieldpositions | ||||||
|       amount' = strnegate amount where strnegate ('-':s) = s |       amount' = strnegate amount where strnegate ('-':s) = s | ||||||
| @ -93,16 +100,19 @@ print_ledger_txn True _ record = do | |||||||
|   hPutStrLn stderr $ printf "ignoring %s" $ show record |   hPutStrLn stderr $ printf "ignoring %s" $ show record | ||||||
| print_ledger_txn _ _ _ = return () | print_ledger_txn _ _ _ = return () | ||||||
| 
 | 
 | ||||||
| choose_acct_desc rules (acct,desc) | null matches = (acct,desc) | choose_acct_desc :: [Rule] -> (String,String) -> (String,String) | ||||||
|  | choose_acct_desc rules (acct,desc) | null matchingrules = (acct,desc) | ||||||
|                                    | otherwise = (a,d) |                                    | otherwise = (a,d) | ||||||
|     where |     where | ||||||
|       matches = filter (any (desc =~) . map head . fst) rules |       matchingrules = filter ismatch rules :: [Rule] | ||||||
|       (pats,a) = head matches :: Rule |           where ismatch = any (isJust . flip matchregex desc . fst) . fst | ||||||
|       ((before,match,after,groups),repl) = head $ filter isMatch $ map (\(pat:repl) -> (desc=~pat,repl)) pats |       (prs,a) = head matchingrules | ||||||
|       d = head $ repl ++ [match]  -- show the replacement text if any, or the matched text |       mrs = filter (isJust . fst) $ map (\(p,r) -> (matchregex p desc, r)) prs | ||||||
|  |       (m,repl) = head mrs | ||||||
|  |       matched = fst $ fst $ fromJust m | ||||||
|  |       d = fromMaybe matched repl | ||||||
| 
 | 
 | ||||||
| isMatch :: ((String, String, String, [String]),[String]) -> Bool | matchregex s = matchRegexPR ("(?i)"++s) | ||||||
| isMatch ((_,m,_,_),_) = not $ null m |  | ||||||
| 
 | 
 | ||||||
| fixdate :: String -> String | fixdate :: String -> String | ||||||
| fixdate s = maybe "0000/00/00" showDate $  | fixdate s = maybe "0000/00/00" showDate $  | ||||||
| @ -112,3 +122,4 @@ fixdate s = maybe "0000/00/00" showDate $ | |||||||
|               ,parseTime defaultTimeLocale "%m/%d/%Y" s |               ,parseTime defaultTimeLocale "%m/%d/%Y" s | ||||||
|               ,parseTime defaultTimeLocale "%m-%d-%Y" s |               ,parseTime defaultTimeLocale "%m-%d-%Y" s | ||||||
|               ] |               ] | ||||||
|  | 
 | ||||||
|  | |||||||
| @ -110,7 +110,6 @@ executable hledger | |||||||
|                  ,parsec |                  ,parsec | ||||||
|                  ,process |                  ,process | ||||||
|                  ,regex-compat |                  ,regex-compat | ||||||
|                  ,regex-pcre |  | ||||||
|                  ,regexpr >= 0.5.1 |                  ,regexpr >= 0.5.1 | ||||||
|                  ,split |                  ,split | ||||||
|                  ,testpack |                  ,testpack | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user