mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-18 17:57:11 +03:00
imp: journal: also parse (lot notes) in amounts (ledger compat)
and rename lotpricep -> lotcostp and instrument some amount parsers for debugging with megaparsec's dbg
This commit is contained in:
parent
aa54c3273a
commit
1ea2bcc83f
@ -80,7 +80,7 @@ module Hledger.Read.Common (
|
||||
commoditysymbolp,
|
||||
costp,
|
||||
balanceassertionp,
|
||||
lotpricep,
|
||||
lotcostp,
|
||||
numberp,
|
||||
fromRawNumber,
|
||||
rawnumberp,
|
||||
@ -133,24 +133,25 @@ import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe)
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Semigroup as Sem
|
||||
import Data.Text (Text)
|
||||
import Data.Text (Text, stripEnd)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day, fromGregorianValid, toGregorian)
|
||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..))
|
||||
import Data.Word (Word8)
|
||||
import System.FilePath (takeFileName)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char (char, char', digitChar, newline, string)
|
||||
import Text.Megaparsec.Char.Lexer (decimal)
|
||||
import Text.Megaparsec.Custom
|
||||
(FinalParseError, attachSource, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion)
|
||||
-- import Text.Megaparsec.Debug (dbg) -- from megaparsec 9.3+
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery)
|
||||
import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts)
|
||||
import Hledger.Utils
|
||||
import Hledger.Read.InputOptions
|
||||
import System.FilePath (takeFileName)
|
||||
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
@ -732,18 +733,24 @@ amountp = amountp' False
|
||||
-- A flag indicates whether we are parsing a multiplier amount;
|
||||
-- if not, a commodity-less amount will have the default commodity applied to it.
|
||||
amountp' :: Bool -> JournalParser m Amount
|
||||
amountp' mult = label "amount" $ do
|
||||
amountp' mult =
|
||||
-- dbg "amountp'" $
|
||||
label "amount" $ do
|
||||
let spaces = lift $ skipNonNewlineSpaces
|
||||
amt <- simpleamountp mult <* spaces
|
||||
(mprice, _elotprice, _elotdate) <- runPermutation $
|
||||
(,,) <$> toPermutationWithDefault Nothing (Just <$> costp amt <* spaces)
|
||||
<*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces)
|
||||
(mcost, _mlotcost, _mlotdate, _mlotnote) <- runPermutation $
|
||||
-- need a try on costp so that it doesn't consume the ( of a lot note
|
||||
(,,,) <$> toPermutationWithDefault Nothing (Just <$> try (costp amt) <* spaces)
|
||||
<*> toPermutationWithDefault Nothing (Just <$> lotcostp <* spaces)
|
||||
<*> toPermutationWithDefault Nothing (Just <$> lotdatep <* spaces)
|
||||
pure $ amt { aprice = mprice }
|
||||
<*> toPermutationWithDefault Nothing (Just <$> lotnotep <* spaces)
|
||||
pure $ amt { aprice = mcost }
|
||||
|
||||
-- An amount with optional cost, but no cost basis.
|
||||
amountnobasisp :: JournalParser m Amount
|
||||
amountnobasisp = label "amount" $ do
|
||||
amountnobasisp =
|
||||
-- dbg "amountnobasisp" $
|
||||
label "amount" $ do
|
||||
let spaces = lift $ skipNonNewlineSpaces
|
||||
amt <- simpleamountp False
|
||||
spaces
|
||||
@ -754,7 +761,9 @@ amountnobasisp = label "amount" $ do
|
||||
-- A flag indicates whether we are parsing a multiplier amount;
|
||||
-- if not, a commodity-less amount will have the default commodity applied to it.
|
||||
simpleamountp :: Bool -> JournalParser m Amount
|
||||
simpleamountp mult = do
|
||||
simpleamountp mult =
|
||||
-- dbg "simpleamountp" $
|
||||
do
|
||||
sign <- lift signp
|
||||
leftsymbolamountp sign <|> rightornosymbolamountp sign
|
||||
|
||||
@ -871,7 +880,9 @@ simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar)
|
||||
-- | Ledger-style cost notation:
|
||||
-- @ UNITAMT, @@ TOTALAMT, (@) UNITAMT, or (@@) TOTALAMT. The () are ignored.
|
||||
costp :: Amount -> JournalParser m AmountPrice
|
||||
costp baseAmt = label "transaction price" $ do
|
||||
costp baseAmt =
|
||||
-- dbg "costp" $
|
||||
label "transaction price" $ do
|
||||
-- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs
|
||||
parenthesised <- option False $ char '(' >> pure True
|
||||
char '@'
|
||||
@ -906,12 +917,13 @@ balanceassertionp = do
|
||||
, baposition = sourcepos
|
||||
}
|
||||
|
||||
-- Parse a Ledger-style fixed {=UNITPRICE} or non-fixed {UNITPRICE}
|
||||
-- or fixed {{=TOTALPRICE}} or non-fixed {{TOTALPRICE}} lot price,
|
||||
-- and ignore it.
|
||||
-- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices .
|
||||
lotpricep :: JournalParser m ()
|
||||
lotpricep = label "ledger-style lot price" $ do
|
||||
-- Parse a Ledger-style lot cost,
|
||||
-- {UNITCOST} or {{TOTALCOST}} or {=FIXEDUNITCOST} or {{=FIXEDTOTALCOST}},
|
||||
-- and discard it.
|
||||
lotcostp :: JournalParser m ()
|
||||
lotcostp =
|
||||
-- dbg "lotcostp" $
|
||||
label "ledger-style lot cost" $ do
|
||||
char '{'
|
||||
doublebrace <- option False $ char '{' >> pure True
|
||||
_fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '='
|
||||
@ -921,17 +933,28 @@ lotpricep = label "ledger-style lot price" $ do
|
||||
char '}'
|
||||
when (doublebrace) $ void $ char '}'
|
||||
|
||||
-- Parse a Ledger-style lot date [DATE], and ignore it.
|
||||
-- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices .
|
||||
-- Parse a Ledger-style [LOTDATE], and discard it.
|
||||
lotdatep :: JournalParser m ()
|
||||
lotdatep = (do
|
||||
lotdatep =
|
||||
-- dbg "lotdatep" $
|
||||
label "ledger-style lot date" $ do
|
||||
char '['
|
||||
lift skipNonNewlineSpaces
|
||||
_d <- datep
|
||||
lift skipNonNewlineSpaces
|
||||
char ']'
|
||||
return ()
|
||||
) <?> "ledger-style lot date"
|
||||
|
||||
-- Parse a Ledger-style (LOT NOTE), and discard it.
|
||||
lotnotep :: JournalParser m ()
|
||||
lotnotep =
|
||||
-- dbg "lotnotep" $
|
||||
label "ledger-style lot note" $ do
|
||||
char '('
|
||||
lift skipNonNewlineSpaces
|
||||
_note <- stripEnd . T.pack <$> (many $ noneOf [')','\n']) -- XXX other line endings ?
|
||||
char ')'
|
||||
return ()
|
||||
|
||||
-- | Parse a string representation of a number for its value and display
|
||||
-- attributes.
|
||||
|
@ -1385,14 +1385,12 @@ Currently, hledger treats the above like `@` and `@@`; the parentheses are ignor
|
||||
- when buying, attaches this acquisition date to the lot
|
||||
- when selling, selects a lot by its acquisition date
|
||||
|
||||
Currently, hledger accepts any or all of the above in any order after the posting amount, but ignores them.
|
||||
(To select lots, we use subaccounts instead.)
|
||||
|
||||
- also: `(SOME TEXT)` ([lot note][ledger: lot notes])
|
||||
- `(SOME TEXT)` ([lot note][ledger: lot notes])
|
||||
- when buying, attaches this note to the lot
|
||||
- when selling, selects a lot by its note
|
||||
|
||||
Currently, hledger rejects lot notes.
|
||||
Currently, hledger accepts any or all of the above in any order after the posting amount, but ignores them.
|
||||
(This can break transaction balancing.)
|
||||
|
||||
[ledger: virtual posting costs]: https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs
|
||||
[ledger: buying and selling stock]: https://www.ledger-cli.org/3.0/doc/ledger3.html#Buying-and-Selling-Stock
|
||||
|
@ -220,7 +220,7 @@ $ hledger -f - print
|
||||
(a) A1B 2
|
||||
|
||||
$ hledger -f- print cur:A1B amt:2
|
||||
>2 /expecting ';', '=', digit, end of input, exponent, ledger-style lot date, ledger-style lot price, newline, space, or transaction price/
|
||||
>2 /unexpected 'B'/
|
||||
>=1
|
||||
|
||||
# 16. Unquoted commodity symbol on the right, gives this long error message.
|
||||
@ -229,7 +229,7 @@ $ hledger -f- print cur:A1B amt:2
|
||||
(a) 1 A2
|
||||
|
||||
$ hledger -f- print cur:A1 amt:2
|
||||
>2 /expecting ';', '=', end of input, ledger-style lot date, ledger-style lot price, newline, or transaction price/
|
||||
>2 /unexpected '2'/
|
||||
>=1
|
||||
|
||||
# 17. Unquoted commodity symbol on the left ending with numbers, could parse successfully.
|
||||
|
@ -41,13 +41,3 @@ $ hledger -f- check
|
||||
$ hledger -f- check
|
||||
>2//
|
||||
>=1
|
||||
|
||||
# lot notation
|
||||
<
|
||||
2012-04-10
|
||||
Assets:Brokerage:Cash $375.00
|
||||
Assets:Brokerage -5 AAPL {$50.00} [2012-04-10] (Oh my!) @@ $375.00
|
||||
Income:Capital Gains $-125.00
|
||||
$ hledger -f- check
|
||||
>2//
|
||||
>=1
|
||||
|
@ -78,3 +78,15 @@ eval foo
|
||||
--command-line-flag
|
||||
|
||||
$ hledger -f- check
|
||||
|
||||
|
||||
# lot notation
|
||||
<
|
||||
2022-01-01 sell 5 AAPL acquired at $50 for $375, for a $125 gain
|
||||
Assets:Brokerage:Cash $375.00
|
||||
Assets:Brokerage -5 AAPL {$50.00} [2012-04-10] (a lot note) (@@) $375.00 ; using (@@) to make parsing harder
|
||||
Income:Capital Gains $-125.00
|
||||
|
||||
$ hledger -f- check
|
||||
>2 /transaction is unbalanced/
|
||||
>=1
|
||||
|
Loading…
Reference in New Issue
Block a user