From 5287fe671b6f232e922f005bc1cb60267c73cc9f Mon Sep 17 00:00:00 2001 From: Mykola Orliuk Date: Sun, 20 Oct 2019 01:01:59 +0200 Subject: [PATCH] ;all: hide RawOpts internals This way we can ensure we always use only functions from RawOptions. --- hledger-lib/Hledger/Data/RawOptions.hs | 45 ++++++++++++++++--- hledger-lib/Hledger/Reports/ReportOptions.hs | 34 +++++++------- hledger-ui/Hledger/UI/Main.hs | 8 +++- hledger-ui/Hledger/UI/UIOptions.hs | 17 ++++--- hledger-web/Hledger/Web/WebOptions.hs | 6 +-- hledger/Hledger/Cli/CliOptions.hs | 4 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 13 +++--- 7 files changed, 85 insertions(+), 42 deletions(-) diff --git a/hledger-lib/Hledger/Data/RawOptions.hs b/hledger-lib/Hledger/Data/RawOptions.hs index d53854a5b..64391cdcf 100644 --- a/hledger-lib/Hledger/Data/RawOptions.hs +++ b/hledger-lib/Hledger/Data/RawOptions.hs @@ -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 = diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index c10bbea6e..e4f29a7c0 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index c50074985..0b12d87b2 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -4,6 +4,7 @@ Copyright (c) 2007-2015 Simon Michael 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) $ diff --git a/hledger-ui/Hledger/UI/UIOptions.hs b/hledger-ui/Hledger/UI/UIOptions.hs index a153d40a7..e136ec1fe 100644 --- a/hledger-ui/Hledger/UI/UIOptions.hs +++ b/hledger-ui/Hledger/UI/UIOptions.hs @@ -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 = diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index 46bcab652..ee83f1f88 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -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]") []) diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 80d82f136..1b3887227 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -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 diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index efce02b19..a64bc6684 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -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