parse Y default year lines in a ledger, so they don't break it (ignoring them)

This commit is contained in:
Simon Michael 2009-01-22 23:42:34 +00:00
parent b12e4e3ac2
commit 16e33b50e6
2 changed files with 23 additions and 0 deletions

View File

@ -61,6 +61,12 @@ popParentAccount = do ctx0 <- getState
getParentAccount :: GenParser tok LedgerFileCtx String
getParentAccount = liftM (concat . reverse . ctxAccount) getState
setYear :: Integer -> GenParser tok LedgerFileCtx ()
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
getYear :: GenParser tok LedgerFileCtx (Maybe Integer)
getYear = liftM ctxYear getState
parseLedger :: FilePath -> String -> ErrorT String IO RawLedger
parseLedger inname intxt = case runParser ledgerFile emptyCtx inname intxt of
Right m -> liftM rawLedgerConvertTimeLog $ m `ap` (return rawLedgerEmpty)
@ -79,6 +85,7 @@ ledgerFile = do entries <- many1 ledgerAnyEntry
, liftM (return . addModifierEntry) ledgerModifierEntry
, liftM (return . addPeriodicEntry) ledgerPeriodicEntry
, liftM (return . addHistoricalPrice) ledgerHistoricalPrice
, ledgerDefaultYear
, emptyLine >> return (return id)
, liftM (return . addTimeLogEntry) timelogentry
]
@ -271,6 +278,17 @@ ledgerHistoricalPrice = do
restofline
return $ HistoricalPrice date symbol1 (symbol c) price
-- like ledgerAccountBegin, updates the LedgerFileCtx
ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
ledgerDefaultYear = do
char 'Y' <?> "default year"
many spacenonewline
y <- many1 digit
let y' = read y
guard (y' >= 1000)
setYear y'
return $ return id
ledgerEntry :: GenParser Char LedgerFileCtx Entry
ledgerEntry = do
date <- ledgerdate <?> "entry"

View File

@ -227,6 +227,11 @@ misc_tests = TestList [
,
"ledgerentry" ~: do
assertparseequal price1 (parseWithCtx ledgerHistoricalPrice price1_str)
,
"ledgerDefaultYear" ~: do
-- something to check default year parsing doesn't blow up
rl <- rawledgerfromstring "Y2009\n"
]
newparse_tests = TestList [ sameParseTests ]