diff --git a/hledger-api/hledger-api.hs b/hledger-api/hledger-api.hs index 87368cb7f..880650d26 100644 --- a/hledger-api/hledger-api.hs +++ b/hledger-api/hledger-api.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 597b8aafb..a3ac29729 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index cb0cc4d6b..09512261b 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 1babebab0..4ca9ad7e9 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -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} diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 0f2c5447c..e2936e9d6 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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 @@ -246,14 +251,14 @@ data Posting = Posting { pamount :: MixedAmount, 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 - 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 - -- (eg its amount or price was inferred, or the account name was - -- changed by a pivot or budget report), this references the original - -- untransformed posting (which will have Nothing in this field). + ptags :: [Tag], -- ^ tag names and values, extracted from the comment + 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 + -- (eg its amount or price was inferred, or the account name was + -- changed by a pivot or budget report), this references the original + -- untransformed posting (which will have Nothing in this field). } deriving (Typeable,Data,Generic) instance NFData Posting diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 8d0e97bf1..eaedd1676 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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) - sourcepos <- genericSourcePos <$> lift getSourcePos - char '=' - pure sourcepos +balanceassertionp :: JournalParser m BalanceAssertion +balanceassertionp = do + sourcepos <- genericSourcePos <$> lift getSourcePos + char '=' 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) diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 419bf2435..5c0dcae71 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -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 = diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 074455408..5b5eef2c1 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index 11f3ca2c5..2613872c0 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -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 diff --git a/site/contributors.md b/site/contributors.md index 1b489ce4a..06963912c 100644 --- a/site/contributors.md +++ b/site/contributors.md @@ -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: