parsing: save final parse context with journal
This commit is contained in:
Simon Michael
parent
7714bab58d
commit
d6c2cf6a90
@ -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
|
||||
|
||||
@ -121,18 +121,31 @@ 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],
|
||||
jtxns :: [Transaction],
|
||||
open_timelog_entries :: [TimeLogEntry],
|
||||
historical_prices :: [HistoricalPrice],
|
||||
final_comment_lines :: String, -- ^ any trailing comments from the journal file
|
||||
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
|
||||
-- order encountered.
|
||||
filereadtime :: ClockTime -- ^ when this journal was last read from its file(s)
|
||||
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
|
||||
-- order encountered.
|
||||
filereadtime :: ClockTime -- ^ when this journal was last read from its file(s)
|
||||
} deriving (Eq, Typeable)
|
||||
|
||||
data Ledger = Ledger {
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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})
|
||||
|
||||
|
||||
@ -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
|
||||
eof
|
||||
return $ juSequence journalupdates
|
||||
journalFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
|
||||
journalFile = do
|
||||
journalupdates <- many journalItem
|
||||
eof
|
||||
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,8 +224,8 @@ 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 ++))
|
||||
Left err -> throwError $ inIncluded ++ show err
|
||||
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`
|
||||
\err -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show err)
|
||||
@ -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])
|
||||
|
||||
]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user