mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-27 04:13:11 +03:00
Rewrite of BalanceAssertion type to track its source position.
Fixes #481.
This commit is contained in:
parent
87567c9514
commit
3a9ea65b99
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user