slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

parsing: save final parse context with journal

Browse Source
This commit is contained in:
Simon Michael 2010-11-13 15:03:40 +00:00
parent 7714bab58d
commit d6c2cf6a90
9 changed files with 78 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
hledger-lib/Hledger/Data/Journal.hs
View File

@ -41,10 +41,14 @@ nulljournal = Journal { jmodifiertxns = []
, open_timelog_entries = []
, historical_prices = []
, final_comment_lines = []
, jContext = nullctx
, files = []
, filereadtime = TOD 0 0
}
nullctx :: JournalContext
nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] }
nullfilterspec = FilterSpec {
datespan=nulldatespan
,cleared=Nothing
@ -221,12 +225,12 @@ journalSelectingDate EffectiveDate j =
j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j}
-- | Do post-parse processing on a journal, to make it ready for use.
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal
journalFinalise tclock tlocal path txt j@Journal{files=fs} =
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Journal
journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =
journalCanonicaliseAmounts $
journalApplyHistoricalPrices $
journalCloseTimeLogEntries tlocal
j{files=(path,txt):fs, filereadtime=tclock}
j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx}
-- | Convert all the journal's amounts to their canonical display
-- settings. Ie, all amounts in a given commodity will use (a) the

13
hledger-lib/Hledger/Data/Types.hs
View File

@ -121,6 +121,18 @@ data HistoricalPrice = HistoricalPrice {
hamount :: MixedAmount
} deriving (Eq) -- & Show (in Amount.hs)
type Year = Integer
-- | A journal "context" is some data which can change in the course of
-- parsing a journal. An example is the default year, which changes when a
-- Y directive is encountered. At the end of parsing, the final context
-- is saved for later use by eg the add command.
data JournalContext = Ctx {
ctxYear :: !(Maybe Year) -- ^ the default year most recently specified with Y
, ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity most recently specified with D
, ctxAccount :: ![AccountName] -- ^ the current stack of parent accounts specified by !account
} deriving (Read, Show, Eq)
data Journal = Journal {
jmodifiertxns :: [ModifierTransaction],
jperiodictxns :: [PeriodicTransaction],
@ -128,6 +140,7 @@ data Journal = Journal {
open_timelog_entries :: [TimeLogEntry],
historical_prices :: [HistoricalPrice],
final_comment_lines :: String, -- ^ any trailing comments from the journal file
jContext :: JournalContext, -- ^ the context (parse state) at the end of parsing
files :: [(FilePath, String)], -- ^ the file path and raw text of the main and
-- any included journal files. The main file is
-- first followed by any included files in the

3
hledger-lib/Hledger/Read.hs
View File

@ -18,6 +18,7 @@ module Hledger.Read (
where
import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Types (Journal(..))
import Hledger.Data.Journal (nullctx)
import Hledger.Data.Utils
import Hledger.Read.Common
import Hledger.Read.Journal as Journal
@ -139,7 +140,7 @@ tests_Hledger_Read = TestList
[
"journalFile" ~: do
assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx emptyCtx Journal.journalFile "")
assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx nullctx Journal.journalFile "")
jE <- readJournal Nothing "" -- don't know how to get it from journalFile
either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE

18
hledger-lib/Hledger/Read/Common.hs
View File

@ -10,7 +10,7 @@ where
import Control.Monad.Error
import Hledger.Data.Utils
import Hledger.Data.Types (Journal, Commodity)
import Hledger.Data.Types (Journal, JournalContext(..), Commodity)
import Hledger.Data.Journal
import System.Directory (getHomeDirectory)
import System.FilePath(takeDirectory,combine)
@ -33,24 +33,14 @@ juSequence us = liftM (foldr (.) id) $ sequence us
-- | Given a JournalUpdate-generating parsec parser, file path and data string,
-- parse and post-process a Journal so that it's ready to use, or give an error.
parseJournalWith :: (GenParser Char JournalContext JournalUpdate) -> FilePath -> String -> ErrorT String IO Journal
parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal
parseJournalWith p f s = do
tc <- liftIO getClockTime
tl <- liftIO getCurrentLocalTime
case runParser p emptyCtx f s of
Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal
case runParser p nullctx f s of
Right (updates,ctx) -> liftM (journalFinalise tc tl f s ctx) $ updates `ap` return nulljournal
Left err -> throwError $ show err
-- | Some state kept while parsing a journal file.
data JournalContext = Ctx {
ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y
, ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity recently specified with D
, ctxAccount :: ![String] -- ^ the current stack of parent accounts specified by !account
} deriving (Read, Show)
emptyCtx :: JournalContext
emptyCtx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] }
setYear :: Integer -> GenParser tok JournalContext ()
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})

70
hledger-lib/Hledger/Read/Journal.hs
View File

@ -151,17 +151,17 @@ detect f _ = fileSuffix f == format
-- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error.
parse :: FilePath -> String -> ErrorT String IO Journal
parse = do
j <- parseJournalWith journalFile
return j
parse = parseJournalWith journalFile
-- | Top-level journal parser. Returns a single composite, I/O performing,
-- error-raising "JournalUpdate" which can be applied to an empty journal
-- to get the final result.
journalFile :: GenParser Char JournalContext JournalUpdate
journalFile = do journalupdates <- many journalItem
journalFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
journalFile = do
journalupdates <- many journalItem
eof
return $ juSequence journalupdates
finalctx <- getState
return $ (juSequence journalupdates, finalctx)
where
-- As all journal line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or
@ -224,7 +224,7 @@ ledgerInclude = do
txt <- readFileOrError outerPos filepath
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
case runParser journalFile outerState filepath txt of
Right ju -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
Right (ju,_) -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
Left err -> throwError $ inIncluded ++ show err
where readFileOrError pos fp =
ErrorT $ liftM Right (readFile fp) `catch`
@ -563,52 +563,52 @@ numberpartsstartingwithpoint = do
tests_Journal = TestList [
"ledgerTransaction" ~: do
assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1
assertParseEqual (parseWithCtx nullctx ledgerTransaction entry1_str) entry1
assertBool "ledgerTransaction should not parse just a date"
$ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n"
$ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1\n"
assertBool "ledgerTransaction should require some postings"
$ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n"
let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"
$ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1 a\n"
let t = parseWithCtx nullctx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"
assertBool "ledgerTransaction should not include a comment in the description"
$ either (const False) ((== "a") . tdescription) t
,"ledgerModifierTransaction" ~: do
assertParse (parseWithCtx emptyCtx ledgerModifierTransaction "= (some value expr)\n some:postings 1\n")
assertParse (parseWithCtx nullctx ledgerModifierTransaction "= (some value expr)\n some:postings 1\n")
,"ledgerPeriodicTransaction" ~: do
assertParse (parseWithCtx emptyCtx ledgerPeriodicTransaction "~ (some period expr)\n some:postings 1\n")
assertParse (parseWithCtx nullctx ledgerPeriodicTransaction "~ (some period expr)\n some:postings 1\n")
,"ledgerExclamationDirective" ~: do
assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!include /some/file.x\n")
assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!account some:account\n")
assertParse (parseWithCtx emptyCtx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n")
assertParse (parseWithCtx nullctx ledgerExclamationDirective "!include /some/file.x\n")
assertParse (parseWithCtx nullctx ledgerExclamationDirective "!account some:account\n")
assertParse (parseWithCtx nullctx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n")
,"ledgercommentline" ~: do
assertParse (parseWithCtx emptyCtx ledgercommentline "; some comment \n")
assertParse (parseWithCtx emptyCtx ledgercommentline " \t; x\n")
assertParse (parseWithCtx emptyCtx ledgercommentline ";x")
assertParse (parseWithCtx nullctx ledgercommentline "; some comment \n")
assertParse (parseWithCtx nullctx ledgercommentline " \t; x\n")
assertParse (parseWithCtx nullctx ledgercommentline ";x")
,"ledgerDefaultYear" ~: do
assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 2010\n")
assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 10001\n")
assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 2010\n")
assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 10001\n")
,"ledgerHistoricalPrice" ~:
assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55])
assertParseEqual (parseWithCtx nullctx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55])
,"ledgerIgnoredPriceCommodity" ~: do
assertParse (parseWithCtx emptyCtx ledgerIgnoredPriceCommodity "N $\n")
assertParse (parseWithCtx nullctx ledgerIgnoredPriceCommodity "N $\n")
,"ledgerDefaultCommodity" ~: do
assertParse (parseWithCtx emptyCtx ledgerDefaultCommodity "D $1,000.0\n")
assertParse (parseWithCtx nullctx ledgerDefaultCommodity "D $1,000.0\n")
,"ledgerCommodityConversion" ~: do
assertParse (parseWithCtx emptyCtx ledgerCommodityConversion "C 1h = $50.00\n")
assertParse (parseWithCtx nullctx ledgerCommodityConversion "C 1h = $50.00\n")
,"ledgerTagDirective" ~: do
assertParse (parseWithCtx emptyCtx ledgerTagDirective "tag foo \n")
assertParse (parseWithCtx nullctx ledgerTagDirective "tag foo \n")
,"ledgerEndTagDirective" ~: do
assertParse (parseWithCtx emptyCtx ledgerEndTagDirective "end tag \n")
assertParse (parseWithCtx nullctx ledgerEndTagDirective "end tag \n")
,"ledgeraccountname" ~: do
assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")
@ -617,29 +617,29 @@ tests_Journal = TestList [
assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")
,"ledgerposting" ~: do
assertParseEqual (parseWithCtx emptyCtx ledgerposting " expenses:food:dining $10.00\n")
assertParseEqual (parseWithCtx nullctx ledgerposting " expenses:food:dining $10.00\n")
(Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing)
assertBool "ledgerposting parses a quoted commodity with numbers"
(isRight $ parseWithCtx emptyCtx ledgerposting " a 1 \"DE123\"\n")
(isRight $ parseWithCtx nullctx ledgerposting " a 1 \"DE123\"\n")
,"someamount" ~: do
let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity
assertMixedAmountParse parseresult mixedamount =
(either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)
assertMixedAmountParse (parseWithCtx emptyCtx someamount "1 @ $2")
assertMixedAmountParse (parseWithCtx nullctx someamount "1 @ $2")
(Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])
,"postingamount" ~: do
assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18])
assertParseEqual (parseWithCtx emptyCtx postingamount " $1.")
assertParseEqual (parseWithCtx nullctx postingamount " $47.18") (Mixed [dollars 47.18])
assertParseEqual (parseWithCtx nullctx postingamount " $1.")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])
,"leftsymbolamount" ~: do
assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$1")
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])
assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$-1")
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])
assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "-$1")
assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])
]

5
hledger-lib/Hledger/Read/Timelog.hs
View File

@ -71,10 +71,11 @@ detect f _ = fileSuffix f == format
parse :: FilePath -> String -> ErrorT String IO Journal
parse = parseJournalWith timelogFile
timelogFile :: GenParser Char JournalContext JournalUpdate
timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
timelogFile = do items <- many timelogItem
eof
return $ liftM (foldr (.) id) $ sequence items
ctx <- getState
return (liftM (foldr (.) id) $ sequence items, ctx)
where
-- As all ledger line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or

5
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -9,7 +9,6 @@ module Hledger.Cli.Commands.Add
where
import Hledger.Data
import Hledger.Read.Journal (someamount)
import Hledger.Read.Common (emptyCtx)
import Hledger.Cli.Options
import Hledger.Cli.Commands.Register (registerReport, registerReportAsText)
#if __GLASGOW_HASKELL__ <= 610
@ -93,7 +92,7 @@ getPostings accept historicalps enteredps = do
then return enteredps
else do
amountstr <- askFor (printf "amount %d" n) defaultamount validateamount
let amount = fromparse $ runParser (someamount <|> return missingamt) emptyCtx "" amountstr
let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr
let p = nullposting{paccount=stripbrackets account,
pamount=amount,
ptype=postingtype account}
@ -114,7 +113,7 @@ getPostings accept historicalps enteredps = do
postingtype _ = RegularPosting
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
validateamount = Just $ \s -> (null s && not (null enteredrealps))
|| isRight (runParser (someamount>>many spacenonewline>>eof) emptyCtx "" s)
|| isRight (parse (someamount>>many spacenonewline>>eof) "" s)
-- | Prompt for and read a string value, optionally with a default value
-- and a validator. A validator causes the prompt to repeat until the

3
hledger/Hledger/Cli/Commands/Convert.hs
View File

@ -8,7 +8,6 @@ import Hledger.Cli.Options (Opt(Debug))
import Hledger.Cli.Version (versionstr)
import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error')
import Hledger.Read.Common (emptyCtx)
import Hledger.Read.Journal (someamount,ledgeraccountname)
import Hledger.Data.Amount (nullmixedamt)
import Safe (atDef, maximumDef)
@ -282,7 +281,7 @@ transactionFromCsvRecord rules fields =
strnegate s = '-':s
currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)
amountstr'' = currency ++ amountstr'
amountparse = runParser someamount emptyCtx "" amountstr''
amountparse = parse someamount "" amountstr''
amount = either (const nullmixedamt) id amountparse
unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown"
| otherwise = "expenses:unknown"

5
hledger/Hledger/Cli/Tests.hs
View File

@ -34,7 +34,6 @@ import System.Time (ClockTime(TOD))
import Hledger.Cli.Commands.All
import Hledger.Data -- including testing utils in Hledger.Data.Utils
import Hledger.Read.Common (emptyCtx)
import Hledger.Read (readJournal)
import Hledger.Read.Journal (someamount)
import Hledger.Cli.Options
@ -1059,6 +1058,7 @@ journal7 = Journal
[]
[]
""
nullctx
[]
(TOD 0 0)
@ -1090,7 +1090,8 @@ journalWithAmounts as =
[]
[]
""
nullctx
[]
(TOD 0 0)
where parse = fromparse . parseWithCtx emptyCtx someamount
where parse = fromparse . parseWithCtx nullctx someamount