slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

convert: keep just the matching part by default, be more verbose with --debug

Browse Source
This commit is contained in:
Simon Michael 2009-04-10 13:45:15 +00:00
parent 522a1f4c2a
commit f699507efd
1 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
ConvertCommand.hs
View File

@ -38,10 +38,11 @@ optional rule saving.
module ConvertCommand where module ConvertCommand where
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
import Options (Opt) import Options -- (Opt,Debug)
import Ledger.Types (Ledger) import Ledger.Types (Ledger)
import Ledger.Utils (strip) import Ledger.Utils (strip)
import System (getArgs) import System (getArgs)
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.Regex.PCRE ((=~))
@ -62,7 +63,7 @@ convert opts args l = do
let records = case parse of let records = case parse of
Left e -> error $ show e Left e -> error $ show e
Right rs -> reverse rs Right rs -> reverse rs
mapM_ (print_ledger_txn (baseacct,fieldpositions,rules)) records mapM_ (print_ledger_txn (Debug `elem` opts) (baseacct,fieldpositions,rules)) records
parseRules s = do parseRules s = do
let ls = map strip $ lines s let ls = map strip $ lines s
@ -71,21 +72,35 @@ parseRules s = do
let rules = [(last p,init p) | p <- tail paras] let rules = [(last p,init p) | p <- tail paras]
return (fieldpositions,rules) return (fieldpositions,rules)
print_ledger_txn (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
strnegate s = '-':s strnegate s = '-':s
unknownacct | (read amount' :: Double) < 0 = "income:unknown" unknownacct | (read amount' :: Double) < 0 = "income:unknown"
| otherwise = "expenses:unknown" | otherwise = "expenses:unknown"
putStrLn $ printf "%s%s %s" (fixdate date) (if not (null number) then printf " (%s)" number else "") description (acct,desc) = choose_acct_desc rules (unknownacct,description)
putStrLn $ printf " %-30s %15s" (fromMaybe unknownacct $ choose_acct rules description) (printf "$%s" amount' :: String) when (debug) $ hPutStrLn stderr $ printf "using %s for %s" desc description
putStrLn $ printf "%s%s %s" (fixdate date) (if not (null number) then printf " (%s)" number else "") desc
putStrLn $ printf " %-30s %15s" acct (printf "$%s" amount' :: String)
putStrLn $ printf " %s\n" baseacct putStrLn $ printf " %s\n" baseacct
print_ledger_txn _ _ = return () print_ledger_txn True _ record = do
hPutStrLn stderr $ printf "ignoring %s" $ show record
print_ledger_txn _ _ _ = return ()
choose_acct rules description | null matches = Nothing choose_acct rules description | null matches = Nothing
| otherwise = Just $ fst $ head $ matches | otherwise = Just $ fst $ head $ matches
where matches = filter (any (description =~) . snd) rules where matches = filter (any (description =~) . snd) rules
choose_acct_desc rules (acct,desc) | null matches = (acct,desc)
| otherwise = (a,d)
where
matches = filter (any (desc =~) . snd) rules
(a,pats) = head matches
(before,match,after,groups) = head $ filter (\(_,m,_,_) -> not $ null m) $ map (desc =~) pats
:: (String, String, String, [String])
-- d = if null groups then before ++ match ++ after else head groups -- default to whole description
d = if null groups then match else head groups -- default to just match
fixdate :: String -> String fixdate :: String -> String
fixdate s = maybe "0000/00/00" showDate $ fixdate s = maybe "0000/00/00" showDate $
firstJust firstJust