journal: add p suffix to date[time] parsers
This commit is contained in:
parent
a0010a294f
commit
3e27f4fb8b
@ -276,7 +276,7 @@ historicalpricedirective :: GenParser Char JournalContext HistoricalPrice
|
|||||||
historicalpricedirective = do
|
historicalpricedirective = do
|
||||||
char 'P' <?> "historical price"
|
char 'P' <?> "historical price"
|
||||||
many spacenonewline
|
many spacenonewline
|
||||||
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> date -- a time is ignored
|
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored
|
||||||
many1 spacenonewline
|
many1 spacenonewline
|
||||||
symbol <- commoditysymbol
|
symbol <- commoditysymbol
|
||||||
many spacenonewline
|
many spacenonewline
|
||||||
@ -325,8 +325,8 @@ transaction :: GenParser Char JournalContext Transaction
|
|||||||
transaction = do
|
transaction = do
|
||||||
-- ptrace "transaction"
|
-- ptrace "transaction"
|
||||||
sourcepos <- getPosition
|
sourcepos <- getPosition
|
||||||
date <- date <?> "transaction"
|
date <- datep <?> "transaction"
|
||||||
edate <- optionMaybe (secondarydate date) <?> "secondary date"
|
edate <- optionMaybe (secondarydatep date) <?> "secondary date"
|
||||||
status <- status <?> "cleared flag"
|
status <- status <?> "cleared flag"
|
||||||
code <- codep <?> "transaction code"
|
code <- codep <?> "transaction code"
|
||||||
description <- descriptionp >>= return . strip
|
description <- descriptionp >>= return . strip
|
||||||
@ -425,8 +425,8 @@ test_transaction = do
|
|||||||
|
|
||||||
-- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year
|
-- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year
|
||||||
-- may be omitted if a default year has already been set.
|
-- may be omitted if a default year has already been set.
|
||||||
date :: GenParser Char JournalContext Day
|
datep :: GenParser Char JournalContext Day
|
||||||
date = do
|
datep = do
|
||||||
-- hacky: try to ensure precise errors for invalid dates
|
-- hacky: try to ensure precise errors for invalid dates
|
||||||
-- XXX reported error position is not too good
|
-- XXX reported error position is not too good
|
||||||
-- pos <- getPosition
|
-- pos <- getPosition
|
||||||
@ -450,7 +450,7 @@ date = do
|
|||||||
-- a default year has already been set.
|
-- a default year has already been set.
|
||||||
datetimep :: GenParser Char JournalContext LocalTime
|
datetimep :: GenParser Char JournalContext LocalTime
|
||||||
datetimep = do
|
datetimep = do
|
||||||
day <- date
|
day <- datep
|
||||||
many1 spacenonewline
|
many1 spacenonewline
|
||||||
h <- many1 digit
|
h <- many1 digit
|
||||||
let h' = read h
|
let h' = read h
|
||||||
@ -476,8 +476,8 @@ datetimep = do
|
|||||||
-- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
|
-- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
|
||||||
return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
|
return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
|
||||||
|
|
||||||
secondarydate :: Day -> GenParser Char JournalContext Day
|
secondarydatep :: Day -> GenParser Char JournalContext Day
|
||||||
secondarydate primarydate = do
|
secondarydatep primarydate = do
|
||||||
char '='
|
char '='
|
||||||
-- kludgy way to use primary date for default year
|
-- kludgy way to use primary date for default year
|
||||||
let withDefaultYear d p = do
|
let withDefaultYear d p = do
|
||||||
@ -486,7 +486,7 @@ secondarydate primarydate = do
|
|||||||
r <- p
|
r <- p
|
||||||
when (isJust y) $ setYear $ fromJust y
|
when (isJust y) $ setYear $ fromJust y
|
||||||
return r
|
return r
|
||||||
edate <- withDefaultYear primarydate date
|
edate <- withDefaultYear primarydate datep
|
||||||
return edate
|
return edate
|
||||||
|
|
||||||
status :: GenParser Char JournalContext Bool
|
status :: GenParser Char JournalContext Bool
|
||||||
@ -521,8 +521,8 @@ postingp = do
|
|||||||
comment <- try followingcommentp <|> (newline >> return "")
|
comment <- try followingcommentp <|> (newline >> return "")
|
||||||
let tags = tagsInComment comment
|
let tags = tagsInComment comment
|
||||||
-- oh boy
|
-- oh boy
|
||||||
d <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)
|
d <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx datep `fmap` dateValueFromTags tags)
|
||||||
d2 <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` date2ValueFromTags tags)
|
d2 <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx datep `fmap` date2ValueFromTags tags)
|
||||||
return posting{pdate=d, pdate2=d2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags, pbalanceassertion=massertion}
|
return posting{pdate=d, pdate2=d2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags, pbalanceassertion=massertion}
|
||||||
|
|
||||||
#ifdef TESTS
|
#ifdef TESTS
|
||||||
@ -959,10 +959,10 @@ test_Hledger_Read_JournalReader = TestList $ concat [
|
|||||||
assertParse (parseWithCtx nullctx comment " \t; x\n")
|
assertParse (parseWithCtx nullctx comment " \t; x\n")
|
||||||
assertParse (parseWithCtx nullctx comment "#x")
|
assertParse (parseWithCtx nullctx comment "#x")
|
||||||
|
|
||||||
,"date" ~: do
|
,"datep" ~: do
|
||||||
assertParse (parseWithCtx nullctx date "2011/1/1")
|
assertParse (parseWithCtx nullctx datep "2011/1/1")
|
||||||
assertParseFailure (parseWithCtx nullctx date "1/1")
|
assertParseFailure (parseWithCtx nullctx datep "1/1")
|
||||||
assertParse (parseWithCtx nullctx{ctxYear=Just 2011} date "1/1")
|
assertParse (parseWithCtx nullctx{ctxYear=Just 2011} datep "1/1")
|
||||||
|
|
||||||
,"datetimep" ~: do
|
,"datetimep" ~: do
|
||||||
let p = do {t <- datetimep; eof; return t}
|
let p = do {t <- datetimep; eof; return t}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user