Skip to content

Commit 11830eb

Browse files
ag-eitiltag-eitilt
committed
lib: journal: Add basic arithmetic
1 parent fba0796 commit 11830eb

File tree

5 files changed

+241
-17
lines changed

5 files changed

+241
-17
lines changed

‎hledger-lib/Hledger/Data/Commodity.hs

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,6 @@ are thousands separated by comma, significant decimal places and so on.
1212

1313
module Hledger.Data.Commodity
1414
where
15-
import Data.Char (isDigit)
1615
import Data.List
1716
import Data.Maybe (fromMaybe)
1817
#if !(MIN_VERSION_base(4,11,0))
@@ -26,13 +25,10 @@ import Hledger.Utils
2625

2726

2827
-- characters that may not be used in a non-quoted commodity symbol
29-
nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char]
28+
nonsimplecommoditychars = "0123456789-+.@*;\n \"(){}=" :: [Char]
3029

3130
isNonsimpleCommodityChar :: Char -> Bool
32-
isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars
33-
where
34-
otherChars = "-+.@*;\n \"{}=" :: T.Text
35-
textElem = T.any . (==)
31+
isNonsimpleCommodityChar = flip elem nonsimplecommoditychars
3632

3733
quoteCommoditySymbolIfNeeded s | T.any (isNonsimpleCommodityChar) s = "\"" <> s <> "\""
3834
| otherwise = s

‎hledger-lib/Hledger/Data/TransactionModifier.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -91,7 +91,7 @@ tmPostingRuleToFunction pr =
9191
where
9292
amount' = case pmultiplier pr of
9393
Nothing -> const $ pamount pr
94-
Just n -> \p ->
94+
Just n -> \p -> pamount pr +
9595
-- Multiply the old posting's amount by the posting rule's multiplier.
9696
let
9797
matchedamount = dbg6 "matchedamount" $ pamount p

‎hledger-lib/Hledger/Read/Common.hs

Lines changed: 64 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,7 @@ module Hledger.Read.Common (
7171
spaceandamountormissingp,
7272
amountp,
7373
amountp',
74+
mamountp,
7475
mamountp',
7576
commoditysymbolp,
7677
priceamountp,
@@ -685,9 +686,44 @@ amountp' s =
685686
Right amt -> amt
686687
Left err -> error' $ show err -- XXX should throwError
687688

689+
-- | Parse a multi-commodity amount, comprising of multiple single amounts
690+
-- joined as an arithmetic expression.
691+
mamountp :: Bool -> JournalParser m MixedAmount
692+
mamountp requireOp = label "mixed amount" $ do
693+
opc <- ( if requireOp
694+
then id
695+
else option '+'
696+
) $ do
697+
c <- satisfy (`elem` ("+-" :: String))
698+
lift (skipMany spacenonewline)
699+
pure c
700+
paren <- option False $ try $ do
701+
char '('
702+
lift (skipMany spacenonewline)
703+
pure True
704+
amount <- if paren
705+
then do
706+
inner <- mamountp False
707+
lift (skipMany spacenonewline)
708+
char ')'
709+
pure inner
710+
else do
711+
inner <- amountp
712+
pure $ Mixed [inner]
713+
tail <- option nullmixedamt $ try $ do
714+
lift (skipMany spacenonewline)
715+
mamountp True
716+
let op = case opc of
717+
'-' -> negate
718+
_ -> id
719+
return $ op amount + tail
720+
688721
-- | Parse a mixed amount from a string, or get an error.
689722
mamountp' :: String -> MixedAmount
690-
mamountp' = Mixed . (:[]) . amountp'
723+
mamountp' s =
724+
case runParser (evalStateT (mamountp False <* eof) mempty) "" (T.pack s) of
725+
Right amt -> amt
726+
Left err -> error' $ show err -- XXX should throwError
691727

692728
signp :: Num a => TextParser m (a -> a)
693729
signp = char '-' *> pure negate <|> char '+' *> pure id <|> pure id
@@ -741,9 +777,9 @@ balanceassertionp = do
741777
char '='
742778
exact <- optional $ try $ char '='
743779
lift (skipMany spacenonewline)
744-
a <- amountp <?> "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount
780+
a <- mamountp False <?> "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount
745781
return BalanceAssertion
746-
{ baamount = Mixed [a]
782+
{ baamount = a
747783
, baexact = isJust exact
748784
, baposition = sourcepos
749785
}
@@ -1338,6 +1374,31 @@ tests_Common = tests "Common" [
13381374
}
13391375
]
13401376

1377+
,tests "mamountp" [
1378+
test "basic" $ expectParseEq (mamountp False) "$47.18" $ Mixed [usd 47.18]
1379+
,test "multiple commodities" $ expectParseEq (mamountp False) "$47.18+€20,59" $ Mixed [
1380+
amount{
1381+
acommodity="$"
1382+
,aquantity=47.18
1383+
,astyle=amountstyle{asprecision=2, asdecimalpoint=Just '.'}
1384+
}
1385+
,amount{
1386+
acommodity="€"
1387+
,aquantity=20.59
1388+
,astyle=amountstyle{asprecision=2, asdecimalpoint=Just ','}
1389+
}
1390+
]
1391+
,test "same commodity multiple times" $ expectParseEq (mamountp False) "$10 + $2 - $5-$2" $ Mixed [
1392+
amount{
1393+
acommodity="$"
1394+
,aquantity=5
1395+
,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing}
1396+
}
1397+
]
1398+
,test "ledger-compatible expressions" $ expectParseEq (mamountp False) "($47.18 - $7.13)" $ Mixed [usd 40.05]
1399+
,test "nested parentheses" $ expectParseEq (mamountp False) "($47.18 - ($20 + $7.13) + $5.05)" $ Mixed [usd 25.10]
1400+
]
1401+
13411402
,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in
13421403
tests "numberp" [
13431404
test "." $ expectParseEq p "0" (0, 0, Nothing, Nothing)

‎hledger-lib/Hledger/Read/JournalReader.hs

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,6 @@ import qualified Control.Exception as C
6868
import Control.Monad
6969
import Control.Monad.Except (ExceptT(..))
7070
import Control.Monad.State.Strict
71-
import Data.Either (fromLeft, fromRight)
7271
import Data.Maybe
7372
import qualified Data.Map.Strict as M
7473
import Data.Text (Text)
@@ -601,10 +600,15 @@ postingp mTransactionYear allowCommodityMult = do
601600
return (status, account)
602601
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
603602
lift (skipMany spacenonewline)
604-
value <- (if allowCommodityMult
605-
then (<|>) $ Left . Just <$> try modifierp
606-
else id
607-
) $ Right <$> (option missingmixedamt $ Mixed . (:[]) <$> amountp)
603+
mult <- (if allowCommodityMult
604+
then optional $ try modifierp
605+
else return Nothing
606+
)
607+
lift (skipMany spacenonewline)
608+
let (defamt, requireOp) = if isJust mult
609+
then (nullmixedamt, True)
610+
else (missingmixedamt, False)
611+
amount <- option defamt $ mamountp requireOp
608612
lift (skipMany spacenonewline)
609613
massertion <- optional $ balanceassertionp
610614
_ <- fixedlotpricep
@@ -615,11 +619,11 @@ postingp mTransactionYear allowCommodityMult = do
615619
, pdate2=mdate2
616620
, pstatus=status
617621
, paccount=account'
618-
, pamount=fromRight nullmixedamt value
622+
, pamount=amount
619623
, pcomment=comment
620624
, ptype=ptype
621625
, ptags=tags
622-
, pmultiplier=fromLeft Nothing value
626+
, pmultiplier=mult
623627
, pbalanceassertion=massertion
624628
}
625629

‎tests/journal/amount-expressions.test

Lines changed: 163 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,163 @@
1+
#!/usr/bin/env shelltest
2+
# 1. Compatibiltiy with the example in Ledger docs
3+
hledger -f - print
4+
<<<
5+
2017-03-10 * KFC
6+
Expenses:Food ($10.00 + $20.00)
7+
Assets:Cash
8+
>>>
9+
2017/03/10 * KFC
10+
Expenses:Food $30.00
11+
Assets:Cash
12+
13+
>>>2
14+
>>>=0
15+
16+
# 2. Expressions don't require parentheses
17+
hledger -f - print
18+
<<<
19+
2017-03-10 * KFC
20+
Expenses:Food $10.00 + $20.00
21+
Assets:Cash
22+
>>>
23+
2017/03/10 * KFC
24+
Expenses:Food $30.00
25+
Assets:Cash
26+
27+
>>>2
28+
>>>=0
29+
30+
# 3. Subtraction is distributive
31+
hledger -f - print
32+
<<<
33+
2018-01-01
34+
a $10 - $5 + $2 + $3
35+
b $10 - ($5 + $2) + $7
36+
c
37+
>>>
38+
2018/01/01
39+
a $10
40+
b $10
41+
c
42+
43+
>>>2
44+
>>>=0
45+
46+
# 4. Expressions consider the default commodity
47+
hledger -f - print
48+
<<<
49+
D $1,000.00
50+
51+
2018-01-01
52+
a $10 - 5
53+
b
54+
>>>
55+
2018/01/01
56+
a $5.00
57+
b
58+
59+
>>>2
60+
>>>=0
61+
62+
# 5. Expressions enable multi-commodity postings
63+
hledger -f - print
64+
<<<
65+
2018-01-01
66+
a:usd $10
67+
a:coupon 10 OMD
68+
b -($10 + 10 OMD)
69+
>>>
70+
2018/01/01
71+
a:usd $10
72+
a:coupon 10 OMD
73+
b $-10
74+
b -10 OMD
75+
76+
>>>2
77+
>>>=0
78+
79+
# 6. Expressions enable multi-commodity assertions
80+
hledger -f - stats
81+
<<<
82+
2018-01-01
83+
a:usd $10
84+
a:coupon 10 OMD
85+
b
86+
87+
2018-01-02
88+
b 0 = -$10 - 10 OMD
89+
>>> /Transactions/
90+
>>>2
91+
>>>=0
92+
93+
# 7. Default commodities are treated alongside their explicit counterpart
94+
hledger -f - print
95+
<<<
96+
D $1,000.00
97+
98+
2018-01-01
99+
a $10 + 2 - 4 CAD
100+
b
101+
>>>
102+
2018/01/01
103+
a $12.00
104+
a -4 CAD
105+
b
106+
107+
>>>2
108+
>>>=0
109+
110+
# 8. Auto-postings respect expressions
111+
hledger -f - print --auto
112+
<<<
113+
= a
114+
c *-1 + $8
115+
d *1 - $8
116+
e *-1
117+
f *1
118+
g $8
119+
h -$8
120+
121+
2018-01-01
122+
a $5
123+
b
124+
>>>
125+
2018/01/01
126+
a $5
127+
c $3
128+
d $-3
129+
e $-5
130+
f $5
131+
g $8
132+
h $-8
133+
b
134+
135+
>>>2
136+
>>>=0
137+
138+
# 9. Standard postings may not be headed by multipliers
139+
hledger -f - print
140+
<<<
141+
2018-01-01
142+
a *-1 + $8
143+
b *1 - $8
144+
>>>
145+
>>>2 /unexpected '*'/
146+
>>>=1
147+
148+
# 10. Auto-postings require an operator between multiplier and expression
149+
# The error message could be a bit more helpful, but at least it mentions
150+
# expecting a mixed amount
151+
hledger -f - print --auto
152+
<<<
153+
= a
154+
c *-1 $8
155+
d *1 - $8
156+
157+
2018-01-01
158+
a $5
159+
b
160+
>>>
161+
>>>2 /unexpected '8'/
162+
>>>=1
163+

0 commit comments

Comments
 (0)