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

lib: rename JournalContext to JournalParseState

Browse Source
This commit is contained in:
Simon Michael 2016-05-18 20:57:34 -07:00
parent ea383d88d6
commit 7f5e09096f
13 changed files with 167 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/hledger-rewrite.hs
View File

@ -51,7 +51,7 @@ type PostingExpr = (AccountName, AmountExpr)
data AmountExpr = AmountLiteral String | AmountMultiplier Quantity deriving (Show) data AmountExpr = AmountLiteral String | AmountMultiplier Quantity deriving (Show)
addPostingExprsFromOpts :: RawOpts -> [PostingExpr] 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 postingexprp = do
a <- accountnamep a <- accountnamep

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

@ -52,7 +52,7 @@ module Hledger.Data.Journal (
-- * Misc -- * Misc
canonicalStyleFrom, canonicalStyleFrom,
matchpats, matchpats,
nullctx, nulljps,
nulljournal, nulljournal,
-- * Tests -- * Tests
samplejournal, samplejournal,
@ -120,27 +120,27 @@ instance Show Journal where
-- ,show $ open_timeclock_entries j -- ,show $ open_timeclock_entries j
-- ,show $ jmarketprices j -- ,show $ jmarketprices j
-- ,show $ final_comment_lines j -- ,show $ final_comment_lines j
-- ,show $ jContext j -- ,show $ jparsestate j
-- ,show $ map fst $ files j -- ,show $ map fst $ files j
-- ] -- ]
-- The monoid instance for Journal concatenates the list fields, -- The monoid instance for Journal concatenates the list fields,
-- combines the map fields, keeps the final comment lines of the -- combines the map fields, keeps the final comment lines of the
-- second journal, and keeps the latest of their last read times. -- 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 instance Monoid Journal where
mempty = nulljournal mempty = nulljournal
mappend j1 j2 = mappend j1 j2 =
Journal{jmodifiertxns = jmodifiertxns j1 <> jmodifiertxns j2 -- [ModifierTransaction] Journal{jmodifiertxns = jmodifiertxns j1 <> jmodifiertxns j2
,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2 -- [PeriodicTransaction] ,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2
,jtxns = jtxns j1 <> jtxns j2 -- [Transaction] ,jtxns = jtxns j1 <> jtxns j2
,jcommoditystyles = jcommoditystyles j1 <> jcommoditystyles j2 -- M.Map CommoditySymbol AmountStyle ,jcommoditystyles = jcommoditystyles j1 <> jcommoditystyles j2
,jcommodities = jcommodities j1 <> jcommodities j2 -- M.Map CommoditySymbol Commodity ,jcommodities = jcommodities j1 <> jcommodities j2
,open_timeclock_entries = open_timeclock_entries j1 <> open_timeclock_entries j2 -- [TimeclockEntry] ,open_timeclock_entries = open_timeclock_entries j1 <> open_timeclock_entries j2
,jmarketprices = jmarketprices j1 <> jmarketprices j2 -- [MarketPrice] ,jmarketprices = jmarketprices j1 <> jmarketprices j2
,final_comment_lines = final_comment_lines j1 <> final_comment_lines j2 -- String ,final_comment_lines = final_comment_lines j1 <> final_comment_lines j2
,jContext = jContext j1 <> jContext j2 -- JournalContext ,jparsestate = jparsestate j1 <> jparsestate j2
,files = files j1 <> files j2 -- [(FilePath, String)] ,files = files j1 <> files j2
,filereadtime = max (filereadtime j1) (filereadtime j2) ,filereadtime = max (filereadtime j1) (filereadtime j2)
} }
@ -152,30 +152,30 @@ nulljournal = Journal { jmodifiertxns = []
, open_timeclock_entries = [] , open_timeclock_entries = []
, jmarketprices = [] , jmarketprices = []
, final_comment_lines = [] , final_comment_lines = []
, jContext = nullctx , jparsestate = nulljps
, files = [] , files = []
, filereadtime = TOD 0 0 , filereadtime = TOD 0 0
, jcommoditystyles = M.fromList [] , jcommoditystyles = M.fromList []
} }
-- The monoid instance for JournalContext assumes the second context -- The monoid instance for JournalParseState mostly discards the
-- is that of an included journal, so it is mostly discarded except -- second parse state, except the accounts defined by account
-- the accounts defined by account directives are concatenated, and -- directives are concatenated, and the transaction indices (counts of
-- the transaction indices (counts of transactions parsed, if any) are -- transactions parsed, if any) are added.
-- added. instance Monoid JournalParseState where
instance Monoid JournalContext where mempty = nulljps
mempty = nullctx
mappend c1 c2 = mappend c1 c2 =
Ctx { ctxYear = ctxYear c1 JournalParseState {
, ctxDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle c1 jpsYear = jpsYear c1
, ctxAccounts = ctxAccounts c1 ++ ctxAccounts c2 , jpsDefaultCommodityAndStyle = jpsDefaultCommodityAndStyle c1
, ctxParentAccount = ctxParentAccount c1 , jpsAccounts = jpsAccounts c1 ++ jpsAccounts c2
, ctxAliases = ctxAliases c1 , jpsParentAccount = jpsParentAccount c1
, ctxTransactionIndex = ctxTransactionIndex c1 + ctxTransactionIndex c2 , jpsAliases = jpsAliases c1
, jpsTransactionIndex = jpsTransactionIndex c1 + jpsTransactionIndex c2
} }
nullctx :: JournalContext nulljps :: JournalParseState
nullctx = Ctx{ctxYear=Nothing, ctxDefaultCommodityAndStyle=Nothing, ctxAccounts=[], ctxParentAccount=[], ctxAliases=[], ctxTransactionIndex=0} nulljps = JournalParseState{jpsYear=Nothing, jpsDefaultCommodityAndStyle=Nothing, jpsAccounts=[], jpsParentAccount=[], jpsAliases=[], jpsTransactionIndex=0}
journalFilePath :: Journal -> FilePath journalFilePath :: Journal -> FilePath
journalFilePath = fst . mainfile 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 -- | Do post-parse processing on a journal to make it ready for use: check
-- all transactions balance, canonicalise amount formats, close any open -- all transactions balance, canonicalise amount formats, close any open
-- timeclock entries, maybe check balance assertions and so on. -- timeclock entries, maybe check balance assertions and so on.
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Bool -> Journal -> Either String Journal journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalParseState -> Bool -> Journal -> Either String Journal
journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do journalFinalise tclock tlocal path txt jps assrt j@Journal{files=fs} = do
(journalBalanceTransactions $ (journalBalanceTransactions $
journalApplyCommodityStyles $ journalApplyCommodityStyles $
journalCloseTimeclockEntries tlocal $ journalCloseTimeclockEntries tlocal $
j{ files=(path,txt):fs j{ files=(path,txt):fs
, filereadtime=tclock , filereadtime=tclock
, jContext=ctx , jparsestate=jps
, jtxns=reverse $ jtxns j -- NOTE: see addTransaction , jtxns=reverse $ jtxns j -- NOTE: see addTransaction
, jmodifiertxns=reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction , jmodifiertxns=reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction
, jperiodictxns=reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction , jperiodictxns=reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction

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

@ -222,23 +222,23 @@ instance NFData MarketPrice
type Year = Integer type Year = Integer
-- | A journal "context" is some data which can change in the course of -- | Journal parse state is data we want to keep track of in the
-- parsing a journal. An example is the default year, which changes when a -- course of parsing a journal. An example is the default year, which
-- Y directive is encountered. At the end of parsing, the final context -- changes when a Y directive is encountered. At the end of parsing,
-- is saved for later use by eg the add command. -- the final state is saved for later use by eg the add command.
data JournalContext = Ctx { data JournalParseState = JournalParseState {
ctxYear :: !(Maybe Year) -- ^ the default year most recently specified with Y jpsYear :: !(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 , jpsDefaultCommodityAndStyle :: !(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 , jpsAccounts :: ![AccountName] -- ^ the accounts that have been defined with account directives so far
, ctxParentAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components , jpsParentAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components
-- specified with "apply account" directive(s). Concatenated, these -- specified with "apply account" directive(s). Concatenated, these
-- are the account prefix prepended to parsed account names. -- are the account prefix prepended to parsed account names.
, ctxAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect , jpsAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect
, ctxTransactionIndex :: !Integer -- ^ the number of transactions read so far. (Does not count , jpsTransactionIndex :: !Integer -- ^ the number of transactions read so far. (Does not count
-- timeclock/timedot/CSV entries, currently). -- timeclock/timedot/CSV entries, currently).
} deriving (Read, Show, Eq, Data, Typeable, Generic) } deriving (Read, Show, Eq, Data, Typeable, Generic)
instance NFData JournalContext instance NFData JournalParseState
deriving instance Data (ClockTime) deriving instance Data (ClockTime)
deriving instance Typeable (ClockTime) deriving instance Typeable (ClockTime)
@ -255,7 +255,7 @@ data Journal = Journal {
open_timeclock_entries :: [TimeclockEntry], open_timeclock_entries :: [TimeclockEntry],
jmarketprices :: [MarketPrice], jmarketprices :: [MarketPrice],
final_comment_lines :: String, -- ^ any trailing comments from the journal file 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 files :: [(FilePath, String)], -- ^ the file path and raw text of the main and
-- any included journal files. The main file is -- any included journal files. The main file is
-- first followed by any included files in the -- first followed by any included files in the

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

@ -47,7 +47,7 @@ import Test.HUnit
import Text.Printf import Text.Printf
import Hledger.Data.Dates (getCurrentDay) import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Journal (nullctx) import Hledger.Data.Journal (nulljps)
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Read.JournalReader as JournalReader import Hledger.Read.JournalReader as JournalReader
import Hledger.Read.TimedotReader as TimedotReader import Hledger.Read.TimedotReader as TimedotReader
@ -259,7 +259,7 @@ tests_Hledger_Read = TestList $
tests_Hledger_Read_CsvReader, tests_Hledger_Read_CsvReader,
"journal" ~: do "journal" ~: do
r <- runExceptT $ parseWithCtx nullctx JournalReader.journalp "" r <- runExceptT $ parseWithState nulljps JournalReader.journalp ""
assertBool "journalp should parse an empty file" (isRight $ r) assertBool "journalp should parse an empty file" (isRight $ r)
jE <- readJournal Nothing Nothing True Nothing "" -- don't know how to get it from journal 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 either error' (assertBool "journalp parsing an empty file should give an empty journal" . null . jtxns) jE

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

@ -43,7 +43,7 @@ import Hledger.Utils
type StringParser u m a = ParsecT String u m a type StringParser u m a = ParsecT String u m a
-- | A string parser with journal-parsing state. -- | 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. -- | A journal parser that runs in IO and can throw an error mid-parse.
type ErroringJournalParser a = JournalParser (ExceptT String IO) a type ErroringJournalParser a = JournalParser (ExceptT String IO) a
@ -55,7 +55,7 @@ rsp = runStringParser
-- | Run a journal parser with a null journal-parsing state. -- | Run a journal parser with a null journal-parsing state.
runJournalParser, rjp :: Monad m => JournalParser m a -> String -> m (Either ParseError a) 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 rjp = runJournalParser
-- | Run an error-raising journal parser with a null journal-parsing state. -- | 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, -- | 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. -- 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 parseAndFinaliseJournal parser assrt f s = do
tc <- liftIO getClockTime tc <- liftIO getClockTime
tl <- liftIO getCurrentLocalTime tl <- liftIO getCurrentLocalTime
y <- liftIO getCurrentYear y <- liftIO getCurrentYear
r <- runParserT parser nullctx{ctxYear=Just y} f s r <- runParserT parser nulljps{jpsYear=Just y} f s
case r of case r of
Right (updates,ctx) -> do Right (updates,jps) -> do
j <- ap updates (return nulljournal) 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' Right j' -> return j'
Left estr -> throwError estr Left estr -> throwError estr
Left e -> throwError $ show e Left e -> throwError $ show e
setYear :: Monad m => Integer -> JournalParser m () 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 :: Monad m => JournalParser m (Maybe Integer)
getYear = fmap ctxYear getState getYear = fmap jpsYear getState
setDefaultCommodityAndStyle :: Monad m => (CommoditySymbol,AmountStyle) -> JournalParser m () 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 :: Monad m => JournalParser m (Maybe (CommoditySymbol,AmountStyle))
getDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle `fmap` getState getDefaultCommodityAndStyle = jpsDefaultCommodityAndStyle `fmap` getState
pushAccount :: Monad m => String -> JournalParser m () pushAccount :: Monad m => String -> JournalParser m ()
pushAccount acct = modifyState addAccount 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 :: Monad m => String -> JournalParser m ()
pushParentAccount parent = modifyState addParentAccount 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 :: Monad m => JournalParser m ()
popParentAccount = do ctx0 <- getState popParentAccount = do jps0 <- getState
case ctxParentAccount ctx0 of case jpsParentAccount jps0 of
[] -> unexpected "End of apply account block with no beginning" [] -> 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 :: Monad m => JournalParser m String
getParentAccount = fmap (concatAccountNames . reverse . ctxParentAccount) getState getParentAccount = fmap (concatAccountNames . reverse . jpsParentAccount) getState
addAccountAlias :: Monad m => AccountAlias -> JournalParser m () 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 :: Monad m => JournalParser m [AccountAlias]
getAccountAliases = fmap ctxAliases getState getAccountAliases = fmap jpsAliases getState
clearAccountAliases :: Monad m => JournalParser m () clearAccountAliases :: Monad m => JournalParser m ()
clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]}) clearAccountAliases = modifyState (\(jps@JournalParseState{..}) -> jps{jpsAliases=[]})
getTransactionIndex :: Monad m => JournalParser m Integer getTransactionIndex :: Monad m => JournalParser m Integer
getTransactionIndex = fmap ctxTransactionIndex getState getTransactionIndex = fmap jpsTransactionIndex getState
setTransactionIndex :: Monad m => Integer -> JournalParser m () 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. -- | Increment the transaction index by one and return the new value.
incrementTransactionIndex :: Monad m => JournalParser m Integer incrementTransactionIndex :: Monad m => JournalParser m Integer
incrementTransactionIndex = do incrementTransactionIndex = do
modifyState (\ctx -> ctx{ctxTransactionIndex=ctxTransactionIndex ctx + 1}) modifyState (\jps -> jps{jpsTransactionIndex=jpsTransactionIndex jps + 1})
getTransactionIndex getTransactionIndex
journalAddFile :: (FilePath,String) -> Journal -> Journal journalAddFile :: (FilePath,String) -> Journal -> Journal
@ -368,10 +368,10 @@ is' :: (Eq a, Show a) => a -> a -> Assertion
a `is'` e = assertEqual e a a `is'` e = assertEqual e a
test_spaceandamountormissingp = do test_spaceandamountormissingp = do
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " $47.18") (Mixed [usd 47.18]) assertParseEqual' (parseWithState nulljps spaceandamountormissingp " $47.18") (Mixed [usd 47.18])
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "$47.18") missingmixedamt assertParseEqual' (parseWithState nulljps spaceandamountormissingp "$47.18") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " ") missingmixedamt assertParseEqual' (parseWithState nulljps spaceandamountormissingp " ") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "") missingmixedamt assertParseEqual' (parseWithState nulljps spaceandamountormissingp "") missingmixedamt
#endif #endif
-- | Parse a single-commodity amount, with optional symbol on the left or -- | Parse a single-commodity amount, with optional symbol on the left or
@ -382,22 +382,22 @@ amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
#ifdef TESTS #ifdef TESTS
test_amountp = do test_amountp = do
assertParseEqual' (parseWithCtx nullctx amountp "$47.18") (usd 47.18) assertParseEqual' (parseWithState nulljps amountp "$47.18") (usd 47.18)
assertParseEqual' (parseWithCtx nullctx amountp "$1.") (usd 1 `withPrecision` 0) assertParseEqual' (parseWithState nulljps amountp "$1.") (usd 1 `withPrecision` 0)
-- ,"amount with unit price" ~: do -- ,"amount with unit price" ~: do
assertParseEqual' assertParseEqual'
(parseWithCtx nullctx amountp "$10 @ €0.5") (parseWithState nulljps amountp "$10 @ €0.5")
(usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1))
-- ,"amount with total price" ~: do -- ,"amount with total price" ~: do
assertParseEqual' assertParseEqual'
(parseWithCtx nullctx amountp "$10 @@ €5") (parseWithState nulljps amountp "$10 @@ €5")
(usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)) (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
#endif #endif
-- | Parse an amount from a string, or get an error. -- | Parse an amount from a string, or get an error.
amountp' :: String -> Amount amountp' :: String -> Amount
amountp' s = amountp' s =
case runParser (amountp <* eof) nullctx "" s of case runParser (amountp <* eof) nulljps "" s of
Right t -> t Right t -> t
Left err -> error' $ show err -- XXX should throwError Left err -> error' $ show err -- XXX should throwError
@ -572,8 +572,8 @@ numberp = do
numeric = isNumber . headDef '_' numeric = isNumber . headDef '_'
-- test_numberp = do -- test_numberp = do
-- let s `is` n = assertParseEqual (parseWithCtx nullctx numberp s) n -- let s `is` n = assertParseEqual (parseWithState nulljps numberp s) n
-- assertFails = assertBool . isLeft . parseWithCtx nullctx numberp -- assertFails = assertBool . isLeft . parseWithState nulljps numberp
-- assertFails "" -- assertFails ""
-- "0" `is` (0, 0, '.', ',', []) -- "0" `is` (0, 0, '.', ',', [])
-- "1" `is` (1, 0, '.', ',', []) -- "1" `is` (1, 0, '.', ',', [])
@ -796,9 +796,9 @@ datetagp mdefdate = do
startpos <- getPosition startpos <- getPosition
v <- tagvaluep v <- tagvaluep
-- re-parse value as a date. -- re-parse value as a date.
ctx <- getState jps <- getState
ep <- parseWithCtx ep <- parseWithState
ctx{ctxYear=first3.toGregorian <$> mdefdate} jps{jpsYear=first3.toGregorian <$> mdefdate}
-- The value extends to a comma, newline, or end of file. -- The value extends to a comma, newline, or end of file.
-- It seems like ignoring any extra stuff following a date -- It seems like ignoring any extra stuff following a date
-- gives better errors here. -- gives better errors here.
@ -855,9 +855,9 @@ bracketeddatetagsp mdefdate = do
-- looks sufficiently like a bracketed date, now we -- looks sufficiently like a bracketed date, now we
-- re-parse as dates and throw any errors -- re-parse as dates and throw any errors
ctx <- getState jps <- getState
ep <- parseWithCtx ep <- parseWithState
ctx{ctxYear=first3.toGregorian <$> mdefdate} jps{jpsYear=first3.toGregorian <$> mdefdate}
(do (do
setPosition startpos setPosition startpos
md1 <- optionMaybe datep md1 <- optionMaybe datep

16
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -605,7 +605,7 @@ transactionFromCsvRecord sourcepos rules record = t
status = status =
case mfieldtemplate "status" of case mfieldtemplate "status" of
Nothing -> Uncleared 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 where
statuserror err = error' $ unlines statuserror err = error' $ unlines
["error: could not parse \""++str++"\" as a cleared status (should be *, ! or empty)" ["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" precomment = maybe "" render $ mfieldtemplate "precomment"
currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency" currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency"
amountstr = (currency++) $ negateIfParenthesised $ getAmountStr rules record 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 amounterror err = error' $ unlines
["error: could not parse \""++amountstr++"\" as an amount" ["error: could not parse \""++amountstr++"\" as an amount"
,showRecord record ,showRecord record
@ -780,20 +780,20 @@ test_parser = [
assertParseEqual (parseCsvRules "unknown" "") rules assertParseEqual (parseCsvRules "unknown" "") rules
-- ,"convert rules parsing: accountrule" ~: do -- ,"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") -- ([("A",Nothing)], "a")
,"convert rules parsing: trailing comments" ~: do ,"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 ,"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 -- not supported
-- ,"convert rules parsing: no final newline" ~: do -- ,"convert rules parsing: no final newline" ~: do
-- assertParse (parseWithCtx rules csvrulesfile "A\na") -- assertParse (parseWithState rules csvrulesfile "A\na")
-- assertParse (parseWithCtx rules csvrulesfile "A\na\n# \n#") -- assertParse (parseWithState rules csvrulesfile "A\na\n# \n#")
-- assertParse (parseWithCtx rules csvrulesfile "A\na\n\n ") -- assertParse (parseWithState rules csvrulesfile "A\na\n\n ")
-- (rules{ -- (rules{
-- -- dateField=Maybe FieldPosition, -- -- dateField=Maybe FieldPosition,

94
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -122,14 +122,14 @@ parse _ = parseAndFinaliseJournal journalp
--- ** journal --- ** journal
-- | Top-level journal parser. Returns a single composite, I/O performing, -- | 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. -- applied to an empty journal to get the final result.
journalp :: ErroringJournalParser (JournalUpdate,JournalContext) journalp :: ErroringJournalParser (JournalUpdate,JournalParseState)
journalp = do journalp = do
journalupdates <- many journalItem journalupdates <- many journalItem
eof eof
finalctx <- getState finaljps <- getState
return (combineJournalUpdates journalupdates, finalctx) return (combineJournalUpdates journalupdates, finaljps)
where where
-- As all journal line types can be distinguished by the first -- As all journal line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or -- character, excepting transactions versus empty (blank or
@ -175,7 +175,7 @@ includedirectivep = do
outerPos <- getPosition outerPos <- getPosition
let curdir = takeDirectory (sourceName outerPos) let curdir = takeDirectory (sourceName outerPos)
-- XXX clean this up, probably after getting rid of JournalUpdate -- 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 filepath <- expandPath curdir filename
txt <- readFileOrError outerPos filepath txt <- readFileOrError outerPos filepath
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
@ -188,11 +188,11 @@ includedirectivep = do
outerState filepath txt outerState filepath txt
case r of case r of
Right (ju, ctx) -> do Right (ju, jps) -> do
u <- combineJournalUpdates [ return $ journalAddFile (filepath,txt) u <- combineJournalUpdates [ return $ journalAddFile (filepath,txt)
, ju , ju
] `catchError` (throwError . (inIncluded ++)) ] `catchError` (throwError . (inIncluded ++))
return (u, ctx) return (u, jps)
Left err -> throwError $ inIncluded ++ show err Left err -> throwError $ inIncluded ++ show err
where readFileOrError pos fp = where readFileOrError pos fp =
ExceptT $ fmap Right (readFile' fp) `C.catch` ExceptT $ fmap Right (readFile' fp) `C.catch`
@ -200,7 +200,7 @@ includedirectivep = do
r <- liftIO $ runExceptT u r <- liftIO $ runExceptT u
case r of case r of
Left err -> return $ throwError err 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 :: ErroringJournalParser JournalUpdate
accountdirectivep = do accountdirectivep = do
@ -422,7 +422,7 @@ transactionp = do
#ifdef TESTS #ifdef TESTS
test_transactionp = do test_transactionp = do
let s `gives` t = do let s `gives` t = do
let p = parseWithCtx nullctx transactionp s let p = parseWithState nulljps transactionp s
assertBool $ isRight p assertBool $ isRight p
let Right t2 = p let Right t2 = p
-- same f = assertEqual (f t) (f t2) -- same f = assertEqual (f t) (f t2)
@ -475,7 +475,7 @@ test_transactionp = do
tdate=parsedate "2015/01/01", tdate=parsedate "2015/01/01",
} }
assertRight $ parseWithCtx nullctx transactionp $ unlines assertRight $ parseWithState nulljps transactionp $ unlines
["2007/01/28 coopportunity" ["2007/01/28 coopportunity"
," expenses:food:groceries $47.18" ," expenses:food:groceries $47.18"
," assets:checking $-47.18" ," assets:checking $-47.18"
@ -483,25 +483,25 @@ test_transactionp = do
] ]
-- transactionp should not parse just a date -- 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 -- 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 -- 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 assertRight p
assertEqual "a" (let Right p' = p in tdescription p') assertEqual "a" (let Right p' = p in tdescription p')
-- parse transaction with following whitespace line -- parse transaction with following whitespace line
assertRight $ parseWithCtx nullctx transactionp $ unlines assertRight $ parseWithState nulljps transactionp $ unlines
["2012/1/1" ["2012/1/1"
," a 1" ," a 1"
," b" ," b"
," " ," "
] ]
let p = parseWithCtx nullctx transactionp $ unlines let p = parseWithState nulljps transactionp $ unlines
["2009/1/1 x ; transaction comment" ["2009/1/1 x ; transaction comment"
," a 1 ; posting 1 comment" ," a 1 ; posting 1 comment"
," ; posting 1 comment 2" ," ; posting 1 comment 2"
@ -555,7 +555,7 @@ postingp mtdate = do
#ifdef TESTS #ifdef TESTS
test_postingp = do test_postingp = do
let s `gives` ep = do let s `gives` ep = do
let parse = parseWithCtx nullctx (postingp Nothing) s let parse = parseWithState nulljps (postingp Nothing) s
assertBool -- "postingp parser" assertBool -- "postingp parser"
$ isRight parse $ isRight parse
let Right ap = parse let Right ap = parse
@ -587,12 +587,12 @@ test_postingp = do
,pdate=parsedateM "2012/11/28"} ,pdate=parsedateM "2012/11/28"}
assertBool -- "postingp parses a quoted commodity with numbers" 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 -- ,"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 -- assertRight parse
-- let Right p = parse -- let Right p = parse
-- assertEqual "next-line comment\n" (pcomment p) -- assertEqual "next-line comment\n" (pcomment p)
@ -619,30 +619,30 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
test_transactionp, test_transactionp,
[ [
"modifiertransactionp" ~: do "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 ,"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 ,"directivep" ~: do
assertParse (parseWithCtx nullctx directivep "!include /some/file.x\n") assertParse (parseWithState nulljps directivep "!include /some/file.x\n")
assertParse (parseWithCtx nullctx directivep "account some:account\n") assertParse (parseWithState nulljps directivep "account some:account\n")
assertParse (parseWithCtx nullctx (directivep >> directivep) "!account a\nend\n") assertParse (parseWithState nulljps (directivep >> directivep) "!account a\nend\n")
,"comment" ~: do ,"comment" ~: do
assertParse (parseWithCtx nullctx comment "; some comment \n") assertParse (parseWithState nulljps comment "; some comment \n")
assertParse (parseWithCtx nullctx comment " \t; x\n") assertParse (parseWithState nulljps comment " \t; x\n")
assertParse (parseWithCtx nullctx comment "#x") assertParse (parseWithState nulljps comment "#x")
,"datep" ~: do ,"datep" ~: do
assertParse (parseWithCtx nullctx datep "2011/1/1") assertParse (parseWithState nulljps datep "2011/1/1")
assertParseFailure (parseWithCtx nullctx datep "1/1") assertParseFailure (parseWithState nulljps datep "1/1")
assertParse (parseWithCtx nullctx{ctxYear=Just 2011} datep "1/1") assertParse (parseWithState nulljps{jpsYear=Just 2011} datep "1/1")
,"datetimep" ~: do ,"datetimep" ~: do
let p = do {t <- datetimep; eof; return t} let p = do {t <- datetimep; eof; return t}
bad = assertParseFailure . parseWithCtx nullctx p bad = assertParseFailure . parseWithState nulljps p
good = assertParse . parseWithCtx nullctx p good = assertParse . parseWithState nulljps p
bad "2011/1/1" bad "2011/1/1"
bad "2011/1/1 24:00:00" bad "2011/1/1 24:00:00"
bad "2011/1/1 00:60: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" good "2011/1/1 3:5:7"
-- timezone is parsed but ignored -- timezone is parsed but ignored
let startofday = LocalTime (fromGregorian 2011 1 1) (TimeOfDay 0 0 (fromIntegral 0)) let startofday = LocalTime (fromGregorian 2011 1 1) (TimeOfDay 0 0 (fromIntegral 0))
assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00-0800") startofday assertParseEqual (parseWithState nulljps 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+1234") startofday
,"defaultyeardirectivep" ~: do ,"defaultyeardirectivep" ~: do
assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 2010\n") assertParse (parseWithState nulljps defaultyeardirectivep "Y 2010\n")
assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 10001\n") assertParse (parseWithState nulljps defaultyeardirectivep "Y 10001\n")
,"marketpricedirectivep" ~: ,"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 ,"ignoredpricecommoditydirectivep" ~: do
assertParse (parseWithCtx nullctx ignoredpricecommoditydirectivep "N $\n") assertParse (parseWithState nulljps ignoredpricecommoditydirectivep "N $\n")
,"defaultcommoditydirectivep" ~: do ,"defaultcommoditydirectivep" ~: do
assertParse (parseWithCtx nullctx defaultcommoditydirectivep "D $1,000.0\n") assertParse (parseWithState nulljps defaultcommoditydirectivep "D $1,000.0\n")
,"commodityconversiondirectivep" ~: do ,"commodityconversiondirectivep" ~: do
assertParse (parseWithCtx nullctx commodityconversiondirectivep "C 1h = $50.00\n") assertParse (parseWithState nulljps commodityconversiondirectivep "C 1h = $50.00\n")
,"tagdirectivep" ~: do ,"tagdirectivep" ~: do
assertParse (parseWithCtx nullctx tagdirectivep "tag foo \n") assertParse (parseWithState nulljps tagdirectivep "tag foo \n")
,"endtagdirectivep" ~: do ,"endtagdirectivep" ~: do
assertParse (parseWithCtx nullctx endtagdirectivep "end tag \n") assertParse (parseWithState nulljps endtagdirectivep "end tag \n")
assertParse (parseWithCtx nullctx endtagdirectivep "pop \n") assertParse (parseWithState nulljps endtagdirectivep "pop \n")
,"accountnamep" ~: do ,"accountnamep" ~: do
assertBool "accountnamep parses a normal account name" (isRight $ parsewith accountnamep "a:b:c") 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:") assertBool "accountnamep rejects an empty trailing component" (isLeft $ parsewith accountnamep "a:b:")
,"leftsymbolamountp" ~: do ,"leftsymbolamountp" ~: do
assertParseEqual (parseWithCtx nullctx leftsymbolamountp "$1") (usd 1 `withPrecision` 0) assertParseEqual (parseWithState nulljps 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 (parseWithCtx nullctx leftsymbolamountp "-$1") (usd (-1) `withPrecision` 0) assertParseEqual (parseWithState nulljps leftsymbolamountp "-$1") (usd (-1) `withPrecision` 0)
,"amount" ~: do ,"amount" ~: do
let -- | compare a parse result with an expected amount, showing the debug representation for clarity let -- | compare a parse result with an expected amount, showing the debug representation for clarity
assertAmountParse parseresult amount = assertAmountParse parseresult amount =
(either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug 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)) (num 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0))
]] ]]

8
hledger-lib/Hledger/Read/TimeclockReader.hs
View File

@ -85,11 +85,11 @@ detect f s
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal timeclockfilep 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 timeclockfilep = do items <- many timeclockitemp
eof eof
ctx <- getState jps <- getState
return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx) return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, jps)
where where
-- As all ledger line types can be distinguished by the first -- As all ledger line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or -- 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" ] <?> "timeclock entry, or default year or historical price directive"
-- | Parse a timeclock entry. -- | Parse a timeclock entry.
timeclockentryp :: ParsecT [Char] JournalContext (ExceptT String IO) TimeclockEntry timeclockentryp :: ParsecT [Char] JournalParseState (ExceptT String IO) TimeclockEntry
timeclockentryp = do timeclockentryp = do
sourcepos <- genericSourcePos <$> getPosition sourcepos <- genericSourcePos <$> getPosition
code <- oneOf "bhioO" code <- oneOf "bhioO"

16
hledger-lib/Hledger/Read/TimedotReader.hs
View File

@ -69,11 +69,11 @@ detect f s
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal timedotfilep 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 timedotfilep = do items <- many timedotfileitemp
eof eof
ctx <- getState jps <- getState
return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx) return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, jps)
where where
timedotfileitemp = do timedotfileitemp = do
ptrace "timedotfileitemp" ptrace "timedotfileitemp"
@ -92,7 +92,7 @@ addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts)
-- biz.research . -- biz.research .
-- inc.client1 .... .... .... .... .... .... -- inc.client1 .... .... .... .... .... ....
-- @ -- @
timedotdayp :: ParsecT [Char] JournalContext (ExceptT String IO) [Transaction] timedotdayp :: ParsecT [Char] JournalParseState (ExceptT String IO) [Transaction]
timedotdayp = do timedotdayp = do
ptrace " timedotdayp" ptrace " timedotdayp"
d <- datep <* eolof d <- datep <* eolof
@ -104,7 +104,7 @@ timedotdayp = do
-- @ -- @
-- fos.haskell .... .. -- fos.haskell .... ..
-- @ -- @
timedotentryp :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction timedotentryp :: ParsecT [Char] JournalParseState (ExceptT String IO) Transaction
timedotentryp = do timedotentryp = do
ptrace " timedotentryp" ptrace " timedotentryp"
pos <- genericSourcePos <$> getPosition pos <- genericSourcePos <$> getPosition
@ -128,14 +128,14 @@ timedotentryp = do
} }
return t return t
timedotdurationp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity timedotdurationp :: ParsecT [Char] JournalParseState (ExceptT String IO) Quantity
timedotdurationp = try timedotnumberp <|> timedotdotsp timedotdurationp = try timedotnumberp <|> timedotdotsp
-- | Parse a duration written as a decimal number of hours (optionally followed by the letter h). -- | Parse a duration written as a decimal number of hours (optionally followed by the letter h).
-- @ -- @
-- 1.5h -- 1.5h
-- @ -- @
timedotnumberp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity timedotnumberp :: ParsecT [Char] JournalParseState (ExceptT String IO) Quantity
timedotnumberp = do timedotnumberp = do
(q, _, _, _) <- numberp (q, _, _, _) <- numberp
many spacenonewline 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 timedotdotsp = do
dots <- filter (not.isSpace) <$> many (oneOf ". ") dots <- filter (not.isSpace) <$> many (oneOf ". ")
return $ (/4) $ fromIntegral $ length dots return $ (/4) $ fromIntegral $ length dots

4
hledger-lib/Hledger/Utils/Parse.hs
View File

@ -16,8 +16,8 @@ choice' = choice . map Text.Parsec.try
parsewith :: Parsec [Char] () a -> String -> Either ParseError a parsewith :: Parsec [Char] () a -> String -> Either ParseError a
parsewith p = runParser p () "" parsewith p = runParser p () ""
parseWithCtx :: Stream s m t => u -> ParsecT s u m a -> s -> m (Either ParseError a) parseWithState :: Stream s m t => u -> ParsecT s u m a -> s -> m (Either ParseError a)
parseWithCtx ctx p = runParserT p ctx "" parseWithState jps p = runParserT p jps ""
fromparse :: Either ParseError a -> a fromparse :: Either ParseError a -> a
fromparse = either parseerror id fromparse = either parseerror id

2
hledger-web/Handler/AddForm.hs
View File

@ -96,7 +96,7 @@ postAddForm = do
map fst amtparams `elem` [[1..num], [1..num-1]] = [] map fst amtparams `elem` [[1..num], [1..num-1]] = []
| otherwise = ["the posting parameters are malformed"] | otherwise = ["the posting parameters are malformed"]
eaccts = map (parsewith (accountnamep <* eof) . strip . T.unpack . snd) acctparams 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) (accts, acctErrs) = (rights eaccts, map show $ lefts eaccts)
(amts', amtErrs) = (rights eamts, map show $ lefts eamts) (amts', amtErrs) = (rights eamts, map show $ lefts eamts)
amts | length amts' == num = amts' amts | length amts' == num = amts'

2
hledger/Hledger/Cli.hs
View File

@ -74,7 +74,7 @@ tests_Hledger_Cli = TestList
let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in 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) 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) 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 in TestList
[ [
"apply account directive 1" ~: sameParse "apply account directive 1" ~: sameParse

18
hledger/Hledger/Cli/Add.hs
View File

@ -181,8 +181,8 @@ dateAndCodeWizard EntryState{..} = do
where where
parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc
where where
edc = runParser (dateandcodep <* eof) nullctx "" $ lowercase s edc = runParser (dateandcodep <* eof) nulljps "" $ lowercase s
dateandcodep :: Stream [Char] m t => ParsecT [Char] JournalContext m (SmartDate, String) dateandcodep :: Stream [Char] m t => ParsecT [Char] JournalParseState m (SmartDate, String)
dateandcodep = do dateandcodep = do
d <- smartdate d <- smartdate
c <- optionMaybe codep c <- optionMaybe codep
@ -245,7 +245,7 @@ accountWizard EntryState{..} = do
parseAccountOrDotOrNull _ _ "." = dbg1 $ Just "." -- . always signals end of txn 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 "" 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 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 dbg1 = id -- strace
validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing
| otherwise = Just s | otherwise = Just s
@ -269,9 +269,9 @@ amountAndCommentWizard EntryState{..} = do
maybeRestartTransaction $ maybeRestartTransaction $
line $ green $ printf "Amount %d%s: " pnum (showDefault def) line $ green $ printf "Amount %d%s: " pnum (showDefault def)
where where
parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) nodefcommodityctx "" parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) noDefCommodityJPS ""
nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing} noDefCommodityJPS = (jparsestate esJournal){jpsDefaultCommodityAndStyle=Nothing}
amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Amount, String) amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalParseState m (Amount, String)
amountandcommentp = do amountandcommentp = do
a <- amountp a <- amountp
many spacenonewline many spacenonewline
@ -290,11 +290,11 @@ amountAndCommentWizard EntryState{..} = do
maxprecisionwithpoint maxprecisionwithpoint
-- --
-- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt -- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt
-- a = fromparse $ runParser (amountp <|> return missingamt) (jContext esJournal) "" amt -- a = fromparse $ runParser (amountp <|> return missingamt) (jparsestate esJournal) "" amt
-- awithoutctx = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amt -- awithoutjps = fromparse $ runParser (amountp <|> return missingamt) nulljps "" amt
-- defamtaccepted = Just (showAmount a) == mdefamt -- defamtaccepted = Just (showAmount a) == mdefamt
-- es2 = if defamtaccepted then es1 else es1{esHistoricalPostings=Nothing} -- 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) $ -- when (isJust mdefaultcommodityapplied) $
-- liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied) -- liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)