slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ref: Simplify parsing of commodity-style option.

Browse Source
This commit is contained in:
Stephen Morgan 2021-09-01 17:15:31 +10:00 committed by Simon Michael
parent 6b400194e3
commit 020dd15be4
1 changed files with 16 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,7 +33,6 @@ module Hledger.Read.Common (
HasInputOpts(..),
definputopts,
rawOptsToInputOpts,
rawOptsToCommodityStylesOpts,
-- * parsing utilities
runTextParser,
@ -198,36 +197,6 @@ data Reader m = Reader {
instance Show (Reader m) where show r = rFormat r ++ " reader"
-- $setup
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:
-- | 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
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 a provided date.
-- This will fail with a usage error if the forecast period expression cannot be parsed.
rawOptsToInputOpts :: Day -> RawOpts -> InputOpts
@ -241,6 +210,9 @@ rawOptsToInputOpts day rawopts =
argsquery = lefts . rights . map (parseQueryTerm day) $ querystring_ ropts
datequery = simplifyQuery . filterQuery queryIsDate . And $ queryFromFlags ropts : argsquery
commodity_styles = either err id $ commodityStyleFromRawOpts rawopts
where err e = error' $ "could not parse commodity-style: '" ++ e ++ "'" -- PARTIAL:
in InputOpts{
-- files_ = listofstringopt "file" rawopts
mformat_ = Nothing
@ -256,7 +228,7 @@ rawOptsToInputOpts day rawopts =
,balancingopts_ = defbalancingopts{
ignore_assertions_ = boolopt "ignore-assertions" rawopts
, infer_prices_ = not noinferprice
, commodity_styles_ = rawOptsToCommodityStylesOpts rawopts
, commodity_styles_ = Just commodity_styles
}
,strict_ = boolopt "strict" rawopts
,_ioDay = day
@ -277,6 +249,18 @@ forecastPeriodFromRawOpts d rawopts = do
_ -> usageError $ "--forecast's argument should not contain a report interval ("
++ show interval ++ " in \"" ++ arg ++ "\")"
-- | Given the name of the option and the raw options, returns either
-- | * a map of successfully parsed commodity styles, if all options where successfully parsed
-- | * the first option which failed to parse, if one or more options failed to parse
commodityStyleFromRawOpts :: RawOpts -> Either String (M.Map CommoditySymbol AmountStyle)
commodityStyleFromRawOpts rawOpts =
foldM (\r -> fmap (\(c,a) -> M.insert c a r) . parseCommodity) mempty optList
where
optList = listofstringopt "commodity-style" rawOpts
parseCommodity optStr = case amountp'' optStr of
Left _ -> Left optStr
Right (Amount acommodity _ astyle _) -> Right (acommodity, astyle)
--- ** parsing utilities
-- | Run a text parser in the identity monad. See also: parseWithState.