diff --git a/extra/hledger-rewrite.hs b/extra/hledger-rewrite.hs index 8ab6b5f77..56e53e275 100755 --- a/extra/hledger-rewrite.hs +++ b/extra/hledger-rewrite.hs @@ -51,7 +51,7 @@ type PostingExpr = (AccountName, AmountExpr) data AmountExpr = AmountLiteral String | AmountMultiplier Quantity deriving (Show) addPostingExprsFromOpts :: RawOpts -> [PostingExpr] -addPostingExprsFromOpts = map (either parseerror id . runParser (postingexprp <* eof) nullctx "") . map stripquotes . listofstringopt "add-posting" +addPostingExprsFromOpts = map (either parseerror id . runParser (postingexprp <* eof) nulljps "") . map stripquotes . listofstringopt "add-posting" postingexprp = do a <- accountnamep diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 85f76c5e4..7720bcaa1 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -52,7 +52,7 @@ module Hledger.Data.Journal ( -- * Misc canonicalStyleFrom, matchpats, - nullctx, + nulljps, nulljournal, -- * Tests samplejournal, @@ -120,27 +120,27 @@ instance Show Journal where -- ,show $ open_timeclock_entries j -- ,show $ jmarketprices j -- ,show $ final_comment_lines j --- ,show $ jContext j +-- ,show $ jparsestate j -- ,show $ map fst $ files j -- ] -- The monoid instance for Journal concatenates the list fields, -- combines the map fields, keeps the final comment lines of the -- second journal, and keeps the latest of their last read times. --- See JournalContext for how the final parse contexts are combined. +-- See JournalParseState for how the final parse states are combined. instance Monoid Journal where mempty = nulljournal mappend j1 j2 = - Journal{jmodifiertxns = jmodifiertxns j1 <> jmodifiertxns j2 -- [ModifierTransaction] - ,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2 -- [PeriodicTransaction] - ,jtxns = jtxns j1 <> jtxns j2 -- [Transaction] - ,jcommoditystyles = jcommoditystyles j1 <> jcommoditystyles j2 -- M.Map CommoditySymbol AmountStyle - ,jcommodities = jcommodities j1 <> jcommodities j2 -- M.Map CommoditySymbol Commodity - ,open_timeclock_entries = open_timeclock_entries j1 <> open_timeclock_entries j2 -- [TimeclockEntry] - ,jmarketprices = jmarketprices j1 <> jmarketprices j2 -- [MarketPrice] - ,final_comment_lines = final_comment_lines j1 <> final_comment_lines j2 -- String - ,jContext = jContext j1 <> jContext j2 -- JournalContext - ,files = files j1 <> files j2 -- [(FilePath, String)] + Journal{jmodifiertxns = jmodifiertxns j1 <> jmodifiertxns j2 + ,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2 + ,jtxns = jtxns j1 <> jtxns j2 + ,jcommoditystyles = jcommoditystyles j1 <> jcommoditystyles j2 + ,jcommodities = jcommodities j1 <> jcommodities j2 + ,open_timeclock_entries = open_timeclock_entries j1 <> open_timeclock_entries j2 + ,jmarketprices = jmarketprices j1 <> jmarketprices j2 + ,final_comment_lines = final_comment_lines j1 <> final_comment_lines j2 + ,jparsestate = jparsestate j1 <> jparsestate j2 + ,files = files j1 <> files j2 ,filereadtime = max (filereadtime j1) (filereadtime j2) } @@ -152,30 +152,30 @@ nulljournal = Journal { jmodifiertxns = [] , open_timeclock_entries = [] , jmarketprices = [] , final_comment_lines = [] - , jContext = nullctx + , jparsestate = nulljps , files = [] , filereadtime = TOD 0 0 , jcommoditystyles = M.fromList [] } --- The monoid instance for JournalContext assumes the second context --- is that of an included journal, so it is mostly discarded except --- the accounts defined by account directives are concatenated, and --- the transaction indices (counts of transactions parsed, if any) are --- added. -instance Monoid JournalContext where - mempty = nullctx +-- The monoid instance for JournalParseState mostly discards the +-- second parse state, except the accounts defined by account +-- directives are concatenated, and the transaction indices (counts of +-- transactions parsed, if any) are added. +instance Monoid JournalParseState where + mempty = nulljps mappend c1 c2 = - Ctx { ctxYear = ctxYear c1 - , ctxDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle c1 - , ctxAccounts = ctxAccounts c1 ++ ctxAccounts c2 - , ctxParentAccount = ctxParentAccount c1 - , ctxAliases = ctxAliases c1 - , ctxTransactionIndex = ctxTransactionIndex c1 + ctxTransactionIndex c2 + JournalParseState { + jpsYear = jpsYear c1 + , jpsDefaultCommodityAndStyle = jpsDefaultCommodityAndStyle c1 + , jpsAccounts = jpsAccounts c1 ++ jpsAccounts c2 + , jpsParentAccount = jpsParentAccount c1 + , jpsAliases = jpsAliases c1 + , jpsTransactionIndex = jpsTransactionIndex c1 + jpsTransactionIndex c2 } -nullctx :: JournalContext -nullctx = Ctx{ctxYear=Nothing, ctxDefaultCommodityAndStyle=Nothing, ctxAccounts=[], ctxParentAccount=[], ctxAliases=[], ctxTransactionIndex=0} +nulljps :: JournalParseState +nulljps = JournalParseState{jpsYear=Nothing, jpsDefaultCommodityAndStyle=Nothing, jpsAccounts=[], jpsParentAccount=[], jpsAliases=[], jpsTransactionIndex=0} journalFilePath :: Journal -> FilePath journalFilePath = fst . mainfile @@ -455,14 +455,14 @@ journalApplyAliases aliases j@Journal{jtxns=ts} = -- | Do post-parse processing on a journal to make it ready for use: check -- all transactions balance, canonicalise amount formats, close any open -- timeclock entries, maybe check balance assertions and so on. -journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Bool -> Journal -> Either String Journal -journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do +journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalParseState -> Bool -> Journal -> Either String Journal +journalFinalise tclock tlocal path txt jps assrt j@Journal{files=fs} = do (journalBalanceTransactions $ journalApplyCommodityStyles $ journalCloseTimeclockEntries tlocal $ j{ files=(path,txt):fs , filereadtime=tclock - , jContext=ctx + , jparsestate=jps , jtxns=reverse $ jtxns j -- NOTE: see addTransaction , jmodifiertxns=reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction , jperiodictxns=reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 6e85df171..4e7a95aeb 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -222,23 +222,23 @@ instance NFData MarketPrice 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 - , ctxDefaultCommodityAndStyle :: !(Maybe (CommoditySymbol,AmountStyle)) -- ^ the default commodity and amount style most recently specified with D - , ctxAccounts :: ![AccountName] -- ^ the accounts that have been defined with account directives so far - , ctxParentAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components +-- | Journal parse state is data we want to keep track of 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 state is saved for later use by eg the add command. +data JournalParseState = JournalParseState { + jpsYear :: !(Maybe Year) -- ^ the default year most recently specified with Y + , jpsDefaultCommodityAndStyle :: !(Maybe (CommoditySymbol,AmountStyle)) -- ^ the default commodity and amount style most recently specified with D + , jpsAccounts :: ![AccountName] -- ^ the accounts that have been defined with account directives so far + , jpsParentAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components -- specified with "apply account" directive(s). Concatenated, these -- are the account prefix prepended to parsed account names. - , ctxAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect - , ctxTransactionIndex :: !Integer -- ^ the number of transactions read so far. (Does not count + , jpsAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect + , jpsTransactionIndex :: !Integer -- ^ the number of transactions read so far. (Does not count -- timeclock/timedot/CSV entries, currently). } deriving (Read, Show, Eq, Data, Typeable, Generic) -instance NFData JournalContext +instance NFData JournalParseState deriving instance Data (ClockTime) deriving instance Typeable (ClockTime) @@ -255,7 +255,7 @@ data Journal = Journal { open_timeclock_entries :: [TimeclockEntry], jmarketprices :: [MarketPrice], final_comment_lines :: String, -- ^ any trailing comments from the journal file - jContext :: JournalContext, -- ^ the context (parse state) at the end of parsing + jparsestate :: JournalParseState, -- ^ the final parse state 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 diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 2cd9a6014..409c3f0d3 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -47,7 +47,7 @@ import Test.HUnit import Text.Printf import Hledger.Data.Dates (getCurrentDay) -import Hledger.Data.Journal (nullctx) +import Hledger.Data.Journal (nulljps) import Hledger.Data.Types import Hledger.Read.JournalReader as JournalReader import Hledger.Read.TimedotReader as TimedotReader @@ -259,7 +259,7 @@ tests_Hledger_Read = TestList $ tests_Hledger_Read_CsvReader, "journal" ~: do - r <- runExceptT $ parseWithCtx nullctx JournalReader.journalp "" + r <- runExceptT $ parseWithState nulljps JournalReader.journalp "" assertBool "journalp should parse an empty file" (isRight $ r) jE <- readJournal Nothing Nothing True Nothing "" -- don't know how to get it from journal either error' (assertBool "journalp 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 334f5ac08..4622b2d22 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -43,7 +43,7 @@ import Hledger.Utils type StringParser u m a = ParsecT String u m a -- | A string parser with journal-parsing state. -type JournalParser m a = StringParser JournalContext m a +type JournalParser m a = StringParser JournalParseState m a -- | A journal parser that runs in IO and can throw an error mid-parse. type ErroringJournalParser a = JournalParser (ExceptT String IO) a @@ -55,7 +55,7 @@ rsp = runStringParser -- | Run a journal parser with a null journal-parsing state. runJournalParser, rjp :: Monad m => JournalParser m a -> String -> m (Either ParseError a) -runJournalParser p s = runParserT p nullctx "" s +runJournalParser p s = runParserT p nulljps "" s rjp = runJournalParser -- | Run an error-raising journal parser with a null journal-parsing state. @@ -127,68 +127,68 @@ combineJournalUpdates us = foldl' (flip (.)) 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. -parseAndFinaliseJournal :: ErroringJournalParser (JournalUpdate,JournalContext) -> Bool -> FilePath -> String -> ExceptT String IO Journal +parseAndFinaliseJournal :: ErroringJournalParser (JournalUpdate,JournalParseState) -> Bool -> FilePath -> String -> ExceptT String IO Journal parseAndFinaliseJournal parser assrt f s = do tc <- liftIO getClockTime tl <- liftIO getCurrentLocalTime y <- liftIO getCurrentYear - r <- runParserT parser nullctx{ctxYear=Just y} f s + r <- runParserT parser nulljps{jpsYear=Just y} f s case r of - Right (updates,ctx) -> do + Right (updates,jps) -> do j <- ap updates (return nulljournal) - case journalFinalise tc tl f s ctx assrt j of + case journalFinalise tc tl f s jps assrt j of Right j' -> return j' Left estr -> throwError estr Left e -> throwError $ show e setYear :: Monad m => Integer -> JournalParser m () -setYear y = modifyState (\ctx -> ctx{ctxYear=Just y}) +setYear y = modifyState (\jps -> jps{jpsYear=Just y}) getYear :: Monad m => JournalParser m (Maybe Integer) -getYear = fmap ctxYear getState +getYear = fmap jpsYear getState setDefaultCommodityAndStyle :: Monad m => (CommoditySymbol,AmountStyle) -> JournalParser m () -setDefaultCommodityAndStyle cs = modifyState (\ctx -> ctx{ctxDefaultCommodityAndStyle=Just cs}) +setDefaultCommodityAndStyle cs = modifyState (\jps -> jps{jpsDefaultCommodityAndStyle=Just cs}) getDefaultCommodityAndStyle :: Monad m => JournalParser m (Maybe (CommoditySymbol,AmountStyle)) -getDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle `fmap` getState +getDefaultCommodityAndStyle = jpsDefaultCommodityAndStyle `fmap` getState pushAccount :: Monad m => String -> JournalParser m () pushAccount acct = modifyState addAccount - where addAccount ctx0 = ctx0 { ctxAccounts = acct : ctxAccounts ctx0 } + where addAccount jps0 = jps0 { jpsAccounts = acct : jpsAccounts jps0 } pushParentAccount :: Monad m => String -> JournalParser m () pushParentAccount parent = modifyState addParentAccount - where addParentAccount ctx0 = ctx0 { ctxParentAccount = parent : ctxParentAccount ctx0 } + where addParentAccount jps0 = jps0 { jpsParentAccount = parent : jpsParentAccount jps0 } popParentAccount :: Monad m => JournalParser m () -popParentAccount = do ctx0 <- getState - case ctxParentAccount ctx0 of +popParentAccount = do jps0 <- getState + case jpsParentAccount jps0 of [] -> unexpected "End of apply account block with no beginning" - (_:rest) -> setState $ ctx0 { ctxParentAccount = rest } + (_:rest) -> setState $ jps0 { jpsParentAccount = rest } getParentAccount :: Monad m => JournalParser m String -getParentAccount = fmap (concatAccountNames . reverse . ctxParentAccount) getState +getParentAccount = fmap (concatAccountNames . reverse . jpsParentAccount) getState addAccountAlias :: Monad m => AccountAlias -> JournalParser m () -addAccountAlias a = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases}) +addAccountAlias a = modifyState (\(jps@JournalParseState{..}) -> jps{jpsAliases=a:jpsAliases}) getAccountAliases :: Monad m => JournalParser m [AccountAlias] -getAccountAliases = fmap ctxAliases getState +getAccountAliases = fmap jpsAliases getState clearAccountAliases :: Monad m => JournalParser m () -clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]}) +clearAccountAliases = modifyState (\(jps@JournalParseState{..}) -> jps{jpsAliases=[]}) getTransactionIndex :: Monad m => JournalParser m Integer -getTransactionIndex = fmap ctxTransactionIndex getState +getTransactionIndex = fmap jpsTransactionIndex getState setTransactionIndex :: Monad m => Integer -> JournalParser m () -setTransactionIndex i = modifyState (\ctx -> ctx{ctxTransactionIndex=i}) +setTransactionIndex i = modifyState (\jps -> jps{jpsTransactionIndex=i}) -- | Increment the transaction index by one and return the new value. incrementTransactionIndex :: Monad m => JournalParser m Integer incrementTransactionIndex = do - modifyState (\ctx -> ctx{ctxTransactionIndex=ctxTransactionIndex ctx + 1}) + modifyState (\jps -> jps{jpsTransactionIndex=jpsTransactionIndex jps + 1}) getTransactionIndex journalAddFile :: (FilePath,String) -> Journal -> Journal @@ -368,10 +368,10 @@ is' :: (Eq a, Show a) => a -> a -> Assertion a `is'` e = assertEqual e a test_spaceandamountormissingp = do - assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " $47.18") (Mixed [usd 47.18]) - assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "$47.18") missingmixedamt - assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " ") missingmixedamt - assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "") missingmixedamt + assertParseEqual' (parseWithState nulljps spaceandamountormissingp " $47.18") (Mixed [usd 47.18]) + assertParseEqual' (parseWithState nulljps spaceandamountormissingp "$47.18") missingmixedamt + assertParseEqual' (parseWithState nulljps spaceandamountormissingp " ") missingmixedamt + assertParseEqual' (parseWithState nulljps spaceandamountormissingp "") missingmixedamt #endif -- | Parse a single-commodity amount, with optional symbol on the left or @@ -382,22 +382,22 @@ amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp #ifdef TESTS test_amountp = do - assertParseEqual' (parseWithCtx nullctx amountp "$47.18") (usd 47.18) - assertParseEqual' (parseWithCtx nullctx amountp "$1.") (usd 1 `withPrecision` 0) + assertParseEqual' (parseWithState nulljps amountp "$47.18") (usd 47.18) + assertParseEqual' (parseWithState nulljps amountp "$1.") (usd 1 `withPrecision` 0) -- ,"amount with unit price" ~: do assertParseEqual' - (parseWithCtx nullctx amountp "$10 @ €0.5") + (parseWithState nulljps amountp "$10 @ €0.5") (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- ,"amount with total price" ~: do assertParseEqual' - (parseWithCtx nullctx amountp "$10 @@ €5") + (parseWithState nulljps amountp "$10 @@ €5") (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)) #endif -- | Parse an amount from a string, or get an error. amountp' :: String -> Amount amountp' s = - case runParser (amountp <* eof) nullctx "" s of + case runParser (amountp <* eof) nulljps "" s of Right t -> t Left err -> error' $ show err -- XXX should throwError @@ -572,8 +572,8 @@ numberp = do numeric = isNumber . headDef '_' -- test_numberp = do --- let s `is` n = assertParseEqual (parseWithCtx nullctx numberp s) n --- assertFails = assertBool . isLeft . parseWithCtx nullctx numberp +-- let s `is` n = assertParseEqual (parseWithState nulljps numberp s) n +-- assertFails = assertBool . isLeft . parseWithState nulljps numberp -- assertFails "" -- "0" `is` (0, 0, '.', ',', []) -- "1" `is` (1, 0, '.', ',', []) @@ -796,9 +796,9 @@ datetagp mdefdate = do startpos <- getPosition v <- tagvaluep -- re-parse value as a date. - ctx <- getState - ep <- parseWithCtx - ctx{ctxYear=first3.toGregorian <$> mdefdate} + jps <- getState + ep <- parseWithState + jps{jpsYear=first3.toGregorian <$> mdefdate} -- The value extends to a comma, newline, or end of file. -- It seems like ignoring any extra stuff following a date -- gives better errors here. @@ -855,9 +855,9 @@ bracketeddatetagsp mdefdate = do -- looks sufficiently like a bracketed date, now we -- re-parse as dates and throw any errors - ctx <- getState - ep <- parseWithCtx - ctx{ctxYear=first3.toGregorian <$> mdefdate} + jps <- getState + ep <- parseWithState + jps{jpsYear=first3.toGregorian <$> mdefdate} (do setPosition startpos md1 <- optionMaybe datep diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 842e741ed..27317f7c8 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -605,7 +605,7 @@ transactionFromCsvRecord sourcepos rules record = t status = case mfieldtemplate "status" of Nothing -> Uncleared - Just str -> either statuserror id $ runParser (statusp <* eof) nullctx "" $ render str + Just str -> either statuserror id $ runParser (statusp <* eof) nulljps "" $ render str where statuserror err = error' $ unlines ["error: could not parse \""++str++"\" as a cleared status (should be *, ! or empty)" @@ -617,7 +617,7 @@ transactionFromCsvRecord sourcepos rules record = t precomment = maybe "" render $ mfieldtemplate "precomment" currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency" amountstr = (currency++) $ negateIfParenthesised $ getAmountStr rules record - amount = either amounterror (Mixed . (:[])) $ runParser (amountp <* eof) nullctx "" amountstr + amount = either amounterror (Mixed . (:[])) $ runParser (amountp <* eof) nulljps "" amountstr amounterror err = error' $ unlines ["error: could not parse \""++amountstr++"\" as an amount" ,showRecord record @@ -780,20 +780,20 @@ test_parser = [ assertParseEqual (parseCsvRules "unknown" "") rules -- ,"convert rules parsing: accountrule" ~: do - -- assertParseEqual (parseWithCtx rules accountrule "A\na\n") -- leading blank line required + -- assertParseEqual (parseWithState rules accountrule "A\na\n") -- leading blank line required -- ([("A",Nothing)], "a") ,"convert rules parsing: trailing comments" ~: do - assertParse (parseWithCtx rules rulesp "skip\n# \n#\n") + assertParse (parseWithState rules rulesp "skip\n# \n#\n") ,"convert rules parsing: trailing blank lines" ~: do - assertParse (parseWithCtx rules rulesp "skip\n\n \n") + assertParse (parseWithState rules rulesp "skip\n\n \n") -- not supported -- ,"convert rules parsing: no final newline" ~: do - -- assertParse (parseWithCtx rules csvrulesfile "A\na") - -- assertParse (parseWithCtx rules csvrulesfile "A\na\n# \n#") - -- assertParse (parseWithCtx rules csvrulesfile "A\na\n\n ") + -- assertParse (parseWithState rules csvrulesfile "A\na") + -- assertParse (parseWithState rules csvrulesfile "A\na\n# \n#") + -- assertParse (parseWithState rules csvrulesfile "A\na\n\n ") -- (rules{ -- -- dateField=Maybe FieldPosition, diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 856124c2e..78c1d0f46 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -122,14 +122,14 @@ parse _ = parseAndFinaliseJournal journalp --- ** journal -- | Top-level journal parser. Returns a single composite, I/O performing, --- error-raising "JournalUpdate" (and final "JournalContext") which can be +-- error-raising "JournalUpdate" (and final "JournalParseState") which can be -- applied to an empty journal to get the final result. -journalp :: ErroringJournalParser (JournalUpdate,JournalContext) +journalp :: ErroringJournalParser (JournalUpdate,JournalParseState) journalp = do journalupdates <- many journalItem eof - finalctx <- getState - return (combineJournalUpdates journalupdates, finalctx) + finaljps <- getState + return (combineJournalUpdates journalupdates, finaljps) where -- As all journal line types can be distinguished by the first -- character, excepting transactions versus empty (blank or @@ -175,7 +175,7 @@ includedirectivep = do outerPos <- getPosition let curdir = takeDirectory (sourceName outerPos) -- XXX clean this up, probably after getting rid of JournalUpdate - let (u::ExceptT String IO (Journal -> Journal, JournalContext)) = do + let (u::ExceptT String IO (Journal -> Journal, JournalParseState)) = do filepath <- expandPath curdir filename txt <- readFileOrError outerPos filepath let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" @@ -188,11 +188,11 @@ includedirectivep = do outerState filepath txt case r of - Right (ju, ctx) -> do + Right (ju, jps) -> do u <- combineJournalUpdates [ return $ journalAddFile (filepath,txt) , ju ] `catchError` (throwError . (inIncluded ++)) - return (u, ctx) + return (u, jps) Left err -> throwError $ inIncluded ++ show err where readFileOrError pos fp = ExceptT $ fmap Right (readFile' fp) `C.catch` @@ -200,7 +200,7 @@ includedirectivep = do r <- liftIO $ runExceptT u case r of Left err -> return $ throwError err - Right (ju, _finalparsectx) -> return $ ExceptT $ return $ Right ju + Right (ju, _finalparsejps) -> return $ ExceptT $ return $ Right ju accountdirectivep :: ErroringJournalParser JournalUpdate accountdirectivep = do @@ -422,7 +422,7 @@ transactionp = do #ifdef TESTS test_transactionp = do let s `gives` t = do - let p = parseWithCtx nullctx transactionp s + let p = parseWithState nulljps transactionp s assertBool $ isRight p let Right t2 = p -- same f = assertEqual (f t) (f t2) @@ -475,7 +475,7 @@ test_transactionp = do tdate=parsedate "2015/01/01", } - assertRight $ parseWithCtx nullctx transactionp $ unlines + assertRight $ parseWithState nulljps transactionp $ unlines ["2007/01/28 coopportunity" ," expenses:food:groceries $47.18" ," assets:checking $-47.18" @@ -483,25 +483,25 @@ test_transactionp = do ] -- transactionp should not parse just a date - assertLeft $ parseWithCtx nullctx transactionp "2009/1/1\n" + assertLeft $ parseWithState nulljps transactionp "2009/1/1\n" -- transactionp should not parse just a date and description - assertLeft $ parseWithCtx nullctx transactionp "2009/1/1 a\n" + assertLeft $ parseWithState nulljps transactionp "2009/1/1 a\n" -- transactionp should not parse a following comment as part of the description - let p = parseWithCtx nullctx transactionp "2009/1/1 a ;comment\n b 1\n" + let p = parseWithState nulljps transactionp "2009/1/1 a ;comment\n b 1\n" assertRight p assertEqual "a" (let Right p' = p in tdescription p') -- parse transaction with following whitespace line - assertRight $ parseWithCtx nullctx transactionp $ unlines + assertRight $ parseWithState nulljps transactionp $ unlines ["2012/1/1" ," a 1" ," b" ," " ] - let p = parseWithCtx nullctx transactionp $ unlines + let p = parseWithState nulljps transactionp $ unlines ["2009/1/1 x ; transaction comment" ," a 1 ; posting 1 comment" ," ; posting 1 comment 2" @@ -555,7 +555,7 @@ postingp mtdate = do #ifdef TESTS test_postingp = do let s `gives` ep = do - let parse = parseWithCtx nullctx (postingp Nothing) s + let parse = parseWithState nulljps (postingp Nothing) s assertBool -- "postingp parser" $ isRight parse let Right ap = parse @@ -587,12 +587,12 @@ test_postingp = do ,pdate=parsedateM "2012/11/28"} assertBool -- "postingp parses a quoted commodity with numbers" - (isRight $ parseWithCtx nullctx (postingp Nothing) " a 1 \"DE123\"\n") + (isRight $ parseWithState nulljps (postingp Nothing) " a 1 \"DE123\"\n") -- ,"postingp parses balance assertions and fixed lot prices" ~: do - assertBool (isRight $ parseWithCtx nullctx (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n") + assertBool (isRight $ parseWithState nulljps (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n") - -- let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n" + -- let parse = parseWithState nulljps postingp " a\n ;next-line comment\n" -- assertRight parse -- let Right p = parse -- assertEqual "next-line comment\n" (pcomment p) @@ -619,30 +619,30 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ test_transactionp, [ "modifiertransactionp" ~: do - assertParse (parseWithCtx nullctx modifiertransactionp "= (some value expr)\n some:postings 1\n") + assertParse (parseWithState nulljps modifiertransactionp "= (some value expr)\n some:postings 1\n") ,"periodictransactionp" ~: do - assertParse (parseWithCtx nullctx periodictransactionp "~ (some period expr)\n some:postings 1\n") + assertParse (parseWithState nulljps periodictransactionp "~ (some period expr)\n some:postings 1\n") ,"directivep" ~: do - assertParse (parseWithCtx nullctx directivep "!include /some/file.x\n") - assertParse (parseWithCtx nullctx directivep "account some:account\n") - assertParse (parseWithCtx nullctx (directivep >> directivep) "!account a\nend\n") + assertParse (parseWithState nulljps directivep "!include /some/file.x\n") + assertParse (parseWithState nulljps directivep "account some:account\n") + assertParse (parseWithState nulljps (directivep >> directivep) "!account a\nend\n") ,"comment" ~: do - assertParse (parseWithCtx nullctx comment "; some comment \n") - assertParse (parseWithCtx nullctx comment " \t; x\n") - assertParse (parseWithCtx nullctx comment "#x") + assertParse (parseWithState nulljps comment "; some comment \n") + assertParse (parseWithState nulljps comment " \t; x\n") + assertParse (parseWithState nulljps comment "#x") ,"datep" ~: do - assertParse (parseWithCtx nullctx datep "2011/1/1") - assertParseFailure (parseWithCtx nullctx datep "1/1") - assertParse (parseWithCtx nullctx{ctxYear=Just 2011} datep "1/1") + assertParse (parseWithState nulljps datep "2011/1/1") + assertParseFailure (parseWithState nulljps datep "1/1") + assertParse (parseWithState nulljps{jpsYear=Just 2011} datep "1/1") ,"datetimep" ~: do let p = do {t <- datetimep; eof; return t} - bad = assertParseFailure . parseWithCtx nullctx p - good = assertParse . parseWithCtx nullctx p + bad = assertParseFailure . parseWithState nulljps p + good = assertParse . parseWithState nulljps p bad "2011/1/1" bad "2011/1/1 24:00:00" bad "2011/1/1 00:60:00" @@ -652,31 +652,31 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ good "2011/1/1 3:5:7" -- timezone is parsed but ignored let startofday = LocalTime (fromGregorian 2011 1 1) (TimeOfDay 0 0 (fromIntegral 0)) - assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00-0800") startofday - assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00+1234") startofday + assertParseEqual (parseWithState nulljps p "2011/1/1 00:00-0800") startofday + assertParseEqual (parseWithState nulljps p "2011/1/1 00:00+1234") startofday ,"defaultyeardirectivep" ~: do - assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 2010\n") - assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 10001\n") + assertParse (parseWithState nulljps defaultyeardirectivep "Y 2010\n") + assertParse (parseWithState nulljps defaultyeardirectivep "Y 10001\n") ,"marketpricedirectivep" ~: - assertParseEqual (parseWithCtx nullctx marketpricedirectivep "P 2004/05/01 XYZ $55.00\n") (MarketPrice (parsedate "2004/05/01") "XYZ" $ usd 55) + assertParseEqual (parseWithState nulljps marketpricedirectivep "P 2004/05/01 XYZ $55.00\n") (MarketPrice (parsedate "2004/05/01") "XYZ" $ usd 55) ,"ignoredpricecommoditydirectivep" ~: do - assertParse (parseWithCtx nullctx ignoredpricecommoditydirectivep "N $\n") + assertParse (parseWithState nulljps ignoredpricecommoditydirectivep "N $\n") ,"defaultcommoditydirectivep" ~: do - assertParse (parseWithCtx nullctx defaultcommoditydirectivep "D $1,000.0\n") + assertParse (parseWithState nulljps defaultcommoditydirectivep "D $1,000.0\n") ,"commodityconversiondirectivep" ~: do - assertParse (parseWithCtx nullctx commodityconversiondirectivep "C 1h = $50.00\n") + assertParse (parseWithState nulljps commodityconversiondirectivep "C 1h = $50.00\n") ,"tagdirectivep" ~: do - assertParse (parseWithCtx nullctx tagdirectivep "tag foo \n") + assertParse (parseWithState nulljps tagdirectivep "tag foo \n") ,"endtagdirectivep" ~: do - assertParse (parseWithCtx nullctx endtagdirectivep "end tag \n") - assertParse (parseWithCtx nullctx endtagdirectivep "pop \n") + assertParse (parseWithState nulljps endtagdirectivep "end tag \n") + assertParse (parseWithState nulljps endtagdirectivep "pop \n") ,"accountnamep" ~: do assertBool "accountnamep parses a normal account name" (isRight $ parsewith accountnamep "a:b:c") @@ -685,15 +685,15 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ assertBool "accountnamep rejects an empty trailing component" (isLeft $ parsewith accountnamep "a:b:") ,"leftsymbolamountp" ~: do - assertParseEqual (parseWithCtx nullctx leftsymbolamountp "$1") (usd 1 `withPrecision` 0) - assertParseEqual (parseWithCtx nullctx leftsymbolamountp "$-1") (usd (-1) `withPrecision` 0) - assertParseEqual (parseWithCtx nullctx leftsymbolamountp "-$1") (usd (-1) `withPrecision` 0) + assertParseEqual (parseWithState nulljps leftsymbolamountp "$1") (usd 1 `withPrecision` 0) + assertParseEqual (parseWithState nulljps leftsymbolamountp "$-1") (usd (-1) `withPrecision` 0) + assertParseEqual (parseWithState nulljps leftsymbolamountp "-$1") (usd (-1) `withPrecision` 0) ,"amount" ~: do let -- | compare a parse result with an expected amount, showing the debug representation for clarity assertAmountParse parseresult amount = (either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug amount) - assertAmountParse (parseWithCtx nullctx amountp "1 @ $2") + assertAmountParse (parseWithState nulljps amountp "1 @ $2") (num 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)) ]] diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 17ff43b40..c121a1fff 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -85,11 +85,11 @@ detect f s parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse _ = parseAndFinaliseJournal timeclockfilep -timeclockfilep :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext) +timeclockfilep :: ParsecT [Char] JournalParseState (ExceptT String IO) (JournalUpdate, JournalParseState) timeclockfilep = do items <- many timeclockitemp eof - ctx <- getState - return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx) + jps <- getState + return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, jps) where -- As all ledger line types can be distinguished by the first -- character, excepting transactions versus empty (blank or @@ -100,7 +100,7 @@ timeclockfilep = do items <- many timeclockitemp ] "timeclock entry, or default year or historical price directive" -- | Parse a timeclock entry. -timeclockentryp :: ParsecT [Char] JournalContext (ExceptT String IO) TimeclockEntry +timeclockentryp :: ParsecT [Char] JournalParseState (ExceptT String IO) TimeclockEntry timeclockentryp = do sourcepos <- genericSourcePos <$> getPosition code <- oneOf "bhioO" diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index ac16a1af5..d254c9d1e 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -69,11 +69,11 @@ detect f s parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse _ = parseAndFinaliseJournal timedotfilep -timedotfilep :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext) +timedotfilep :: ParsecT [Char] JournalParseState (ExceptT String IO) (JournalUpdate, JournalParseState) timedotfilep = do items <- many timedotfileitemp eof - ctx <- getState - return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx) + jps <- getState + return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, jps) where timedotfileitemp = do ptrace "timedotfileitemp" @@ -92,7 +92,7 @@ addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts) -- biz.research . -- inc.client1 .... .... .... .... .... .... -- @ -timedotdayp :: ParsecT [Char] JournalContext (ExceptT String IO) [Transaction] +timedotdayp :: ParsecT [Char] JournalParseState (ExceptT String IO) [Transaction] timedotdayp = do ptrace " timedotdayp" d <- datep <* eolof @@ -104,7 +104,7 @@ timedotdayp = do -- @ -- fos.haskell .... .. -- @ -timedotentryp :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction +timedotentryp :: ParsecT [Char] JournalParseState (ExceptT String IO) Transaction timedotentryp = do ptrace " timedotentryp" pos <- genericSourcePos <$> getPosition @@ -128,14 +128,14 @@ timedotentryp = do } return t -timedotdurationp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity +timedotdurationp :: ParsecT [Char] JournalParseState (ExceptT String IO) Quantity timedotdurationp = try timedotnumberp <|> timedotdotsp -- | Parse a duration written as a decimal number of hours (optionally followed by the letter h). -- @ -- 1.5h -- @ -timedotnumberp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity +timedotnumberp :: ParsecT [Char] JournalParseState (ExceptT String IO) Quantity timedotnumberp = do (q, _, _, _) <- numberp many spacenonewline @@ -147,7 +147,7 @@ timedotnumberp = do -- @ -- .... .. -- @ -timedotdotsp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity +timedotdotsp :: ParsecT [Char] JournalParseState (ExceptT String IO) Quantity timedotdotsp = do dots <- filter (not.isSpace) <$> many (oneOf ". ") return $ (/4) $ fromIntegral $ length dots diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index b1fbd6e80..a649ddf3d 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -16,8 +16,8 @@ choice' = choice . map Text.Parsec.try parsewith :: Parsec [Char] () a -> String -> Either ParseError a parsewith p = runParser p () "" -parseWithCtx :: Stream s m t => u -> ParsecT s u m a -> s -> m (Either ParseError a) -parseWithCtx ctx p = runParserT p ctx "" +parseWithState :: Stream s m t => u -> ParsecT s u m a -> s -> m (Either ParseError a) +parseWithState jps p = runParserT p jps "" fromparse :: Either ParseError a -> a fromparse = either parseerror id diff --git a/hledger-web/Handler/AddForm.hs b/hledger-web/Handler/AddForm.hs index 7afe95bbf..570ba8f77 100644 --- a/hledger-web/Handler/AddForm.hs +++ b/hledger-web/Handler/AddForm.hs @@ -96,7 +96,7 @@ postAddForm = do map fst amtparams `elem` [[1..num], [1..num-1]] = [] | otherwise = ["the posting parameters are malformed"] eaccts = map (parsewith (accountnamep <* eof) . strip . T.unpack . snd) acctparams - eamts = map (runParser (amountp <* eof) nullctx "" . strip . T.unpack . snd) amtparams + eamts = map (runParser (amountp <* eof) nulljps "" . strip . T.unpack . snd) amtparams (accts, acctErrs) = (rights eaccts, map show $ lefts eaccts) (amts', amtErrs) = (rights eamts, map show $ lefts eamts) amts | length amts' == num = amts' diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 805c699b7..d249ffd8f 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -74,7 +74,7 @@ tests_Hledger_Cli = TestList let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' (return . ignoresourcepos) j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos) - j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} + j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jparsestate=jparsestate j1} in TestList [ "apply account directive 1" ~: sameParse diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index e1b6bfd81..91576f396 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -181,8 +181,8 @@ dateAndCodeWizard EntryState{..} = do where parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc where - edc = runParser (dateandcodep <* eof) nullctx "" $ lowercase s - dateandcodep :: Stream [Char] m t => ParsecT [Char] JournalContext m (SmartDate, String) + edc = runParser (dateandcodep <* eof) nulljps "" $ lowercase s + dateandcodep :: Stream [Char] m t => ParsecT [Char] JournalParseState m (SmartDate, String) dateandcodep = do d <- smartdate c <- optionMaybe codep @@ -245,7 +245,7 @@ accountWizard EntryState{..} = do parseAccountOrDotOrNull _ _ "." = dbg1 $ Just "." -- . always signals end of txn parseAccountOrDotOrNull "" True "" = dbg1 $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn parseAccountOrDotOrNull def@(_:_) _ "" = dbg1 $ Just def -- when there's a default, "" means use that - parseAccountOrDotOrNull _ _ s = dbg1 $ either (const Nothing) validateAccount $ runParser (accountnamep <* eof) (jContext esJournal) "" s -- otherwise, try to parse the input as an accountname + parseAccountOrDotOrNull _ _ s = dbg1 $ either (const Nothing) validateAccount $ runParser (accountnamep <* eof) (jparsestate esJournal) "" s -- otherwise, try to parse the input as an accountname dbg1 = id -- strace validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing | otherwise = Just s @@ -269,9 +269,9 @@ amountAndCommentWizard EntryState{..} = do maybeRestartTransaction $ line $ green $ printf "Amount %d%s: " pnum (showDefault def) where - parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) nodefcommodityctx "" - nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing} - amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Amount, String) + parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) noDefCommodityJPS "" + noDefCommodityJPS = (jparsestate esJournal){jpsDefaultCommodityAndStyle=Nothing} + amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalParseState m (Amount, String) amountandcommentp = do a <- amountp many spacenonewline @@ -290,11 +290,11 @@ amountAndCommentWizard EntryState{..} = do maxprecisionwithpoint -- -- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt - -- a = fromparse $ runParser (amountp <|> return missingamt) (jContext esJournal) "" amt - -- awithoutctx = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amt + -- a = fromparse $ runParser (amountp <|> return missingamt) (jparsestate esJournal) "" amt + -- awithoutjps = fromparse $ runParser (amountp <|> return missingamt) nulljps "" amt -- defamtaccepted = Just (showAmount a) == mdefamt -- es2 = if defamtaccepted then es1 else es1{esHistoricalPostings=Nothing} - -- mdefaultcommodityapplied = if acommodity a == acommodity awithoutctx then Nothing else Just $ acommodity a + -- mdefaultcommodityapplied = if acommodity a == acommodity awithoutjps then Nothing else Just $ acommodity a -- when (isJust mdefaultcommodityapplied) $ -- liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)