diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index a722b34ec..bf6a91de6 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -72,6 +72,7 @@ module Hledger.Data.Amount ( -- * MixedAmount nullmixedamt, missingmixedamt, + mixed, amounts, normaliseMixedAmountPreservingFirstPrice, normaliseMixedAmountPreservingPrices, @@ -162,11 +163,11 @@ sumAmounts = normaliseMixedAmountPreservingPrices . Mixed -- | Set an amount's unit price. at :: Amount -> Amount -> Amount -amt `at` priceamt = amt{aprice=UnitPrice $ Mixed [priceamt]} +amt `at` priceamt = amt{aprice=UnitPrice priceamt} -- | Set an amount's total price. (@@) :: Amount -> Amount -> Amount -amt @@ priceamt = amt{aprice=TotalPrice $ Mixed [priceamt]} +amt @@ priceamt = amt{aprice=TotalPrice priceamt} tests_sumAmounts = [ "sumAmounts" ~: do @@ -189,9 +190,8 @@ costOfAmount :: Amount -> Amount costOfAmount a@Amount{aquantity=q, aprice=price} = case price of NoPrice -> a - UnitPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * q} - TotalPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * signum q} - _ -> error' "costOfAmount: Malformed price encountered, programmer error" + UnitPrice p@Amount{aquantity=pq} -> p{aquantity=pq * q} + TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q} -- | Divide an amount's quantity by a constant. divideAmount :: Amount -> Double -> Amount @@ -244,13 +244,13 @@ showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice showPrice :: Price -> String showPrice NoPrice = "" -showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa -showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa +showPrice (UnitPrice pa) = " @ " ++ showAmount pa +showPrice (TotalPrice pa) = " @@ " ++ showAmount pa showPriceDebug :: Price -> String showPriceDebug NoPrice = "" -showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa -showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa +showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa +showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa -- | Get the string representation of an amount, based on its commodity's -- display settings. String representations equivalent to zero are @@ -343,6 +343,9 @@ missingamt = amount{acommodity="AUTO"} missingmixedamt :: MixedAmount missingmixedamt = Mixed [missingamt] +mixed :: Amount -> MixedAmount +mixed a = Mixed [a] + -- | Simplify a mixed amount's component amounts: we can combine amounts -- with the same commodity and unit price. Also remove any zero or missing -- amounts and replace an empty amount list with a single zero amount. @@ -510,9 +513,9 @@ tests_Hledger_Data_Amount = TestList $ "costOfAmount" ~: do costOfAmount (eur 1) `is` eur 1 - costOfAmount (eur 2){aprice=UnitPrice $ Mixed [usd 2]} `is` usd 4 - costOfAmount (eur 1){aprice=TotalPrice $ Mixed [usd 2]} `is` usd 2 - costOfAmount (eur (-1)){aprice=TotalPrice $ Mixed [usd 2]} `is` usd (-2) + costOfAmount (eur 2){aprice=UnitPrice $ usd 2} `is` usd 4 + costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2 + costOfAmount (eur (-1)){aprice=TotalPrice $ usd 2} `is` usd (-2) ,"isZeroAmount" ~: do assertBool "" $ isZeroAmount $ amount @@ -521,7 +524,7 @@ tests_Hledger_Data_Amount = TestList $ ,"negating amounts" ~: do let a = usd 1 negate a `is` a{aquantity=(-1)} - let b = (usd 1){aprice=UnitPrice $ Mixed [eur 2]} + let b = (usd 1){aprice=UnitPrice $ eur 2} negate b `is` b{aquantity=(-1)} ,"adding amounts without prices" ~: do diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 987cfb739..443958aa8 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -296,8 +296,8 @@ balanceTransaction styles t@Transaction{tpostings=ps} -- assign a balancing price. Use @@ for more exact output when possible. -- invariant: prices should always be positive. Enforced with "abs" = if length ramountsinunpricedcommodity == 1 - then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount] - else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)] + then TotalPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount + else UnitPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount) | otherwise = NoPrice where unpricedcommodity = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder @@ -320,8 +320,8 @@ balanceTransaction styles t@Transaction{tpostings=ps} where conversionprice c | c == unpricedcommodity = if length bvamountsinunpricedcommodity == 1 - then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount] - else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)] + then TotalPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount + else UnitPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount) | otherwise = NoPrice where unpricedcommodity = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index e715ee075..d9e18f1c0 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -48,11 +48,8 @@ type Commodity = String type Quantity = Double -- | An amount's price (none, per unit, or total) in another commodity. --- Note although a MixedAmount is used, it should be in a single --- commodity, also the amount should be positive; these are not enforced --- currently. -data Price = NoPrice | UnitPrice MixedAmount | TotalPrice MixedAmount - deriving (Eq,Ord) +-- Note the price should be a positive number, although this is not enforced. +data Price = NoPrice | UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord) -- | Display style for an amount. data AmountStyle = AmountStyle { @@ -127,7 +124,7 @@ data TimeLogEntry = TimeLogEntry { data HistoricalPrice = HistoricalPrice { hdate :: Day, hsymbol :: String, - hamount :: MixedAmount + hamount :: Amount } deriving (Eq) -- & Show (in Amount.hs) type Year = Integer diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index a2c95e86f..08db7459c 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -21,6 +21,7 @@ module Hledger.Read ( accountname, amountp, amountp', + mamountp', -- * Tests samplejournal, tests_Hledger_Read, diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 1d6068a5c..676836865 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -427,7 +427,7 @@ transactionFromCsvRecord rules fields = currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules) amountstr'' = currency ++ amountstr' amountparse = runParser amountp nullctx "" amountstr'' - a = either (const nullmixedamt) id amountparse + a = either (const nullmixedamt) mixed amountparse -- Using costOfMixedAmount here to allow complex costs like "10 GBP @@ 15 USD". -- Aim is to have "10 GBP @@ 15 USD" applied to account "acct", but have "-15USD" applied to "baseacct" baseamount = costOfMixedAmount a diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 007efe830..ddfc421cd 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -29,6 +29,7 @@ module Hledger.Read.JournalReader ( accountname, amountp, amountp', + mamountp', emptyline, -- * Tests tests_Hledger_Read_JournalReader @@ -254,11 +255,8 @@ defaultcommoditydirective :: GenParser Char JournalContext JournalUpdate defaultcommoditydirective = do char 'D' "default commodity" many1 spacenonewline - a <- amountp - -- amount always returns a MixedAmount containing one Amount, but let's be safe - let as = amounts a - when (not $ null as) $ - let Amount{..} = head as in setCommodityAndStyle (acommodity, astyle) + Amount{..} <- amountp + setCommodityAndStyle (acommodity, astyle) restofline return $ return id @@ -559,7 +557,7 @@ spaceandamountormissing :: GenParser Char JournalContext MixedAmount spaceandamountormissing = try (do many1 spacenonewline - amountp <|> return missingmixedamt + (Mixed . (:[])) `fmap` amountp <|> return missingmixedamt ) <|> return missingmixedamt tests_spaceandamountormissing = [ @@ -570,30 +568,35 @@ tests_spaceandamountormissing = [ assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt ] --- | Parse an amount, optionally with a left or right currency symbol, --- price, and/or (ignored) ledger-style balance assertion. -amountp :: GenParser Char JournalContext MixedAmount +-- | Parse a single-commodity amount, with optional symbol on the left or +-- right, optional unit or total price, and optional (ignored) +-- ledger-style balance assertion or fixed lot price declaration. +amountp :: GenParser Char JournalContext Amount amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount tests_amountp = [ "amountp" ~: do - assertParseEqual (parseWithCtx nullctx amountp "$47.18") (Mixed [usd 47.18]) - assertParseEqual (parseWithCtx nullctx amountp "$1.") (Mixed [setAmountPrecision 0 $ usd 1]) + assertParseEqual (parseWithCtx nullctx amountp "$47.18") (usd 47.18) + assertParseEqual (parseWithCtx nullctx amountp "$1.") (setAmountPrecision 0 $ usd 1) ,"amount with unit price" ~: do assertParseEqual (parseWithCtx nullctx amountp "$10 @ €0.5") - (Mixed [usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)]) + (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) ,"amount with total price" ~: do assertParseEqual (parseWithCtx nullctx amountp "$10 @@ €5") - (Mixed [usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)]) + (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)) ] --- | Run the amount parser on a string to get the result or an error. -amountp' :: String -> MixedAmount +-- | Parse an amount from a string, or get an error. +amountp' :: String -> Amount amountp' s = either (error' . show) id $ parseWithCtx nullctx amountp s -leftsymbolamount :: GenParser Char JournalContext MixedAmount +-- | Parse a mixed amount from a string, or get an error. +mamountp' :: String -> MixedAmount +mamountp' = mixed . amountp' + +leftsymbolamount :: GenParser Char JournalContext Amount leftsymbolamount = do sign <- optionMaybe $ string "-" let applysign = if isJust sign then negate else id @@ -602,20 +605,20 @@ leftsymbolamount = do (q,prec,dec,sep,seppos) <- number let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos} p <- priceamount - return $ applysign $ Mixed [Amount c q p s] + return $ applysign $ Amount c q p s "left-symbol amount" -rightsymbolamount :: GenParser Char JournalContext MixedAmount +rightsymbolamount :: GenParser Char JournalContext Amount rightsymbolamount = do (q,prec,dec,sep,seppos) <- number sp <- many spacenonewline c <- commoditysymbol p <- priceamount let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos} - return $ Mixed [Amount c q p s] + return $ Amount c q p s "right-symbol amount" -nosymbolamount :: GenParser Char JournalContext MixedAmount +nosymbolamount :: GenParser Char JournalContext Amount nosymbolamount = do (q,prec,dec,sep,seppos) <- number p <- priceamount @@ -623,7 +626,7 @@ nosymbolamount = do let (c,s) = case defcs of Just (c',s') -> (c',s') Nothing -> ("", amountstyle{asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}) - return $ Mixed [Amount c q p s] + return $ Amount c q p s "no-symbol amount" commoditysymbol :: GenParser Char JournalContext String @@ -655,7 +658,7 @@ priceamount = return $ UnitPrice a)) <|> return NoPrice -balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount) +balanceassertion :: GenParser Char JournalContext (Maybe Amount) balanceassertion = try (do many spacenonewline @@ -666,7 +669,7 @@ balanceassertion = <|> return Nothing -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices -fixedlotprice :: GenParser Char JournalContext (Maybe MixedAmount) +fixedlotprice :: GenParser Char JournalContext (Maybe Amount) fixedlotprice = try (do many spacenonewline @@ -885,7 +888,7 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n") ,"historicalpricedirective" ~: - assertParseEqual (parseWithCtx nullctx historicalpricedirective "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [usd 55]) + assertParseEqual (parseWithCtx nullctx historicalpricedirective "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ usd 55) ,"ignoredpricecommoditydirective" ~: do assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n") @@ -910,16 +913,16 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:") ,"leftsymbolamount" ~: do - assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (Mixed [usd 1 `withPrecision` 0]) - assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (Mixed [usd (-1) `withPrecision` 0]) - assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (Mixed [usd (-1) `withPrecision` 0]) + assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (usd 1 `withPrecision` 0) + assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (usd (-1) `withPrecision` 0) + assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (usd (-1) `withPrecision` 0) ,"amount" ~: do - let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity - assertMixedAmountParse parseresult mixedamount = - (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) - assertMixedAmountParse (parseWithCtx nullctx amountp "1 @ $2") - (Mixed [amt 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)]) + let -- | compare a parse result with an expected amount, showing the debug representation for clarity + assertAmountParse parseresult amount = + (either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug amount) + assertAmountParse (parseWithCtx nullctx amountp "1 @ $2") + (amt 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)) ]] diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index fb5e62ff3..edb6e4391 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -61,7 +61,7 @@ import Text.ParserCombinators.Parsec import Text.Printf import Hledger.Data -import Hledger.Read (amountp') +import Hledger.Read (mamountp') import Hledger.Query import Hledger.Utils @@ -759,36 +759,36 @@ tests_accountsReport = ,"accountsReport with no args on sample journal" ~: do (defreportopts, samplejournal) `gives` ([ - ("assets","assets",0, amountp' "$-1.00") - ,("assets:bank:saving","bank:saving",1, amountp' "$1.00") - ,("assets:cash","cash",1, amountp' "$-2.00") - ,("expenses","expenses",0, amountp' "$2.00") - ,("expenses:food","food",1, amountp' "$1.00") - ,("expenses:supplies","supplies",1, amountp' "$1.00") - ,("income","income",0, amountp' "$-2.00") - ,("income:gifts","gifts",1, amountp' "$-1.00") - ,("income:salary","salary",1, amountp' "$-1.00") - ,("liabilities:debts","liabilities:debts",0, amountp' "$1.00") + ("assets","assets",0, mamountp' "$-1.00") + ,("assets:bank:saving","bank:saving",1, mamountp' "$1.00") + ,("assets:cash","cash",1, mamountp' "$-2.00") + ,("expenses","expenses",0, mamountp' "$2.00") + ,("expenses:food","food",1, mamountp' "$1.00") + ,("expenses:supplies","supplies",1, mamountp' "$1.00") + ,("income","income",0, mamountp' "$-2.00") + ,("income:gifts","gifts",1, mamountp' "$-1.00") + ,("income:salary","salary",1, mamountp' "$-1.00") + ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00") ], Mixed [nullamt]) ,"accountsReport with --depth=N" ~: do (defreportopts{depth_=Just 1}, samplejournal) `gives` ([ - ("assets", "assets", 0, amountp' "$-1.00") - ,("expenses", "expenses", 0, amountp' "$2.00") - ,("income", "income", 0, amountp' "$-2.00") - ,("liabilities", "liabilities", 0, amountp' "$1.00") + ("assets", "assets", 0, mamountp' "$-1.00") + ,("expenses", "expenses", 0, mamountp' "$2.00") + ,("income", "income", 0, mamountp' "$-2.00") + ,("liabilities", "liabilities", 0, mamountp' "$1.00") ], Mixed [nullamt]) ,"accountsReport with depth:N" ~: do (defreportopts{query_="depth:1"}, samplejournal) `gives` ([ - ("assets", "assets", 0, amountp' "$-1.00") - ,("expenses", "expenses", 0, amountp' "$2.00") - ,("income", "income", 0, amountp' "$-2.00") - ,("liabilities", "liabilities", 0, amountp' "$1.00") + ("assets", "assets", 0, mamountp' "$-1.00") + ,("expenses", "expenses", 0, mamountp' "$2.00") + ,("income", "income", 0, mamountp' "$-2.00") + ,("liabilities", "liabilities", 0, mamountp' "$1.00") ], Mixed [nullamt]) @@ -798,32 +798,32 @@ tests_accountsReport = Mixed [nullamt]) (defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives` ([ - ("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00") - ,("income:salary","income:salary",0,amountp' "$-1.00") + ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") + ,("income:salary","income:salary",0,mamountp' "$-1.00") ], Mixed [nullamt]) ,"accountsReport with desc:" ~: do (defreportopts{query_="desc:income"}, samplejournal) `gives` ([ - ("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00") - ,("income:salary","income:salary",0, amountp' "$-1.00") + ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") + ,("income:salary","income:salary",0, mamountp' "$-1.00") ], Mixed [nullamt]) ,"accountsReport with not:desc:" ~: do (defreportopts{query_="not:desc:income"}, samplejournal) `gives` ([ - ("assets","assets",0, amountp' "$-2.00") + ("assets","assets",0, mamountp' "$-2.00") ,("assets:bank","bank",1, Mixed [nullamt]) - ,("assets:bank:checking","checking",2,amountp' "$-1.00") - ,("assets:bank:saving","saving",2, amountp' "$1.00") - ,("assets:cash","cash",1, amountp' "$-2.00") - ,("expenses","expenses",0, amountp' "$2.00") - ,("expenses:food","food",1, amountp' "$1.00") - ,("expenses:supplies","supplies",1, amountp' "$1.00") - ,("income:gifts","income:gifts",0, amountp' "$-1.00") - ,("liabilities:debts","liabilities:debts",0, amountp' "$1.00") + ,("assets:bank:checking","checking",2,mamountp' "$-1.00") + ,("assets:bank:saving","saving",2, mamountp' "$1.00") + ,("assets:cash","cash",1, mamountp' "$-2.00") + ,("expenses","expenses",0, mamountp' "$2.00") + ,("expenses:food","food",1, mamountp' "$1.00") + ,("expenses:supplies","supplies",1, mamountp' "$1.00") + ,("income:gifts","income:gifts",0, mamountp' "$-1.00") + ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00") ], Mixed [nullamt]) diff --git a/hledger-web/Handler/Handlers.hs b/hledger-web/Handler/Handlers.hs index 1d9beae72..19fb57389 100644 --- a/hledger-web/Handler/Handlers.hs +++ b/hledger-web/Handler/Handlers.hs @@ -527,7 +527,7 @@ handleAdd = do acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt1M - amt2E = maybe (Right missingmixedamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt2M + amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt2M journalE = maybe (Right $ journalFilePath j) (\f -> let f' = unpack f in if f' `elem` journalFilePaths j @@ -547,8 +547,8 @@ handleAdd = do tdate=parsedate date ,tdescription=desc ,tpostings=[ - Posting False acct1 amt1 "" RegularPosting [] Nothing - ,Posting False acct2 amt2 "" RegularPosting [] Nothing + Posting False acct1 (mixed amt1) "" RegularPosting [] Nothing + ,Posting False acct2 (mixed amt2) "" RegularPosting [] Nothing ] }) -- display errors or add transaction diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 98cebbd76..44788a794 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -17,7 +17,6 @@ import Data.Char (toUpper) import Data.List import Data.Maybe import Data.Time.Calendar -import Safe (headMay) import System.Console.Haskeline (InputT, runInputT, defaultSettings, setComplete, getInputLine) import System.Console.Haskeline.Completion import System.IO ( stderr, hPutStrLn, hPutStr ) @@ -148,22 +147,20 @@ getPostings st enteredps = do -- I think 1 or 4, whichever would show the most decimal places p = maxprecisionwithpoint amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount - let a = fromparse $ runParser (amountp <|> return missingmixedamt) ctx "" amountstr - a' = fromparse $ runParser (amountp <|> return missingmixedamt) nullctx "" amountstr - defaultamtused = Just (showMixedAmount a) == defaultamountstr - commodityadded | c == cwithnodef = Nothing - | otherwise = c - where c = maybemixedamountcommodity a - cwithnodef = maybemixedamountcommodity a' - maybemixedamountcommodity = maybe Nothing (Just . acommodity) . headMay . amounts - p = nullposting{paccount=stripbrackets account, - pamount=a, - ptype=postingtype account} - st' = if defaultamtused then st - else st{psHistory = historicalps', - psSuggestHistoricalAmount = False} - when (isJust commodityadded) $ - liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust commodityadded) + let a = fromparse $ runParser (amountp <|> return missingamt) ctx "" amountstr + a' = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amountstr + wasdefaultamtused = Just (showAmount a) == defaultamountstr + defaultcommodityadded | acommodity a == acommodity a' = Nothing + | otherwise = Just $ acommodity a + p = nullposting{paccount=stripbrackets account + ,pamount=mixed a + ,ptype=postingtype account + } + st' = if wasdefaultamtused + then st + else st{psHistory=historicalps', psSuggestHistoricalAmount=False} + when (isJust defaultcommodityadded) $ + liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust defaultcommodityadded) getPostings st' (enteredps ++ [p]) where j = psJournal st