ui: briefer on-screen help, and a more detailed help dialog

2016-06-10 11:50:57 -07:00 · 2016-06-10 11:50:57 -07:00 · ea180f72a0
commit ea180f72a0
parent aa75cc69f6
6 changed files with 366 additions and 317 deletions
--- a/hledger-ui/Hledger/UI/AccountsScreen.hs
+++ b/hledger-ui/Hledger/UI/AccountsScreen.hs
@ -23,6 +23,7 @@ import System.FilePath (takeFileName)
 import qualified Data.Vector as V
 import Graphics.Vty as Vty
 import Brick
+-- import Brick.Widgets.Center
 import Brick.Widgets.List
 import Brick.Widgets.Edit
 import Brick.Widgets.Border (borderAttr)
@ -108,7 +109,10 @@ asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
                           ,aScreen=s@AccountsScreen{}
                           ,aMode=mode
                           } =
-  [ui]
+  case mode of
+    Help       -> [helpDialog, maincontent]
+    -- Minibuffer e -> [minibuffer e, maincontent]
+    _          -> [maincontent]
  where
    toplabel = files
            <+> nonzero
@ -143,29 +147,7 @@ asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
                Nothing -> "-"
                Just i -> show (i + 1))
    total = str $ show $ V.length $ s ^. asList . listElementsL
-
-      bottomlabel = borderKeysStr [
-         -- ("up/down/pgup/pgdown/home/end", "move")
-         ("a", "add")
-        ,("-=1234567890", "depth")
-        ,("F", "flat?")
-        ,("E", "nonzero?")
-        ,("C", "cleared?")
-        ,("U", "uncleared?")
-        ,("R", "real?")
-        ,("/", "filter")
-        ,("DEL", "unfilter")
-        ,("right/enter", "register")
-        ,("ESC", "cancel/top")
-        ,("g", "reload")
-        ,("q", "quit")
-        ]
-
-      bottomarea = case mode of
-                     Minibuffer ed -> minibuffer ed
-                     _             -> bottomlabel
-
-      ui = Widget Greedy Greedy $ do
+    maincontent = Widget Greedy Greedy $ do
      c <- getContext
      let
        availwidth =
@ -200,7 +182,24 @@ asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}

        colwidths = (acctwidth, balwidth)

-        render $ defaultLayout toplabel bottomarea $ renderList (s ^. asList) (asDrawItem colwidths)
+      render $ defaultLayout toplabel bottomlabel $ renderList (s ^. asList) (asDrawItem colwidths)
+
+      where
+        bottomlabel = case mode of
+                        Minibuffer ed -> minibuffer ed
+                        _             -> quickhelp
+        quickhelp = borderKeysStr [
+           ("h", "help")
+          ,("right", "register")
+          ,("F", "flat?")
+          ,("-+=1234567890", "depth")
+          --,("/", "filter")
+          --,("DEL", "unfilter")
+          --,("ESC", "cancel/top")
+          ,("a", "add")
+          ,("g", "reload")
+          ,("q", "quit")
+          ]

 asDraw _ = error "draw function called with wrong screen type, should not happen"

@ -253,18 +252,23 @@ asHandle st'@AppState{
  case mode of
    Minibuffer ed ->
      case ev of
-            Vty.EvKey Vty.KEsc   [] -> continue $ stHideMinibuffer st'
-            Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st'
+        Vty.EvKey Vty.KEsc   [] -> continue $ stCloseMinibuffer st'
+        Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stCloseMinibuffer st'
                                    where s = chomp $ unlines $ getEditContents ed
        ev                      -> do ed' <- handleEvent ev ed
                                      continue $ st'{aMode=Minibuffer ed'}

-      _ ->
+    Help ->
+      case ev of
+        Vty.EvKey (Vty.KChar 'q') [] -> halt st
+        _                            -> helpHandle st ev

+    Normal ->
      case ev of
        Vty.EvKey (Vty.KChar 'q') [] -> halt st
        -- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do
        Vty.EvKey Vty.KEsc   [] -> continue $ resetScreens d st
+        Vty.EvKey k [] | k `elem` [Vty.KChar 'h', Vty.KChar '?'] -> continue $ setMode Help st
        Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue
        Vty.EvKey (Vty.KChar 'a') [] -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> stReloadJournalIfChanged copts d j st
        Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st
--- a/hledger-ui/Hledger/UI/ErrorScreen.hs
+++ b/hledger-ui/Hledger/UI/ErrorScreen.hs
@ -42,75 +42,48 @@ esInit _ _ _ = error "init function called with wrong screen type, should not ha

 esDraw :: AppState -> [Widget]
 esDraw AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
-                             aScreen=ErrorScreen{..}} = [ui]
+                             aScreen=ErrorScreen{..}
+                             ,aMode=mode} =
+  case mode of
+    Help       -> [helpDialog, maincontent]
+    -- Minibuffer e -> [minibuffer e, maincontent]
+    _          -> [maincontent]
  where
    toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload")
-            -- <+> str " transactions"
-            -- <+> borderQueryStr querystr -- no, account transactions report shows all transactions in the acct ?
-            -- <+> str " and subs"
-    --         <+> str " ("
-    --         <+> cur
-    --         <+> str "/"
-    --         <+> total
-    --         <+> str ")"
-    -- cur = str $ case l^.listSelectedL of
-    --              Nothing -> "-"
-    --              Just i -> show (i + 1)
-    -- total = str $ show $ length displayitems
-    -- displayitems = V.toList $ l^.listElementsL
-    bottomlabel = borderKeysStr [
-       -- ("up/down/pgup/pgdown/home/end", "move")
-       ("g", "reload")
-      -- ,("left", "return to accounts")
+    maincontent = Widget Greedy Greedy $ do
+      render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError
+      where
+        bottomlabel = case mode of
+                        -- Minibuffer ed -> minibuffer ed
+                        _             -> quickhelp
+        quickhelp = borderKeysStr [
+           ("h", "help")
+          ,("ESC", "cancel/top")
+          ,("g", "reload")
+          ,("q", "quit")
          ]

-
-    -- query = query_ $ reportopts_ $ cliopts_ opts
-
-    ui = Widget Greedy Greedy $ do
-
-      -- calculate column widths, based on current available width
-      -- c <- getContext
-      -- let
-      --   totalwidth = c^.availWidthL
-      --                - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
-
-      render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError
-
 esDraw _ = error "draw function called with wrong screen type, should not happen"

-- drawErrorItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget
-- drawErrorItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal) =
--   Widget Greedy Fixed $ do
--     render $
--       str (fitString (Just datewidth) (Just datewidth) True True date) <+>
--       str "  " <+>
--       str (fitString (Just descwidth) (Just descwidth) True True desc) <+>
--       str "  " <+>
--       str (fitString (Just acctswidth) (Just acctswidth) True True accts) <+>
--       str "   " <+>
--       withAttr changeattr (str (fitString (Just changewidth) (Just changewidth) True False change)) <+>
--       str "   " <+>
--       withAttr balattr (str (fitString (Just balwidth) (Just balwidth) True False bal))
--   where
--     changeattr | '-' `elem` change = sel $ "list" <> "amount" <> "decrease"
--                | otherwise         = sel $ "list" <> "amount" <> "increase"
--     balattr    | '-' `elem` bal    = sel $ "list" <> "balance" <> "negative"
--                | otherwise         = sel $ "list" <> "balance" <> "positive"
--     sel | selected  = (<> "selected")
--         | otherwise = id
-
 esHandle :: AppState -> Vty.Event -> EventM (Next AppState)
 esHandle st@AppState{
   aScreen=s@ErrorScreen{}
  ,aopts=UIOpts{cliopts_=copts}
  ,ajournal=j
-  } e = do
+  ,aMode=mode
+  } ev =
+  case mode of
+    Help ->
+      case ev of
+        Vty.EvKey (Vty.KChar 'q') [] -> halt st
+        _                            -> helpHandle st ev
+
+    _ -> do
      d <- liftIO getCurrentDay
-  case e of
+      case ev of
        Vty.EvKey (Vty.KChar 'q') [] -> halt st
        Vty.EvKey Vty.KEsc   [] -> continue $ resetScreens d st
-
+        Vty.EvKey k [] | k `elem` [Vty.KChar 'h', Vty.KChar '?'] -> continue $ setMode Help st
        Vty.EvKey (Vty.KChar 'g') [] -> do
          (ej, _) <- liftIO $ journalReloadIfChanged copts d j
          case ej of
--- a/hledger-ui/Hledger/UI/RegisterScreen.hs
+++ b/hledger-ui/Hledger/UI/RegisterScreen.hs
@ -103,8 +103,11 @@ rsDraw :: AppState -> [Widget]
 rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
                            ,aScreen=RegisterScreen{..}
                            ,aMode=mode
-                            }
-  = [ui]
+                            } =
+  case mode of
+    Help       -> [helpDialog, maincontent]
+    -- Minibuffer e -> [minibuffer e, maincontent]
+    _          -> [maincontent]
  where
    toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount)
            <+> togglefilters
@ -134,17 +137,14 @@ rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}

    -- query = query_ $ reportopts_ $ cliopts_ opts

-    ui = Widget Greedy Greedy $ do
-
+    maincontent = Widget Greedy Greedy $ do
      -- calculate column widths, based on current available width
      c <- getContext
      let
        totalwidth = c^.availWidthL
                     - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
-
        -- the date column is fixed width
        datewidth = 10
-
        -- multi-commodity amounts rendered on one line can be
        -- arbitrarily wide.  Give the two amounts as much space as
        -- they need, while reserving a minimum of space for other
@ -160,7 +160,6 @@ rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
        maxbalwidth = maxamtswidth - maxchangewidth
        changewidth = min maxchangewidth maxchangewidthseen 
        balwidth = min maxbalwidth maxbalwidthseen
-
        -- assign the remaining space to the description and accounts columns
        -- maxdescacctswidth = totalwidth - (whitespacewidth - 4) - changewidth - balwidth
        maxdescacctswidth =
@ -179,28 +178,24 @@ rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
        acctswidth = maxdescacctswidth - descwidth
        colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth)

-        bottomlabel = borderKeysStr [
-           -- ("up/down/pgup/pgdown/home/end", "move")
-           ("left", "back")
-          ,("a", "add")
-          ,("E", "nonzero?")
-          ,("C", "cleared?")
-          ,("U", "uncleared?")
-          ,("R", "real?")
+      render $ defaultLayout toplabel bottomlabel $ renderList rsList (rsDrawItem colwidths)
+
+      where
+        bottomlabel = case mode of
+                        Minibuffer ed -> minibuffer ed
+                        _             -> quickhelp
+        quickhelp = borderKeysStr [
+           ("h", "help")
+          ,("left", "back")
+          ,("right", "transaction")
          ,("/", "filter")
          ,("DEL", "unfilter")
-          ,("right/enter", "transaction")
-          ,("ESC", "cancel/top")
+          --,("ESC", "reset")
+          ,("a", "add")
          ,("g", "reload")
          ,("q", "quit")
          ]

-        bottomarea = case mode of
-                      Minibuffer ed -> minibuffer ed
-                      _             -> bottomlabel
-
-      render $ defaultLayout toplabel bottomarea $ renderList rsList (rsDrawItem colwidths)
-
 rsDraw _ = error "draw function called with wrong screen type, should not happen"

 rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget
@ -236,17 +231,22 @@ rsHandle st@AppState{
  case mode of
    Minibuffer ed ->
      case ev of
-            Vty.EvKey Vty.KEsc   [] -> continue $ stHideMinibuffer st
-            Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st
+        Vty.EvKey Vty.KEsc   [] -> continue $ stCloseMinibuffer st
+        Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stCloseMinibuffer st
                                    where s = chomp $ unlines $ getEditContents ed
        ev                      -> do ed' <- handleEvent ev ed
                                      continue $ st{aMode=Minibuffer ed'}

-    _ ->
+    Help ->
+      case ev of
+        Vty.EvKey (Vty.KChar 'q') [] -> halt st
+        _                            -> helpHandle st ev

+    Normal ->
      case ev of
        Vty.EvKey (Vty.KChar 'q') [] -> halt st
        Vty.EvKey Vty.KEsc   [] -> continue $ resetScreens d st
+        Vty.EvKey k [] | k `elem` [Vty.KChar 'h', Vty.KChar '?'] -> continue $ setMode Help st
        Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue
        Vty.EvKey (Vty.KChar 'a') [] -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> stReloadJournalIfChanged copts d j st
        Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st)
@ -281,4 +281,3 @@ rsHandle st@AppState{
    scrollTop = vScrollToBeginning $ viewportScroll "register"

 rsHandle _ _ = error "event handler called with wrong screen type, should not happen"
-
--- a/hledger-ui/Hledger/UI/TransactionScreen.hs
+++ b/hledger-ui/Hledger/UI/TransactionScreen.hs
@ -57,8 +57,12 @@ tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
                              ,aScreen=TransactionScreen{
                                   tsTransaction=(i,t)
                                  ,tsTransactions=nts
-                                  ,tsAccount=acct}} =
-  [ui]
+                                  ,tsAccount=acct}
+                              ,aMode=mode} =
+  case mode of
+    Help       -> [helpDialog, maincontent]
+    -- Minibuffer e -> [minibuffer e, maincontent]
+    _          -> [maincontent]
  where
    -- datedesc = show (tdate t) ++ " " ++ tdescription t
    toplabel =
@ -82,40 +86,51 @@ tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
          ] of
        [] -> str ""
        fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs)
-    bottomlabel = borderKeysStr [
-       ("left", "back")
-      ,("up/down", "prev/next")
--       ,("C", "cleared?")
--       ,("U", "uncleared?")
--       ,("R", "real?")
-      ,("g", "reload")
-      ,("q", "quit")
-      ]
-    ui = Widget Greedy Greedy $ do
+    maincontent = Widget Greedy Greedy $ do
      render $ defaultLayout toplabel bottomlabel $ str $
        showTransactionUnelidedOneLineAmounts $
        -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
        t
+      where
+        bottomlabel = case mode of
+                        -- Minibuffer ed -> minibuffer ed
+                        _             -> quickhelp
+        quickhelp = borderKeysStr [
+           ("h", "help")
+          ,("left", "back")
+          ,("up/down", "prev/next")
+          --,("ESC", "cancel/top")
+          -- ,("a", "add")
+          ,("g", "reload")
+          ,("q", "quit")
+          ]

 tsDraw _ = error "draw function called with wrong screen type, should not happen"

 tsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
-tsHandle
-  st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
+tsHandle st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
                                                ,tsTransactions=nts
                                                ,tsAccount=acct}
                    ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
                    ,ajournal=j
+                    ,aMode=mode
                    }
-  e = do
+         ev =
+  case mode of
+    Help ->
+      case ev of
+        Vty.EvKey (Vty.KChar 'q') [] -> halt st
+        _                            -> helpHandle st ev
+
+    _ -> do
      d <- liftIO getCurrentDay
      let
        (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
        (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
-  case e of
+      case ev of
        Vty.EvKey (Vty.KChar 'q') [] -> halt st
        Vty.EvKey Vty.KEsc   [] -> continue $ resetScreens d st
-
+        Vty.EvKey k [] | k `elem` [Vty.KChar 'h', Vty.KChar '?'] -> continue $ setMode Help st
        Vty.EvKey (Vty.KChar 'g') [] -> do
          d <- liftIO getCurrentDay
          (ej, _) <- liftIO $ journalReloadIfChanged copts d j
--- a/hledger-ui/Hledger/UI/UITypes.hs
+++ b/hledger-ui/Hledger/UI/UITypes.hs
@ -73,7 +73,11 @@ data Mode =
    Normal
  | Help
  | Minibuffer Editor
-  deriving (Show)
+  deriving (Show,Eq)
+
+-- Ignore the editor when comparing Modes.
+instance Eq Editor where _ == _ = True
+

 -- | hledger-ui screen types & instances.
 -- Each screen type has generically named initialisation, draw, and event handling functions,
--- a/hledger-ui/Hledger/UI/UIUtils.hs
+++ b/hledger-ui/Hledger/UI/UIUtils.hs
@ -28,7 +28,7 @@ module Hledger.UI.UIUtils
 --  ,stFilter
 --  ,stResetFilter
 --  ,stShowMinibuffer
--  ,stHideMinibuffer
+--  ,stCloseMinibuffer
 --  )
  where

@ -41,6 +41,7 @@ import Data.Monoid
 import Data.Text.Zipper (gotoEOL)
 import Data.Time.Calendar (Day)
 import Brick
+import Brick.Widgets.Dialog
 -- import Brick.Widgets.List
 import Brick.Widgets.Edit
 import Brick.Widgets.Border
@ -153,14 +154,17 @@ setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_
            | depth >= maxDepth st = Nothing
            | otherwise            = Just depth

-- | Enable the minibuffer, setting its content to the current query with the cursor at the end.
-stShowMinibuffer st = st{aMode=Minibuffer e}
+-- | Open the minibuffer, setting its content to the current query with the cursor at the end.
+stShowMinibuffer st = setMode (Minibuffer e) st
  where
    e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq
    oldq = query_ $ reportopts_ $ cliopts_ $ aopts st

-- | Disable the minibuffer, discarding any edit in progress.
-stHideMinibuffer st = st{aMode=Normal}
+-- | Close the minibuffer, discarding any edit in progress.
+stCloseMinibuffer = setMode Normal
+
+setMode :: Mode -> AppState -> AppState
+setMode m st = st{aMode=m}

 -- | Regenerate the content for the current and previous screens, from a new journal and current date.
 regenerateScreens :: Journal -> Day -> AppState -> AppState
@ -188,7 +192,7 @@ popScreen st = st

 resetScreens :: Day -> AppState -> AppState
 resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} =
-  (sInit topscreen) d True $ stResetDepth $ stResetFilter $ stHideMinibuffer st{aScreen=topscreen, aPrevScreens=[]}
+  (sInit topscreen) d True $ stResetDepth $ stResetFilter $ stCloseMinibuffer st{aScreen=topscreen, aPrevScreens=[]}
  where
    topscreen = case ss of _:_ -> last ss
                           []  -> s
@ -203,6 +207,56 @@ screenEnter d scr st = (sInit scr) d True $
                       pushScreen scr
                       st

+-- | Draw the help dialog, called when help mode is active.
+helpDialog =
+  Widget Fixed Fixed $ do
+    c <- getContext
+    render $
+      renderDialog (dialog "help" (Just "Help (h/ESC to close)") Nothing (c^.availWidthL - 2)) $ -- (Just (0,[("ok",())]))
+      padTopBottom 1 $ padLeftRight 1 $
+      hBox [
+         (padLeftRight 1 $
+           vBox [
+             str "MISC"
+            ,renderKey ("h", "toggle help")
+            ,renderKey ("a", "add transaction")
+            ,renderKey ("g", "reload data")
+            ,renderKey ("q", "quit")
+            ,str " "
+            ,str "NAVIGATION"
+            ,renderKey ("UP/DOWN/PGUP/PGDN/HOME/END", "")
+            ,str "  move selection"
+            ,renderKey ("RIGHT/ENTER", "drill down")
+            ,renderKey ("LEFT", "previous screen")
+            ,renderKey ("ESC", "cancel / reset to top")
+            ]
+        )
+        ,(padLeftRight 1 $
+           vBox [
+             str "FILTERING"
+            ,renderKey ("C", "toggle cleared filter")
+            ,renderKey ("U", "toggle uncleared filter")
+            ,renderKey ("R", "toggle real filter")
+            ,renderKey ("E", "toggle nonzero filter")
+            ,renderKey ("/", "set a filter query")
+            ,renderKey ("DEL/BS", "clear filters")
+            ,str "accounts screen:"
+            ,renderKey ("F", "toggle flat mode")
+            ,renderKey ("-+=1234567890", "")
+            ,str "  adjust/set depth limit"
+            ,str "  0 means no limit"
+            ]
+        )
+      ]
+  where
+    renderKey (key,desc) = withAttr (borderAttr <> "keys") (str key) <+> str " " <+> str desc
+
+-- | Event handler used when help mode is active.
+helpHandle st ev =
+  case ev of
+    Vty.EvKey k [] | k `elem` [Vty.KEsc, Vty.KChar 'h'] -> continue $ setMode Normal st
+    _ -> continue st
+
 -- | In the EventM monad, get the named current viewport's width and height,
 -- or (0,0) if the named viewport is not found.
 getViewportSize :: Name -> EventM (Int,Int)