convert: tests, allow blank/comment lines at end of rules file

This commit is contained in:
Simon Michael 2010-03-10 19:59:56 +00:00
parent 98f1e2afdf
commit e09ac0cb53
2 changed files with 53 additions and 11 deletions

View File

@ -50,10 +50,10 @@ tests_Commands = TestList
[
-- Commands.Add.tests_Add
-- ,Commands.Balance.tests_Balance
-- ,Commands.Convert.tests_Convert
Commands.Convert.tests_Convert
-- ,Commands.Histogram.tests_Histogram
-- ,Commands.Print.tests_Print
Commands.Register.tests_Register
,Commands.Register.tests_Register
-- ,Commands.Stats.tests_Stats
]
-- #ifdef VTY

View File

@ -7,7 +7,7 @@ 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.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual)
import Ledger.Parse (someamount, emptyCtx, ledgeraccountname)
import Ledger.Amount (nullmixedamt)
import Safe (atDef, maximumDef)
@ -19,12 +19,13 @@ import Data.Maybe
import Ledger.Dates (firstJust, showDate, parsedate)
import System.Locale (defaultTimeLocale)
import Data.Time.Format (parseTime)
import Control.Monad (when, guard)
import Control.Monad (when, guard, liftM)
import Safe (readDef, readMay)
import System.Directory (doesFileExist)
import System.Exit (exitFailure)
import System.FilePath.Posix (takeBaseName, replaceExtension)
import Text.ParserCombinators.Parsec
import Test.HUnit
convert :: [Opt] -> [String] -> Ledger -> IO ()
@ -43,10 +44,7 @@ convert opts args _ = do
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
rules <- liftM (either (error.show) id) $ parseCsvRulesFile rulesfile
when debug $ hPrintf stderr "rules: %s\n" (show rules)
let requiredfields = max 2 (maxFieldIndex rules + 1)
badrecords = take 1 $ filter ((< requiredfields).length) records
@ -113,7 +111,7 @@ data CsvRules = CsvRules {
baseCurrency :: Maybe String,
baseAccount :: AccountName,
accountRules :: [AccountRule]
} deriving (Show)
} deriving (Show, Eq)
nullrules = CsvRules {
dateField=Nothing,
@ -138,6 +136,11 @@ type CsvRecord = [String]
-- rules file parser
parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules)
parseCsvRulesFile f = do
s <- readFile f
return $ parseCsvRules f s
parseCsvRules :: FilePath -> String -> Either ParseError CsvRules
parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
@ -228,14 +231,14 @@ baseaccount = do
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
many blankorcommentline
return (pats',acct)
<?> "account rule"
blanklines = many1 blankline >> return ()
@ -339,3 +342,42 @@ identify rules defacct desc | null matchingrules = (defacct,desc)
Nothing -> desc
caseinsensitive = ("(?i)"++)
tests_Convert = TestList [
"convert rules parsing: empty file" ~: do
-- let assertMixedAmountParse parseresult mixedamount =
-- (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)
assertParseEqual (parseCsvRules "unknown" "") nullrules
,"convert rules parsing: accountrule" ~: do
assertParseEqual (parseWithCtx nullrules accountrule "A\na\n") -- leading blank line required
([("A",Nothing)], "a")
,"convert rules parsing: trailing comments" ~: do
assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#\n")
,"convert rules parsing: trailing blank lines" ~: do
assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n \n")
-- not supported
-- ,"convert rules parsing: no final newline" ~: do
-- assertParse (parseWithCtx nullrules csvrulesfile "A\na")
-- assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#")
-- assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n ")
-- (nullrules{
-- -- dateField=Maybe FieldPosition,
-- -- statusField=Maybe FieldPosition,
-- -- codeField=Maybe FieldPosition,
-- -- descriptionField=Maybe FieldPosition,
-- -- amountField=Maybe FieldPosition,
-- -- currencyField=Maybe FieldPosition,
-- -- baseCurrency=Maybe String,
-- -- baseAccount=AccountName,
-- accountRules=[
-- ([("A",Nothing)], "a")
-- ]
-- })
]