lib: rename JournalContext to JournalParseState
This commit is contained in:
Simon Michael
parent
ea383d88d6
commit
7f5e09096f
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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))
|
||||
|
||||
]]
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user