slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 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 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.

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{ -- 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.

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

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

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

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

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

@ -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,

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

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