hledger/hledger-ui/Hledger/UI/UIOptions.hs
Simon Michael 1db9b018f1 ui: add --present/--future, hide future txns by default, toggle with F
You may have transactions dated later than today, perhaps piped from
print --forecast or recorded in the journal, which you don't want to
see except when forecasting.

By default, we now hide future transactions, showing "today's balance".
This can be toggled with the F key, which is easier than setting a
date query. --present and --future flags have been added to set the
initial mode.

(Experimental. Interactions with date queries have not been explored.)
2018-10-18 14:43:00 -07:00

125 lines
5.0 KiB
Haskell

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-|
-}
module Hledger.UI.UIOptions
where
import Data.Data (Data)
import Data.Default
import Data.Typeable (Typeable)
import Data.List (intercalate)
import System.Environment
import Hledger.Cli hiding (progname,version,prognameandversion)
import Hledger.UI.Theme (themeNames)
progname, version :: String
progname = "hledger-ui"
#ifdef VERSION
version = VERSION
#else
version = ""
#endif
prognameandversion :: String
prognameandversion = progname ++ " " ++ version :: String
uiflags = [
-- flagNone ["debug-ui"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
flagNone ["watch"] (\opts -> setboolopt "watch" opts) "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++")")
,flagReq ["register"] (\s opts -> Right $ setopt "register" s opts) "ACCTREGEX" "start in the (first) matched account's register"
,flagNone ["change"] (\opts -> setboolopt "change" opts)
"show period balances (changes) at startup instead of historical balances"
-- ,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts)
-- "show balance change accumulated across periods (in multicolumn reports)"
-- ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts)
-- "show historical ending balance in each period (includes postings before report start date)\n "
,flagNone ["flat","F"] (\opts -> setboolopt "flat" opts) "show full account names, unindented (default)"
,flagNone ["tree","T"] (\opts -> setboolopt "tree" opts) "show accounts as a tree"
,flagNone ["present"] (\opts -> setboolopt "present" opts) "exclude transactions dated later than today (default)"
,flagNone ["future"] (\opts -> setboolopt "future" opts) "include transactions dated later than today"
-- ,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"] (\opts -> setboolopt "no-elide" opts) "don't compress empty parent accounts on one line"
,flagReq ["status-toggles"] (\s opts -> Right $ setopt "status-toggles" s opts) "N"
(intercalate "\n"
["choose how status toggles work:"
," 1 UPC toggles X/all"
," 2 UPC cycles X/not-X/all"
," 3 UPC toggles each X"
-- ," 4 upc sets X, UPC sets not-X"
-- ," 5 upc toggles X, UPC toggles not-X"
])
]
--uimode :: Mode [([Char], [Char])]
uimode = (mode "hledger-ui" [("command","ui")]
"browse accounts, postings and entries in a full-window curses interface"
(argsFlag "[PATTERNS]") []){
modeGroupFlags = Group {
groupUnnamed = uiflags
,groupHidden = []
,groupNamed = [(generalflagsgroup1)]
}
,modeHelpSuffix=[
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
]
}
-- hledger-ui options, used in hledger-ui and above
data UIOpts = UIOpts {
watch_ :: Bool
,change_ :: Bool
,presentorfuture_ :: PresentOrFutureOpt
,cliopts_ :: CliOpts
} deriving (Show)
defuiopts = UIOpts
def
def
def
def
-- instance Default CliOpts where def = defcliopts
rawOptsToUIOpts :: RawOpts -> IO UIOpts
rawOptsToUIOpts rawopts = checkUIOpts <$> do
cliopts <- rawOptsToCliOpts rawopts
return defuiopts {
watch_ = boolopt "watch" rawopts
,change_ = boolopt "change" rawopts
,presentorfuture_ = presentorfutureopt rawopts
,cliopts_ = cliopts
}
-- | Should transactions dated later than today be included ?
-- Like flat/tree mode, there are three states, and the meaning of default can vary by command.
data PresentOrFutureOpt = PFDefault | PFPresent | PFFuture deriving (Eq, Show, Data, Typeable)
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
checkUIOpts :: UIOpts -> UIOpts
checkUIOpts opts =
either usageError (const opts) $ do
case maybestringopt "theme" $ rawopts_ $ cliopts_ opts of
Just t | not $ elem t themeNames -> Left $ "invalid theme name: "++t
_ -> Right ()
-- XXX some refactoring seems due
getHledgerUIOpts :: IO UIOpts
--getHledgerUIOpts = processArgs uimode >>= return . decodeRawOpts >>= rawOptsToUIOpts
getHledgerUIOpts = do
args <- getArgs >>= expandArgsAt
let args' = replaceNumericFlags args
let cmdargopts = either usageError id $ process uimode args'
rawOptsToUIOpts $ decodeRawOpts cmdargopts