ui: add temporary --status-toggles for testing toggle styles (#564)

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -16,6 +16,7 @@ module Hledger.Reports.ReportOptions (
   flat_,
   tree_,
   reportOptsToggleStatus,
+  simplifyStatuses,
   whichDateFromOpts,
   journalSelectingAmountFromOpts,
   queryFromOpts,

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 ""

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{}}
+esDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{}}
-               aScreen=ErrorScreen{..}
+              ,aScreen=ErrorScreen{..}
               ,aMode=mode} =
   case mode of
-    Help       -> [helpDialog, maincontent]
+    Help       -> [helpDialog copts, maincontent]
     -- Minibuffer e -> [minibuffer e, maincontent]
     _          -> [maincontent]
   where

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

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

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])]

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

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 :: CliOpts -> Widget Name
-helpDialog =
+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 ("U", 
-                  ,renderKey ("P", "toggle pending filter")
+                    ["toggle unmarked/all"
-                  ,renderKey ("C", "toggle cleared filter")
+                    ,"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)