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

parsing: save final parse context with journal

Browse Source
This commit is contained in:
Simon Michael 2010-11-13 15:03:40 +00:00
parent 7714bab58d
commit d6c2cf6a90
9 changed files with 78 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -41,10 +41,14 @@ nulljournal = Journal { jmodifiertxns = []
, open_timelog_entries = [] , open_timelog_entries = []
, historical_prices = [] , historical_prices = []
, final_comment_lines = [] , final_comment_lines = []
, jContext = nullctx
, files = [] , files = []
, filereadtime = TOD 0 0 , filereadtime = TOD 0 0
} }
nullctx :: JournalContext
nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] }
nullfilterspec = FilterSpec { nullfilterspec = FilterSpec {
datespan=nulldatespan datespan=nulldatespan
,cleared=Nothing ,cleared=Nothing
@ -221,12 +225,12 @@ journalSelectingDate EffectiveDate j =
j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j} j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j}
-- | Do post-parse processing on a journal, to make it ready for use. -- | Do post-parse processing on a journal, to make it ready for use.
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Journal
journalFinalise tclock tlocal path txt j@Journal{files=fs} = journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =
journalCanonicaliseAmounts $ journalCanonicaliseAmounts $
journalApplyHistoricalPrices $ journalApplyHistoricalPrices $
journalCloseTimeLogEntries tlocal journalCloseTimeLogEntries tlocal
j{files=(path,txt):fs, filereadtime=tclock} j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx}
-- | Convert all the journal's amounts to their canonical display -- | Convert all the journal's amounts to their canonical display
-- settings. Ie, all amounts in a given commodity will use (a) the -- settings. Ie, all amounts in a given commodity will use (a) the

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

@ -121,18 +121,31 @@ data HistoricalPrice = HistoricalPrice {
hamount :: MixedAmount hamount :: MixedAmount
} deriving (Eq) -- & Show (in Amount.hs) } deriving (Eq) -- & Show (in Amount.hs)
type Year = Integer
-- | A journal "context" is some data which can change in the course of
-- parsing a journal. An example is the default year, which changes when a
-- Y directive is encountered. At the end of parsing, the final context
-- is saved for later use by eg the add command.
data JournalContext = Ctx {
ctxYear :: !(Maybe Year) -- ^ the default year most recently specified with Y
, ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity most recently specified with D
, ctxAccount :: ![AccountName] -- ^ the current stack of parent accounts specified by !account
} deriving (Read, Show, Eq)
data Journal = Journal { data Journal = Journal {
jmodifiertxns :: [ModifierTransaction], jmodifiertxns :: [ModifierTransaction],
jperiodictxns :: [PeriodicTransaction], jperiodictxns :: [PeriodicTransaction],
jtxns :: [Transaction], jtxns :: [Transaction],
open_timelog_entries :: [TimeLogEntry], open_timelog_entries :: [TimeLogEntry],
historical_prices :: [HistoricalPrice], historical_prices :: [HistoricalPrice],
final_comment_lines :: String, -- ^ any trailing comments from the journal file final_comment_lines :: String, -- ^ any trailing comments from the journal file
files :: [(FilePath, String)], -- ^ the file path and raw text of the main and jContext :: JournalContext, -- ^ the context (parse state) at the end of parsing
-- any included journal files. The main file is files :: [(FilePath, String)], -- ^ the file path and raw text of the main and
-- first followed by any included files in the -- any included journal files. The main file is
-- order encountered. -- first followed by any included files in the
filereadtime :: ClockTime -- ^ when this journal was last read from its file(s) -- order encountered.
filereadtime :: ClockTime -- ^ when this journal was last read from its file(s)
} deriving (Eq, Typeable) } deriving (Eq, Typeable)
data Ledger = Ledger { data Ledger = Ledger {

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

@ -18,6 +18,7 @@ module Hledger.Read (
where where
import Hledger.Data.Dates (getCurrentDay) import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Types (Journal(..)) import Hledger.Data.Types (Journal(..))
import Hledger.Data.Journal (nullctx)
import Hledger.Data.Utils import Hledger.Data.Utils
import Hledger.Read.Common import Hledger.Read.Common
import Hledger.Read.Journal as Journal import Hledger.Read.Journal as Journal
@ -139,7 +140,7 @@ tests_Hledger_Read = TestList
[ [
"journalFile" ~: do "journalFile" ~: do
assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx emptyCtx Journal.journalFile "") assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx nullctx Journal.journalFile "")
jE <- readJournal Nothing "" -- don't know how to get it from journalFile jE <- readJournal Nothing "" -- don't know how to get it from journalFile
either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE

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

@ -10,7 +10,7 @@ where
import Control.Monad.Error import Control.Monad.Error
import Hledger.Data.Utils import Hledger.Data.Utils
import Hledger.Data.Types (Journal, Commodity) import Hledger.Data.Types (Journal, JournalContext(..), Commodity)
import Hledger.Data.Journal import Hledger.Data.Journal
import System.Directory (getHomeDirectory) import System.Directory (getHomeDirectory)
import System.FilePath(takeDirectory,combine) import System.FilePath(takeDirectory,combine)
@ -33,24 +33,14 @@ juSequence us = liftM (foldr (.) id) $ sequence us
-- | Given a JournalUpdate-generating parsec parser, file path and data string, -- | 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.
parseJournalWith :: (GenParser Char JournalContext JournalUpdate) -> FilePath -> String -> ErrorT String IO Journal parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal
parseJournalWith p f s = do parseJournalWith p f s = do
tc <- liftIO getClockTime tc <- liftIO getClockTime
tl <- liftIO getCurrentLocalTime tl <- liftIO getCurrentLocalTime
case runParser p emptyCtx f s of case runParser p nullctx f s of
Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal Right (updates,ctx) -> liftM (journalFinalise tc tl f s ctx) $ updates `ap` return nulljournal
Left err -> throwError $ show err Left err -> throwError $ show err
-- | Some state kept while parsing a journal file.
data JournalContext = Ctx {
ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y
, ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity recently specified with D
, ctxAccount :: ![String] -- ^ the current stack of parent accounts specified by !account
} deriving (Read, Show)
emptyCtx :: JournalContext
emptyCtx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] }
setYear :: Integer -> GenParser tok JournalContext () setYear :: Integer -> GenParser tok JournalContext ()
setYear y = updateState (\ctx -> ctx{ctxYear=Just y}) setYear y = updateState (\ctx -> ctx{ctxYear=Just y})

74
hledger-lib/Hledger/Read/Journal.hs
View File

@ -151,17 +151,17 @@ detect f _ = fileSuffix f == format
-- | Parse and post-process a "Journal" from hledger's journal file -- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error. -- format, or give an error.
parse :: FilePath -> String -> ErrorT String IO Journal parse :: FilePath -> String -> ErrorT String IO Journal
parse = do parse = parseJournalWith journalFile
j <- parseJournalWith journalFile
return j
-- | 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" which can be applied to an empty journal -- error-raising "JournalUpdate" which can be applied to an empty journal
-- to get the final result. -- to get the final result.
journalFile :: GenParser Char JournalContext JournalUpdate journalFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
journalFile = do journalupdates <- many journalItem journalFile = do
eof journalupdates <- many journalItem
return $ juSequence journalupdates eof
finalctx <- getState
return $ (juSequence journalupdates, finalctx)
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
@ -224,8 +224,8 @@ ledgerInclude = do
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"
case runParser journalFile outerState filepath txt of case runParser journalFile outerState filepath txt of
Right ju -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++)) Right (ju,_) -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
Left err -> throwError $ inIncluded ++ show err Left err -> throwError $ inIncluded ++ show err
where readFileOrError pos fp = where readFileOrError pos fp =
ErrorT $ liftM Right (readFile fp) `catch` ErrorT $ liftM Right (readFile fp) `catch`
\err -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show err) \err -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show err)
@ -563,52 +563,52 @@ numberpartsstartingwithpoint = do
tests_Journal = TestList [ tests_Journal = TestList [
"ledgerTransaction" ~: do "ledgerTransaction" ~: do
assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1 assertParseEqual (parseWithCtx nullctx ledgerTransaction entry1_str) entry1
assertBool "ledgerTransaction should not parse just a date" assertBool "ledgerTransaction should not parse just a date"
$ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n" $ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1\n"
assertBool "ledgerTransaction should require some postings" assertBool "ledgerTransaction should require some postings"
$ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n" $ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1 a\n"
let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n" let t = parseWithCtx nullctx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"
assertBool "ledgerTransaction should not include a comment in the description" assertBool "ledgerTransaction should not include a comment in the description"
$ either (const False) ((== "a") . tdescription) t $ either (const False) ((== "a") . tdescription) t
,"ledgerModifierTransaction" ~: do ,"ledgerModifierTransaction" ~: do
assertParse (parseWithCtx emptyCtx ledgerModifierTransaction "= (some value expr)\n some:postings 1\n") assertParse (parseWithCtx nullctx ledgerModifierTransaction "= (some value expr)\n some:postings 1\n")
,"ledgerPeriodicTransaction" ~: do ,"ledgerPeriodicTransaction" ~: do
assertParse (parseWithCtx emptyCtx ledgerPeriodicTransaction "~ (some period expr)\n some:postings 1\n") assertParse (parseWithCtx nullctx ledgerPeriodicTransaction "~ (some period expr)\n some:postings 1\n")
,"ledgerExclamationDirective" ~: do ,"ledgerExclamationDirective" ~: do
assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!include /some/file.x\n") assertParse (parseWithCtx nullctx ledgerExclamationDirective "!include /some/file.x\n")
assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!account some:account\n") assertParse (parseWithCtx nullctx ledgerExclamationDirective "!account some:account\n")
assertParse (parseWithCtx emptyCtx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n") assertParse (parseWithCtx nullctx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n")
,"ledgercommentline" ~: do ,"ledgercommentline" ~: do
assertParse (parseWithCtx emptyCtx ledgercommentline "; some comment \n") assertParse (parseWithCtx nullctx ledgercommentline "; some comment \n")
assertParse (parseWithCtx emptyCtx ledgercommentline " \t; x\n") assertParse (parseWithCtx nullctx ledgercommentline " \t; x\n")
assertParse (parseWithCtx emptyCtx ledgercommentline ";x") assertParse (parseWithCtx nullctx ledgercommentline ";x")
,"ledgerDefaultYear" ~: do ,"ledgerDefaultYear" ~: do
assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 2010\n") assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 2010\n")
assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 10001\n") assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 10001\n")
,"ledgerHistoricalPrice" ~: ,"ledgerHistoricalPrice" ~:
assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55]) assertParseEqual (parseWithCtx nullctx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55])
,"ledgerIgnoredPriceCommodity" ~: do ,"ledgerIgnoredPriceCommodity" ~: do
assertParse (parseWithCtx emptyCtx ledgerIgnoredPriceCommodity "N $\n") assertParse (parseWithCtx nullctx ledgerIgnoredPriceCommodity "N $\n")
,"ledgerDefaultCommodity" ~: do ,"ledgerDefaultCommodity" ~: do
assertParse (parseWithCtx emptyCtx ledgerDefaultCommodity "D $1,000.0\n") assertParse (parseWithCtx nullctx ledgerDefaultCommodity "D $1,000.0\n")
,"ledgerCommodityConversion" ~: do ,"ledgerCommodityConversion" ~: do
assertParse (parseWithCtx emptyCtx ledgerCommodityConversion "C 1h = $50.00\n") assertParse (parseWithCtx nullctx ledgerCommodityConversion "C 1h = $50.00\n")
,"ledgerTagDirective" ~: do ,"ledgerTagDirective" ~: do
assertParse (parseWithCtx emptyCtx ledgerTagDirective "tag foo \n") assertParse (parseWithCtx nullctx ledgerTagDirective "tag foo \n")
,"ledgerEndTagDirective" ~: do ,"ledgerEndTagDirective" ~: do
assertParse (parseWithCtx emptyCtx ledgerEndTagDirective "end tag \n") assertParse (parseWithCtx nullctx ledgerEndTagDirective "end tag \n")
,"ledgeraccountname" ~: do ,"ledgeraccountname" ~: do
assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c") assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")
@ -617,29 +617,29 @@ tests_Journal = TestList [
assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:") assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")
,"ledgerposting" ~: do ,"ledgerposting" ~: do
assertParseEqual (parseWithCtx emptyCtx ledgerposting " expenses:food:dining $10.00\n") assertParseEqual (parseWithCtx nullctx ledgerposting " expenses:food:dining $10.00\n")
(Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing) (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing)
assertBool "ledgerposting parses a quoted commodity with numbers" assertBool "ledgerposting parses a quoted commodity with numbers"
(isRight $ parseWithCtx emptyCtx ledgerposting " a 1 \"DE123\"\n") (isRight $ parseWithCtx nullctx ledgerposting " a 1 \"DE123\"\n")
,"someamount" ~: do ,"someamount" ~: do
let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity
assertMixedAmountParse parseresult mixedamount = assertMixedAmountParse parseresult mixedamount =
(either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)
assertMixedAmountParse (parseWithCtx emptyCtx someamount "1 @ $2") assertMixedAmountParse (parseWithCtx nullctx someamount "1 @ $2")
(Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])
,"postingamount" ~: do ,"postingamount" ~: do
assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18]) assertParseEqual (parseWithCtx nullctx postingamount " $47.18") (Mixed [dollars 47.18])
assertParseEqual (parseWithCtx emptyCtx postingamount " $1.") assertParseEqual (parseWithCtx nullctx postingamount " $1.")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing]) (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])
,"leftsymbolamount" ~: do ,"leftsymbolamount" ~: do
assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$1") assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing]) (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])
assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$-1") assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing]) (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])
assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "-$1") assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing]) (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])
] ]

5
hledger-lib/Hledger/Read/Timelog.hs
View File

@ -71,10 +71,11 @@ detect f _ = fileSuffix f == format
parse :: FilePath -> String -> ErrorT String IO Journal parse :: FilePath -> String -> ErrorT String IO Journal
parse = parseJournalWith timelogFile parse = parseJournalWith timelogFile
timelogFile :: GenParser Char JournalContext JournalUpdate timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
timelogFile = do items <- many timelogItem timelogFile = do items <- many timelogItem
eof eof
return $ liftM (foldr (.) id) $ sequence items ctx <- getState
return (liftM (foldr (.) id) $ sequence items, ctx)
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

5
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -9,7 +9,6 @@ module Hledger.Cli.Commands.Add
where where
import Hledger.Data import Hledger.Data
import Hledger.Read.Journal (someamount) import Hledger.Read.Journal (someamount)
import Hledger.Read.Common (emptyCtx)
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Commands.Register (registerReport, registerReportAsText) import Hledger.Cli.Commands.Register (registerReport, registerReportAsText)
#if __GLASGOW_HASKELL__ <= 610 #if __GLASGOW_HASKELL__ <= 610
@ -93,7 +92,7 @@ getPostings accept historicalps enteredps = do
then return enteredps then return enteredps
else do else do
amountstr <- askFor (printf "amount %d" n) defaultamount validateamount amountstr <- askFor (printf "amount %d" n) defaultamount validateamount
let amount = fromparse $ runParser (someamount <|> return missingamt) emptyCtx "" amountstr let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr
let p = nullposting{paccount=stripbrackets account, let p = nullposting{paccount=stripbrackets account,
pamount=amount, pamount=amount,
ptype=postingtype account} ptype=postingtype account}
@ -114,7 +113,7 @@ getPostings accept historicalps enteredps = do
postingtype _ = RegularPosting postingtype _ = RegularPosting
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
validateamount = Just $ \s -> (null s && not (null enteredrealps)) validateamount = Just $ \s -> (null s && not (null enteredrealps))
|| isRight (runParser (someamount>>many spacenonewline>>eof) emptyCtx "" s) || isRight (parse (someamount>>many spacenonewline>>eof) "" s)
-- | Prompt for and read a string value, optionally with a default value -- | Prompt for and read a string value, optionally with a default value
-- and a validator. A validator causes the prompt to repeat until the -- and a validator. A validator causes the prompt to repeat until the

3
hledger/Hledger/Cli/Commands/Convert.hs
View File

@ -8,7 +8,6 @@ import Hledger.Cli.Options (Opt(Debug))
import Hledger.Cli.Version (versionstr) import Hledger.Cli.Version (versionstr)
import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..)) import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error') import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error')
import Hledger.Read.Common (emptyCtx)
import Hledger.Read.Journal (someamount,ledgeraccountname) import Hledger.Read.Journal (someamount,ledgeraccountname)
import Hledger.Data.Amount (nullmixedamt) import Hledger.Data.Amount (nullmixedamt)
import Safe (atDef, maximumDef) import Safe (atDef, maximumDef)
@ -282,7 +281,7 @@ transactionFromCsvRecord rules fields =
strnegate s = '-':s strnegate s = '-':s
currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules) currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)
amountstr'' = currency ++ amountstr' amountstr'' = currency ++ amountstr'
amountparse = runParser someamount emptyCtx "" amountstr'' amountparse = parse someamount "" amountstr''
amount = either (const nullmixedamt) id amountparse amount = either (const nullmixedamt) id amountparse
unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown" unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown"
| otherwise = "expenses:unknown" | otherwise = "expenses:unknown"

5
hledger/Hledger/Cli/Tests.hs
View File

@ -34,7 +34,6 @@ import System.Time (ClockTime(TOD))
import Hledger.Cli.Commands.All import Hledger.Cli.Commands.All
import Hledger.Data -- including testing utils in Hledger.Data.Utils import Hledger.Data -- including testing utils in Hledger.Data.Utils
import Hledger.Read.Common (emptyCtx)
import Hledger.Read (readJournal) import Hledger.Read (readJournal)
import Hledger.Read.Journal (someamount) import Hledger.Read.Journal (someamount)
import Hledger.Cli.Options import Hledger.Cli.Options
@ -1059,6 +1058,7 @@ journal7 = Journal
[] []
[] []
"" ""
nullctx
[] []
(TOD 0 0) (TOD 0 0)
@ -1090,7 +1090,8 @@ journalWithAmounts as =
[] []
[] []
"" ""
nullctx
[] []
(TOD 0 0) (TOD 0 0)
where parse = fromparse . parseWithCtx emptyCtx someamount where parse = fromparse . parseWithCtx nullctx someamount