feat: added commodity style commandline option

This commit is contained in:
Arjen Langebaerd 2021-07-04 11:44:35 +02:00 committed by Simon Michael
parent b4c516c074
commit 3426030a91
19 changed files with 204 additions and 70 deletions

View File

@ -730,7 +730,7 @@ journalModifyTransactions d j =
-- | Check any balance assertions in the journal and return an error message
-- if any of them fail (or if the transaction balancing they require fails).
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions def
journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions balancingOpts
-- "Transaction balancing", including: inferring missing amounts,
-- applying balance assignments, checking transaction balancedness,
@ -1415,7 +1415,7 @@ journalApplyAliases aliases j =
-- liabilities:debts $1
-- assets:bank:checking
--
Right samplejournal = journalBalanceTransactions def $
Right samplejournal = journalBalanceTransactions balancingOpts $
nulljournal
{jtxns = [
txnTieKnot $ Transaction {
@ -1558,7 +1558,7 @@ tests_Journal = tests "Journal" [
,tests "journalBalanceTransactions" [
test "balance-assignment" $ do
let ej = journalBalanceTransactions def $
let ej = journalBalanceTransactions balancingOpts $
--2019/01/01
-- (a) = 1
nulljournal{ jtxns = [
@ -1569,7 +1569,7 @@ tests_Journal = tests "Journal" [
(jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1]
,test "same-day-1" $ do
assertRight $ journalBalanceTransactions def $
assertRight $ journalBalanceTransactions balancingOpts $
--2019/01/01
-- (a) = 1
--2019/01/01
@ -1580,7 +1580,7 @@ tests_Journal = tests "Journal" [
]}
,test "same-day-2" $ do
assertRight $ journalBalanceTransactions def $
assertRight $ journalBalanceTransactions balancingOpts $
--2019/01/01
-- (a) 2 = 2
--2019/01/01
@ -1598,7 +1598,7 @@ tests_Journal = tests "Journal" [
]}
,test "out-of-order" $ do
assertRight $ journalBalanceTransactions def $
assertRight $ journalBalanceTransactions balancingOpts $
--2019/1/2
-- (a) 1 = 2
--2019/1/1

View File

@ -360,8 +360,6 @@ data BalancingOpts = BalancingOpts
, commodity_styles_ :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles
} deriving (Show)
instance Default BalancingOpts where def = balancingOpts
balancingOpts :: BalancingOpts
balancingOpts = BalancingOpts
{ ignore_assertions_ = False
@ -856,7 +854,7 @@ tests_Transaction =
, tests "balanceTransaction" [
test "detect unbalanced entry, sign error" $
assertLeft
(balanceTransaction def
(balanceTransaction balancingOpts
(Transaction
0
""
@ -871,7 +869,7 @@ tests_Transaction =
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}]))
,test "detect unbalanced entry, multiple missing amounts" $
assertLeft $
balanceTransaction def
balanceTransaction balancingOpts
(Transaction
0
""
@ -888,7 +886,7 @@ tests_Transaction =
])
,test "one missing amount is inferred" $
(pamount . last . tpostings <$>
balanceTransaction def
balanceTransaction balancingOpts
(Transaction
0
""
@ -904,7 +902,7 @@ tests_Transaction =
Right (mixedAmount $ usd (-1))
,test "conversion price is inferred" $
(pamount . head . tpostings <$>
balanceTransaction def
balanceTransaction balancingOpts
(Transaction
0
""
@ -922,7 +920,7 @@ tests_Transaction =
Right (mixedAmount $ usd 1.35 @@ eur 1)
,test "balanceTransaction balances based on cost if there are unit prices" $
assertRight $
balanceTransaction def
balanceTransaction balancingOpts
(Transaction
0
""
@ -939,7 +937,7 @@ tests_Transaction =
])
,test "balanceTransaction balances based on cost if there are total prices" $
assertRight $
balanceTransaction def
balanceTransaction balancingOpts
(Transaction
0
""
@ -958,7 +956,7 @@ tests_Transaction =
, tests "isTransactionBalanced" [
test "detect balanced" $
assertBool "" $
isTransactionBalanced def $
isTransactionBalanced balancingOpts $
Transaction
0
""
@ -976,7 +974,7 @@ tests_Transaction =
,test "detect unbalanced" $
assertBool "" $
not $
isTransactionBalanced def $
isTransactionBalanced balancingOpts $
Transaction
0
""
@ -994,7 +992,7 @@ tests_Transaction =
,test "detect unbalanced, one posting" $
assertBool "" $
not $
isTransactionBalanced def $
isTransactionBalanced balancingOpts $
Transaction
0
""
@ -1009,7 +1007,7 @@ tests_Transaction =
[posting {paccount = "b", pamount = mixedAmount (usd 1.00)}]
,test "one zero posting is considered balanced for now" $
assertBool "" $
isTransactionBalanced def $
isTransactionBalanced balancingOpts $
Transaction
0
""
@ -1024,7 +1022,7 @@ tests_Transaction =
[posting {paccount = "b", pamount = mixedAmount (usd 0)}]
,test "virtual postings don't need to balance" $
assertBool "" $
isTransactionBalanced def $
isTransactionBalanced balancingOpts $
Transaction
0
""
@ -1043,7 +1041,7 @@ tests_Transaction =
,test "balanced virtual postings need to balance among themselves" $
assertBool "" $
not $
isTransactionBalanced def $
isTransactionBalanced balancingOpts $
Transaction
0
""
@ -1061,7 +1059,7 @@ tests_Transaction =
]
,test "balanced virtual postings need to balance among themselves (2)" $
assertBool "" $
isTransactionBalanced def $
isTransactionBalanced balancingOpts $
Transaction
0
""

View File

@ -89,7 +89,7 @@ journalDefaultFilename = ".hledger.journal"
-- | Read a Journal from the given text, assuming journal format; or
-- throw an error.
readJournal' :: Text -> IO Journal
readJournal' t = readJournal def Nothing t >>= either error' return -- PARTIAL:
readJournal' t = readJournal definputopts Nothing t >>= either error' return -- PARTIAL:
-- | @readJournal iopts mfile txt@
--
@ -115,7 +115,7 @@ readJournal iopts mpath txt = do
-- | Read the default journal file specified by the environment, or raise an error.
defaultJournal :: IO Journal
defaultJournal = defaultJournalPath >>= readJournalFile def >>= either error' return -- PARTIAL:
defaultJournal = defaultJournalPath >>= readJournalFile definputopts >>= either error' return -- PARTIAL:
-- | Get the default journal file path specified by the environment.
-- Like ledger, we look first for the LEDGER_FILE environment

View File

@ -29,10 +29,11 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.
--- ** exports
module Hledger.Read.Common (
Reader (..),
InputOpts (..),
InputOpts(..),
definputopts,
rawOptsToInputOpts,
forecastPeriodFromRawOpts,
rawOptsToCommodityStylesOpts,
-- * parsing utilities
runTextParser,
@ -136,7 +137,6 @@ import Control.Monad.State.Strict hiding (fail)
import Data.Bifunctor (bimap, second)
import Data.Char (digitToInt, isDigit, isSpace)
import Data.Decimal (DecimalRaw (Decimal), Decimal)
import Data.Default (Default(..))
import Data.Either (lefts, rights)
import Data.Function ((&))
import Data.Functor ((<&>))
@ -164,6 +164,7 @@ import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, quer
import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts)
import Hledger.Utils
import Text.Printf (printf)
import Hledger.Read.InputOptions
--- ** doctest setup
-- $setup
@ -199,40 +200,33 @@ instance Show (Reader m) where show r = rFormat r ++ " reader"
-- $setup
-- | Various options to use when reading journal files.
-- Similar to CliOptions.inputflags, simplifies the journal-reading functions.
data InputOpts = InputOpts {
-- files_ :: [FilePath]
mformat_ :: Maybe StorageFormat -- ^ a file/storage format to try, unless overridden
-- by a filename prefix. Nothing means try all.
,mrules_file_ :: Maybe FilePath -- ^ a conversion rules file to use (when reading CSV)
,aliases_ :: [String] -- ^ account name aliases to apply
,anon_ :: Bool -- ^ do light anonymisation/obfuscation of the data
,new_ :: Bool -- ^ read only new transactions since this file was last read
,new_save_ :: Bool -- ^ save latest new transactions state for next time
,pivot_ :: String -- ^ use the given field's value as the account name
,forecast_ :: Maybe DateSpan -- ^ span in which to generate forecast transactions
,auto_ :: Bool -- ^ generate automatic postings when journal is parsed
,balancingopts_ :: BalancingOpts -- ^ options for balancing transactions
,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred)
} deriving (Show)
rawOptsToCommodityStylesOpts :: RawOpts -> Maybe (M.Map CommoditySymbol AmountStyle)
rawOptsToCommodityStylesOpts rawOpts =
let
optionStr = "commodity-style"
optResult = mapofcommodityStyleopt optionStr rawOpts
in case optResult of
Right cmap -> Just cmap
Left failedOpt -> error' ("could not parse " ++
optionStr ++ ": '" ++ failedOpt ++ "'.") -- PARTIAL:
instance Default InputOpts where def = definputopts
-- | Given the name of the option and the raw options, returns either
-- | * a map of succesfully parsed commodity styles, if all options where succesfully parsed
-- | * the list of options which failed to parse, if one or more options failed to parse
mapofcommodityStyleopt :: String -> RawOpts -> Either String (M.Map CommoditySymbol AmountStyle)
mapofcommodityStyleopt name rawOpts =
let optList = listofstringopt name rawOpts
addStyle (Right cmap) (Right (c,a)) = Right (M.insert c a cmap)
addStyle err@(Left _) _ = err
addStyle _ (Left v) = Left v
in
foldl' (\r e -> addStyle r $ parseCommodity e) (Right M.empty) optList
definputopts :: InputOpts
definputopts = InputOpts
{ mformat_ = Nothing
, mrules_file_ = Nothing
, aliases_ = []
, anon_ = False
, new_ = False
, new_save_ = True
, pivot_ = ""
, forecast_ = Nothing
, auto_ = False
, balancingopts_ = def
, strict_ = False
}
parseCommodity :: String -> Either String (CommoditySymbol, AmountStyle)
parseCommodity optStr =
case amountp'' optStr of
Left _ -> Left optStr
Right (Amount acommodity _ astyle _) -> Right (acommodity, astyle)
-- | Parse an InputOpts from a RawOpts and the current date.
-- This will fail with a usage error if the forecast period expression cannot be parsed.
@ -251,8 +245,10 @@ rawOptsToInputOpts rawopts = do
,pivot_ = stringopt "pivot" rawopts
,forecast_ = forecastPeriodFromRawOpts d rawopts
,auto_ = boolopt "auto" rawopts
,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts
,balancingopts_ = balancingOpts{
ignore_assertions_ = boolopt "ignore-assertions" rawopts
, infer_prices_ = not noinferprice
, commodity_styles_ = rawOptsToCommodityStylesOpts rawopts
}
,strict_ = boolopt "strict" rawopts
}
@ -914,10 +910,14 @@ amountwithoutpricep mult = do
uncurry parseErrorAtRegion posRegion errMsg
Right (q,p,d,g) -> pure (q, Precision p, d, g)
-- | Try to parse an amount from a string
amountp'' :: String -> Either (ParseErrorBundle Text CustomErr) Amount
amountp'' s = runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s)
-- | Parse an amount from a string, or get an error.
amountp' :: String -> Amount
amountp' s =
case runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s) of
case amountp'' s of
Right amt -> amt
Left err -> error' $ show err -- PARTIAL: XXX should throwError

View File

@ -77,7 +77,7 @@ import Text.Printf (printf)
import Hledger.Data
import Hledger.Utils
import Hledger.Read.Common (aliasesFromOpts, Reader(..),InputOpts(..), amountp, statusp, genericSourcePos, journalFinalise )
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, genericSourcePos, journalFinalise )
--- ** doctest setup
-- $setup

View File

@ -0,0 +1,48 @@
{-|
Various options to use when reading journal files.
Similar to CliOptions.inputflags, simplifies the journal-reading functions.
-}
module Hledger.Read.InputOptions (
-- * Types and helpers for input options
InputOpts(..)
, definputopts
)
where
import Hledger.Data.Types
import Hledger.Data.Transaction
import Hledger.Data.Dates()
data InputOpts = InputOpts {
-- files_ :: [FilePath]
mformat_ :: Maybe StorageFormat -- ^ a file/storage format to try, unless overridden
-- by a filename prefix. Nothing means try all.
,mrules_file_ :: Maybe FilePath -- ^ a conversion rules file to use (when reading CSV)
,aliases_ :: [String] -- ^ account name aliases to apply
,anon_ :: Bool -- ^ do light anonymisation/obfuscation of the data
,new_ :: Bool -- ^ read only new transactions since this file was last read
,new_save_ :: Bool -- ^ save latest new transactions state for next time
,pivot_ :: String -- ^ use the given field's value as the account name
,forecast_ :: Maybe DateSpan -- ^ span in which to generate forecast transactions
,auto_ :: Bool -- ^ generate automatic postings when journal is parsed
,balancingopts_ :: BalancingOpts -- ^ options for balancing transactions
,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred)
} deriving (Show)
definputopts :: InputOpts
definputopts = InputOpts
{ mformat_ = Nothing
, mrules_file_ = Nothing
, aliases_ = []
, anon_ = False
, new_ = False
, new_save_ = True
, pivot_ = ""
, forecast_ = Nothing
, auto_ = False
, balancingopts_ = balancingOpts
, strict_ = False
}

View File

@ -47,6 +47,7 @@ library
Hledger.Data.Amount
Hledger.Data.Commodity
Hledger.Data.Dates
Hledger.Read.InputOptions
Hledger.Data.Journal
Hledger.Data.Json
Hledger.Data.Ledger

View File

@ -98,6 +98,7 @@ library:
- Hledger.Data.Amount
- Hledger.Data.Commodity
- Hledger.Data.Dates
- Hledger.Read.InputOptions
- Hledger.Data.Journal
- Hledger.Data.Json
- Hledger.Data.Ledger

View File

@ -19,7 +19,6 @@ module Hledger.Web.Widget.Common
, replaceInacct
) where
import Data.Default (def)
import Data.Foldable (find, for_)
import Data.List (elemIndex)
import Data.Text (Text)
@ -66,7 +65,7 @@ writeJournalTextIfValidAndChanged f t = do
-- formatdirectivep, #1194) writeFileWithBackupIfChanged require them.
-- XXX klunky. Any equivalent of "hSetNewlineMode h universalNewlineMode" for form posts ?
let t' = T.replace "\r" "" t
liftIO (readJournal def (Just f) t') >>= \case
liftIO (readJournal definputopts (Just f) t') >>= \case
Left e -> return (Left e)
Right _ -> do
_ <- liftIO (writeFileWithBackupIfChanged f t')

View File

@ -18,6 +18,7 @@ module Hledger.Cli.CliOptions (
reportflags,
-- outputflags,
outputFormatFlag,
commodityStyleFlag,
outputFileFlag,
generalflagsgroup1,
generalflagsgroup2,
@ -235,6 +236,11 @@ outputFileFlag = flagReq
["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE"
"write output to FILE. A file extension matching one of the above formats selects that format."
commodityStyleFlag :: Flag RawOpts
commodityStyleFlag = flagReq
["commodity-style", "c"] (\s opts -> Right $ setopt "commodity-style" s opts) "COMM"
("Override the commodity style in the output for the specified commodity. For example 'EUR1.000,00'.")
argsFlag :: FlagHelp -> Arg RawOpts
argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc
@ -426,7 +432,7 @@ defcliopts = CliOpts
{ rawopts_ = def
, command_ = ""
, file_ = []
, inputopts_ = def
, inputopts_ = definputopts
, reportspec_ = def
, output_file_ = Nothing
, output_format_ = Nothing

View File

@ -46,7 +46,6 @@ module Hledger.Cli.Commands (
where
import Data.Char (isSpace)
import Data.Default
import Data.List
import Data.Text (Text)
import qualified Data.Text as T
@ -293,8 +292,8 @@ tests_Commands = tests "Commands" [
let
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
sameParse str1 str2 = do
j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) -- PARTIAL:
j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos)
j1 <- readJournal definputopts Nothing str1 >>= either error' (return . ignoresourcepos) -- PARTIAL:
j2 <- readJournal definputopts Nothing str2 >>= either error' (return . ignoresourcepos)
j1 @?= j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
@ -311,19 +310,19 @@ tests_Commands = tests "Commands" [
)
,test "preserves \"virtual\" posting type" $ do
j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return -- PARTIAL:
j <- readJournal definputopts Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return -- PARTIAL:
let p = head $ tpostings $ head $ jtxns j
paccount p @?= "test:from"
ptype p @?= VirtualPosting
]
,test "alias directive" $ do
j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return -- PARTIAL:
j <- readJournal definputopts Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return -- PARTIAL:
let p = head $ tpostings $ head $ jtxns j
paccount p @?= "equity:draw:personal:food"
,test "Y default year directive" $ do
j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return -- PARTIAL:
j <- readJournal definputopts Nothing defaultyear_journal_txt >>= either error' return -- PARTIAL:
tdate (head $ jtxns j) @?= fromGregorian 2009 1 1
,test "ledgerAccountNames" $

View File

@ -56,6 +56,7 @@ aregistermode = hledgerCommandMode
)
,outputFormatFlag ["txt","csv","json"]
,outputFileFlag
,commodityStyleFlag
])
[generalflagsgroup1]
hiddenflags

View File

@ -314,6 +314,7 @@ balancemode = hledgerCommandMode
"show commodity symbols in a separate column, amounts as bare numbers, one row per commodity"
,outputFormatFlag ["txt","html","csv","json"]
,outputFileFlag
,commodityStyleFlag
]
)
[generalflagsgroup1]

View File

@ -33,7 +33,16 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do
inputstr = intercalate ", " $ map quoteIfNeeded inputfiles
catchup = boolopt "catchup" rawopts
dryrun = boolopt "dry-run" rawopts
iopts' = iopts{new_=True, new_save_=not dryrun, balancingopts_=balancingOpts{commodity_styles_=Just $ journalCommodityStyles j}}
combinedStyles =
let
maybeInputStyles = commodity_styles_ . balancingopts_ $ iopts
inferredStyles = journalCommodityStyles j
in
case maybeInputStyles of
Nothing -> Just inferredStyles
Just inputStyles -> Just $ inputStyles <> inferredStyles
iopts' = iopts{new_=True, new_save_=not dryrun, balancingopts_=balancingOpts{commodity_styles_= combinedStyles}}
case inputfiles of
[] -> error' "please provide one or more input files as arguments" -- PARTIAL:
fs -> do

View File

@ -41,6 +41,7 @@ printmode = hledgerCommandMode
"show only newer-dated transactions added in each file since last run"
,outputFormatFlag ["txt","csv","json","sql"]
,outputFileFlag
,commodityStyleFlag
])
[generalflagsgroup1]
hiddenflags

View File

@ -53,6 +53,7 @@ registermode = hledgerCommandMode
)
,outputFormatFlag ["txt","csv","json"]
,outputFileFlag
,commodityStyleFlag
])
[generalflagsgroup1]
hiddenflags

View File

@ -86,6 +86,7 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total"
,outputFormatFlag ["txt","html","csv","json"]
,outputFileFlag
,commodityStyleFlag
])
[generalflagsgroup1]
hiddenflags

View File

@ -1408,6 +1408,20 @@ real-world feedback.
of existing data (via `delete` or `truncate` SQL statements) or drop
tables completely as otherwise your postings will be duped.
## Commodity styles
The display style of a commodity/currence is inferred according to the rules
described in [Commodity display style](#commodity-display-style). The
inferred display style can be overriden by an optional `-c/--commodity-style`
option. For example, the following will override the display style for dollars.
```shell
$ hledger print -c '$1.000,0'
```
The format specification of the style is identical to the commodity display
style specification for the [commodity directive](#declaring-commodities).
The command line option can be supplied repeatedly to override the display
style for multiple commodity/currency symbols.
# COMMANDS
hledger provides a number of commands for producing reports and managing your data.
@ -2084,6 +2098,8 @@ commodity 1000.00000000 BTC
commodity 1 000.
```
The inferred commodity style can be [overridden](#commodity-styles) by supplying a command line option.
### Rounding
Amounts are stored internally as decimal numbers with up to 255 decimal places,
@ -2591,6 +2607,9 @@ Note hledger normally uses
so 0.5 displayed with zero decimal digits is "0".
(More at [Commodity display style](#commodity-display-style).)
Even in the presence of commodity directives, the commodity display style
can still be [overridden](#commodity-styles) by supplying a command line option.
### Commodity error checking
In [strict mode], enabled with the `-s`/`--strict` flag, hledger will report an error if a

View File

@ -0,0 +1,49 @@
# Test whether only the style without a symbol is changed
<
2021-07-09 no symbol
(a) 1234
2021-07-09 Euro
(a) EUR 1.234,56
2021-07-09 Dollar
(a) $ 1,234.56
$ hledger -f- print -c '10 00'
>
2021-07-09 no symbol
(a) 12 34
2021-07-09 Euro
(a) EUR 1.234,56
2021-07-09 Dollar
(a) $ 1,234.56
>= 0
# Test whether setting the style of multiple symbols work
<
2021-07-09 Euro
(a) EUR 1,234.56
2021-07-09 Dollar
(a) $ 1.234,56
$ hledger -f- print -c 'EUR 1.000,00' -c '$ 1,000.00'
>
2021-07-09 Euro
(a) EUR 1.234,56
2021-07-09 Dollar
(a) $ 1,234.56
>= 0
# When setting the same symbol multiple times, the last one is in effect
<
2021-07-09 Euro
(a) EUR 1234
$ hledger -f- print -c 'EUR 1.000,00' -c 'EUR 1,000.00'
>
2021-07-09 Euro
(a) EUR 1,234.00
>= 0