From 3a9ea65b99cc33c031038ab093817a2e29e7ad97 Mon Sep 17 00:00:00 2001 From: jeevcat Date: Sun, 15 Oct 2017 19:52:41 +0200 Subject: [PATCH] Rewrite of BalanceAssertion type to track its source position. Fixes #481. --- hledger-lib/Hledger/Data/Journal.hs | 9 ++++----- hledger-lib/Hledger/Data/Transaction.hs | 7 +------ hledger-lib/Hledger/Data/Types.hs | 4 +++- hledger-lib/Hledger/Read/Common.hs | 5 +++-- hledger-lib/Hledger/Read/CsvReader.hs | 2 +- hledger/Hledger/Cli/Commands/Equity.hs | 4 ++-- tests/journal/balance-assertions.test | 2 +- 7 files changed, 15 insertions(+), 18 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 6a115c9ef..672b4e3c4 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -513,7 +513,7 @@ journalCheckBalanceAssertions j = -- | Check a posting's balance assertion and return an error if it -- fails. checkBalanceAssertion :: Posting -> MixedAmount -> Either String () -checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass} amt +checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt | isReallyZeroAmount diff = Right () | True = Left err where assertedcomm = acommodity ass @@ -535,9 +535,8 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass} amt (case ptransaction p of Nothing -> ":" -- shouldn't happen Just t -> printf " in %s:\nin transaction:\n%s" - (showGenericSourcePos postingPos) (chomp $ show t) :: String - where postingLine = fromJust $ elemIndex p $ tpostings t -- assume postings are in order - postingPos = increaseSourceLine (1+postingLine) (tsourcepos t)) + (showGenericSourcePos pos) (chomp $ show t) :: String + where pos = snd $ fromJust $ pbalanceassertion p) (showPostingLine p) (showDate $ postingDate p) (T.unpack $ paccount p) -- XXX pack @@ -665,7 +664,7 @@ checkInferAndRegisterAmounts (Right oldTx) = do where inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting inferFromAssignment p = maybe (return p) - (fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p)) + (fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p) . fst) $ pbalanceassertion p -- | Adds a posting's amonut to the posting's account balance and diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index acd6454dd..80a6895f7 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -42,7 +42,6 @@ module Hledger.Data.Transaction ( sourceFilePath, sourceFirstLine, showGenericSourcePos, - increaseSourceLine, -- * misc. tests_Hledger_Data_Transaction ) @@ -82,10 +81,6 @@ sourceFirstLine = \case GenericSourcePos _ line _ -> line JournalSourcePos _ (line, _) -> line -increaseSourceLine :: Int -> GenericSourcePos -> GenericSourcePos -increaseSourceLine val (GenericSourcePos fp line col) = GenericSourcePos fp (line+val) col -increaseSourceLine val (JournalSourcePos fp (first, _)) = GenericSourcePos fp (first+val) 0 - showGenericSourcePos :: GenericSourcePos -> String showGenericSourcePos = \case GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")" @@ -218,7 +213,7 @@ postingAsLines elideamount onelineamounts ps p = concat [ | postingblock <- postingblocks] where postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, " ", amount, assertion, samelinecomment] | amount <- shownAmounts] - assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity) $ pbalanceassertion p + assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . fst) $ pbalanceassertion p statusandaccount = indent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p where -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 0700e3f4e..77d22e2ea 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -192,6 +192,8 @@ instance Show Status where -- custom show.. bad idea.. don't do it.. show Pending = "!" show Cleared = "*" +type BalanceAssertion = Maybe (Amount, GenericSourcePos) + data Posting = Posting { pdate :: Maybe Day, -- ^ this posting's date, if different from the transaction's pdate2 :: Maybe Day, -- ^ this posting's secondary date, if different from the transaction's @@ -201,7 +203,7 @@ data Posting = Posting { pcomment :: Text, -- ^ this posting's comment lines, as a single non-indented multi-line string ptype :: PostingType, ptags :: [Tag], -- ^ tag names and values, extracted from the comment - pbalanceassertion :: Maybe Amount, -- ^ optional: the expected balance in this commodity in the account after this posting + pbalanceassertion :: BalanceAssertion, -- ^ optional: the expected balance in this commodity in the account after this posting ptransaction :: Maybe Transaction, -- ^ this posting's parent transaction (co-recursive types). -- Tying this knot gets tedious, Maybe makes it easier/optional. porigin :: Maybe Posting -- ^ original posting if this one is result of any transformations (one level only) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 0af594816..9afc3ae65 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -477,14 +477,15 @@ priceamountp = return $ UnitPrice a)) <|> return NoPrice -partialbalanceassertionp :: Monad m => JournalParser m (Maybe Amount) +partialbalanceassertionp :: Monad m => JournalParser m BalanceAssertion partialbalanceassertionp = try (do lift (many spacenonewline) + sourcepos <- genericSourcePos <$> lift getPosition char '=' lift (many spacenonewline) a <- amountp -- XXX should restrict to a simple amount - return $ Just $ a) + return $ Just (a, sourcepos)) <|> return Nothing -- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount) diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 3c23615c3..dcaa0c487 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -676,7 +676,7 @@ transactionFromCsvRecord sourcepos rules record = t balance = maybe Nothing (parsebalance.render) $ mfieldtemplate "balance" parsebalance str | all isSpace str = Nothing - | otherwise = Just $ either (balanceerror str) id $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack $ (currency++) $ simplifySign str + | otherwise = Just $ (either (balanceerror str) id $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack $ (currency++) $ simplifySign str, nullsourcepos) balanceerror str err = error' $ unlines ["error: could not parse \""++str++"\" as balance amount" ,showRecord record diff --git a/hledger/Hledger/Cli/Commands/Equity.hs b/hledger/Hledger/Cli/Commands/Equity.hs index ea1fdcc21..98cd40567 100755 --- a/hledger/Hledger/Cli/Commands/Equity.hs +++ b/hledger/Hledger/Cli/Commands/Equity.hs @@ -66,7 +66,7 @@ equity CliOpts{reportopts_=ropts} j = do balancingamt = negate $ sum $ map (\(_,_,_,b) -> normaliseMixedAmountSquashPricesForDisplay b) acctbals ps = [posting{paccount=a ,pamount=mixed [b] - ,pbalanceassertion=Just b + ,pbalanceassertion=Just (b,nullsourcepos) } |(a,_,_,mb) <- acctbals ,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb @@ -75,7 +75,7 @@ equity CliOpts{reportopts_=ropts} j = do enddate = fromMaybe today $ queryEndDate (date2_ ropts_) q nps = [posting{paccount=a ,pamount=mixed [negate b] - ,pbalanceassertion=Just b{aquantity=0} + ,pbalanceassertion=Just (b{aquantity=0}, nullsourcepos) } |(a,_,_,mb) <- acctbals ,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb diff --git a/tests/journal/balance-assertions.test b/tests/journal/balance-assertions.test index b99270024..0570ab983 100755 --- a/tests/journal/balance-assertions.test +++ b/tests/journal/balance-assertions.test @@ -57,7 +57,7 @@ hledger -f - stats b $-1 = $-3 >>> ->>>2 /balance assertion error.*line 11/ +>>>2 /balance assertion error.*line 11, column 12/ >>>=1 # 4. should also work without commodity symbols