1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{-# LANGUAGE CPP #-}
{-|
-}
module Hledger.UI.UIOptions
where
import Data.Default (def)
import Data.List (intercalate)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Lens.Micro (set)
import System.Environment (getArgs)
import Hledger.Cli hiding (packageversion, progname, prognameandversion)
import Hledger.UI.Theme (themes, themeNames)
-- cf Hledger.Cli.Version
packageversion :: PackageVersion
packageversion =
#ifdef VERSION
VERSION
#else
""
#endif
progname :: ProgramName
progname = "hledger-ui"
prognameandversion :: VersionString
prognameandversion = versionString progname packageversion
uiflags = [
-- flagNone ["debug-ui"] (setboolopt "rules-file") "run with no terminal output, showing console"
flagNone ["watch","w"] (setboolopt "watch") "watch for data and date changes and reload automatically"
,flagReq ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
,flagNone ["cash"] (setboolopt "cash") "start in the cash accounts screen"
,flagNone ["bs"] (setboolopt "bs") "start in the balance sheet accounts screen"
,flagNone ["is"] (setboolopt "is") "start in the income statement accounts screen"
,flagNone ["all"] (setboolopt "all") "start in the all accounts screen"
,flagReq ["register"] (\s opts -> Right $ setopt "register" s opts) "ACCTREGEX" "start in the (first matched) account's register"
,flagNone ["change"] (setboolopt "change")
"show period balances (changes) at startup instead of historical balances"
-- ,flagNone ["cumulative"] (setboolopt "cumulative")
-- "show balance change accumulated across periods (in multicolumn reports)"
-- ,flagNone ["historical","H"] (setboolopt "historical")
-- "show historical ending balance in each period (includes postings before report start date)\n "
]
++ flattreeflags False
-- ,flagNone ["present"] (setboolopt "present") "exclude transactions dated later than today (default)"
-- ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
-- ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
-- ,flagNone ["no-elide"] (setboolopt "no-elide") "don't compress empty parent accounts on one line"
--uimode :: Mode RawOpts
uimode = (mode "hledger-ui" (setopt "command" "ui" def)
"browse accounts, postings and entries in a full-window TUI"
(argsFlag "[--cash|--bs|--is|--all|--register=ACCT] [QUERY]") []){
modeGroupFlags = Group {
groupUnnamed = uiflags
,groupHidden = hiddenflags
++
[flagNone ["future"] (setboolopt "forecast") "old flag, use --forecast instead"
,flagNone ["menu"] (setboolopt "menu") "old flag, menu screen is now the default"
]
,groupNamed = [(generalflagsgroup1)]
}
,modeHelpSuffix=[
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window TUI."
]
}
-- hledger-ui options, used in hledger-ui and above
data UIOpts = UIOpts
{ uoWatch :: Bool
, uoTheme :: Maybe String
, uoRegister :: Maybe String
, uoCliOpts :: CliOpts
} deriving (Show)
defuiopts = UIOpts
{ uoWatch = False
, uoTheme = Nothing
, uoRegister = Nothing
, uoCliOpts = defcliopts
}
-- | Process a RawOpts into a UIOpts.
-- This will return a usage error if provided an invalid theme.
rawOptsToUIOpts :: RawOpts -> IO UIOpts
rawOptsToUIOpts rawopts = do
cliopts <- set balanceaccum accum <$> rawOptsToCliOpts rawopts
return defuiopts {
uoWatch = boolopt "watch" rawopts
,uoTheme = checkTheme <$> maybestringopt "theme" rawopts
,uoRegister = maybestringopt "register" rawopts
,uoCliOpts = cliopts
}
where
-- show historical balance by default (unlike hledger)
accum = fromMaybe Historical $ balanceAccumulationOverride rawopts
checkTheme t = if t `M.member` themes then t else usageError $ "invalid theme name: " ++ t
-- XXX some refactoring seems due
getHledgerUIOpts :: IO UIOpts
--getHledgerUIOpts = processArgs uimode >>= return >>= rawOptsToUIOpts
getHledgerUIOpts = do
args <- getArgs >>= expandArgsAt
let args' = replaceNumericFlags $ ensureDebugHasArg args
let cmdargopts = either usageError id $ process uimode args'
rawOptsToUIOpts cmdargopts
instance HasCliOpts UIOpts where
cliOpts f uiopts = (\x -> uiopts{uoCliOpts=x}) <$> f (uoCliOpts uiopts)
instance HasInputOpts UIOpts where
inputOpts = cliOpts.inputOpts
instance HasBalancingOpts UIOpts where
balancingOpts = cliOpts.balancingOpts
instance HasReportSpec UIOpts where
reportSpec = cliOpts.reportSpec
instance HasReportOptsNoUpdate UIOpts where
reportOptsNoUpdate = cliOpts.reportOptsNoUpdate
instance HasReportOpts UIOpts where
reportOpts = cliOpts.reportOpts
|
