;all: hide RawOpts internals
This way we can ensure we always use only functions from RawOptions.
This commit is contained in:
		
							parent
							
								
									8991419c68
								
							
						
					
					
						commit
						5287fe671b
					
				| @ -1,3 +1,5 @@ | ||||
| {-# LANGUAGE DeriveDataTypeable #-} | ||||
| 
 | ||||
| {-| | ||||
| 
 | ||||
| hledger's cmdargs modes parse command-line arguments to an | ||||
| @ -13,6 +15,8 @@ module Hledger.Data.RawOptions ( | ||||
|   setboolopt, | ||||
|   inRawOpts, | ||||
|   boolopt, | ||||
|   choiceopt, | ||||
|   collectopts, | ||||
|   stringopt, | ||||
|   maybestringopt, | ||||
|   listofstringopt, | ||||
| @ -23,38 +27,65 @@ module Hledger.Data.RawOptions ( | ||||
| where | ||||
| 
 | ||||
| import Data.Maybe | ||||
| import Data.Data | ||||
| import Data.Default | ||||
| import Safe | ||||
| 
 | ||||
| import Hledger.Utils | ||||
| 
 | ||||
| 
 | ||||
| -- | The result of running cmdargs: an association list of option names to string values. | ||||
| type RawOpts = [(String,String)] | ||||
| newtype RawOpts = RawOpts { unRawOpts :: [(String,String)] } | ||||
|     deriving (Show, Data, Typeable) | ||||
| 
 | ||||
| instance Default RawOpts where def = RawOpts [] | ||||
| 
 | ||||
| overRawOpts f = RawOpts . f . unRawOpts | ||||
| 
 | ||||
| setopt :: String -> String -> RawOpts -> RawOpts | ||||
| setopt name val = (++ [(name, val)]) | ||||
| setopt name val = overRawOpts (++ [(name, val)]) | ||||
| 
 | ||||
| setboolopt :: String -> RawOpts -> RawOpts | ||||
| setboolopt name = (++ [(name,"")]) | ||||
| setboolopt name = overRawOpts (++ [(name,"")]) | ||||
| 
 | ||||
| -- | Is the named option present ? | ||||
| inRawOpts :: String -> RawOpts -> Bool | ||||
| inRawOpts name = isJust . lookup name | ||||
| inRawOpts name = isJust . lookup name . unRawOpts | ||||
| 
 | ||||
| boolopt :: String -> RawOpts -> Bool | ||||
| boolopt = inRawOpts | ||||
| 
 | ||||
| -- | Get latests successfully parsed flag | ||||
| -- | ||||
| -- >>> choiceopt Just (RawOpts [("a",""), ("b",""), ("c","")]) | ||||
| -- Just "c" | ||||
| -- >>> choiceopt (const Nothing) (RawOpts [("a","")]) | ||||
| -- Nothing | ||||
| -- >>> choiceopt (listToMaybe . filter (`elem` ["a","b"])) (RawOpts [("a",""), ("b",""), ("c","")]) | ||||
| -- Just "b" | ||||
| choiceopt :: (String -> Maybe a) -> RawOpts -> Maybe a | ||||
| choiceopt f = lastMay . collectopts (f . fst) | ||||
| 
 | ||||
| -- | Collects processed and filtered list of options preserving their order | ||||
| -- | ||||
| -- >>> collectopts (const Nothing) (RawOpts [("x","")]) | ||||
| -- [] | ||||
| -- >>> collectopts Just (RawOpts [("a",""),("b","")]) | ||||
| -- [("a",""),("b","")] | ||||
| collectopts :: ((String, String) -> Maybe a) -> RawOpts -> [a] | ||||
| collectopts f = mapMaybe f . unRawOpts | ||||
| 
 | ||||
| maybestringopt :: String -> RawOpts -> Maybe String | ||||
| maybestringopt name = lookup name . reverse | ||||
| maybestringopt name = lookup name . reverse . unRawOpts | ||||
| 
 | ||||
| stringopt :: String -> RawOpts -> String | ||||
| stringopt name = fromMaybe "" . maybestringopt name | ||||
| 
 | ||||
| maybecharopt :: String -> RawOpts -> Maybe Char | ||||
| maybecharopt name rawopts = lookup name rawopts >>= headMay | ||||
| maybecharopt name (RawOpts rawopts) = lookup name rawopts >>= headMay | ||||
| 
 | ||||
| listofstringopt :: String -> RawOpts -> [String] | ||||
| listofstringopt name rawopts = [v | (k,v) <- rawopts, k==name] | ||||
| listofstringopt name (RawOpts rawopts) = [v | (k,v) <- rawopts, k==name] | ||||
| 
 | ||||
| maybeintopt :: String -> RawOpts -> Maybe Int | ||||
| maybeintopt name rawopts = | ||||
|  | ||||
| @ -4,7 +4,7 @@ Options common to most hledger reports. | ||||
| 
 | ||||
| -} | ||||
| 
 | ||||
| {-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable #-} | ||||
| {-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase, DeriveDataTypeable #-} | ||||
| 
 | ||||
| module Hledger.Reports.ReportOptions ( | ||||
|   ReportOpts(..), | ||||
| @ -220,18 +220,20 @@ checkReportOpts ropts@ReportOpts{..} = | ||||
|       _              -> Right () | ||||
| 
 | ||||
| accountlistmodeopt :: RawOpts -> AccountListMode | ||||
| accountlistmodeopt rawopts = | ||||
|   case reverse $ filter (`elem` ["tree","flat"]) $ map fst rawopts of | ||||
|     ("tree":_) -> ALTree | ||||
|     ("flat":_) -> ALFlat | ||||
|     _          -> ALDefault | ||||
| accountlistmodeopt = | ||||
|   fromMaybe ALDefault . choiceopt parse where | ||||
|     parse = \case | ||||
|       "tree" -> Just ALTree | ||||
|       "flat" -> Just ALFlat | ||||
|       _      -> Nothing | ||||
| 
 | ||||
| balancetypeopt :: RawOpts -> BalanceType | ||||
| balancetypeopt rawopts = | ||||
|   case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst rawopts of | ||||
|     ("historical":_) -> HistoricalBalance | ||||
|     ("cumulative":_) -> CumulativeChange | ||||
|     _                -> PeriodChange | ||||
| balancetypeopt = | ||||
|   fromMaybe PeriodChange . choiceopt parse where | ||||
|     parse = \case | ||||
|       "historical" -> Just HistoricalBalance | ||||
|       "cumulative" -> Just CumulativeChange | ||||
|       _            -> Nothing | ||||
| 
 | ||||
| -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period | ||||
| -- options appearing in the command line. | ||||
| @ -257,7 +259,7 @@ periodFromRawOpts d rawopts = | ||||
| -- Get all begin dates specified by -b/--begin or -p/--period options, in order, | ||||
| -- using the given date to interpret relative date expressions. | ||||
| beginDatesFromRawOpts :: Day -> RawOpts -> [Day] | ||||
| beginDatesFromRawOpts d = catMaybes . map (begindatefromrawopt d) | ||||
| beginDatesFromRawOpts d = collectopts (begindatefromrawopt d) | ||||
|   where | ||||
|     begindatefromrawopt d (n,v) | ||||
|       | n == "begin" = | ||||
| @ -275,7 +277,7 @@ beginDatesFromRawOpts d = catMaybes . map (begindatefromrawopt d) | ||||
| -- Get all end dates specified by -e/--end or -p/--period options, in order, | ||||
| -- using the given date to interpret relative date expressions. | ||||
| endDatesFromRawOpts :: Day -> RawOpts -> [Day] | ||||
| endDatesFromRawOpts d = catMaybes . map (enddatefromrawopt d) | ||||
| endDatesFromRawOpts d = collectopts (enddatefromrawopt d) | ||||
|   where | ||||
|     enddatefromrawopt d (n,v) | ||||
|       | n == "end" = | ||||
| @ -294,7 +296,7 @@ endDatesFromRawOpts d = catMaybes . map (enddatefromrawopt d) | ||||
| -- -D/--daily, -W/--weekly, -M/--monthly etc. options. | ||||
| -- An interval from --period counts only if it is explicitly defined. | ||||
| intervalFromRawOpts :: RawOpts -> Interval | ||||
| intervalFromRawOpts = lastDef NoInterval . catMaybes . map intervalfromrawopt | ||||
| intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt | ||||
|   where | ||||
|     intervalfromrawopt (n,v) | ||||
|       | n == "period" = | ||||
| @ -321,7 +323,7 @@ extractIntervalOrNothing (interval, _) = Just interval | ||||
| -- -P/--pending, -C/--cleared flags. -UPC is equivalent to no flags, | ||||
| -- so this returns a list of 0-2 unique statuses. | ||||
| statusesFromRawOpts :: RawOpts -> [Status] | ||||
| statusesFromRawOpts = simplifyStatuses . catMaybes . map statusfromrawopt | ||||
| statusesFromRawOpts = simplifyStatuses . collectopts statusfromrawopt | ||||
|   where | ||||
|     statusfromrawopt (n,_) | ||||
|       | n == "unmarked"  = Just Unmarked | ||||
| @ -347,7 +349,7 @@ reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss} | ||||
| -- -B/--cost, -V, -X/--exchange, or --value flags. If there's more | ||||
| -- than one of these, the rightmost flag wins. | ||||
| valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType | ||||
| valuationTypeFromRawOpts = lastDef Nothing . filter isJust . map valuationfromrawopt | ||||
| valuationTypeFromRawOpts = lastMay . collectopts valuationfromrawopt | ||||
|   where | ||||
|     valuationfromrawopt (n,v)  -- option name, value | ||||
|       | n == "B"     = Just $ AtCost Nothing | ||||
|  | ||||
| @ -4,6 +4,7 @@ Copyright (c) 2007-2015 Simon Michael <simon@joyful.com> | ||||
| Released under GPL version 3 or later. | ||||
| -} | ||||
| {-# LANGUAGE CPP #-} | ||||
| {-# LANGUAGE LambdaCase #-} | ||||
| {-# LANGUAGE OverloadedStrings #-} | ||||
| {-# LANGUAGE MultiParamTypeClasses #-} | ||||
| 
 | ||||
| @ -97,7 +98,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop | ||||
|             depth_ =depthfromoptsandargs, | ||||
|             period_=periodfromoptsandargs, | ||||
|             query_ =unwords -- as in ReportOptions, with same limitations | ||||
|                     [quoteIfNeeded v | (k,v) <- rawopts_ copts, k=="args", not $ any (`isPrefixOf` v) ["depth","date"]], | ||||
|                     $ collectopts filteredQueryArg (rawopts_ copts), | ||||
|             -- always disable boring account name eliding, unlike the CLI, for a more regular tree | ||||
|             no_elide_=True, | ||||
|             -- flip the default for items with zero amounts, show them by default | ||||
| @ -114,6 +115,11 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop | ||||
|         datespanfromargs = queryDateSpan (date2_ ropts) $ fst $ parseQuery d (T.pack $ query_ ropts) | ||||
|         periodfromoptsandargs = | ||||
|           dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs] | ||||
|         filteredQueryArg = \case | ||||
|             ("args", v) | ||||
|                 | not $ any (`isPrefixOf` v) ["depth:", "date:"] -- skip depth/date passed as query | ||||
|                     -> Just (quoteIfNeeded v) | ||||
|             _ -> Nothing | ||||
| 
 | ||||
|     -- XXX move this stuff into Options, UIOpts | ||||
|     theme = maybe defaultTheme (fromMaybe defaultTheme . getTheme) $ | ||||
|  | ||||
| @ -1,5 +1,6 @@ | ||||
| {-# LANGUAGE CPP #-} | ||||
| {-# LANGUAGE DeriveDataTypeable #-} | ||||
| {-# LANGUAGE LambdaCase #-} | ||||
| {-| | ||||
| 
 | ||||
| -} | ||||
| @ -10,6 +11,7 @@ import Data.Data (Data) | ||||
| import Data.Default | ||||
| import Data.Typeable (Typeable) | ||||
| import Data.List (intercalate) | ||||
| import Data.Maybe (fromMaybe) | ||||
| import System.Environment | ||||
| 
 | ||||
| import Hledger.Cli hiding (progname,version,prognameandversion) | ||||
| @ -45,8 +47,8 @@ uiflags = [ | ||||
|   -- ,flagNone ["no-elide"] (setboolopt "no-elide") "don't compress empty parent accounts on one line" | ||||
|  ] | ||||
| 
 | ||||
| --uimode :: Mode [([Char], [Char])] | ||||
| uimode =  (mode "hledger-ui" [("command","ui")] | ||||
| --uimode :: Mode RawOpts | ||||
| uimode =  (mode "hledger-ui" (setopt "command" "ui" def) | ||||
|             "browse accounts, postings and entries in a full-window curses interface" | ||||
|             (argsFlag "[PATTERNS]") []){ | ||||
|               modeGroupFlags = Group { | ||||
| @ -91,11 +93,12 @@ data PresentOrFutureOpt = PFDefault | PFPresent | PFFuture deriving (Eq, Show, D | ||||
| instance Default PresentOrFutureOpt where def = PFDefault | ||||
| 
 | ||||
| presentorfutureopt :: RawOpts -> PresentOrFutureOpt | ||||
| presentorfutureopt rawopts = | ||||
|   case reverse $ filter (`elem` ["present","future"]) $ map fst rawopts of | ||||
|     ("present":_) -> PFPresent | ||||
|     ("future":_)  -> PFFuture | ||||
|     _             -> PFDefault | ||||
| presentorfutureopt = | ||||
|   fromMaybe PFDefault . choiceopt parse where | ||||
|     parse = \case | ||||
|       "present" -> Just PFPresent | ||||
|       "future"  -> Just PFFuture | ||||
|       _         -> Nothing | ||||
| 
 | ||||
| checkUIOpts :: UIOpts -> UIOpts | ||||
| checkUIOpts opts = | ||||
|  | ||||
| @ -28,7 +28,7 @@ version = "" | ||||
| prognameandversion :: String | ||||
| prognameandversion = progname ++ " " ++ version :: String | ||||
| 
 | ||||
| webflags :: [Flag [(String, String)]] | ||||
| webflags :: [Flag RawOpts] | ||||
| webflags = | ||||
|   [ flagNone | ||||
|       ["serve", "server"] | ||||
| @ -75,11 +75,11 @@ webflags = | ||||
|       "read capabilities to enable from a HTTP header, like X-Sandstorm-Permissions (default: disabled)" | ||||
|   ] | ||||
| 
 | ||||
| webmode :: Mode [(String, String)] | ||||
| webmode :: Mode RawOpts | ||||
| webmode = | ||||
|   (mode | ||||
|      "hledger-web" | ||||
|      [("command", "web")] | ||||
|      (setopt "command" "web" def) | ||||
|      "start serving the hledger web interface" | ||||
|      (argsFlag "[PATTERNS]") | ||||
|      []) | ||||
|  | ||||
| @ -223,7 +223,7 @@ defMode = Mode { | ||||
|    ,groupHidden  = []             --  flags not displayed in the usage | ||||
|    } | ||||
|  ,modeArgs        = ([], Nothing) -- description of arguments accepted by the command | ||||
|  ,modeValue       = []            -- value returned when this mode is used to parse a command line | ||||
|  ,modeValue       = def           -- value returned when this mode is used to parse a command line | ||||
|  ,modeCheck       = Right         -- whether the mode's value is correct | ||||
|  ,modeReform      = const Nothing -- function to convert the value back to a command line arguments | ||||
|  ,modeExpandAt    = True          -- expand @ arguments for program ? | ||||
| @ -245,7 +245,7 @@ defCommandMode names = defMode { | ||||
|     ,groupHidden  = []             --  flags not displayed in the usage | ||||
|     } | ||||
|   ,modeArgs = ([], Just $ argsFlag "[QUERY]") | ||||
|   ,modeValue=[("command", headDef "" names)] | ||||
|   ,modeValue=setopt "command" (headDef "" names) def | ||||
|   } | ||||
| 
 | ||||
| -- | A cmdargs mode representing the hledger add-on command with the | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| {-# LANGUAGE OverloadedStrings, RecordWildCards #-} | ||||
| {-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-} | ||||
| {-| | ||||
| 
 | ||||
| Common helpers for making multi-section balance report commands | ||||
| @ -125,11 +125,12 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r | ||||
|     let | ||||
|       -- use the default balance type for this report, unless the user overrides | ||||
|       mBalanceTypeOverride = | ||||
|         case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst rawopts of | ||||
|           "historical":_ -> Just HistoricalBalance | ||||
|           "cumulative":_ -> Just CumulativeChange | ||||
|           "change":_     -> Just PeriodChange | ||||
|           _              -> Nothing | ||||
|         choiceopt parse rawopts where | ||||
|           parse = \case | ||||
|             "historical" -> Just HistoricalBalance | ||||
|             "cumulative" -> Just CumulativeChange | ||||
|             "change"     -> Just PeriodChange | ||||
|             _            -> Nothing | ||||
|       balancetype = fromMaybe cbctype mBalanceTypeOverride | ||||
|       -- Set balance type in the report options. | ||||
|       -- Also, use tree mode (by default, at least?) if --cumulative/--historical | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user