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