diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 622ba6000..2839463b4 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index b8e62c13e..0520114fa 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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 { diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index e7128de26..37a9742f4 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 460c795d4..936429e9a 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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}) diff --git a/hledger-lib/Hledger/Read/Journal.hs b/hledger-lib/Hledger/Read/Journal.hs index 2805705b0..2257f144d 100644 --- a/hledger-lib/Hledger/Read/Journal.hs +++ b/hledger-lib/Hledger/Read/Journal.hs @@ -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]) ] diff --git a/hledger-lib/Hledger/Read/Timelog.hs b/hledger-lib/Hledger/Read/Timelog.hs index 22634bb1e..da98b3bf3 100644 --- a/hledger-lib/Hledger/Read/Timelog.hs +++ b/hledger-lib/Hledger/Read/Timelog.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 45f938a83..d9ab32463 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Convert.hs b/hledger/Hledger/Cli/Commands/Convert.hs index d9e9978b5..f8b45d63a 100644 --- a/hledger/Hledger/Cli/Commands/Convert.hs +++ b/hledger/Hledger/Cli/Commands/Convert.hs @@ -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" diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs index e9fc78c90..d3b617159 100644 --- a/hledger/Hledger/Cli/Tests.hs +++ b/hledger/Hledger/Cli/Tests.hs @@ -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