slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Simon Michael 2016-06-10 11:50:57 -07:00
parent aa75cc69f6
commit ea180f72a0
6 changed files with 366 additions and 317 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

294
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -23,6 +23,7 @@ import System.FilePath (takeFileName)
import qualified Data.Vector as V import qualified Data.Vector as V
import Graphics.Vty as Vty import Graphics.Vty as Vty
import Brick import Brick
-- import Brick.Widgets.Center
import Brick.Widgets.List import Brick.Widgets.List
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Brick.Widgets.Border (borderAttr) import Brick.Widgets.Border (borderAttr)
@ -108,99 +109,97 @@ asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,aScreen=s@AccountsScreen{} ,aScreen=s@AccountsScreen{}
,aMode=mode ,aMode=mode
} = } =
[ui] case mode of
where Help -> [helpDialog, maincontent]
toplabel = files -- Minibuffer e -> [minibuffer e, maincontent]
<+> nonzero _ -> [maincontent]
<+> str " accounts" where
<+> borderQueryStr querystr toplabel = files
<+> togglefilters <+> nonzero
<+> borderDepthStr mdepth <+> str " accounts"
<+> str " (" <+> borderQueryStr querystr
<+> cur <+> togglefilters
<+> str "/" <+> borderDepthStr mdepth
<+> total <+> str " ("
<+> str ")" <+> cur
files = case journalFilePaths j of <+> str "/"
[] -> str "" <+> total
f:_ -> withAttr ("border" <> "bold") $ str $ takeFileName f <+> str ")"
-- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)" files = case journalFilePaths j of
-- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)") [] -> str ""
querystr = query_ ropts f:_ -> withAttr ("border" <> "bold") $ str $ takeFileName f
mdepth = depth_ ropts -- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)"
togglefilters = -- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)")
case concat [ querystr = query_ ropts
if cleared_ ropts then ["cleared"] else [] mdepth = depth_ ropts
,if uncleared_ ropts then ["uncleared"] else [] togglefilters =
,if pending_ ropts then ["pending"] else [] case concat [
,if real_ ropts then ["real"] else [] if cleared_ ropts then ["cleared"] else []
] of ,if uncleared_ ropts then ["uncleared"] else []
[] -> str "" ,if pending_ ropts then ["pending"] else []
fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" ,if real_ ropts then ["real"] else []
nonzero | empty_ ropts = str "" ] of
| otherwise = withAttr (borderAttr <> "query") (str " nonzero") [] -> str ""
cur = str (case s ^. asList ^. listSelectedL of -- XXX second ^. required here but not below.. fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns"
Nothing -> "-" nonzero | empty_ ropts = str ""
Just i -> show (i + 1)) | otherwise = withAttr (borderAttr <> "query") (str " nonzero")
total = str $ show $ V.length $ s ^. asList . listElementsL 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 [ -- XXX how to minimise the balance column's jumping around
-- ("up/down/pgup/pgdown/home/end", "move") -- as you change the depth limit ?
("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 colwidths = (acctwidth, balwidth)
Minibuffer ed -> minibuffer ed
_ -> bottomlabel
ui = Widget Greedy Greedy $ do render $ defaultLayout toplabel bottomlabel $ renderList (s ^. asList) (asDrawItem colwidths)
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
-- XXX how to minimise the balance column's jumping around where
-- as you change the depth limit ? bottomlabel = case mode of
Minibuffer ed -> minibuffer ed
colwidths = (acctwidth, balwidth) _ -> quickhelp
quickhelp = borderKeysStr [
render $ defaultLayout toplabel bottomarea $ renderList (s ^. asList) (asDrawItem colwidths) ("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" asDraw _ = error "draw function called with wrong screen type, should not happen"
@ -238,67 +237,72 @@ asHandle st'@AppState{
,ajournal=j ,ajournal=j
,aMode=mode ,aMode=mode
} ev = do } ev = do
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
-- c <- getContext -- c <- getContext
-- let h = c^.availHeightL -- let h = c^.availHeightL
-- moveSel n l = listMoveBy n l -- moveSel n l = listMoveBy n l
-- save the currently selected account, in case we leave this screen and lose the selection -- save the currently selected account, in case we leave this screen and lose the selection
let let
selacct = case listSelectedElement $ scr ^. asList of selacct = case listSelectedElement $ scr ^. asList of
Just (_, AccountsScreenItem{..}) -> asItemAccountName Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> scr ^. asSelectedAccount Nothing -> scr ^. asSelectedAccount
st = st'{aScreen=scr & asSelectedAccount .~ selacct} st = st'{aScreen=scr & asSelectedAccount .~ selacct}
case mode of case mode of
Minibuffer ed -> Minibuffer ed ->
case ev of case ev of
Vty.EvKey Vty.KEsc [] -> continue $ stHideMinibuffer st' Vty.EvKey Vty.KEsc [] -> continue $ stCloseMinibuffer st'
Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st' Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stCloseMinibuffer st'
where s = chomp $ unlines $ getEditContents ed where s = chomp $ unlines $ getEditContents ed
ev -> do ed' <- handleEvent ev ed ev -> do ed' <- handleEvent ev ed
continue $ st'{aMode=Minibuffer ed'} continue $ st'{aMode=Minibuffer ed'}
_ -> Help ->
case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st
_ -> helpHandle st ev
case ev of Normal ->
Vty.EvKey (Vty.KChar 'q') [] -> halt st case ev of
-- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st -- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do
Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st
Vty.EvKey (Vty.KChar 'a') [] -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> stReloadJournalIfChanged copts d j st Vty.EvKey k [] | k `elem` [Vty.KChar 'h', Vty.KChar '?'] -> continue $ setMode Help st
Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue
Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st 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 $ incDepth st Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st
Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st
Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st
Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st
Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st
Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st
Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st
Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st
Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st
Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st
Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st
Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st
Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st) Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st
Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st) Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st
Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st) Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st)
Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st) Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st)
Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st)
Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st) Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st)
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> scrollTopRegister >> continue (screenEnter d scr st) Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st)
where Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
scr = rsSetAccount selacct registerScreen 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) -- fall through to the list's event handler (handles up/down)
ev -> do ev -> do
newitems <- handleEvent ev (scr ^. asList) newitems <- handleEvent ev (scr ^. asList)
continue $ st'{aScreen=scr & asList .~ newitems continue $ st'{aScreen=scr & asList .~ newitems
& asSelectedAccount .~ selacct & asSelectedAccount .~ selacct
} }
-- continue =<< handleEventLensed st' someLens ev -- continue =<< handleEventLensed st' someLens ev
where where
-- Encourage a more stable scroll position when toggling list items. -- Encourage a more stable scroll position when toggling list items.

111
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -42,88 +42,61 @@ esInit _ _ _ = error "init function called with wrong screen type, should not ha
esDraw :: AppState -> [Widget] esDraw :: AppState -> [Widget]
esDraw AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, 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 where
toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload") toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload")
-- <+> str " transactions" maincontent = Widget Greedy Greedy $ do
-- <+> 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)
render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError 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" 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 :: AppState -> Vty.Event -> EventM (Next AppState)
esHandle st@AppState{ esHandle st@AppState{
aScreen=s@ErrorScreen{} aScreen=s@ErrorScreen{}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
} e = do ,aMode=mode
d <- liftIO getCurrentDay } ev =
case e of case mode of
Vty.EvKey (Vty.KChar 'q') [] -> halt st Help ->
Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st
_ -> helpHandle st ev
Vty.EvKey (Vty.KChar 'g') [] -> do _ -> do
(ej, _) <- liftIO $ journalReloadIfChanged copts d j d <- liftIO getCurrentDay
case ej of case ev of
Left err -> continue st{aScreen=s{esError=err}} -- show latest parse error Vty.EvKey (Vty.KChar 'q') [] -> halt st
Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it 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.KLeft) [] -> continue $ popScreen st
-- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is -- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is
-- fall through to the list's event handler (handles [pg]up/down) -- fall through to the list's event handler (handles [pg]up/down)
_ -> do continue st _ -> do continue st
-- is' <- handleEvent ev is -- is' <- handleEvent ev is
-- continue st{aScreen=s{rsState=is'}} -- continue st{aScreen=s{rsState=is'}}
-- continue =<< handleEventLensed st someLens e -- continue =<< handleEventLensed st someLens e
esHandle _ _ = error "event handler called with wrong screen type, should not happen" 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. -- If journal file(s) have changed, reload the journal and regenerate all screens.

61
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -103,8 +103,11 @@ rsDraw :: AppState -> [Widget]
rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,aScreen=RegisterScreen{..} ,aScreen=RegisterScreen{..}
,aMode=mode ,aMode=mode
} } =
= [ui] case mode of
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where where
toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount) toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount)
<+> togglefilters <+> togglefilters
@ -134,17 +137,14 @@ rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
-- query = query_ $ reportopts_ $ cliopts_ opts -- query = query_ $ reportopts_ $ cliopts_ opts
ui = Widget Greedy Greedy $ do maincontent = Widget Greedy Greedy $ do
-- calculate column widths, based on current available width -- calculate column widths, based on current available width
c <- getContext c <- getContext
let let
totalwidth = c^.availWidthL totalwidth = c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
-- the date column is fixed width -- the date column is fixed width
datewidth = 10 datewidth = 10
-- multi-commodity amounts rendered on one line can be -- multi-commodity amounts rendered on one line can be
-- arbitrarily wide. Give the two amounts as much space as -- arbitrarily wide. Give the two amounts as much space as
-- they need, while reserving a minimum of space for other -- 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 maxbalwidth = maxamtswidth - maxchangewidth
changewidth = min maxchangewidth maxchangewidthseen changewidth = min maxchangewidth maxchangewidthseen
balwidth = min maxbalwidth maxbalwidthseen balwidth = min maxbalwidth maxbalwidthseen
-- assign the remaining space to the description and accounts columns -- assign the remaining space to the description and accounts columns
-- maxdescacctswidth = totalwidth - (whitespacewidth - 4) - changewidth - balwidth -- maxdescacctswidth = totalwidth - (whitespacewidth - 4) - changewidth - balwidth
maxdescacctswidth = maxdescacctswidth =
@ -179,28 +178,24 @@ rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
acctswidth = maxdescacctswidth - descwidth acctswidth = maxdescacctswidth - descwidth
colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth) colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth)
bottomlabel = borderKeysStr [ render $ defaultLayout toplabel bottomlabel $ renderList rsList (rsDrawItem colwidths)
-- ("up/down/pgup/pgdown/home/end", "move")
("left", "back") where
,("a", "add") bottomlabel = case mode of
,("E", "nonzero?") Minibuffer ed -> minibuffer ed
,("C", "cleared?") _ -> quickhelp
,("U", "uncleared?") quickhelp = borderKeysStr [
,("R", "real?") ("h", "help")
,("left", "back")
,("right", "transaction")
,("/", "filter") ,("/", "filter")
,("DEL", "unfilter") ,("DEL", "unfilter")
,("right/enter", "transaction") --,("ESC", "reset")
,("ESC", "cancel/top") ,("a", "add")
,("g", "reload") ,("g", "reload")
,("q", "quit") ,("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" rsDraw _ = error "draw function called with wrong screen type, should not happen"
rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget
@ -235,18 +230,23 @@ rsHandle st@AppState{
case mode of case mode of
Minibuffer ed -> Minibuffer ed ->
case ev of case ev of
Vty.EvKey Vty.KEsc [] -> continue $ stHideMinibuffer st Vty.EvKey Vty.KEsc [] -> continue $ stCloseMinibuffer st
Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stCloseMinibuffer st
where s = chomp $ unlines $ getEditContents ed where s = chomp $ unlines $ getEditContents ed
ev -> do ed' <- handleEvent ev ed ev -> do ed' <- handleEvent ev ed
continue $ st{aMode=Minibuffer ed'} continue $ st{aMode=Minibuffer ed'}
_ -> Help ->
case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st
_ -> helpHandle st ev
Normal ->
case ev of case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d 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 '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 '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) Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st)
@ -281,4 +281,3 @@ rsHandle st@AppState{
scrollTop = vScrollToBeginning $ viewportScroll "register" scrollTop = vScrollToBeginning $ viewportScroll "register"
rsHandle _ _ = error "event handler called with wrong screen type, should not happen" rsHandle _ _ = error "event handler called with wrong screen type, should not happen"

145
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -57,8 +57,12 @@ tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,aScreen=TransactionScreen{ ,aScreen=TransactionScreen{
tsTransaction=(i,t) tsTransaction=(i,t)
,tsTransactions=nts ,tsTransactions=nts
,tsAccount=acct}} = ,tsAccount=acct}
[ui] ,aMode=mode} =
case mode of
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where where
-- datedesc = show (tdate t) ++ " " ++ tdescription t -- datedesc = show (tdate t) ++ " " ++ tdescription t
toplabel = toplabel =
@ -82,84 +86,95 @@ tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
] of ] of
[] -> str "" [] -> str ""
fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs) fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs)
bottomlabel = borderKeysStr [ maincontent = Widget Greedy Greedy $ do
("left", "back")
,("up/down", "prev/next")
-- ,("C", "cleared?")
-- ,("U", "uncleared?")
-- ,("R", "real?")
,("g", "reload")
,("q", "quit")
]
ui = Widget Greedy Greedy $ do
render $ defaultLayout toplabel bottomlabel $ str $ render $ defaultLayout toplabel bottomlabel $ str $
showTransactionUnelidedOneLineAmounts $ showTransactionUnelidedOneLineAmounts $
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
t 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" tsDraw _ = error "draw function called with wrong screen type, should not happen"
tsHandle :: AppState -> Vty.Event -> EventM (Next AppState) tsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
tsHandle tsHandle st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t) ,tsTransactions=nts
,tsTransactions=nts ,tsAccount=acct}
,tsAccount=acct} ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,ajournal=j
,ajournal=j ,aMode=mode
} }
e = do ev =
d <- liftIO getCurrentDay case mode of
let Help ->
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts case ev of
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts Vty.EvKey (Vty.KChar 'q') [] -> halt st
case e of _ -> helpHandle st ev
Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st
Vty.EvKey (Vty.KChar 'g') [] -> do _ -> do
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
(ej, _) <- liftIO $ journalReloadIfChanged copts d j let
case ej of (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
Right j' -> do (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
-- got to redo the register screen's transactions report, to get the latest transactions list for this screen case ev of
-- XXX duplicates rsInit Vty.EvKey (Vty.KChar 'q') [] -> halt st
let Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st
ropts' = ropts {depth_=Nothing Vty.EvKey k [] | k `elem` [Vty.KChar 'h', Vty.KChar '?'] -> continue $ setMode Help st
,balancetype_=HistoricalBalance Vty.EvKey (Vty.KChar 'g') [] -> do
} d <- liftIO getCurrentDay
q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts' (ej, _) <- liftIO $ journalReloadIfChanged copts d j
thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs case ej of
items = reverse $ snd $ accountTransactionsReport ropts j' q thisacctq Right j' -> do
ts = map first6 items -- got to redo the register screen's transactions report, to get the latest transactions list for this screen
numberedts = zip [1..] ts -- XXX duplicates rsInit
-- select the best current transaction from the new list let
-- stay at the same index if possible, or if we are now past the end, select the last, otherwise select the first ropts' = ropts {depth_=Nothing
(i',t') = case lookup i numberedts ,balancetype_=HistoricalBalance
of Just t'' -> (i,t'') }
Nothing | null numberedts -> (0,nulltransaction) q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts'
| i > fst (last numberedts) -> last numberedts thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
| otherwise -> head numberedts items = reverse $ snd $ accountTransactionsReport ropts j' q thisacctq
st' = st{aScreen=s{tsTransaction=(i',t') ts = map first6 items
,tsTransactions=numberedts numberedts = zip [1..] ts
,tsAccount=acct}} -- select the best current transaction from the new list
continue $ regenerateScreens j' d st' -- 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 -- 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 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st
-- Vty.EvKey (Vty.KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared 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.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.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.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(inext,tnext)}}
Vty.EvKey (Vty.KLeft) [] -> continue st'' Vty.EvKey (Vty.KLeft) [] -> continue st''
where where
st'@AppState{aScreen=scr} = popScreen st st'@AppState{aScreen=scr} = popScreen st
st'' = st'{aScreen=rsSelect (fromIntegral i) scr} 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" tsHandle _ _ = error "event handler called with wrong screen type, should not happen"

6
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -73,7 +73,11 @@ data Mode =
Normal Normal
| Help | Help
| Minibuffer Editor | Minibuffer Editor
deriving (Show) deriving (Show,Eq)
-- Ignore the editor when comparing Modes.
instance Eq Editor where _ == _ = True
-- | hledger-ui screen types & instances. -- | hledger-ui screen types & instances.
-- Each screen type has generically named initialisation, draw, and event handling functions, -- Each screen type has generically named initialisation, draw, and event handling functions,

66
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -28,7 +28,7 @@ module Hledger.UI.UIUtils
-- ,stFilter -- ,stFilter
-- ,stResetFilter -- ,stResetFilter
-- ,stShowMinibuffer -- ,stShowMinibuffer
-- ,stHideMinibuffer -- ,stCloseMinibuffer
-- ) -- )
where where
@ -41,6 +41,7 @@ import Data.Monoid
import Data.Text.Zipper (gotoEOL) import Data.Text.Zipper (gotoEOL)
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Brick import Brick
import Brick.Widgets.Dialog
-- import Brick.Widgets.List -- import Brick.Widgets.List
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Brick.Widgets.Border import Brick.Widgets.Border
@ -153,14 +154,17 @@ setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_
| depth >= maxDepth st = Nothing | depth >= maxDepth st = Nothing
| otherwise = Just depth | otherwise = Just depth
-- | Enable the minibuffer, setting its content to the current query with the cursor at the end. -- | Open the minibuffer, setting its content to the current query with the cursor at the end.
stShowMinibuffer st = st{aMode=Minibuffer e} stShowMinibuffer st = setMode (Minibuffer e) st
where where
e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq
oldq = query_ $ reportopts_ $ cliopts_ $ aopts st oldq = query_ $ reportopts_ $ cliopts_ $ aopts st
-- | Disable the minibuffer, discarding any edit in progress. -- | Close the minibuffer, discarding any edit in progress.
stHideMinibuffer st = st{aMode=Normal} 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. -- | Regenerate the content for the current and previous screens, from a new journal and current date.
regenerateScreens :: Journal -> Day -> AppState -> AppState regenerateScreens :: Journal -> Day -> AppState -> AppState
@ -188,7 +192,7 @@ popScreen st = st
resetScreens :: Day -> AppState -> AppState resetScreens :: Day -> AppState -> AppState
resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} = 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 where
topscreen = case ss of _:_ -> last ss topscreen = case ss of _:_ -> last ss
[] -> s [] -> s
@ -203,6 +207,56 @@ screenEnter d scr st = (sInit scr) d True $
pushScreen scr pushScreen scr
st 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, -- | In the EventM monad, get the named current viewport's width and height,
-- or (0,0) if the named viewport is not found. -- or (0,0) if the named viewport is not found.
getViewportSize :: Name -> EventM (Int,Int) getViewportSize :: Name -> EventM (Int,Int)