lib: rename and expose more journal file parsers
This commit is contained in:
Simon Michael
parent
ac95930b15
commit
5223bc5c41
@ -19,11 +19,12 @@ module Hledger.Read (
|
||||
ensureJournalFileExists,
|
||||
-- * Parsers used elsewhere
|
||||
postingp,
|
||||
accountname,
|
||||
accountnamep,
|
||||
amountp,
|
||||
amountp',
|
||||
mamountp',
|
||||
code,
|
||||
numberp,
|
||||
codep,
|
||||
-- * Tests
|
||||
samplejournal,
|
||||
tests_Hledger_Read,
|
||||
|
||||
@ -26,13 +26,14 @@ module Hledger.Read.JournalReader (
|
||||
directive,
|
||||
defaultyeardirective,
|
||||
historicalpricedirective,
|
||||
datetime,
|
||||
code,
|
||||
accountname,
|
||||
datetimep,
|
||||
codep,
|
||||
accountnamep,
|
||||
postingp,
|
||||
amountp,
|
||||
amountp',
|
||||
mamountp',
|
||||
numberp,
|
||||
emptyline
|
||||
#ifdef TESTS
|
||||
-- * Tests
|
||||
@ -207,7 +208,7 @@ accountdirective :: GenParser Char JournalContext JournalUpdate
|
||||
accountdirective = do
|
||||
string "account"
|
||||
many1 spacenonewline
|
||||
parent <- accountname
|
||||
parent <- accountnamep
|
||||
newline
|
||||
pushParentAccount parent
|
||||
return $ return id
|
||||
@ -272,7 +273,7 @@ historicalpricedirective :: GenParser Char JournalContext HistoricalPrice
|
||||
historicalpricedirective = do
|
||||
char 'P' <?> "historical price"
|
||||
many spacenonewline
|
||||
date <- try (do {LocalTime d _ <- datetime; return d}) <|> date -- a time is ignored
|
||||
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> date -- a time is ignored
|
||||
many1 spacenonewline
|
||||
symbol <- commoditysymbol
|
||||
many spacenonewline
|
||||
@ -323,7 +324,7 @@ transaction = do
|
||||
date <- date <?> "transaction"
|
||||
edate <- optionMaybe (secondarydate date) <?> "secondary date"
|
||||
status <- status <?> "cleared flag"
|
||||
code <- code <?> "transaction code"
|
||||
code <- codep <?> "transaction code"
|
||||
description <- descriptionp >>= return . strip
|
||||
comment <- try followingcomment <|> (newline >> return "")
|
||||
let tags = tagsInComment comment
|
||||
@ -443,8 +444,8 @@ date = do
|
||||
-- timezone will be ignored; the time is treated as local time. Fewer
|
||||
-- digits are allowed, except in the timezone. The year may be omitted if
|
||||
-- a default year has already been set.
|
||||
datetime :: GenParser Char JournalContext LocalTime
|
||||
datetime = do
|
||||
datetimep :: GenParser Char JournalContext LocalTime
|
||||
datetimep = do
|
||||
day <- date
|
||||
many1 spacenonewline
|
||||
h <- many1 digit
|
||||
@ -487,8 +488,8 @@ secondarydate primarydate = do
|
||||
status :: GenParser Char JournalContext Bool
|
||||
status = try (do { many spacenonewline; (char '*' <|> char '!') <?> "status"; return True } ) <|> return False
|
||||
|
||||
code :: GenParser Char JournalContext String
|
||||
code = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
|
||||
codep :: GenParser Char JournalContext String
|
||||
codep = try (do { many1 spacenonewline; char '(' <?> "codep"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
|
||||
|
||||
-- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments.
|
||||
postings :: GenParser Char JournalContext [Posting]
|
||||
@ -570,7 +571,7 @@ test_postingp = do
|
||||
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
|
||||
modifiedaccountname :: GenParser Char JournalContext AccountName
|
||||
modifiedaccountname = do
|
||||
a <- accountname
|
||||
a <- accountnamep
|
||||
prefix <- getParentAccount
|
||||
let prefixed = prefix `joinAccountNames` a
|
||||
aliases <- getAccountAliases
|
||||
@ -580,8 +581,8 @@ modifiedaccountname = do
|
||||
-- them, and are terminated by two or more spaces. They should have one or
|
||||
-- more components of at least one character, separated by the account
|
||||
-- separator char.
|
||||
accountname :: GenParser Char st AccountName
|
||||
accountname = do
|
||||
accountnamep :: GenParser Char st AccountName
|
||||
accountnamep = do
|
||||
a <- many1 (nonspace <|> singlespace)
|
||||
let a' = striptrailingspace a
|
||||
when (accountNameFromComponents (accountNameComponents a') /= a')
|
||||
@ -653,7 +654,7 @@ leftsymbolamount = do
|
||||
let applysign = if isJust sign then negate else id
|
||||
c <- commoditysymbol
|
||||
sp <- many spacenonewline
|
||||
(q,prec,dec,sep,seppos) <- number
|
||||
(q,prec,dec,sep,seppos) <- numberp
|
||||
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}
|
||||
p <- priceamount
|
||||
return $ applysign $ Amount c q p s
|
||||
@ -661,7 +662,7 @@ leftsymbolamount = do
|
||||
|
||||
rightsymbolamount :: GenParser Char JournalContext Amount
|
||||
rightsymbolamount = do
|
||||
(q,prec,dec,sep,seppos) <- number
|
||||
(q,prec,dec,sep,seppos) <- numberp
|
||||
sp <- many spacenonewline
|
||||
c <- commoditysymbol
|
||||
p <- priceamount
|
||||
@ -671,7 +672,7 @@ rightsymbolamount = do
|
||||
|
||||
nosymbolamount :: GenParser Char JournalContext Amount
|
||||
nosymbolamount = do
|
||||
(q,prec,dec,sep,seppos) <- number
|
||||
(q,prec,dec,sep,seppos) <- numberp
|
||||
p <- priceamount
|
||||
defcs <- getCommodityAndStyle
|
||||
let (c,s) = case defcs of
|
||||
@ -744,8 +745,8 @@ fixedlotprice =
|
||||
-- and separator characters (defaulting to . and ,), and the positions of
|
||||
-- separators (counting leftward from the decimal point, the last is
|
||||
-- assumed to repeat).
|
||||
number :: GenParser Char JournalContext (Quantity, Int, Char, Char, [Int])
|
||||
number = do
|
||||
numberp :: GenParser Char JournalContext (Quantity, Int, Char, Char, [Int])
|
||||
numberp = do
|
||||
sign <- optionMaybe $ string "-"
|
||||
parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
|
||||
let numeric = isNumber . headDef '_'
|
||||
@ -781,12 +782,12 @@ number = do
|
||||
(Nothing, Just ',') -> ('.',',')
|
||||
_ -> ('.',',')
|
||||
return (quantity,precision,decimalpoint,separator,separatorpositions)
|
||||
<?> "number"
|
||||
<?> "numberp"
|
||||
|
||||
#ifdef TESTS
|
||||
test_number = do
|
||||
let s `is` n = assertParseEqual' (parseWithCtx nullctx number s) n
|
||||
assertFails = assertBool . isLeft . parseWithCtx nullctx number
|
||||
test_numberp = do
|
||||
let s `is` n = assertParseEqual' (parseWithCtx nullctx numberp s) n
|
||||
assertFails = assertBool . isLeft . parseWithCtx nullctx numberp
|
||||
assertFails ""
|
||||
"0" `is` (0, 0, '.', ',', [])
|
||||
"1" `is` (1, 0, '.', ',', [])
|
||||
@ -893,7 +894,7 @@ date2ValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date2") . fst) ts
|
||||
{- old hunit tests
|
||||
|
||||
test_Hledger_Read_JournalReader = TestList $ concat [
|
||||
test_number,
|
||||
test_numberp,
|
||||
test_amountp,
|
||||
test_spaceandamountormissing,
|
||||
test_tagcomment,
|
||||
@ -924,8 +925,8 @@ test_Hledger_Read_JournalReader = TestList $ concat [
|
||||
assertParseFailure (parseWithCtx nullctx date "1/1")
|
||||
assertParse (parseWithCtx nullctx{ctxYear=Just 2011} date "1/1")
|
||||
|
||||
,"datetime" ~: do
|
||||
let p = do {t <- datetime; eof; return t}
|
||||
,"datetimep" ~: do
|
||||
let p = do {t <- datetimep; eof; return t}
|
||||
bad = assertParseFailure . parseWithCtx nullctx p
|
||||
good = assertParse . parseWithCtx nullctx p
|
||||
bad "2011/1/1"
|
||||
@ -963,11 +964,11 @@ test_Hledger_Read_JournalReader = TestList $ concat [
|
||||
assertParse (parseWithCtx nullctx endtagdirective "end tag \n")
|
||||
assertParse (parseWithCtx nullctx endtagdirective "pop \n")
|
||||
|
||||
,"accountname" ~: do
|
||||
assertBool "accountname parses a normal accountname" (isRight $ parsewith accountname "a:b:c")
|
||||
assertBool "accountname rejects an empty inner component" (isLeft $ parsewith accountname "a::c")
|
||||
assertBool "accountname rejects an empty leading component" (isLeft $ parsewith accountname ":b:c")
|
||||
assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:")
|
||||
,"accountnamep" ~: do
|
||||
assertBool "accountnamep parses a normal account name" (isRight $ parsewith accountnamep "a:b:c")
|
||||
assertBool "accountnamep rejects an empty inner component" (isLeft $ parsewith accountnamep "a::c")
|
||||
assertBool "accountnamep rejects an empty leading component" (isLeft $ parsewith accountnamep ":b:c")
|
||||
assertBool "accountnamep rejects an empty trailing component" (isLeft $ parsewith accountnamep "a:b:")
|
||||
|
||||
,"leftsymbolamount" ~: do
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (usd 1 `withPrecision` 0)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user