diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 27d741f8a..ef45052ee 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -16,6 +16,7 @@ module Hledger.Reports.ReportOptions ( flat_, tree_, reportOptsToggleStatus, + simplifyStatuses, whichDateFromOpts, journalSelectingAmountFromOpts, queryFromOpts, diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 3cd042743..a57f31243 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -109,7 +109,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,aMode=mode } = case mode of - Help -> [helpDialog, maincontent] + Help -> [helpDialog copts, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] _ -> [maincontent] where @@ -181,7 +181,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} mdepth = depth_ ropts togglefilters = case concat [ - uiShowStatus $ statuses_ ropts + uiShowStatus copts $ statuses_ ropts ,if real_ ropts then ["real"] else [] ] of [] -> str "" diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index a45ff3c18..0d297bb3a 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -39,11 +39,11 @@ esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui esInit _ _ _ = error "init function called with wrong screen type, should not happen" esDraw :: UIState -> [Widget Name] -esDraw UIState{ --aopts=UIOpts{cliopts_=copts@CliOpts{}} - aScreen=ErrorScreen{..} +esDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{}} + ,aScreen=ErrorScreen{..} ,aMode=mode} = case mode of - Help -> [helpDialog, maincontent] + Help -> [helpDialog copts, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] _ -> [maincontent] where diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index a2fd2c2eb..c389c2fca 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -108,7 +108,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,aMode=mode } = case mode of - Help -> [helpDialog, maincontent] + Help -> [helpDialog copts, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] _ -> [maincontent] where @@ -178,7 +178,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} where togglefilters = case concat [ - uiShowStatus $ statuses_ ropts + uiShowStatus copts $ statuses_ ropts ,if real_ ropts then ["real"] else [] ,if empty_ ropts then [] else ["nonzero"] ] of diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 65ad028fd..735dd9398 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -53,7 +53,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,tsAccount=acct} ,aMode=mode} = case mode of - Help -> [helpDialog, maincontent] + Help -> [helpDialog copts, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] _ -> [maincontent] where @@ -78,7 +78,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} where togglefilters = case concat [ - uiShowStatus $ statuses_ ropts + uiShowStatus copts $ statuses_ ropts ,if real_ ropts then ["real"] else [] ,if empty_ ropts then [] else ["nonzero"] ] of diff --git a/hledger-ui/Hledger/UI/UIOptions.hs b/hledger-ui/Hledger/UI/UIOptions.hs index 62d35513e..572bcf81d 100644 --- a/hledger-ui/Hledger/UI/UIOptions.hs +++ b/hledger-ui/Hledger/UI/UIOptions.hs @@ -39,6 +39,15 @@ uiflags = [ -- ,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])] diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 597d3ae4a..1968d9783 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -20,17 +20,83 @@ import Hledger.UI.UIOptions -- | Toggle between showing only unmarked items or all items. toggleUnmarked :: UIState -> UIState toggleUnmarked ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = - ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatus Unmarked ropts}}} + ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Unmarked copts ropts}}} -- | Toggle between showing only pending items or all items. togglePending :: UIState -> UIState togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = - ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatus Pending ropts}}} + ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Pending copts ropts}}} -- | Toggle between showing only cleared items or all items. toggleCleared :: UIState -> UIState toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = - ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatus Cleared ropts}}} + ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Cleared copts ropts}}} + +-- TODO testing different status toggle styles + +-- | Generate zero or more indicators of the status filters currently active, +-- which will be shown comma-separated as part of the indicators list. +uiShowStatus :: CliOpts -> [Status] -> [String] +uiShowStatus copts ss = + case style of + -- in style 2, instead of "Y, Z" show "not X" + Just 2 | length ss == numstatuses-1 + -> map (("not "++). showstatus) $ sort $ complement ss -- should be just one + _ -> map showstatus $ sort ss + where + numstatuses = length [minBound..maxBound::Status] + style = maybeintopt "status-toggles" $ rawopts_ copts + showstatus Cleared = "cleared" + showstatus Pending = "pending" + showstatus Unmarked = "unmarked" + +reportOptsToggleStatusSomehow :: Status -> CliOpts -> ReportOpts -> ReportOpts +reportOptsToggleStatusSomehow s copts ropts = + case maybeintopt "status-toggles" $ rawopts_ copts of + Just 2 -> reportOptsToggleStatus2 s ropts + Just 3 -> reportOptsToggleStatus3 s ropts +-- Just 4 -> reportOptsToggleStatus4 s ropts +-- Just 5 -> reportOptsToggleStatus5 s ropts + _ -> reportOptsToggleStatus1 s ropts + +-- 1 UPC toggles only X/all +reportOptsToggleStatus1 s ropts@ReportOpts{statuses_=ss} + | ss == [s] = ropts{statuses_=[]} + | otherwise = ropts{statuses_=[s]} + +-- 2 UPC cycles X/not-X/all +-- repeatedly pressing X cycles: +-- [] U [u] +-- [u] U [pc] +-- [pc] U [] +-- pressing Y after first or second step starts new cycle: +-- [u] P [p] +-- [pc] P [p] +reportOptsToggleStatus2 s ropts@ReportOpts{statuses_=ss} + | ss == [s] = ropts{statuses_=complement [s]} + | ss == complement [s] = ropts{statuses_=[]} + | otherwise = ropts{statuses_=[s]} -- XXX assume only three values + +-- 3 UPC toggles each X +reportOptsToggleStatus3 s ropts@ReportOpts{statuses_=ss} + | s `elem` ss = ropts{statuses_=filter (/= s) ss} + | otherwise = ropts{statuses_=simplifyStatuses (s:ss)} + +-- 4 upc sets X, UPC sets not-X +--reportOptsToggleStatus4 s ropts@ReportOpts{statuses_=ss} +-- | s `elem` ss = ropts{statuses_=filter (/= s) ss} +-- | otherwise = ropts{statuses_=simplifyStatuses (s:ss)} +-- +-- 5 upc toggles X, UPC toggles not-X +--reportOptsToggleStatus5 s ropts@ReportOpts{statuses_=ss} +-- | s `elem` ss = ropts{statuses_=filter (/= s) ss} +-- | otherwise = ropts{statuses_=simplifyStatuses (s:ss)} + +-- | Given a list of unique enum values, list the other possible values of that enum. +complement :: (Bounded a, Enum a, Eq a) => [a] -> [a] +complement = ([minBound..maxBound] \\) + +-- -- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items. toggleEmpty :: UIState -> UIState diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index cbd7d075f..48afeccc8 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -12,12 +12,14 @@ import Brick.Widgets.Border.Style import Brick.Widgets.Dialog import Brick.Widgets.Edit import Data.List +import Data.Maybe import Data.Monoid import Graphics.Vty (Event(..),Key(..),Color,Attr,currentAttr) import Lens.Micro.Platform import System.Process import Hledger hiding (Color) +import Hledger.Cli (CliOpts(rawopts_)) import Hledger.UI.UITypes import Hledger.UI.UIState @@ -28,15 +30,9 @@ runHelp = runCommand "hledger-ui --help | less" >>= waitForProcess -- ui -uiShowStatus = map showstatus . sort - where - showstatus Cleared = "cleared" - showstatus Pending = "pending" - showstatus Unmarked = "unmarked" - -- | Draw the help dialog, called when help mode is active. -helpDialog :: Widget Name -helpDialog = +helpDialog :: CliOpts -> Widget Name +helpDialog copts = Widget Fixed Fixed $ do c <- getContext render $ @@ -76,9 +72,21 @@ helpDialog = ,renderKey ("t", "set report period to today") ,str " " ,renderKey ("/", "set a filter query") - ,renderKey ("U", "toggle unmarked filter") - ,renderKey ("P", "toggle pending filter") - ,renderKey ("C", "toggle cleared filter") + ,renderKey ("U", + ["toggle unmarked/all" + ,"cycle unmarked/not unmarked/all" + ,"toggle unmarked filter" + ] !! (statusstyle-1)) + ,renderKey ("P", + ["toggle pending/all" + ,"cycle pending/not pending/all" + ,"toggle pending filter" + ] !! (statusstyle-1)) + ,renderKey ("C", + ["toggle cleared/all" + ,"cycle cleared/not cleared/all" + ,"toggle cleared filter" + ] !! (statusstyle-1)) ,renderKey ("R", "toggle real/all") ,renderKey ("Z", "toggle nonzero/all") ,renderKey ("DEL/BS", "remove filters") @@ -109,6 +117,7 @@ helpDialog = ] where renderKey (key,desc) = withAttr (borderAttr <> "keys") (str key) <+> str " " <+> str desc + statusstyle = min 3 $ fromMaybe 1 $ maybeintopt "status-toggles" $ rawopts_ copts -- | Event handler used when help mode is active. helpHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)