From ea180f72a05d80258d95b258c0206e406a948fa4 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 10 Jun 2016 11:50:57 -0700 Subject: [PATCH] ui: briefer on-screen help, and a more detailed help dialog --- hledger-ui/Hledger/UI/AccountsScreen.hs | 294 +++++++++++---------- hledger-ui/Hledger/UI/ErrorScreen.hs | 111 +++----- hledger-ui/Hledger/UI/RegisterScreen.hs | 61 +++-- hledger-ui/Hledger/UI/TransactionScreen.hs | 145 +++++----- hledger-ui/Hledger/UI/UITypes.hs | 6 +- hledger-ui/Hledger/UI/UIUtils.hs | 66 ++++- 6 files changed, 366 insertions(+), 317 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index fb4b87422..28c4cd52f 100644 --- 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,99 +109,97 @@ asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ,aScreen=s@AccountsScreen{} ,aMode=mode } = - [ui] - where - toplabel = files - <+> nonzero - <+> str " accounts" - <+> borderQueryStr querystr - <+> togglefilters - <+> borderDepthStr mdepth - <+> str " (" - <+> cur - <+> str "/" - <+> total - <+> str ")" - files = case journalFilePaths j of - [] -> str "" - f:_ -> withAttr ("border" <> "bold") $ str $ takeFileName f - -- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)" - -- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)") - querystr = query_ ropts - mdepth = depth_ ropts - togglefilters = - case concat [ - if cleared_ ropts then ["cleared"] else [] - ,if uncleared_ ropts then ["uncleared"] else [] - ,if pending_ ropts then ["pending"] else [] - ,if real_ ropts then ["real"] else [] - ] of - [] -> str "" - fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" - nonzero | empty_ ropts = str "" - | otherwise = withAttr (borderAttr <> "query") (str " nonzero") - cur = str (case s ^. asList ^. listSelectedL of -- XXX second ^. required here but not below.. - Nothing -> "-" - Just i -> show (i + 1)) - total = str $ show $ V.length $ s ^. asList . listElementsL + case mode of + Help -> [helpDialog, maincontent] + -- Minibuffer e -> [minibuffer e, maincontent] + _ -> [maincontent] + where + toplabel = files + <+> nonzero + <+> str " accounts" + <+> borderQueryStr querystr + <+> togglefilters + <+> borderDepthStr mdepth + <+> str " (" + <+> cur + <+> str "/" + <+> total + <+> str ")" + files = case journalFilePaths j of + [] -> str "" + f:_ -> withAttr ("border" <> "bold") $ str $ takeFileName f + -- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)" + -- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)") + querystr = query_ ropts + mdepth = depth_ ropts + togglefilters = + case concat [ + if cleared_ ropts then ["cleared"] else [] + ,if uncleared_ ropts then ["uncleared"] else [] + ,if pending_ ropts then ["pending"] else [] + ,if real_ ropts then ["real"] else [] + ] of + [] -> str "" + fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" + nonzero | empty_ ropts = str "" + | otherwise = withAttr (borderAttr <> "query") (str " nonzero") + cur = str (case s ^. asList ^. listSelectedL of -- XXX second ^. required here but not below.. + Nothing -> "-" + Just i -> show (i + 1)) + total = str $ show $ V.length $ s ^. asList . listElementsL + maincontent = Widget Greedy Greedy $ do + c <- getContext + let + availwidth = + -- ltrace "availwidth" $ + c^.availWidthL + - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) + displayitems = s ^. asList . listElementsL + maxacctwidthseen = + -- ltrace "maxacctwidthseen" $ + V.maximum $ + V.map (\AccountsScreenItem{..} -> asItemIndentLevel*2 + textWidth asItemDisplayAccountName) $ + -- V.filter (\(indent,_,_,_) -> (indent-1) <= fromMaybe 99999 mdepth) $ + displayitems + maxbalwidthseen = + -- ltrace "maxbalwidthseen" $ + V.maximum $ V.map (\AccountsScreenItem{..} -> sum (map strWidth asItemRenderedAmounts) + 2 * (length asItemRenderedAmounts - 1)) displayitems + maxbalwidth = + -- ltrace "maxbalwidth" $ + max 0 (availwidth - 2 - 4) -- leave 2 whitespace plus least 4 for accts + balwidth = + -- ltrace "balwidth" $ + min maxbalwidth maxbalwidthseen + maxacctwidth = + -- ltrace "maxacctwidth" $ + availwidth - 2 - balwidth + acctwidth = + -- ltrace "acctwidth" $ + min maxacctwidth maxacctwidthseen - 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") - ] + -- XXX how to minimise the balance column's jumping around + -- as you change the depth limit ? - bottomarea = case mode of - Minibuffer ed -> minibuffer ed - _ -> bottomlabel + colwidths = (acctwidth, balwidth) - ui = Widget Greedy Greedy $ do - c <- getContext - let - availwidth = - -- ltrace "availwidth" $ - c^.availWidthL - - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - displayitems = s ^. asList . listElementsL - maxacctwidthseen = - -- ltrace "maxacctwidthseen" $ - V.maximum $ - V.map (\AccountsScreenItem{..} -> asItemIndentLevel*2 + textWidth asItemDisplayAccountName) $ - -- V.filter (\(indent,_,_,_) -> (indent-1) <= fromMaybe 99999 mdepth) $ - displayitems - maxbalwidthseen = - -- ltrace "maxbalwidthseen" $ - V.maximum $ V.map (\AccountsScreenItem{..} -> sum (map strWidth asItemRenderedAmounts) + 2 * (length asItemRenderedAmounts - 1)) displayitems - maxbalwidth = - -- ltrace "maxbalwidth" $ - max 0 (availwidth - 2 - 4) -- leave 2 whitespace plus least 4 for accts - balwidth = - -- ltrace "balwidth" $ - min maxbalwidth maxbalwidthseen - maxacctwidth = - -- ltrace "maxacctwidth" $ - availwidth - 2 - balwidth - acctwidth = - -- ltrace "acctwidth" $ - min maxacctwidth maxacctwidthseen + render $ defaultLayout toplabel bottomlabel $ renderList (s ^. asList) (asDrawItem colwidths) - -- XXX how to minimise the balance column's jumping around - -- as you change the depth limit ? - - colwidths = (acctwidth, balwidth) - - render $ defaultLayout toplabel bottomarea $ 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" @@ -238,67 +237,72 @@ asHandle st'@AppState{ ,ajournal=j ,aMode=mode } ev = do - d <- liftIO getCurrentDay - -- c <- getContext - -- let h = c^.availHeightL - -- moveSel n l = listMoveBy n l + d <- liftIO getCurrentDay + -- c <- getContext + -- let h = c^.availHeightL + -- moveSel n l = listMoveBy n l - -- save the currently selected account, in case we leave this screen and lose the selection - let - selacct = case listSelectedElement $ scr ^. asList of - Just (_, AccountsScreenItem{..}) -> asItemAccountName - Nothing -> scr ^. asSelectedAccount - st = st'{aScreen=scr & asSelectedAccount .~ selacct} + -- save the currently selected account, in case we leave this screen and lose the selection + let + selacct = case listSelectedElement $ scr ^. asList of + Just (_, AccountsScreenItem{..}) -> asItemAccountName + Nothing -> scr ^. asSelectedAccount + st = st'{aScreen=scr & asSelectedAccount .~ selacct} - 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' - where s = chomp $ unlines $ getEditContents ed - ev -> do ed' <- handleEvent ev ed - continue $ st'{aMode=Minibuffer ed'} + case mode of + Minibuffer ed -> + case ev of + 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 - 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 (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 - Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st - Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st - Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st - Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st - Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st - Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st - Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st - Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st - Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st - Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st - Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st - Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st - Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st - Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st) - Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st) - Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st) - Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st) - Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st - Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st) - Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st - Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> scrollTopRegister >> continue (screenEnter d scr st) - where - scr = rsSetAccount selacct registerScreen + 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 + Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st + Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st + Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st + Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st + Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st + Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st + Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st + Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st + Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st + Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st + Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st + Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st + Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st + Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st) + Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st) + Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st) + Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st) + Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st + Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st) + Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st + Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> scrollTopRegister >> continue (screenEnter d scr st) + where + scr = rsSetAccount selacct registerScreen - -- fall through to the list's event handler (handles up/down) - ev -> do - newitems <- handleEvent ev (scr ^. asList) - continue $ st'{aScreen=scr & asList .~ newitems - & asSelectedAccount .~ selacct - } - -- continue =<< handleEventLensed st' someLens ev + -- fall through to the list's event handler (handles up/down) + ev -> do + newitems <- handleEvent ev (scr ^. asList) + continue $ st'{aScreen=scr & asList .~ newitems + & asSelectedAccount .~ selacct + } + -- continue =<< handleEventLensed st' someLens ev where -- Encourage a more stable scroll position when toggling list items. diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index ad19386f4..3dca91078 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -42,88 +42,61 @@ 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") - ] - - - -- 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) - + 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") + ] 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 - d <- liftIO getCurrentDay - case e of - Vty.EvKey (Vty.KChar 'q') [] -> halt st - Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st + ,aMode=mode + } ev = + case mode of + Help -> + case ev of + Vty.EvKey (Vty.KChar 'q') [] -> halt st + _ -> helpHandle st ev - Vty.EvKey (Vty.KChar 'g') [] -> do - (ej, _) <- liftIO $ journalReloadIfChanged copts d j - case ej of - Left err -> continue st{aScreen=s{esError=err}} -- show latest parse error - Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it + _ -> do + d <- liftIO getCurrentDay + 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 + Left err -> continue st{aScreen=s{esError=err}} -- show latest parse error + Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it - -- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st - -- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is - -- fall through to the list's event handler (handles [pg]up/down) - _ -> do continue st - -- is' <- handleEvent ev is - -- continue st{aScreen=s{rsState=is'}} - -- continue =<< handleEventLensed st someLens e + -- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st + -- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is + -- fall through to the list's event handler (handles [pg]up/down) + _ -> do continue st + -- is' <- handleEvent ev is + -- continue st{aScreen=s{rsState=is'}} + -- continue =<< handleEventLensed st someLens e esHandle _ _ = error "event handler called with wrong screen type, should not happen" -- If journal file(s) have changed, reload the journal and regenerate all screens. diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index d1988ee24..6959898b7 100644 --- 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 @@ -235,18 +230,23 @@ 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 - where s = chomp $ unlines $ getEditContents ed - ev -> do ed' <- handleEvent ev ed - continue $ st{aMode=Minibuffer ed'} + case ev of + 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" - diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index ce80bd14f..263f26462 100644 --- 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,84 +86,95 @@ 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) - ,tsTransactions=nts - ,tsAccount=acct} - ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} - ,ajournal=j - } - e = 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 - Vty.EvKey (Vty.KChar 'q') [] -> halt st - Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st +tsHandle st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t) + ,tsTransactions=nts + ,tsAccount=acct} + ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} + ,ajournal=j + ,aMode=mode + } + ev = + case mode of + Help -> + case ev of + Vty.EvKey (Vty.KChar 'q') [] -> halt st + _ -> helpHandle st ev - Vty.EvKey (Vty.KChar 'g') [] -> do + _ -> do d <- liftIO getCurrentDay - (ej, _) <- liftIO $ journalReloadIfChanged copts d j - case ej of - Right j' -> do - -- got to redo the register screen's transactions report, to get the latest transactions list for this screen - -- XXX duplicates rsInit - let - ropts' = ropts {depth_=Nothing - ,balancetype_=HistoricalBalance - } - q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts' - thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs - items = reverse $ snd $ accountTransactionsReport ropts j' q thisacctq - ts = map first6 items - numberedts = zip [1..] ts - -- select the best current transaction from the new list - -- stay at the same index if possible, or if we are now past the end, select the last, otherwise select the first - (i',t') = case lookup i numberedts - of Just t'' -> (i,t'') - Nothing | null numberedts -> (0,nulltransaction) - | i > fst (last numberedts) -> last numberedts - | otherwise -> head numberedts - st' = st{aScreen=s{tsTransaction=(i',t') - ,tsTransactions=numberedts - ,tsAccount=acct}} - continue $ regenerateScreens j' d st' + let + (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts + (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts + 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 + case ej of + Right j' -> do + -- got to redo the register screen's transactions report, to get the latest transactions list for this screen + -- XXX duplicates rsInit + let + ropts' = ropts {depth_=Nothing + ,balancetype_=HistoricalBalance + } + q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts' + thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs + items = reverse $ snd $ accountTransactionsReport ropts j' q thisacctq + ts = map first6 items + numberedts = zip [1..] ts + -- select the best current transaction from the new list + -- stay at the same index if possible, or if we are now past the end, select the last, otherwise select the first + (i',t') = case lookup i numberedts + of Just t'' -> (i,t'') + Nothing | null numberedts -> (0,nulltransaction) + | i > fst (last numberedts) -> last numberedts + | otherwise -> head numberedts + st' = st{aScreen=s{tsTransaction=(i',t') + ,tsTransactions=numberedts + ,tsAccount=acct}} + continue $ regenerateScreens j' d st' - Left err -> continue $ screenEnter d errorScreen{esError=err} st + Left err -> continue $ screenEnter d errorScreen{esError=err} st - -- if allowing toggling here, we should refresh the txn list from the parent register screen - -- Vty.EvKey (Vty.KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st - -- Vty.EvKey (Vty.KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared st - -- Vty.EvKey (Vty.KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal st + -- if allowing toggling here, we should refresh the txn list from the parent register screen + -- Vty.EvKey (Vty.KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st + -- Vty.EvKey (Vty.KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared st + -- Vty.EvKey (Vty.KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal st - Vty.EvKey (Vty.KUp) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(iprev,tprev)}} - Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(inext,tnext)}} + Vty.EvKey (Vty.KUp) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(iprev,tprev)}} + Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(inext,tnext)}} - Vty.EvKey (Vty.KLeft) [] -> continue st'' - where - st'@AppState{aScreen=scr} = popScreen st - st'' = st'{aScreen=rsSelect (fromIntegral i) scr} + Vty.EvKey (Vty.KLeft) [] -> continue st'' + where + st'@AppState{aScreen=scr} = popScreen st + st'' = st'{aScreen=rsSelect (fromIntegral i) scr} - _ev -> continue st + _ev -> continue st tsHandle _ _ = error "event handler called with wrong screen type, should not happen" diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index d674a4eb9..7b7b98593 100644 --- 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, diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 2f1d7ea44..e367b42df 100644 --- 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)