simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-19 18:29:36 +03:00
Code Issues Projects Releases Wiki Activity

lib: Make BalanceAssertion a full datatype

Browse Source 
Note: simplifies/moves whitespace parsing out of the balance assertion
parser.
This commit is contained in:
Samuel May 2018-10-11 20:37:20 -07:00 committed by Simon Michael
parent 22645881c1
commit cde91fc5f4
10 changed files with 58 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-api/hledger-api.hs
View File

@ -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

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

@ -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

13
hledger-lib/Hledger/Data/Posting.hs
View File

@ -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

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

@ -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}

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

@ -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

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

@ -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)

6
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -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 =

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

@ -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

4
hledger/Hledger/Cli/Commands/Close.hs
View File

@ -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

1
site/contributors.md
View File

@ -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: