ref: Simplify parsing of commodity-style option.
This commit is contained in:
		
							parent
							
								
									6b400194e3
								
							
						
					
					
						commit
						020dd15be4
					
				| @ -33,7 +33,6 @@ module Hledger.Read.Common ( | |||||||
|   HasInputOpts(..), |   HasInputOpts(..), | ||||||
|   definputopts, |   definputopts, | ||||||
|   rawOptsToInputOpts, |   rawOptsToInputOpts, | ||||||
|   rawOptsToCommodityStylesOpts, |  | ||||||
| 
 | 
 | ||||||
|   -- * parsing utilities |   -- * parsing utilities | ||||||
|   runTextParser, |   runTextParser, | ||||||
| @ -198,36 +197,6 @@ data Reader m = Reader { | |||||||
| 
 | 
 | ||||||
| instance Show (Reader m) where show r = rFormat r ++ " 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. | -- | 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. | -- This will fail with a usage error if the forecast period expression cannot be parsed. | ||||||
| rawOptsToInputOpts :: Day -> RawOpts -> InputOpts | rawOptsToInputOpts :: Day -> RawOpts -> InputOpts | ||||||
| @ -241,6 +210,9 @@ rawOptsToInputOpts day rawopts = | |||||||
|         argsquery = lefts . rights . map (parseQueryTerm day) $ querystring_ ropts |         argsquery = lefts . rights . map (parseQueryTerm day) $ querystring_ ropts | ||||||
|         datequery = simplifyQuery . filterQuery queryIsDate . And $ queryFromFlags ropts : argsquery |         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{ |     in InputOpts{ | ||||||
|        -- files_             = listofstringopt "file" rawopts |        -- files_             = listofstringopt "file" rawopts | ||||||
|        mformat_           = Nothing |        mformat_           = Nothing | ||||||
| @ -256,7 +228,7 @@ rawOptsToInputOpts day rawopts = | |||||||
|       ,balancingopts_     = defbalancingopts{ |       ,balancingopts_     = defbalancingopts{ | ||||||
|                                  ignore_assertions_ = boolopt "ignore-assertions" rawopts |                                  ignore_assertions_ = boolopt "ignore-assertions" rawopts | ||||||
|                                , infer_prices_      = not noinferprice |                                , infer_prices_      = not noinferprice | ||||||
|                                , commodity_styles_  = rawOptsToCommodityStylesOpts rawopts |                                , commodity_styles_  = Just commodity_styles | ||||||
|                                } |                                } | ||||||
|       ,strict_            = boolopt "strict" rawopts |       ,strict_            = boolopt "strict" rawopts | ||||||
|       ,_ioDay             = day |       ,_ioDay             = day | ||||||
| @ -277,6 +249,18 @@ forecastPeriodFromRawOpts d rawopts = do | |||||||
|         _          -> usageError $ "--forecast's argument should not contain a report interval (" |         _          -> usageError $ "--forecast's argument should not contain a report interval (" | ||||||
|                                  ++ show interval ++ " in \"" ++ arg ++ "\")" |                                  ++ 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 | --- ** parsing utilities | ||||||
| 
 | 
 | ||||||
| -- | Run a text parser in the identity monad. See also: parseWithState. | -- | Run a text parser in the identity monad. See also: parseWithState. | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user