ec95b0723c
With this change, Transactions and Postings reference each other co-recursively. This makes constructing them more tedious, but it may also allow LedgerPostings to be dropped and code to be simplified. Time and space performance of register and balance is as before.
319 lines
10 KiB
Haskell
319 lines
10 KiB
Haskell
{-|
|
|
Convert account data in CSV format (eg downloaded from a bank) to ledger
|
|
format, and print it on stdout. See the manual for more details.
|
|
-}
|
|
|
|
module Commands.Convert where
|
|
import Options (Opt(Debug))
|
|
import Version (versionstr)
|
|
import Ledger.Types (Ledger,AccountName,Transaction(..),Posting(..),PostingType(..))
|
|
import Ledger.Utils (strip, spacenonewline, restofline)
|
|
import Ledger.Parse (someamount, emptyCtx, ledgeraccountname)
|
|
import Ledger.Amount (nullmixedamt)
|
|
import System.IO (stderr)
|
|
import Text.CSV (parseCSVFromFile, printCSV)
|
|
import Text.Printf (hPrintf)
|
|
import Text.RegexPR (matchRegexPR)
|
|
import Data.Maybe
|
|
import Ledger.Dates (firstJust, showDate, parsedate)
|
|
import Locale (defaultTimeLocale)
|
|
import Data.Time.Format (parseTime)
|
|
import Control.Monad (when, guard)
|
|
import Safe (readDef, readMay)
|
|
import System.Directory (doesFileExist)
|
|
import System.FilePath.Posix (takeBaseName, replaceExtension)
|
|
import Text.ParserCombinators.Parsec
|
|
|
|
|
|
convert :: [Opt] -> [String] -> Ledger -> IO ()
|
|
convert opts args _ = do
|
|
when (null args) $ error "please specify a csv data file."
|
|
let csvfile = head args
|
|
csvparse <- parseCSVFromFile csvfile
|
|
let records = case csvparse of
|
|
Left e -> error $ show e
|
|
Right rs -> reverse $ filter (/= [""]) rs
|
|
let debug = Debug `elem` opts
|
|
rulesfile = rulesFileFor csvfile
|
|
exists <- doesFileExist rulesfile
|
|
if (not exists) then do
|
|
hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile
|
|
writeFile rulesfile initialRulesFileContent
|
|
else
|
|
hPrintf stderr "using conversion rules file %s\n" rulesfile
|
|
rulesstr <- readFile rulesfile
|
|
let rules = case parseCsvRules rulesfile rulesstr of
|
|
Left e -> error $ show e
|
|
Right r -> r
|
|
when debug $ hPrintf stderr "rules: %s\n" (show rules)
|
|
mapM_ (printTxn debug rules) records
|
|
|
|
rulesFileFor :: FilePath -> FilePath
|
|
rulesFileFor csvfile = replaceExtension csvfile ".rules"
|
|
|
|
initialRulesFileContent :: String
|
|
initialRulesFileContent =
|
|
"# csv conversion rules file generated by hledger "++versionstr++"\n" ++
|
|
"# Add rules to this file for more accurate conversion, see\n"++
|
|
"# http://hledger.org/MANUAL.html#convert\n" ++
|
|
"\n" ++
|
|
"base-account assets:bank:checking\n" ++
|
|
"date-field 0\n" ++
|
|
"description-field 4\n" ++
|
|
"amount-field 1\n" ++
|
|
"currency $\n" ++
|
|
"\n" ++
|
|
"# account-assigning rules\n" ++
|
|
"\n" ++
|
|
"SPECTRUM\n" ++
|
|
"expenses:health:gym\n" ++
|
|
"\n" ++
|
|
"ITUNES\n" ++
|
|
"BLKBSTR=BLOCKBUSTER\n" ++
|
|
"expenses:entertainment\n" ++
|
|
"\n" ++
|
|
"(TO|FROM) SAVINGS\n" ++
|
|
"assets:bank:savings\n"
|
|
|
|
{- |
|
|
A set of data definitions and account-matching patterns sufficient to
|
|
convert a particular CSV data file into meaningful ledger transactions. See above.
|
|
-}
|
|
data CsvRules = CsvRules {
|
|
dateField :: Maybe FieldPosition,
|
|
statusField :: Maybe FieldPosition,
|
|
codeField :: Maybe FieldPosition,
|
|
descriptionField :: Maybe FieldPosition,
|
|
amountField :: Maybe FieldPosition,
|
|
currencyField :: Maybe FieldPosition,
|
|
baseCurrency :: Maybe String,
|
|
baseAccount :: AccountName,
|
|
accountRules :: [AccountRule]
|
|
} deriving (Show)
|
|
|
|
nullrules = CsvRules {
|
|
dateField=Nothing,
|
|
statusField=Nothing,
|
|
codeField=Nothing,
|
|
descriptionField=Nothing,
|
|
amountField=Nothing,
|
|
currencyField=Nothing,
|
|
baseCurrency=Nothing,
|
|
baseAccount="unknown",
|
|
accountRules=[]
|
|
}
|
|
|
|
type FieldPosition = Int
|
|
|
|
type AccountRule = (
|
|
[(String, Maybe String)] -- list of regex match patterns with optional replacements
|
|
,AccountName -- account name to use for a transaction matching this rule
|
|
)
|
|
|
|
type CsvRecord = [String]
|
|
|
|
-- rules file parser
|
|
|
|
parseCsvRules :: FilePath -> String -> Either ParseError CsvRules
|
|
parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
|
|
|
|
csvrulesfile :: GenParser Char CsvRules CsvRules
|
|
csvrulesfile = do
|
|
many blankorcommentline
|
|
many definitions
|
|
r <- getState
|
|
ars <- many accountrule
|
|
many blankorcommentline
|
|
eof
|
|
return r{accountRules=ars}
|
|
|
|
-- | Real independent parser choice, even when alternative matches share a prefix.
|
|
choice' parsers = choice $ map try (init parsers) ++ [last parsers]
|
|
|
|
definitions :: GenParser Char CsvRules ()
|
|
definitions = do
|
|
choice' [
|
|
datefield
|
|
,statusfield
|
|
,codefield
|
|
,descriptionfield
|
|
,amountfield
|
|
,currencyfield
|
|
,basecurrency
|
|
,baseaccount
|
|
,commentline
|
|
] <?> "definition"
|
|
return ()
|
|
|
|
datefield = do
|
|
string "date-field"
|
|
many1 spacenonewline
|
|
v <- restofline
|
|
r <- getState
|
|
setState r{dateField=readMay v}
|
|
|
|
codefield = do
|
|
string "code-field"
|
|
many1 spacenonewline
|
|
v <- restofline
|
|
r <- getState
|
|
setState r{codeField=readMay v}
|
|
|
|
statusfield = do
|
|
string "status-field"
|
|
many1 spacenonewline
|
|
v <- restofline
|
|
r <- getState
|
|
setState r{statusField=readMay v}
|
|
|
|
descriptionfield = do
|
|
string "description-field"
|
|
many1 spacenonewline
|
|
v <- restofline
|
|
r <- getState
|
|
setState r{descriptionField=readMay v}
|
|
|
|
amountfield = do
|
|
string "amount-field"
|
|
many1 spacenonewline
|
|
v <- restofline
|
|
r <- getState
|
|
setState r{amountField=readMay v}
|
|
|
|
currencyfield = do
|
|
string "currency-field"
|
|
many1 spacenonewline
|
|
v <- restofline
|
|
r <- getState
|
|
setState r{currencyField=readMay v}
|
|
|
|
basecurrency = do
|
|
string "currency"
|
|
many1 spacenonewline
|
|
v <- restofline
|
|
r <- getState
|
|
setState r{baseCurrency=Just v}
|
|
|
|
baseaccount = do
|
|
string "base-account"
|
|
many1 spacenonewline
|
|
v <- ledgeraccountname
|
|
optional newline
|
|
r <- getState
|
|
setState r{baseAccount=v}
|
|
|
|
accountrule :: GenParser Char CsvRules AccountRule
|
|
accountrule = do
|
|
blanklines
|
|
many blankorcommentline
|
|
pats <- many1 matchreplacepattern
|
|
guard $ length pats >= 2
|
|
let pats' = init pats
|
|
acct = either (fail.show) id $ runParser ledgeraccountname () "" $ fst $ last pats
|
|
many commentline
|
|
return (pats',acct)
|
|
|
|
blanklines = many1 blankline >> return ()
|
|
|
|
blankline = many spacenonewline >> newline >> return () <?> "blank line"
|
|
|
|
commentchar = oneOf ";#"
|
|
|
|
commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line"
|
|
|
|
blankorcommentline = choice' [blankline, commentline]
|
|
|
|
matchreplacepattern = do
|
|
notFollowedBy commentchar
|
|
matchpat <- many1 (noneOf "=\n")
|
|
replpat <- optionMaybe $ do {char '='; many $ noneOf "\n"}
|
|
newline
|
|
return (matchpat,replpat)
|
|
|
|
printTxn :: Bool -> CsvRules -> CsvRecord -> IO ()
|
|
printTxn debug rules rec = do
|
|
when debug $ hPrintf stderr "csv: %s" (printCSV [rec])
|
|
putStr $ show $ transactionFromCsvRecord rules rec
|
|
|
|
-- csv record conversion
|
|
|
|
transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction
|
|
transactionFromCsvRecord rules fields =
|
|
let
|
|
date = parsedate $ normaliseDate $ maybe "1900/1/1" (fields !!) (dateField rules)
|
|
status = maybe False (null . strip . (fields !!)) (statusField rules)
|
|
code = maybe "" (fields !!) (codeField rules)
|
|
desc = maybe "" (fields !!) (descriptionField rules)
|
|
comment = ""
|
|
precomment = ""
|
|
amountstr = maybe "" (fields !!) (amountField rules)
|
|
amountstr' = strnegate amountstr where strnegate ('-':s) = s
|
|
strnegate s = '-':s
|
|
currency = maybe (fromMaybe "" $ baseCurrency rules) (fields !!) (currencyField rules)
|
|
amountstr'' = currency ++ amountstr'
|
|
amountparse = runParser someamount emptyCtx "" amountstr''
|
|
amount = either (const nullmixedamt) id amountparse
|
|
unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown"
|
|
| otherwise = "expenses:unknown"
|
|
(acct,newdesc) = identify (accountRules rules) unknownacct desc
|
|
t = Transaction {
|
|
tdate=date,
|
|
teffectivedate=Nothing,
|
|
tstatus=status,
|
|
tcode=code,
|
|
tdescription=newdesc,
|
|
tcomment=comment,
|
|
tpreceding_comment_lines=precomment,
|
|
tpostings=[
|
|
Posting {
|
|
pstatus=False,
|
|
paccount=acct,
|
|
pamount=amount,
|
|
pcomment="",
|
|
ptype=RegularPosting,
|
|
ptransaction=Just t
|
|
},
|
|
Posting {
|
|
pstatus=False,
|
|
paccount=baseAccount rules,
|
|
pamount=(-amount),
|
|
pcomment="",
|
|
ptype=RegularPosting,
|
|
ptransaction=Just t
|
|
}
|
|
]
|
|
}
|
|
in t
|
|
|
|
-- | Convert some date string with unknown format to YYYY/MM/DD.
|
|
normaliseDate :: String -> String
|
|
normaliseDate s = maybe "0000/00/00" showDate $
|
|
firstJust
|
|
[parseTime defaultTimeLocale "%Y/%m/%e" s
|
|
-- can't parse a month without leading 0, try adding one
|
|
,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)
|
|
,parseTime defaultTimeLocale "%Y-%m-%e" s
|
|
,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)
|
|
,parseTime defaultTimeLocale "%m/%e/%Y" s
|
|
,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)
|
|
,parseTime defaultTimeLocale "%m-%e-%Y" s
|
|
,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)
|
|
]
|
|
|
|
-- | Apply account matching rules to a transaction description to obtain
|
|
-- the most appropriate account and a new description.
|
|
identify :: [AccountRule] -> String -> String -> (String,String)
|
|
identify rules defacct desc | null matchingrules = (defacct,desc)
|
|
| otherwise = (acct,newdesc)
|
|
where
|
|
matchingrules = filter ismatch rules :: [AccountRule]
|
|
where ismatch = any (isJust . flip matchregex desc . fst) . fst
|
|
(prs,acct) = head matchingrules
|
|
mrs = filter (isJust . fst) $ map (\(p,r) -> (matchregex p desc, r)) prs
|
|
(m,repl) = head mrs
|
|
matched = fst $ fst $ fromJust m
|
|
newdesc = fromMaybe matched repl
|
|
|
|
matchregex = matchRegexPR . ("(?i)" ++)
|
|
|