mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib: Make BalanceAssertion a full datatype
Note: simplifies/moves whitespace parsing out of the balance assertion parser.
This commit is contained in:
parent
22645881c1
commit
cde91fc5f4
@ -170,6 +170,7 @@ instance ToJSON AmountStyle where toJSON = genericToJSON defaultOptions
|
||||
instance ToJSON Side where toJSON = genericToJSON defaultOptions
|
||||
instance ToJSON DigitGroupStyle where toJSON = genericToJSON defaultOptions
|
||||
instance ToJSON MixedAmount where toJSON = genericToJSON defaultOptions
|
||||
instance ToJSON BalanceAssertion where toJSON = genericToJSON defaultOptions
|
||||
instance ToJSON Price where toJSON = genericToJSON defaultOptions
|
||||
instance ToJSON MarketPrice where toJSON = genericToJSON defaultOptions
|
||||
instance ToJSON PostingType where toJSON = genericToJSON defaultOptions
|
||||
@ -213,6 +214,7 @@ instance ToSchema AmountStyle
|
||||
instance ToSchema Side
|
||||
instance ToSchema DigitGroupStyle
|
||||
instance ToSchema MixedAmount
|
||||
instance ToSchema BalanceAssertion
|
||||
instance ToSchema Price
|
||||
#if MIN_VERSION_swagger2(2,1,5)
|
||||
where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
|
||||
|
@ -568,12 +568,13 @@ 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 } bal
|
||||
| isReallyZeroAmount diff = Right ()
|
||||
| True = Left err
|
||||
where assertedcomm = acommodity ass
|
||||
actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts amt)
|
||||
diff = ass - actualbal
|
||||
where amt = baamount ass
|
||||
assertedcomm = acommodity amt
|
||||
actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal)
|
||||
diff = amt - actualbal
|
||||
diffplus | isNegativeAmount diff == False = "+"
|
||||
| otherwise = ""
|
||||
err = printf (unlines
|
||||
@ -591,13 +592,13 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt
|
||||
Nothing -> ":" -- shouldn't happen
|
||||
Just t -> printf " in %s:\nin transaction:\n%s"
|
||||
(showGenericSourcePos pos) (chomp $ showTransaction t) :: String
|
||||
where pos = snd $ fromJust $ pbalanceassertion p)
|
||||
where pos = baposition $ fromJust $ pbalanceassertion p)
|
||||
(showPostingLine p)
|
||||
(showDate $ postingDate p)
|
||||
(T.unpack $ paccount p) -- XXX pack
|
||||
assertedcomm
|
||||
(showAmount actualbal)
|
||||
(showAmount ass)
|
||||
(showAmount amt)
|
||||
(diffplus ++ showAmount diff)
|
||||
checkBalanceAssertion _ _ = Right ()
|
||||
|
||||
@ -717,7 +718,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) . fst)
|
||||
(fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p) . baamount)
|
||||
$ pbalanceassertion p
|
||||
|
||||
-- | Adds a posting's amount to the posting's account balance and
|
||||
|
@ -15,6 +15,9 @@ module Hledger.Data.Posting (
|
||||
nullposting,
|
||||
posting,
|
||||
post,
|
||||
nullsourcepos,
|
||||
nullassertion,
|
||||
assertion,
|
||||
-- * operations
|
||||
originalPosting,
|
||||
postingStatus,
|
||||
@ -96,6 +99,16 @@ posting = nullposting
|
||||
post :: AccountName -> Amount -> Posting
|
||||
post acct amt = posting {paccount=acct, pamount=Mixed [amt]}
|
||||
|
||||
nullsourcepos :: GenericSourcePos
|
||||
nullsourcepos = JournalSourcePos "" (1,1)
|
||||
|
||||
nullassertion, assertion :: BalanceAssertion
|
||||
nullassertion = BalanceAssertion
|
||||
{baamount=nullamt
|
||||
,baposition=nullsourcepos
|
||||
}
|
||||
assertion = nullassertion
|
||||
|
||||
-- Get the original posting, if any.
|
||||
originalPosting :: Posting -> Posting
|
||||
originalPosting p = fromMaybe p $ porigin p
|
||||
|
@ -12,7 +12,6 @@ tags.
|
||||
|
||||
module Hledger.Data.Transaction (
|
||||
-- * Transaction
|
||||
nullsourcepos,
|
||||
nulltransaction,
|
||||
txnTieKnot,
|
||||
txnUntieKnot,
|
||||
@ -77,9 +76,6 @@ showGenericSourcePos = \case
|
||||
GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")"
|
||||
JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")"
|
||||
|
||||
nullsourcepos :: GenericSourcePos
|
||||
nullsourcepos = JournalSourcePos "" (1,1)
|
||||
|
||||
nulltransaction :: Transaction
|
||||
nulltransaction = Transaction {
|
||||
tindex=0,
|
||||
@ -220,7 +216,7 @@ postingAsLines elideamount onelineamounts pstoalignwith p = concat [
|
||||
| postingblock <- postingblocks]
|
||||
where
|
||||
postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, " ", amount, assertion, samelinecomment] | amount <- shownAmounts]
|
||||
assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . fst) $ pbalanceassertion p
|
||||
assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ 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
|
||||
@ -681,10 +677,8 @@ tests_Transaction = tests "Transaction" [
|
||||
," assets:checking"
|
||||
,""
|
||||
]
|
||||
]
|
||||
|
||||
,tests "showTransaction" [
|
||||
test "show a balanced transaction, no eliding" $
|
||||
,test "show a balanced transaction, no eliding" $
|
||||
(let t = Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" []
|
||||
[posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t}
|
||||
,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t}
|
||||
|
@ -236,7 +236,12 @@ instance Show Status where -- custom show.. bad idea.. don't do it..
|
||||
show Pending = "!"
|
||||
show Cleared = "*"
|
||||
|
||||
type BalanceAssertion = Maybe (Amount, GenericSourcePos)
|
||||
data BalanceAssertion = BalanceAssertion {
|
||||
baamount :: Amount,
|
||||
baposition :: GenericSourcePos
|
||||
} deriving (Eq,Typeable,Data,Generic,Show)
|
||||
|
||||
instance NFData BalanceAssertion
|
||||
|
||||
data Posting = Posting {
|
||||
pdate :: Maybe Day, -- ^ this posting's date, if different from the transaction's
|
||||
@ -247,7 +252,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 :: BalanceAssertion, -- ^ optional: the expected balance in this commodity in the account after this posting
|
||||
pbalanceassertion :: Maybe 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 -- ^ When this posting has been transformed in some way
|
||||
|
@ -74,7 +74,7 @@ module Hledger.Read.Common (
|
||||
mamountp',
|
||||
commoditysymbolp,
|
||||
priceamountp,
|
||||
partialbalanceassertionp,
|
||||
balanceassertionp,
|
||||
fixedlotpricep,
|
||||
numberp,
|
||||
fromRawNumber,
|
||||
@ -717,26 +717,16 @@ priceamountp = option NoPrice $ do
|
||||
|
||||
pure $ priceConstructor priceAmount
|
||||
|
||||
partialbalanceassertionp :: JournalParser m BalanceAssertion
|
||||
partialbalanceassertionp = optional $ do
|
||||
sourcepos <- try $ do
|
||||
lift (skipMany spacenonewline)
|
||||
balanceassertionp :: JournalParser m BalanceAssertion
|
||||
balanceassertionp = do
|
||||
sourcepos <- genericSourcePos <$> lift getSourcePos
|
||||
char '='
|
||||
pure sourcepos
|
||||
lift (skipMany spacenonewline)
|
||||
a <- amountp <?> "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount
|
||||
return (a, sourcepos)
|
||||
|
||||
-- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount)
|
||||
-- balanceassertion =
|
||||
-- try (do
|
||||
-- lift (skipMany spacenonewline)
|
||||
-- string "=="
|
||||
-- lift (skipMany spacenonewline)
|
||||
-- a <- amountp -- XXX should restrict to a simple amount
|
||||
-- return $ Just $ Mixed [a])
|
||||
-- <|> return Nothing
|
||||
return BalanceAssertion
|
||||
{ baamount = a
|
||||
, baposition = sourcepos
|
||||
}
|
||||
|
||||
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
|
||||
fixedlotpricep :: JournalParser m (Maybe Amount)
|
||||
|
@ -748,10 +748,14 @@ transactionFromCsvRecord sourcepos rules record = t
|
||||
tcomment = T.pack comment,
|
||||
tpreceding_comment_lines = T.pack precomment,
|
||||
tpostings =
|
||||
[posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=balance}
|
||||
[posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=toAssertion <$> balance}
|
||||
,posting {paccount=account2, pamount=amount2, ptransaction=Just t}
|
||||
]
|
||||
}
|
||||
toAssertion (a, b) = BalanceAssertion{
|
||||
baamount = a,
|
||||
baposition = b
|
||||
}
|
||||
|
||||
getAmountStr :: CsvRules -> CsvRecord -> Maybe String
|
||||
getAmountStr rules record =
|
||||
|
@ -589,7 +589,8 @@ postingp mTransactionYear = do
|
||||
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
|
||||
lift (skipMany spacenonewline)
|
||||
amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp
|
||||
massertion <- partialbalanceassertionp
|
||||
lift (skipMany spacenonewline)
|
||||
massertion <- optional $ balanceassertionp
|
||||
_ <- fixedlotpricep
|
||||
lift (skipMany spacenonewline)
|
||||
(comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
|
||||
|
@ -85,7 +85,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
|
||||
balancingamt = negate $ sum $ map (\(_,_,_,b) -> normaliseMixedAmountSquashPricesForDisplay b) acctbals
|
||||
ps = [posting{paccount=a
|
||||
,pamount=mixed [b]
|
||||
,pbalanceassertion=Just (b,nullsourcepos)
|
||||
,pbalanceassertion=Just assertion{ baamount=b }
|
||||
}
|
||||
|(a,_,_,mb) <- acctbals
|
||||
,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb
|
||||
@ -93,7 +93,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
|
||||
++ [posting{paccount="equity:opening balances", pamount=balancingamt}]
|
||||
nps = [posting{paccount=a
|
||||
,pamount=mixed [negate b]
|
||||
,pbalanceassertion=Just (b{aquantity=0}, nullsourcepos)
|
||||
,pbalanceassertion=Just assertion{ baamount=b{aquantity=0} }
|
||||
}
|
||||
|(a,_,_,mb) <- acctbals
|
||||
,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb
|
||||
|
@ -8,6 +8,7 @@ hledger is brought to you by:
|
||||
- Roman Cheplyaka - "chart" command, "add" command improvements
|
||||
- Michael Snoyman - some additions to the Yesod web interface
|
||||
- Marko Kocić - hlint cleanup
|
||||
- Samuel May - exact assertions
|
||||
|
||||
Developers who have not yet signed the contributor agreement:
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user