mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
pkg: ui: use/require brick 1.0+ (#1889)
This commit is contained in:
parent
b636eb78a9
commit
2a594b7fb7
@ -152,7 +152,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
|||||||
ishistorical = balanceaccum_ ropts == Historical
|
ishistorical = balanceaccum_ ropts == Historical
|
||||||
|
|
||||||
toplabel =
|
toplabel =
|
||||||
withAttr ("border" <> "filename") files
|
withAttr (attrName "border" <> attrName "filename") files
|
||||||
<+> toggles
|
<+> toggles
|
||||||
<+> str (" account " ++ if ishistorical then "balances" else "changes")
|
<+> str (" account " ++ if ishistorical then "balances" else "changes")
|
||||||
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
|
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
|
||||||
@ -160,7 +160,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
|||||||
<+> borderDepthStr mdepth
|
<+> borderDepthStr mdepth
|
||||||
<+> str (" ("++curidx++"/"++totidx++")")
|
<+> str (" ("++curidx++"/"++totidx++")")
|
||||||
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
|
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
|
||||||
then withAttr ("border" <> "query") (str " ignoring balance assertions")
|
then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions")
|
||||||
else str "")
|
else str "")
|
||||||
where
|
where
|
||||||
files = case journalFilePaths j of
|
files = case journalFilePaths j of
|
||||||
@ -168,7 +168,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
|||||||
f:_ -> str $ takeFileName f
|
f:_ -> str $ takeFileName f
|
||||||
-- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)"
|
-- [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)")
|
-- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)")
|
||||||
toggles = withAttr ("border" <> "query") $ str $ unwords $ concat [
|
toggles = withAttr (attrName "border" <> attrName "query") $ str $ unwords $ concat [
|
||||||
[""]
|
[""]
|
||||||
,if empty_ ropts then [] else ["nonzero"]
|
,if empty_ ropts then [] else ["nonzero"]
|
||||||
,uiShowStatus copts $ statuses_ ropts
|
,uiShowStatus copts $ statuses_ ropts
|
||||||
@ -220,22 +220,24 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
|||||||
balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " "
|
balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " "
|
||||||
splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText
|
splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText
|
||||||
renderamt :: T.Text -> Widget Name
|
renderamt :: T.Text -> Widget Name
|
||||||
renderamt a | T.any (=='-') a = withAttr (sel $ "list" <> "balance" <> "negative") $ txt a
|
renderamt a | T.any (=='-') a = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "negative") $ txt a
|
||||||
| otherwise = withAttr (sel $ "list" <> "balance" <> "positive") $ txt a
|
| otherwise = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "positive") $ txt a
|
||||||
sel | selected = (<> "selected")
|
sel | selected = (<> attrName "selected")
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
|
||||||
asHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
asHandle ui0@UIState{
|
asHandle ev = do
|
||||||
|
ui0@UIState{
|
||||||
aScreen=scr@AccountsScreen{..}
|
aScreen=scr@AccountsScreen{..}
|
||||||
,aopts=UIOpts{uoCliOpts=copts}
|
,aopts=UIOpts{uoCliOpts=copts}
|
||||||
,ajournal=j
|
,ajournal=j
|
||||||
,aMode=mode
|
,aMode=mode
|
||||||
} ev = do
|
} <- get -- PARTIAL: should not fail
|
||||||
let
|
let
|
||||||
d = copts^.rsDay
|
d = copts^.rsDay
|
||||||
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
|
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
|
||||||
lastnonblankidx = max 0 (length nonblanks - 1)
|
lastnonblankidx = max 0 (length nonblanks - 1)
|
||||||
|
journalspan = journalDateSpan False j
|
||||||
|
|
||||||
-- 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
|
||||||
@ -247,87 +249,81 @@ asHandle ui0@UIState{
|
|||||||
case mode of
|
case mode of
|
||||||
Minibuffer _ ed ->
|
Minibuffer _ ed ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey KEsc []) -> continue $ closeMinibuffer ui
|
VtyEvent (EvKey KEsc []) -> put $ closeMinibuffer ui
|
||||||
VtyEvent (EvKey KEnter []) -> continue $ regenerateScreens j d $
|
VtyEvent (EvKey KEnter []) -> put $ regenerateScreens j d $
|
||||||
case setFilter s $ closeMinibuffer ui of
|
case setFilter s $ closeMinibuffer ui of
|
||||||
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
|
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
|
||||||
Right ui' -> ui'
|
Right ui' -> ui'
|
||||||
where s = chomp $ unlines $ map strip $ getEditContents ed
|
where s = chomp $ unlines $ map strip $ getEditContents ed
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
VtyEvent ev -> do
|
VtyEvent ev -> do
|
||||||
ed' <- handleEditorEvent
|
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
||||||
#if MIN_VERSION_brick(0,72,0)
|
put ui{aMode=Minibuffer "filter" ed'}
|
||||||
(VtyEvent ev)
|
AppEvent _ -> return ()
|
||||||
#else
|
MouseDown{} -> return ()
|
||||||
ev
|
MouseUp{} -> return ()
|
||||||
#endif
|
|
||||||
ed
|
|
||||||
continue $ ui{aMode=Minibuffer "filter" ed'}
|
|
||||||
AppEvent _ -> continue ui
|
|
||||||
MouseDown{} -> continue ui
|
|
||||||
MouseUp{} -> continue ui
|
|
||||||
|
|
||||||
Help ->
|
Help ->
|
||||||
case ev of
|
case ev of
|
||||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
_ -> helpHandle ui ev
|
_ -> helpHandle ev
|
||||||
|
|
||||||
Normal ->
|
Normal ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
-- EvKey (KChar 'l') [MCtrl] -> do
|
-- EvKey (KChar 'l') [MCtrl] -> do
|
||||||
VtyEvent (EvKey KEsc []) -> continue $ resetScreens d ui
|
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> continue $ setMode Help ui
|
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||||
-- XXX AppEvents currently handled only in Normal mode
|
-- XXX AppEvents currently handled only in Normal mode
|
||||||
-- XXX be sure we don't leave unconsumed events piling up
|
-- XXX be sure we don't leave unconsumed events piling up
|
||||||
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
||||||
continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||||
where
|
where
|
||||||
p = reportPeriod ui
|
p = reportPeriod ui
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||||
liftIO (uiReloadJournal copts d ui) >>= continue
|
liftIO (uiReloadJournal copts d ui) >>= put
|
||||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||||
VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
|
||||||
VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
|
||||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor endPosition (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor endPosition (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
|
||||||
VtyEvent (EvKey (KChar 'B') []) -> continue $ regenerateScreens j d $ toggleConversionOp ui
|
VtyEvent (EvKey (KChar 'B') []) -> put $ regenerateScreens j d $ toggleConversionOp ui
|
||||||
VtyEvent (EvKey (KChar 'V') []) -> continue $ regenerateScreens j d $ toggleValue ui
|
VtyEvent (EvKey (KChar 'V') []) -> put $ regenerateScreens j d $ toggleValue ui
|
||||||
VtyEvent (EvKey (KChar '0') []) -> continue $ regenerateScreens j d $ setDepth (Just 0) ui
|
VtyEvent (EvKey (KChar '0') []) -> put $ regenerateScreens j d $ setDepth (Just 0) ui
|
||||||
VtyEvent (EvKey (KChar '1') []) -> continue $ regenerateScreens j d $ setDepth (Just 1) ui
|
VtyEvent (EvKey (KChar '1') []) -> put $ regenerateScreens j d $ setDepth (Just 1) ui
|
||||||
VtyEvent (EvKey (KChar '2') []) -> continue $ regenerateScreens j d $ setDepth (Just 2) ui
|
VtyEvent (EvKey (KChar '2') []) -> put $ regenerateScreens j d $ setDepth (Just 2) ui
|
||||||
VtyEvent (EvKey (KChar '3') []) -> continue $ regenerateScreens j d $ setDepth (Just 3) ui
|
VtyEvent (EvKey (KChar '3') []) -> put $ regenerateScreens j d $ setDepth (Just 3) ui
|
||||||
VtyEvent (EvKey (KChar '4') []) -> continue $ regenerateScreens j d $ setDepth (Just 4) ui
|
VtyEvent (EvKey (KChar '4') []) -> put $ regenerateScreens j d $ setDepth (Just 4) ui
|
||||||
VtyEvent (EvKey (KChar '5') []) -> continue $ regenerateScreens j d $ setDepth (Just 5) ui
|
VtyEvent (EvKey (KChar '5') []) -> put $ regenerateScreens j d $ setDepth (Just 5) ui
|
||||||
VtyEvent (EvKey (KChar '6') []) -> continue $ regenerateScreens j d $ setDepth (Just 6) ui
|
VtyEvent (EvKey (KChar '6') []) -> put $ regenerateScreens j d $ setDepth (Just 6) ui
|
||||||
VtyEvent (EvKey (KChar '7') []) -> continue $ regenerateScreens j d $ setDepth (Just 7) ui
|
VtyEvent (EvKey (KChar '7') []) -> put $ regenerateScreens j d $ setDepth (Just 7) ui
|
||||||
VtyEvent (EvKey (KChar '8') []) -> continue $ regenerateScreens j d $ setDepth (Just 8) ui
|
VtyEvent (EvKey (KChar '8') []) -> put $ regenerateScreens j d $ setDepth (Just 8) ui
|
||||||
VtyEvent (EvKey (KChar '9') []) -> continue $ regenerateScreens j d $ setDepth (Just 9) ui
|
VtyEvent (EvKey (KChar '9') []) -> put $ regenerateScreens j d $ setDepth (Just 9) ui
|
||||||
VtyEvent (EvKey (KChar '-') []) -> continue $ regenerateScreens j d $ decDepth ui
|
VtyEvent (EvKey (KChar '-') []) -> put $ regenerateScreens j d $ decDepth ui
|
||||||
VtyEvent (EvKey (KChar '_') []) -> continue $ regenerateScreens j d $ decDepth ui
|
VtyEvent (EvKey (KChar '_') []) -> put $ regenerateScreens j d $ decDepth ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> continue $ regenerateScreens j d $ incDepth ui
|
VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> put $ regenerateScreens j d $ incDepth ui
|
||||||
VtyEvent (EvKey (KChar 'T') []) -> continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
VtyEvent (EvKey (KChar 'T') []) -> put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||||
|
|
||||||
-- display mode/query toggles
|
-- display mode/query toggles
|
||||||
VtyEvent (EvKey (KChar 'H') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui
|
VtyEvent (EvKey (KChar 'H') []) -> modify (regenerateScreens j d . toggleHistorical) >> asCenterAndContinue
|
||||||
VtyEvent (EvKey (KChar 't') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleTree ui
|
VtyEvent (EvKey (KChar 't') []) -> modify (regenerateScreens j d . toggleTree) >> asCenterAndContinue
|
||||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> asCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui
|
VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify (regenerateScreens j d . toggleEmpty) >> asCenterAndContinue
|
||||||
VtyEvent (EvKey (KChar 'R') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleReal ui
|
VtyEvent (EvKey (KChar 'R') []) -> modify (regenerateScreens j d . toggleReal) >> asCenterAndContinue
|
||||||
VtyEvent (EvKey (KChar 'U') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
|
VtyEvent (EvKey (KChar 'U') []) -> modify (regenerateScreens j d . toggleUnmarked) >> asCenterAndContinue
|
||||||
VtyEvent (EvKey (KChar 'P') []) -> asCenterAndContinue $ regenerateScreens j d $ togglePending ui
|
VtyEvent (EvKey (KChar 'P') []) -> modify (regenerateScreens j d . togglePending) >> asCenterAndContinue
|
||||||
VtyEvent (EvKey (KChar 'C') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
|
VtyEvent (EvKey (KChar 'C') []) -> modify (regenerateScreens j d . toggleCleared) >> asCenterAndContinue
|
||||||
VtyEvent (EvKey (KChar 'F') []) -> continue $ regenerateScreens j d $ toggleForecast d ui
|
VtyEvent (EvKey (KChar 'F') []) -> modify (regenerateScreens j d . toggleForecast d)
|
||||||
|
|
||||||
VtyEvent (EvKey (KDown) [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui
|
VtyEvent (EvKey (KDown) [MShift]) -> put $ regenerateScreens j d $ shrinkReportPeriod d ui
|
||||||
VtyEvent (EvKey (KUp) [MShift]) -> continue $ regenerateScreens j d $ growReportPeriod d ui
|
VtyEvent (EvKey (KUp) [MShift]) -> put $ regenerateScreens j d $ growReportPeriod d ui
|
||||||
VtyEvent (EvKey (KRight) [MShift]) -> continue $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
VtyEvent (EvKey (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
||||||
VtyEvent (EvKey (KLeft) [MShift]) -> continue $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
VtyEvent (EvKey (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
||||||
VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
||||||
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
|
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui)
|
||||||
VtyEvent e | e `elem` moveLeftEvents -> continue $ popScreen ui
|
VtyEvent e | e `elem` moveLeftEvents -> put $ popScreen ui
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
|
|
||||||
-- enter register screen for selected account (if there is one),
|
-- enter register screen for selected account (if there is one),
|
||||||
@ -338,7 +334,7 @@ asHandle ui0@UIState{
|
|||||||
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
||||||
-- just use it to move the selection
|
-- just use it to move the selection
|
||||||
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
||||||
continue ui{aScreen=scr{_asList=listMoveTo y _asList}}
|
case scr of AccountsScreen{} -> put ui{aScreen=scr}; _ -> fail "" -- PARTIAL: should not happen
|
||||||
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
|
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
|
||||||
-- and on MouseUp, enter the subscreen
|
-- and on MouseUp, enter the subscreen
|
||||||
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
||||||
@ -347,42 +343,35 @@ asHandle ui0@UIState{
|
|||||||
|
|
||||||
-- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
|
-- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
|
||||||
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
|
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
|
||||||
vScrollBy (viewportScroll $ _asList^.listNameL) 1 >> continue ui
|
vScrollBy (viewportScroll $ _asList^.listNameL) 1 >> put ui
|
||||||
where mnextelement = listSelectedElement $ listMoveDown _asList
|
where mnextelement = listSelectedElement $ listMoveDown _asList
|
||||||
|
|
||||||
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
|
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
|
||||||
-- pushing the selection when necessary.
|
-- pushing the selection when necessary.
|
||||||
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
||||||
let scrollamt = if btn==BScrollUp then -1 else 1
|
let scrollamt = if btn==BScrollUp then -1 else 1
|
||||||
list' <- listScrollPushingSelection name _asList (asListSize _asList) scrollamt
|
list' <- nestEventM' _asList $ listScrollPushingSelection name (asListSize _asList) scrollamt
|
||||||
continue ui{aScreen=scr{_asList=list'}}
|
case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list'}}; _ -> fail "" -- PARTIAL: should not fail
|
||||||
|
|
||||||
-- if page down or end leads to a blank padding item, stop at last non-blank
|
-- if page down or end leads to a blank padding item, stop at last non-blank
|
||||||
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
||||||
list <- handleListEvent e _asList
|
list <- nestEventM' _asList $ handleListEvent e
|
||||||
if isBlankElement $ listSelectedElement list
|
if isBlankElement $ listSelectedElement list
|
||||||
then do
|
then do
|
||||||
let list' = listMoveTo lastnonblankidx list
|
let list' = listMoveTo lastnonblankidx list
|
||||||
scrollSelectionToMiddle list'
|
scrollSelectionToMiddle list'
|
||||||
continue ui{aScreen=scr{_asList=list'}}
|
case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list'}}; _ -> fail "" -- PARTIAL: should not fail
|
||||||
else
|
else
|
||||||
continue ui{aScreen=scr{_asList=list}}
|
case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list}}; _ -> fail "" -- PARTIAL: should not fail
|
||||||
|
|
||||||
-- fall through to the list's event handler (handles up/down)
|
-- fall through to the list's event handler (handles up/down)
|
||||||
VtyEvent ev -> do
|
VtyEvent ev -> do
|
||||||
newitems <- handleListEvent (normaliseMovementKeys ev) _asList
|
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys ev)
|
||||||
continue $ ui{aScreen=scr & asList .~ newitems
|
put $ ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct }
|
||||||
& asSelectedAccount .~ selacct
|
|
||||||
}
|
|
||||||
|
|
||||||
MouseDown{} -> continue ui
|
MouseDown{} -> put ui
|
||||||
MouseUp{} -> continue ui
|
MouseUp{} -> put ui
|
||||||
AppEvent _ -> continue ui
|
AppEvent _ -> put ui
|
||||||
|
|
||||||
where
|
|
||||||
journalspan = journalDateSpan False j
|
|
||||||
|
|
||||||
asHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
|
||||||
|
|
||||||
asEnterRegister d selacct ui = do
|
asEnterRegister d selacct ui = do
|
||||||
rsCenterAndContinue $
|
rsCenterAndContinue $
|
||||||
@ -399,8 +388,9 @@ asSetSelectedAccount _ s = s
|
|||||||
|
|
||||||
isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
|
isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
|
||||||
|
|
||||||
asCenterAndContinue ui = do
|
asCenterAndContinue :: EventM Name UIState ()
|
||||||
scrollSelectionToMiddle $ _asList $ aScreen ui
|
asCenterAndContinue = do
|
||||||
continue ui
|
ui <- get
|
||||||
|
scrollSelectionToMiddle (_asList $ aScreen ui)
|
||||||
|
|
||||||
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements
|
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements
|
||||||
|
@ -54,10 +54,10 @@ esDraw UIState{aopts=UIOpts{uoCliOpts=copts}
|
|||||||
_ -> [maincontent]
|
_ -> [maincontent]
|
||||||
where
|
where
|
||||||
maincontent = Widget Greedy Greedy $ do
|
maincontent = Widget Greedy Greedy $ do
|
||||||
render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError
|
render $ defaultLayout toplabel bottomlabel $ withAttr (attrName "error") $ str $ esError
|
||||||
where
|
where
|
||||||
toplabel =
|
toplabel =
|
||||||
withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload")
|
withAttr (attrName "border" <> attrName "bold") (str "Oops. Please fix this problem then press g to reload")
|
||||||
-- <+> (if ignore_assertions_ copts then withAttr ("border" <> "query") (str " ignoring") else str " not ignoring")
|
-- <+> (if ignore_assertions_ copts then withAttr ("border" <> "query") (str " ignoring") else str " not ignoring")
|
||||||
|
|
||||||
bottomlabel = quickhelp
|
bottomlabel = quickhelp
|
||||||
@ -75,44 +75,42 @@ esDraw UIState{aopts=UIOpts{uoCliOpts=copts}
|
|||||||
|
|
||||||
esDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
esDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
||||||
|
|
||||||
esHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
esHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
esHandle ui@UIState{aScreen=ErrorScreen{..}
|
esHandle ev = do
|
||||||
|
ui@UIState{aScreen=ErrorScreen{..}
|
||||||
,aopts=UIOpts{uoCliOpts=copts}
|
,aopts=UIOpts{uoCliOpts=copts}
|
||||||
,ajournal=j
|
,ajournal=j
|
||||||
,aMode=mode
|
,aMode=mode
|
||||||
}
|
} <- get
|
||||||
ev =
|
|
||||||
case mode of
|
case mode of
|
||||||
Help ->
|
Help ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
_ -> helpHandle ui ev
|
_ -> helpHandle ev
|
||||||
|
|
||||||
_ -> do
|
_ -> do
|
||||||
let d = copts^.rsDay
|
let d = copts^.rsDay
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey KEsc []) -> continue $ uiCheckBalanceAssertions d $ resetScreens d ui
|
VtyEvent (EvKey KEsc []) -> put $ uiCheckBalanceAssertions d $ resetScreens d ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['h','?'] -> continue $ setMode Help ui
|
VtyEvent (EvKey (KChar c) []) | c `elem` ['h','?'] -> put $ setMode Help ui
|
||||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j (popScreen ui)
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j (popScreen ui)
|
||||||
where
|
where
|
||||||
(pos,f) = case parsewithString hledgerparseerrorpositionp esError of
|
(pos,f) = case parsewithString hledgerparseerrorpositionp esError of
|
||||||
Right (f,l,c) -> (Just (l, Just c),f)
|
Right (f,l,c) -> (Just (l, Just c),f)
|
||||||
Left _ -> (endPosition, journalFilePath j)
|
Left _ -> (endPosition, journalFilePath j)
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||||
liftIO (uiReloadJournal copts d (popScreen ui)) >>= continue . uiCheckBalanceAssertions d
|
liftIO (uiReloadJournal copts d (popScreen ui)) >>= put . uiCheckBalanceAssertions d
|
||||||
-- (ej, _) <- liftIO $ journalReloadIfChanged copts d j
|
-- (ej, _) <- liftIO $ journalReloadIfChanged copts d j
|
||||||
-- case ej of
|
-- case ej of
|
||||||
-- Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error
|
-- Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error
|
||||||
-- Right j' -> continue $ regenerateScreens j' d $ popScreen ui -- return to previous screen, and reload it
|
-- Right j' -> continue $ regenerateScreens j' d $ popScreen ui -- return to previous screen, and reload it
|
||||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui)
|
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui)
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
_ -> continue ui
|
_ -> return ()
|
||||||
|
|
||||||
esHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
|
||||||
|
|
||||||
-- | Parse the file name, line and column number from a hledger parse error message, if possible.
|
-- | Parse the file name, line and column number from a hledger parse error message, if possible.
|
||||||
-- Temporary, we should keep the original parse error location. XXX
|
-- Temporary, we should keep the original parse error location. XXX
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
-- TODO: brick 1 support
|
||||||
|
-- https://hackage.haskell.org/package/brick-1.0/changelog
|
||||||
{-|
|
{-|
|
||||||
hledger-ui - a hledger add-on providing a curses-style interface.
|
hledger-ui - a hledger add-on providing a curses-style interface.
|
||||||
Copyright (c) 2007-2015 Simon Michael <simon@joyful.com>
|
Copyright (c) 2007-2015 Simon Michael <simon@joyful.com>
|
||||||
@ -159,11 +161,11 @@ runBrickUi uopts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=rs
|
|||||||
|
|
||||||
brickapp :: App UIState AppEvent Name
|
brickapp :: App UIState AppEvent Name
|
||||||
brickapp = App {
|
brickapp = App {
|
||||||
appStartEvent = return
|
appStartEvent = return ()
|
||||||
, appAttrMap = const $ fromMaybe defaultTheme $ getTheme =<< uoTheme uopts'
|
, appAttrMap = const $ fromMaybe defaultTheme $ getTheme =<< uoTheme uopts'
|
||||||
, appChooseCursor = showFirstCursor
|
, appChooseCursor = showFirstCursor
|
||||||
, appHandleEvent = \ui ev -> sHandle (aScreen ui) ui ev
|
, appHandleEvent = sHandle (aScreen ui)
|
||||||
, appDraw = \ui -> sDraw (aScreen ui) ui
|
, appDraw = sDraw (aScreen ui)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit
|
-- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit
|
||||||
|
@ -4,7 +4,6 @@
|
|||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
|
||||||
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
|
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
|
||||||
|
|
||||||
module Hledger.UI.RegisterScreen
|
module Hledger.UI.RegisterScreen
|
||||||
@ -199,7 +198,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
|||||||
-- inclusive = tree_ ropts || rsForceInclusive
|
-- inclusive = tree_ ropts || rsForceInclusive
|
||||||
|
|
||||||
toplabel =
|
toplabel =
|
||||||
withAttr ("border" <> "bold") (str $ T.unpack $ replaceHiddenAccountsNameWith "All" rsAccount)
|
withAttr (attrName "border" <> attrName "bold") (str $ T.unpack $ replaceHiddenAccountsNameWith "All" rsAccount)
|
||||||
-- <+> withAttr ("border" <> "query") (str $ if inclusive then "" else " exclusive")
|
-- <+> withAttr ("border" <> "query") (str $ if inclusive then "" else " exclusive")
|
||||||
<+> togglefilters
|
<+> togglefilters
|
||||||
<+> str " transactions"
|
<+> str " transactions"
|
||||||
@ -212,7 +211,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
|||||||
<+> str "/"
|
<+> str "/"
|
||||||
<+> total
|
<+> total
|
||||||
<+> str ")"
|
<+> str ")"
|
||||||
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "")
|
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions") else str "")
|
||||||
where
|
where
|
||||||
togglefilters =
|
togglefilters =
|
||||||
case concat [
|
case concat [
|
||||||
@ -221,7 +220,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
|||||||
,if empty_ ropts then [] else ["nonzero"]
|
,if empty_ ropts then [] else ["nonzero"]
|
||||||
] of
|
] of
|
||||||
[] -> str ""
|
[] -> str ""
|
||||||
fs -> withAttr ("border" <> "query") (str $ " " ++ intercalate ", " fs)
|
fs -> withAttr (attrName "border" <> attrName "query") (str $ " " ++ intercalate ", " fs)
|
||||||
cur = str $ case rsList ^. listSelectedL of
|
cur = str $ case rsList ^. listSelectedL of
|
||||||
Nothing -> "-"
|
Nothing -> "-"
|
||||||
Just i -> show (i + 1)
|
Just i -> show (i + 1)
|
||||||
@ -271,20 +270,21 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
|
|||||||
where
|
where
|
||||||
changeAmt = wbToText rsItemChangeAmount
|
changeAmt = wbToText rsItemChangeAmount
|
||||||
balanceAmt = wbToText rsItemBalanceAmount
|
balanceAmt = wbToText rsItemBalanceAmount
|
||||||
changeattr | T.any (=='-') changeAmt = sel $ "list" <> "amount" <> "decrease"
|
changeattr | T.any (=='-') changeAmt = sel $ attrName "list" <> attrName "amount" <> attrName "decrease"
|
||||||
| otherwise = sel $ "list" <> "amount" <> "increase"
|
| otherwise = sel $ attrName "list" <> attrName "amount" <> attrName "increase"
|
||||||
balattr | T.any (=='-') balanceAmt = sel $ "list" <> "balance" <> "negative"
|
balattr | T.any (=='-') balanceAmt = sel $ attrName "list" <> attrName "balance" <> attrName "negative"
|
||||||
| otherwise = sel $ "list" <> "balance" <> "positive"
|
| otherwise = sel $ attrName "list" <> attrName "balance" <> attrName "positive"
|
||||||
sel | selected = (<> "selected")
|
sel | selected = (<> attrName "selected")
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
|
||||||
rsHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
rsHandle ui@UIState{
|
rsHandle ev = do
|
||||||
|
ui@UIState{
|
||||||
aScreen=s@RegisterScreen{..}
|
aScreen=s@RegisterScreen{..}
|
||||||
,aopts=UIOpts{uoCliOpts=copts}
|
,aopts=UIOpts{uoCliOpts=copts}
|
||||||
,ajournal=j
|
,ajournal=j
|
||||||
,aMode=mode
|
,aMode=mode
|
||||||
} ev = do
|
} <- get
|
||||||
let
|
let
|
||||||
d = copts^.rsDay
|
d = copts^.rsDay
|
||||||
journalspan = journalDateSpan False j
|
journalspan = journalDateSpan False j
|
||||||
@ -294,50 +294,44 @@ rsHandle ui@UIState{
|
|||||||
case mode of
|
case mode of
|
||||||
Minibuffer _ ed ->
|
Minibuffer _ ed ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey KEsc []) -> continue $ closeMinibuffer ui
|
VtyEvent (EvKey KEsc []) -> modify closeMinibuffer
|
||||||
VtyEvent (EvKey KEnter []) -> continue $ regenerateScreens j d $
|
VtyEvent (EvKey KEnter []) -> put $ regenerateScreens j d $
|
||||||
case setFilter s $ closeMinibuffer ui of
|
case setFilter s $ closeMinibuffer ui of
|
||||||
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
|
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
|
||||||
Right ui' -> ui'
|
Right ui' -> ui'
|
||||||
where s = chomp . unlines . map strip $ getEditContents ed
|
where s = chomp . unlines . map strip $ getEditContents ed
|
||||||
-- VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer ui
|
-- VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer ui
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
VtyEvent ev -> do
|
VtyEvent ev -> do
|
||||||
ed' <- handleEditorEvent
|
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
||||||
#if MIN_VERSION_brick(0,72,0)
|
put ui{aMode=Minibuffer "filter" ed'}
|
||||||
(VtyEvent ev)
|
AppEvent _ -> return ()
|
||||||
#else
|
MouseDown{} -> return ()
|
||||||
ev
|
MouseUp{} -> return ()
|
||||||
#endif
|
|
||||||
ed
|
|
||||||
continue $ ui{aMode=Minibuffer "filter" ed'}
|
|
||||||
AppEvent _ -> continue ui
|
|
||||||
MouseDown{} -> continue ui
|
|
||||||
MouseUp{} -> continue ui
|
|
||||||
|
|
||||||
Help ->
|
Help ->
|
||||||
case ev of
|
case ev of
|
||||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
_ -> helpHandle ui ev
|
_ -> helpHandle ev
|
||||||
|
|
||||||
Normal ->
|
Normal ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey KEsc []) -> continue $ resetScreens d ui
|
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> continue $ setMode Help ui
|
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||||
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
||||||
continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||||
where
|
where
|
||||||
p = reportPeriod ui
|
p = reportPeriod ui
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||||
liftIO (uiReloadJournal copts d ui) >>= continue
|
liftIO (uiReloadJournal copts d ui) >>= put
|
||||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||||
VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
|
||||||
VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
|
||||||
VtyEvent (EvKey (KChar 'T') []) -> continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
VtyEvent (EvKey (KChar 'T') []) -> put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
||||||
where
|
where
|
||||||
(pos,f) = case listSelectedElement rsList of
|
(pos,f) = case listSelectedElement rsList of
|
||||||
@ -357,78 +351,76 @@ rsHandle ui@UIState{
|
|||||||
VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
|
VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
|
||||||
VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast d ui
|
VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast d ui
|
||||||
|
|
||||||
VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
||||||
VtyEvent (EvKey (KDown) [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui
|
VtyEvent (EvKey (KDown) [MShift]) -> put $ regenerateScreens j d $ shrinkReportPeriod d ui
|
||||||
VtyEvent (EvKey (KUp) [MShift]) -> continue $ regenerateScreens j d $ growReportPeriod d ui
|
VtyEvent (EvKey (KUp) [MShift]) -> put $ regenerateScreens j d $ growReportPeriod d ui
|
||||||
VtyEvent (EvKey (KRight) [MShift]) -> continue $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
VtyEvent (EvKey (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
||||||
VtyEvent (EvKey (KLeft) [MShift]) -> continue $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
VtyEvent (EvKey (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
||||||
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
|
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui)
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
|
|
||||||
-- exit screen on LEFT
|
-- exit screen on LEFT
|
||||||
VtyEvent e | e `elem` moveLeftEvents -> continue $ popScreen ui
|
VtyEvent e | e `elem` moveLeftEvents -> put $ popScreen ui
|
||||||
-- or on a click in the app's left margin. This is a VtyEvent since not in a clickable widget.
|
-- or on a click in the app's left margin. This is a VtyEvent since not in a clickable widget.
|
||||||
VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> continue $ popScreen ui
|
VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put $ popScreen ui
|
||||||
-- or on clicking a blank list item.
|
-- or on clicking a blank list item.
|
||||||
MouseUp _ (Just BLeft) Location{loc=(_,y)} | clickeddate == "" -> continue $ popScreen ui
|
MouseUp _ (Just BLeft) Location{loc=(_,y)} | clickeddate == "" -> put $ popScreen ui
|
||||||
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
||||||
|
|
||||||
-- enter transaction screen on RIGHT
|
-- enter transaction screen on RIGHT
|
||||||
VtyEvent e | e `elem` moveRightEvents ->
|
VtyEvent e | e `elem` moveRightEvents ->
|
||||||
case listSelectedElement rsList of
|
case listSelectedElement rsList of
|
||||||
Just _ -> continue $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
Just _ -> put $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
||||||
Nothing -> continue ui
|
Nothing -> put ui
|
||||||
-- or on transaction click
|
-- or on transaction click
|
||||||
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
||||||
-- just use it to move the selection
|
-- just use it to move the selection
|
||||||
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
||||||
continue $ ui{aScreen=s{rsList=listMoveTo y rsList}}
|
put $ ui{aScreen=s{rsList=listMoveTo y rsList}}
|
||||||
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
||||||
-- and on MouseUp, enter the subscreen
|
-- and on MouseUp, enter the subscreen
|
||||||
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
||||||
continue $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
put $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
||||||
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
||||||
|
|
||||||
-- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
|
-- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
|
||||||
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
|
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
|
||||||
vScrollBy (viewportScroll $ rsList ^. listNameL) 1 >> continue ui
|
vScrollBy (viewportScroll $ rsList ^. listNameL) 1 >> put ui
|
||||||
where mnextelement = listSelectedElement $ listMoveDown rsList
|
where mnextelement = listSelectedElement $ listMoveDown rsList
|
||||||
|
|
||||||
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
|
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
|
||||||
-- pushing the selection when necessary.
|
-- pushing the selection when necessary.
|
||||||
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
||||||
let scrollamt = if btn==BScrollUp then -1 else 1
|
let scrollamt = if btn==BScrollUp then -1 else 1
|
||||||
list' <- listScrollPushingSelection name rsList (rsListSize rsList) scrollamt
|
list' <- nestEventM' rsList $ listScrollPushingSelection name (rsListSize rsList) scrollamt
|
||||||
continue ui{aScreen=s{rsList=list'}}
|
put ui{aScreen=s{rsList=list'}}
|
||||||
|
|
||||||
-- if page down or end leads to a blank padding item, stop at last non-blank
|
-- if page down or end leads to a blank padding item, stop at last non-blank
|
||||||
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
||||||
list <- handleListEvent e rsList
|
list <- nestEventM' rsList $ handleListEvent e
|
||||||
if isBlankElement $ listSelectedElement list
|
if isBlankElement $ listSelectedElement list
|
||||||
then do
|
then do
|
||||||
let list' = listMoveTo lastnonblankidx list
|
let list' = listMoveTo lastnonblankidx list
|
||||||
scrollSelectionToMiddle list'
|
scrollSelectionToMiddle list'
|
||||||
continue ui{aScreen=s{rsList=list'}}
|
put ui{aScreen=s{rsList=list'}}
|
||||||
else
|
else
|
||||||
continue ui{aScreen=s{rsList=list}}
|
put ui{aScreen=s{rsList=list}}
|
||||||
|
|
||||||
-- fall through to the list's event handler (handles other [pg]up/down events)
|
-- fall through to the list's event handler (handles other [pg]up/down events)
|
||||||
VtyEvent ev -> do
|
VtyEvent ev -> do
|
||||||
let ev' = normaliseMovementKeys ev
|
let ev' = normaliseMovementKeys ev
|
||||||
newitems <- handleListEvent ev' rsList
|
newitems <- nestEventM' rsList $ handleListEvent ev'
|
||||||
continue ui{aScreen=s{rsList=newitems}}
|
put ui{aScreen=s{rsList=newitems}}
|
||||||
|
|
||||||
MouseDown{} -> continue ui
|
MouseDown{} -> put ui
|
||||||
MouseUp{} -> continue ui
|
MouseUp{} -> put ui
|
||||||
AppEvent _ -> continue ui
|
AppEvent _ -> put ui
|
||||||
|
|
||||||
rsHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
|
||||||
|
|
||||||
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
|
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
|
||||||
|
|
||||||
rsCenterAndContinue ui = do
|
rsCenterAndContinue ui = do
|
||||||
scrollSelectionToMiddle $ rsList $ aScreen ui
|
scrollSelectionToMiddle $ rsList $ aScreen ui
|
||||||
continue ui
|
put ui
|
||||||
|
|
||||||
rsListSize = V.length . V.takeWhile ((/="").rsItemDate) . listElements
|
rsListSize = V.length . V.takeWhile ((/="").rsItemDate) . listElements
|
||||||
|
@ -65,42 +65,42 @@ select = black `on` selectbg
|
|||||||
themesList :: [(String, AttrMap)]
|
themesList :: [(String, AttrMap)]
|
||||||
themesList = [
|
themesList = [
|
||||||
("default", attrMap (black `on` white) [
|
("default", attrMap (black `on` white) [
|
||||||
("border" , white `on` black & dim)
|
(attrName "border" , white `on` black & dim)
|
||||||
,("border" <> "bold" , currentAttr & bold)
|
,(attrName "border" <> attrName "bold" , currentAttr & bold)
|
||||||
,("border" <> "depth" , active)
|
,(attrName "border" <> attrName "depth" , active)
|
||||||
,("border" <> "filename" , currentAttr)
|
,(attrName "border" <> attrName "filename" , currentAttr)
|
||||||
,("border" <> "key" , active)
|
,(attrName "border" <> attrName "key" , active)
|
||||||
,("border" <> "minibuffer" , white `on` black & bold)
|
,(attrName "border" <> attrName "minibuffer" , white `on` black & bold)
|
||||||
,("border" <> "query" , active)
|
,(attrName "border" <> attrName "query" , active)
|
||||||
,("border" <> "selected" , active)
|
,(attrName "border" <> attrName "selected" , active)
|
||||||
,("error" , fg red)
|
,(attrName "error" , fg red)
|
||||||
,("help" , white `on` black & dim)
|
,(attrName "help" , white `on` black & dim)
|
||||||
,("help" <> "heading" , fg yellow)
|
,(attrName "help" <> attrName "heading" , fg yellow)
|
||||||
,("help" <> "key" , active)
|
,(attrName "help" <> attrName "key" , active)
|
||||||
-- ,("list" , black `on` white)
|
-- ,(attrName "list" , black `on` white)
|
||||||
-- ,("list" <> "amount" , currentAttr)
|
-- ,(attrName "list" <> attrName "amount" , currentAttr)
|
||||||
,("list" <> "amount" <> "decrease" , fg red)
|
,(attrName "list" <> attrName "amount" <> attrName "decrease" , fg red)
|
||||||
-- ,("list" <> "amount" <> "increase" , fg green)
|
-- ,(attrName "list" <> attrName "amount" <> attrName "increase" , fg green)
|
||||||
,("list" <> "amount" <> "decrease" <> "selected" , red `on` selectbg & bold)
|
,(attrName "list" <> attrName "amount" <> attrName "decrease" <> attrName "selected" , red `on` selectbg & bold)
|
||||||
-- ,("list" <> "amount" <> "increase" <> "selected" , green `on` selectbg & bold)
|
-- ,(attrName "list" <> attrName "amount" <> attrName "increase" <> attrName "selected" , green `on` selectbg & bold)
|
||||||
,("list" <> "balance" , currentAttr & bold)
|
,(attrName "list" <> attrName "balance" , currentAttr & bold)
|
||||||
,("list" <> "balance" <> "negative" , fg red)
|
,(attrName "list" <> attrName "balance" <> attrName "negative" , fg red)
|
||||||
,("list" <> "balance" <> "positive" , fg black)
|
,(attrName "list" <> attrName "balance" <> attrName "positive" , fg black)
|
||||||
,("list" <> "balance" <> "negative" <> "selected" , red `on` selectbg & bold)
|
,(attrName "list" <> attrName "balance" <> attrName "negative" <> attrName "selected" , red `on` selectbg & bold)
|
||||||
,("list" <> "balance" <> "positive" <> "selected" , select & bold)
|
,(attrName "list" <> attrName "balance" <> attrName "positive" <> attrName "selected" , select & bold)
|
||||||
,("list" <> "selected" , select)
|
,(attrName "list" <> attrName "selected" , select)
|
||||||
-- ,("list" <> "accounts" , white `on` brightGreen)
|
-- ,(attrName "list" <> attrName "accounts" , white `on` brightGreen)
|
||||||
-- ,("list" <> "selected" , black `on` brightYellow)
|
-- ,(attrName "list" <> attrName "selected" , black `on` brightYellow)
|
||||||
])
|
])
|
||||||
|
|
||||||
,("greenterm", attrMap (green `on` black) [
|
,("greenterm", attrMap (green `on` black) [
|
||||||
("list" <> "selected" , black `on` green)
|
(attrName "list" <> attrName "selected" , black `on` green)
|
||||||
])
|
])
|
||||||
|
|
||||||
,("terminal", attrMap defAttr [
|
,("terminal", attrMap defAttr [
|
||||||
("border" , white `on` black),
|
(attrName "border" , white `on` black),
|
||||||
("list" , defAttr),
|
(attrName "list" , defAttr),
|
||||||
("list" <> "selected" , defAttr & reverseVideo)
|
(attrName "list" <> attrName "selected" , defAttr & reverseVideo)
|
||||||
])
|
])
|
||||||
|
|
||||||
]
|
]
|
||||||
|
@ -107,12 +107,12 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec
|
|||||||
-- <+> str (" ("++show i++" of "++show (length nts)++" in "++acct++")")
|
-- <+> str (" ("++show i++" of "++show (length nts)++" in "++acct++")")
|
||||||
<+> (str $ "#" ++ show (tindex t))
|
<+> (str $ "#" ++ show (tindex t))
|
||||||
<+> str " ("
|
<+> str " ("
|
||||||
<+> withAttr ("border" <> "bold") (str $ show i)
|
<+> withAttr (attrName "border" <> attrName "bold") (str $ show i)
|
||||||
<+> str (" of "++show (length nts))
|
<+> str (" of "++show (length nts))
|
||||||
<+> togglefilters
|
<+> togglefilters
|
||||||
<+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
|
<+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
|
||||||
<+> str (" in "++T.unpack (replaceHiddenAccountsNameWith "All" acct)++")")
|
<+> str (" in "++T.unpack (replaceHiddenAccountsNameWith "All" acct)++")")
|
||||||
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "")
|
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions") else str "")
|
||||||
where
|
where
|
||||||
togglefilters =
|
togglefilters =
|
||||||
case concat [
|
case concat [
|
||||||
@ -121,7 +121,7 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec
|
|||||||
,if empty_ ropts then [] else ["nonzero"]
|
,if empty_ ropts then [] else ["nonzero"]
|
||||||
] of
|
] of
|
||||||
[] -> str ""
|
[] -> str ""
|
||||||
fs -> withAttr ("border" <> "query") (str $ " " ++ intercalate ", " fs)
|
fs -> withAttr (attrName "border" <> attrName "query") (str $ " " ++ intercalate ", " fs)
|
||||||
|
|
||||||
bottomlabel = quickhelp
|
bottomlabel = quickhelp
|
||||||
-- case mode of
|
-- case mode of
|
||||||
@ -141,20 +141,20 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec
|
|||||||
|
|
||||||
tsDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
tsDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
||||||
|
|
||||||
tsHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
|
tsHandle ev = do
|
||||||
|
ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
|
||||||
,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
|
,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
|
||||||
,ajournal=j
|
,ajournal=j
|
||||||
,aMode=mode
|
,aMode=mode
|
||||||
}
|
} <- get
|
||||||
ev =
|
|
||||||
case mode of
|
case mode of
|
||||||
Help ->
|
Help ->
|
||||||
case ev of
|
case ev of
|
||||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
_ -> helpHandle ui ev
|
_ -> helpHandle ev
|
||||||
|
|
||||||
_ -> do
|
_ -> do
|
||||||
let
|
let
|
||||||
@ -162,49 +162,47 @@ tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransaction
|
|||||||
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
|
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
|
||||||
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey KEsc []) -> continue $ resetScreens d ui
|
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> continue $ setMode Help ui
|
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
||||||
where
|
where
|
||||||
(pos,f) = case tsourcepos t of
|
(pos,f) = case tsourcepos t of
|
||||||
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
|
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
|
||||||
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
||||||
continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||||
where
|
where
|
||||||
p = reportPeriod ui
|
p = reportPeriod ui
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
|
||||||
-- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return ()
|
-- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return ()
|
||||||
ej <- liftIO . runExceptT $ journalReload copts
|
ej <- liftIO . runExceptT $ journalReload copts
|
||||||
case ej of
|
case ej of
|
||||||
Left err -> continue $ screenEnter d errorScreen{esError=err} ui
|
Left err -> put $ screenEnter d errorScreen{esError=err} ui
|
||||||
Right j' -> continue $ regenerateScreens j' d ui
|
Right j' -> put $ regenerateScreens j' d ui
|
||||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||||
|
|
||||||
-- for toggles that may change the current/prev/next transactions,
|
-- for toggles that may change the current/prev/next transactions,
|
||||||
-- we must regenerate the transaction list, like the g handler above ? with regenerateTransactions ? TODO WIP
|
-- we must regenerate the transaction list, like the g handler above ? with regenerateTransactions ? TODO WIP
|
||||||
-- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty ui
|
-- EvKey (KChar 'E') [] -> put $ regenerateScreens j d $ stToggleEmpty ui
|
||||||
-- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared ui
|
-- EvKey (KChar 'C') [] -> put $ regenerateScreens j d $ stToggleCleared ui
|
||||||
-- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal ui
|
-- EvKey (KChar 'R') [] -> put $ regenerateScreens j d $ stToggleReal ui
|
||||||
VtyEvent (EvKey (KChar 'B') []) -> continue . regenerateScreens j d $ toggleConversionOp ui
|
VtyEvent (EvKey (KChar 'B') []) -> put . regenerateScreens j d $ toggleConversionOp ui
|
||||||
VtyEvent (EvKey (KChar 'V') []) -> continue . regenerateScreens j d $ toggleValue ui
|
VtyEvent (EvKey (KChar 'V') []) -> put . regenerateScreens j d $ toggleValue ui
|
||||||
|
|
||||||
VtyEvent e | e `elem` moveUpEvents -> continue $ tsSelect iprev tprev ui
|
VtyEvent e | e `elem` moveUpEvents -> put $ tsSelect iprev tprev ui
|
||||||
VtyEvent e | e `elem` moveDownEvents -> continue $ tsSelect inext tnext ui
|
VtyEvent e | e `elem` moveDownEvents -> put $ tsSelect inext tnext ui
|
||||||
|
|
||||||
-- exit screen on LEFT
|
-- exit screen on LEFT
|
||||||
VtyEvent e | e `elem` moveLeftEvents -> continue . popScreen $ tsSelect i t ui -- Probably not necessary to tsSelect here, but it's safe.
|
VtyEvent e | e `elem` moveLeftEvents -> put . popScreen $ tsSelect i t ui -- Probably not necessary to tsSelect here, but it's safe.
|
||||||
-- or on a click in the app's left margin.
|
-- or on a click in the app's left margin.
|
||||||
VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> continue . popScreen $ tsSelect i t ui
|
VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put . popScreen $ tsSelect i t ui
|
||||||
-- or on clicking the blank area below the transaction.
|
-- or on clicking the blank area below the transaction.
|
||||||
MouseUp _ (Just BLeft) Location{loc=(_,y)} | y+1 > numentrylines -> continue . popScreen $ tsSelect i t ui
|
MouseUp _ (Just BLeft) Location{loc=(_,y)} | y+1 > numentrylines -> put . popScreen $ tsSelect i t ui
|
||||||
where numentrylines = length (T.lines $ showTxn ropts rspec j t) - 1
|
where numentrylines = length (T.lines $ showTxn ropts rspec j t) - 1
|
||||||
|
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
_ -> continue ui
|
_ -> return ()
|
||||||
|
|
||||||
tsHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
|
||||||
|
|
||||||
-- | Select a new transaction and update the previous register screen
|
-- | Select a new transaction and update the previous register screen
|
||||||
tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of
|
tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of
|
||||||
|
@ -33,6 +33,7 @@ Brick.defaultMain brickapp st
|
|||||||
|
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE DeriveAnyClass #-}
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
@ -100,7 +101,7 @@ data Screen =
|
|||||||
AccountsScreen {
|
AccountsScreen {
|
||||||
sInit :: Day -> Bool -> UIState -> UIState -- ^ function to initialise or update this screen's state
|
sInit :: Day -> Bool -> UIState -> UIState -- ^ function to initialise or update this screen's state
|
||||||
,sDraw :: UIState -> [Widget Name] -- ^ brick renderer for this screen
|
,sDraw :: UIState -> [Widget Name] -- ^ brick renderer for this screen
|
||||||
,sHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState) -- ^ brick event handler for this screen
|
,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState () -- ^ brick event handler for this screen
|
||||||
-- state fields.These ones have lenses:
|
-- state fields.These ones have lenses:
|
||||||
,_asList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
|
,_asList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
|
||||||
,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "")
|
,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "")
|
||||||
@ -108,7 +109,7 @@ data Screen =
|
|||||||
| RegisterScreen {
|
| RegisterScreen {
|
||||||
sInit :: Day -> Bool -> UIState -> UIState
|
sInit :: Day -> Bool -> UIState -> UIState
|
||||||
,sDraw :: UIState -> [Widget Name]
|
,sDraw :: UIState -> [Widget Name]
|
||||||
,sHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
--
|
--
|
||||||
,rsList :: List Name RegisterScreenItem -- ^ list widget showing transactions affecting this account
|
,rsList :: List Name RegisterScreenItem -- ^ list widget showing transactions affecting this account
|
||||||
,rsAccount :: AccountName -- ^ the account this register is for
|
,rsAccount :: AccountName -- ^ the account this register is for
|
||||||
@ -119,7 +120,7 @@ data Screen =
|
|||||||
| TransactionScreen {
|
| TransactionScreen {
|
||||||
sInit :: Day -> Bool -> UIState -> UIState
|
sInit :: Day -> Bool -> UIState -> UIState
|
||||||
,sDraw :: UIState -> [Widget Name]
|
,sDraw :: UIState -> [Widget Name]
|
||||||
,sHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
--
|
--
|
||||||
,tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list
|
,tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list
|
||||||
,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through
|
,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through
|
||||||
@ -128,7 +129,7 @@ data Screen =
|
|||||||
| ErrorScreen {
|
| ErrorScreen {
|
||||||
sInit :: Day -> Bool -> UIState -> UIState
|
sInit :: Day -> Bool -> UIState -> UIState
|
||||||
,sDraw :: UIState -> [Widget Name]
|
,sDraw :: UIState -> [Widget Name]
|
||||||
,sHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
--
|
--
|
||||||
,esError :: String -- ^ error message to show
|
,esError :: String -- ^ error message to show
|
||||||
}
|
}
|
||||||
@ -154,6 +155,10 @@ data RegisterScreenItem = RegisterScreenItem {
|
|||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
instance MonadFail (EventM Name UIState) where fail _ = wrongScreenTypeError
|
||||||
|
|
||||||
|
wrongScreenTypeError = error' "handler called with wrong screen type, should not happen"
|
||||||
|
|
||||||
type NumberedTransaction = (Integer, Transaction)
|
type NumberedTransaction = (Integer, Transaction)
|
||||||
|
|
||||||
-- dummy monoid instance needed make lenses work with List fields not common across constructors
|
-- dummy monoid instance needed make lenses work with List fields not common across constructors
|
||||||
|
@ -35,7 +35,7 @@ import Brick.Widgets.Border
|
|||||||
import Brick.Widgets.Border.Style
|
import Brick.Widgets.Border.Style
|
||||||
import Brick.Widgets.Dialog
|
import Brick.Widgets.Dialog
|
||||||
import Brick.Widgets.Edit
|
import Brick.Widgets.Edit
|
||||||
import Brick.Widgets.List (List, listSelectedL, listNameL, listItemHeightL, listSelected, listMoveDown, listMoveUp, GenericList, Splittable)
|
import Brick.Widgets.List (List, listSelectedL, listNameL, listItemHeightL, listSelected, listMoveDown, listMoveUp, GenericList)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Data.Bifunctor (second)
|
import Data.Bifunctor (second)
|
||||||
import Data.List
|
import Data.List
|
||||||
@ -60,6 +60,7 @@ suspendSignal :: IO ()
|
|||||||
suspendSignal = return ()
|
suspendSignal = return ()
|
||||||
#else
|
#else
|
||||||
import System.Posix.Signals
|
import System.Posix.Signals
|
||||||
|
import Data.Vector (Vector)
|
||||||
suspendSignal :: IO ()
|
suspendSignal :: IO ()
|
||||||
suspendSignal = raiseSignal sigSTOP
|
suspendSignal = raiseSignal sigSTOP
|
||||||
#endif
|
#endif
|
||||||
@ -68,12 +69,12 @@ suspendSignal = raiseSignal sigSTOP
|
|||||||
-- like control-z in bash, returning to the original shell prompt,
|
-- like control-z in bash, returning to the original shell prompt,
|
||||||
-- and when resumed, continue where we left off.
|
-- and when resumed, continue where we left off.
|
||||||
-- On windows, does nothing.
|
-- On windows, does nothing.
|
||||||
suspend :: s -> EventM a (Next s)
|
suspend :: Ord a => s -> EventM a s ()
|
||||||
suspend st = suspendAndResume $ suspendSignal >> return st
|
suspend st = suspendAndResume $ suspendSignal >> return st
|
||||||
|
|
||||||
-- | Tell vty to redraw the whole screen, and continue.
|
-- | Tell vty to redraw the whole screen.
|
||||||
redraw :: s -> EventM a (Next s)
|
redraw :: EventM a s ()
|
||||||
redraw st = getVtyHandle >>= liftIO . refresh >> continue st
|
redraw = getVtyHandle >>= liftIO . refresh
|
||||||
|
|
||||||
-- | Wrap a widget in the default hledger-ui screen layout.
|
-- | Wrap a widget in the default hledger-ui screen layout.
|
||||||
defaultLayout :: Widget Name -> Widget Name -> Widget Name -> Widget Name
|
defaultLayout :: Widget Name -> Widget Name -> Widget Name -> Widget Name
|
||||||
@ -90,14 +91,14 @@ helpDialog _copts =
|
|||||||
Widget Fixed Fixed $ do
|
Widget Fixed Fixed $ do
|
||||||
c <- getContext
|
c <- getContext
|
||||||
render $
|
render $
|
||||||
withDefAttr "help" $
|
withDefAttr (attrName "help") $
|
||||||
renderDialog (dialog (Just "Help (LEFT/ESC/?/q to close help)") Nothing (c^.availWidthL)) $ -- (Just (0,[("ok",())]))
|
renderDialog (dialog (Just "Help (LEFT/ESC/?/q to close help)") Nothing (c^.availWidthL)) $ -- (Just (0,[("ok",())]))
|
||||||
padTop (Pad 0) $ padLeft (Pad 1) $ padRight (Pad 1) $
|
padTop (Pad 0) $ padLeft (Pad 1) $ padRight (Pad 1) $
|
||||||
vBox [
|
vBox [
|
||||||
hBox [
|
hBox [
|
||||||
padRight (Pad 1) $
|
padRight (Pad 1) $
|
||||||
vBox [
|
vBox [
|
||||||
withAttr ("help" <> "heading") $ str "Navigation"
|
withAttr (attrName "help" <> attrName "heading") $ str "Navigation"
|
||||||
,renderKey ("UP/DOWN/PUP/PDN/HOME/END/k/j/C-p/C-n", "")
|
,renderKey ("UP/DOWN/PUP/PDN/HOME/END/k/j/C-p/C-n", "")
|
||||||
,str " move selection up/down"
|
,str " move selection up/down"
|
||||||
,renderKey ("RIGHT/l/C-f", "show txns, or txn detail")
|
,renderKey ("RIGHT/l/C-f", "show txns, or txn detail")
|
||||||
@ -105,23 +106,23 @@ helpDialog _copts =
|
|||||||
,renderKey ("ESC ", "cancel, or reset app state")
|
,renderKey ("ESC ", "cancel, or reset app state")
|
||||||
|
|
||||||
,str " "
|
,str " "
|
||||||
,withAttr ("help" <> "heading") $ str "Accounts screen"
|
,withAttr (attrName "help" <> attrName "heading") $ str "Accounts screen"
|
||||||
,renderKey ("1234567890-+ ", "set/adjust depth limit")
|
,renderKey ("1234567890-+ ", "set/adjust depth limit")
|
||||||
,renderKey ("t ", "toggle accounts tree/list mode")
|
,renderKey ("t ", "toggle accounts tree/list mode")
|
||||||
,renderKey ("H ", "toggle historical balance/change")
|
,renderKey ("H ", "toggle historical balance/change")
|
||||||
,str " "
|
,str " "
|
||||||
,withAttr ("help" <> "heading") $ str "Register screen"
|
,withAttr (attrName "help" <> attrName "heading") $ str "Register screen"
|
||||||
,renderKey ("t ", "toggle subaccount txns\n(and accounts tree/list mode)")
|
,renderKey ("t ", "toggle subaccount txns\n(and accounts tree/list mode)")
|
||||||
,renderKey ("H ", "toggle historical/period total")
|
,renderKey ("H ", "toggle historical/period total")
|
||||||
,str " "
|
,str " "
|
||||||
,withAttr ("help" <> "heading") $ str "Help"
|
,withAttr (attrName "help" <> attrName "heading") $ str "Help"
|
||||||
,renderKey ("? ", "toggle this help")
|
,renderKey ("? ", "toggle this help")
|
||||||
,renderKey ("p/m/i", "while help is open:\nshow manual in pager/man/info")
|
,renderKey ("p/m/i", "while help is open:\nshow manual in pager/man/info")
|
||||||
,str " "
|
,str " "
|
||||||
]
|
]
|
||||||
,padLeft (Pad 1) $ padRight (Pad 0) $
|
,padLeft (Pad 1) $ padRight (Pad 0) $
|
||||||
vBox [
|
vBox [
|
||||||
withAttr ("help" <> "heading") $ str "Filtering"
|
withAttr (attrName "help" <> attrName "heading") $ str "Filtering"
|
||||||
,renderKey ("/ ", "set a filter query")
|
,renderKey ("/ ", "set a filter query")
|
||||||
,renderKey ("F ", "show future & periodic txns")
|
,renderKey ("F ", "show future & periodic txns")
|
||||||
,renderKey ("R ", "show real/all postings")
|
,renderKey ("R ", "show real/all postings")
|
||||||
@ -132,7 +133,7 @@ helpDialog _copts =
|
|||||||
,renderKey ("T ", "set period to today")
|
,renderKey ("T ", "set period to today")
|
||||||
,renderKey ("DEL ", "reset filters")
|
,renderKey ("DEL ", "reset filters")
|
||||||
,str " "
|
,str " "
|
||||||
,withAttr ("help" <> "heading") $ str "Other"
|
,withAttr (attrName "help" <> attrName "heading") $ str "Other"
|
||||||
,renderKey ("a ", "add transaction (hledger add)")
|
,renderKey ("a ", "add transaction (hledger add)")
|
||||||
,renderKey ("A ", "add transaction (hledger-iadd)")
|
,renderKey ("A ", "add transaction (hledger-iadd)")
|
||||||
,renderKey ("B ", "show amounts/costs")
|
,renderKey ("B ", "show amounts/costs")
|
||||||
@ -160,39 +161,40 @@ helpDialog _copts =
|
|||||||
-- ]
|
-- ]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
renderKey (key,desc) = withAttr ("help" <> "key") (str key) <+> str " " <+> str desc
|
renderKey (key,desc) = withAttr (attrName "help" <> attrName "key") (str key) <+> str " " <+> str desc
|
||||||
|
|
||||||
-- | Event handler used when help mode is active.
|
-- | Event handler used when help mode is active.
|
||||||
-- May invoke $PAGER, less, man or info, which is likely to fail on MS Windows, TODO.
|
-- May invoke $PAGER, less, man or info, which is likely to fail on MS Windows, TODO.
|
||||||
helpHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
helpHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
helpHandle ui ev = do
|
helpHandle ev = do
|
||||||
|
ui <- get
|
||||||
|
let ui' = setMode Normal ui
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent e | e `elem` closeHelpEvents -> continue $ setMode Normal ui
|
VtyEvent e | e `elem` closeHelpEvents -> put ui'
|
||||||
VtyEvent (EvKey (KChar 'p') []) -> suspendAndResume $ runPagerForTopic "hledger-ui" Nothing >> return ui'
|
VtyEvent (EvKey (KChar 'p') []) -> suspendAndResume $ runPagerForTopic "hledger-ui" Nothing >> return ui'
|
||||||
VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume $ runManForTopic "hledger-ui" Nothing >> return ui'
|
VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume $ runManForTopic "hledger-ui" Nothing >> return ui'
|
||||||
VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume $ runInfoForTopic "hledger-ui" Nothing >> return ui'
|
VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume $ runInfoForTopic "hledger-ui" Nothing >> return ui'
|
||||||
_ -> continue ui
|
_ -> return ()
|
||||||
where
|
where
|
||||||
ui' = setMode Normal ui
|
|
||||||
closeHelpEvents = moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') [], EvKey (KChar 'q') []]
|
closeHelpEvents = moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') [], EvKey (KChar 'q') []]
|
||||||
|
|
||||||
-- | Draw the minibuffer with the given label.
|
-- | Draw the minibuffer with the given label.
|
||||||
minibuffer :: T.Text -> Editor String Name -> Widget Name
|
minibuffer :: T.Text -> Editor String Name -> Widget Name
|
||||||
minibuffer string ed =
|
minibuffer string ed =
|
||||||
forceAttr ("border" <> "minibuffer") $
|
forceAttr (attrName "border" <> attrName "minibuffer") $
|
||||||
hBox [txt $ string <> ": ", renderEditor (str . unlines) True ed]
|
hBox [txt $ string <> ": ", renderEditor (str . unlines) True ed]
|
||||||
|
|
||||||
borderQueryStr :: String -> Widget Name
|
borderQueryStr :: String -> Widget Name
|
||||||
borderQueryStr "" = str ""
|
borderQueryStr "" = str ""
|
||||||
borderQueryStr qry = str " matching " <+> withAttr ("border" <> "query") (str qry)
|
borderQueryStr qry = str " matching " <+> withAttr (attrName "border" <> attrName "query") (str qry)
|
||||||
|
|
||||||
borderDepthStr :: Maybe Int -> Widget Name
|
borderDepthStr :: Maybe Int -> Widget Name
|
||||||
borderDepthStr Nothing = str ""
|
borderDepthStr Nothing = str ""
|
||||||
borderDepthStr (Just d) = str " to depth " <+> withAttr ("border" <> "query") (str $ show d)
|
borderDepthStr (Just d) = str " to depth " <+> withAttr (attrName "border" <> attrName "query") (str $ show d)
|
||||||
|
|
||||||
borderPeriodStr :: String -> Period -> Widget Name
|
borderPeriodStr :: String -> Period -> Widget Name
|
||||||
borderPeriodStr _ PeriodAll = str ""
|
borderPeriodStr _ PeriodAll = str ""
|
||||||
borderPeriodStr preposition p = str (" "++preposition++" ") <+> withAttr ("border" <> "query") (str . T.unpack $ showPeriod p)
|
borderPeriodStr preposition p = str (" "++preposition++" ") <+> withAttr (attrName "border" <> attrName "query") (str . T.unpack $ showPeriod p)
|
||||||
|
|
||||||
borderKeysStr :: [(String,String)] -> Widget Name
|
borderKeysStr :: [(String,String)] -> Widget Name
|
||||||
borderKeysStr = borderKeysStr' . map (second str)
|
borderKeysStr = borderKeysStr' . map (second str)
|
||||||
@ -201,7 +203,7 @@ borderKeysStr' :: [(String,Widget Name)] -> Widget Name
|
|||||||
borderKeysStr' keydescs =
|
borderKeysStr' keydescs =
|
||||||
hBox $
|
hBox $
|
||||||
intersperse sep $
|
intersperse sep $
|
||||||
[withAttr ("border" <> "key") (str keys) <+> str ":" <+> desc | (keys, desc) <- keydescs]
|
[withAttr (attrName "border" <> attrName "key") (str keys) <+> str ":" <+> desc | (keys, desc) <- keydescs]
|
||||||
where
|
where
|
||||||
-- sep = str " | "
|
-- sep = str " | "
|
||||||
sep = str " "
|
sep = str " "
|
||||||
@ -209,7 +211,7 @@ borderKeysStr' keydescs =
|
|||||||
-- | Show both states of a toggle ("aaa/bbb"), highlighting the active one.
|
-- | Show both states of a toggle ("aaa/bbb"), highlighting the active one.
|
||||||
renderToggle :: Bool -> String -> String -> Widget Name
|
renderToggle :: Bool -> String -> String -> Widget Name
|
||||||
renderToggle isright l r =
|
renderToggle isright l r =
|
||||||
let bold = withAttr ("border" <> "selected") in
|
let bold = withAttr (attrName "border" <> attrName "selected") in
|
||||||
if isright
|
if isright
|
||||||
then str (l++"/") <+> bold (str r)
|
then str (l++"/") <+> bold (str r)
|
||||||
else bold (str l) <+> str ("/"++r)
|
else bold (str l) <+> str ("/"++r)
|
||||||
@ -217,7 +219,7 @@ renderToggle isright l r =
|
|||||||
-- | Show a toggle's label, highlighted (bold) when the toggle is active.
|
-- | Show a toggle's label, highlighted (bold) when the toggle is active.
|
||||||
renderToggle1 :: Bool -> String -> Widget Name
|
renderToggle1 :: Bool -> String -> Widget Name
|
||||||
renderToggle1 isactive l =
|
renderToggle1 isactive l =
|
||||||
let bold = withAttr ("border" <> "selected") in
|
let bold = withAttr (attrName "border" <> attrName "selected") in
|
||||||
if isactive
|
if isactive
|
||||||
then bold (str l)
|
then bold (str l)
|
||||||
else str l
|
else str l
|
||||||
@ -262,11 +264,11 @@ topBottomBorderWithLabels toplabel bottomlabel body =
|
|||||||
""
|
""
|
||||||
-- " debug: "++show (_w,h')
|
-- " debug: "++show (_w,h')
|
||||||
render $
|
render $
|
||||||
hBorderWithLabel (withAttr "border" $ toplabel <+> str debugmsg)
|
hBorderWithLabel (withAttr (attrName "border") $ toplabel <+> str debugmsg)
|
||||||
<=>
|
<=>
|
||||||
body'
|
body'
|
||||||
<=>
|
<=>
|
||||||
hBorderWithLabel (withAttr "border" bottomlabel)
|
hBorderWithLabel (withAttr (attrName "border") bottomlabel)
|
||||||
|
|
||||||
---- XXX should be equivalent to the above, but isn't (page down goes offscreen)
|
---- XXX should be equivalent to the above, but isn't (page down goes offscreen)
|
||||||
--_topBottomBorderWithLabel2 :: Widget Name -> Widget Name -> Widget Name
|
--_topBottomBorderWithLabel2 :: Widget Name -> Widget Name -> Widget Name
|
||||||
@ -303,7 +305,7 @@ margin h v mcolour w = Widget Greedy Greedy $ do
|
|||||||
-- applyN n border
|
-- applyN n border
|
||||||
|
|
||||||
withBorderAttr :: Attr -> Widget Name -> Widget Name
|
withBorderAttr :: Attr -> Widget Name -> Widget Name
|
||||||
withBorderAttr attr = updateAttrMap (applyAttrMappings [("border", attr)])
|
withBorderAttr attr = updateAttrMap (applyAttrMappings [(attrName "border", attr)])
|
||||||
|
|
||||||
---- | Like brick's continue, but first run some action to modify brick's state.
|
---- | Like brick's continue, but first run some action to modify brick's state.
|
||||||
---- This action does not affect the app state, but might eg adjust a widget's scroll position.
|
---- This action does not affect the app state, but might eg adjust a widget's scroll position.
|
||||||
@ -319,7 +321,7 @@ withBorderAttr attr = updateAttrMap (applyAttrMappings [("border", attr)])
|
|||||||
|
|
||||||
-- | Scroll a list's viewport so that the selected item is centered in the
|
-- | Scroll a list's viewport so that the selected item is centered in the
|
||||||
-- middle of the display area.
|
-- middle of the display area.
|
||||||
scrollSelectionToMiddle :: List Name e -> EventM Name ()
|
scrollSelectionToMiddle :: List Name item -> EventM Name UIState ()
|
||||||
scrollSelectionToMiddle list = do
|
scrollSelectionToMiddle list = do
|
||||||
case list^.listSelectedL of
|
case list^.listSelectedL of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
@ -364,9 +366,9 @@ reportSpecSetFutureAndForecast d forecast rspec =
|
|||||||
-- Vertically scroll the named list's viewport with the given number of non-empty items
|
-- Vertically scroll the named list's viewport with the given number of non-empty items
|
||||||
-- by the given positive or negative number of items (usually 1 or -1).
|
-- by the given positive or negative number of items (usually 1 or -1).
|
||||||
-- The selection will be moved when necessary to keep it visible and allow the scroll.
|
-- The selection will be moved when necessary to keep it visible and allow the scroll.
|
||||||
listScrollPushingSelection :: (Ord n, Foldable t, Splittable t) =>
|
listScrollPushingSelection :: Name -> Int -> Int -> EventM Name (List Name item) (GenericList Name Vector item)
|
||||||
n -> GenericList n t e -> Int -> Int -> EventM n (GenericList n t e)
|
listScrollPushingSelection name listheight scrollamt = do
|
||||||
listScrollPushingSelection name list listheight scrollamt = do
|
list <- get
|
||||||
viewportScroll name `vScrollBy` scrollamt
|
viewportScroll name `vScrollBy` scrollamt
|
||||||
mvp <- lookupViewport name
|
mvp <- lookupViewport name
|
||||||
case mvp of
|
case mvp of
|
||||||
|
@ -68,7 +68,7 @@ executable hledger-ui
|
|||||||
ansi-terminal >=0.9
|
ansi-terminal >=0.9
|
||||||
, async
|
, async
|
||||||
, base >=4.11 && <4.17
|
, base >=4.11 && <4.17
|
||||||
, brick >=0.23
|
, brick >=1.0
|
||||||
, cmdargs >=0.8
|
, cmdargs >=0.8
|
||||||
, containers >=0.5.9
|
, containers >=0.5.9
|
||||||
, data-default
|
, data-default
|
||||||
|
@ -76,7 +76,7 @@ dependencies:
|
|||||||
- transformers
|
- transformers
|
||||||
- vector
|
- vector
|
||||||
# not installable on windows, cf buildable flag below
|
# not installable on windows, cf buildable flag below
|
||||||
- brick >=0.23 && <1
|
- brick >=1.0
|
||||||
- vty >=5.15
|
- vty >=5.15
|
||||||
- unix
|
- unix
|
||||||
|
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
# stack build plan using GHC 9.2.4
|
# stack build plan using GHC 9.2.4
|
||||||
|
|
||||||
resolver: nightly-2022-08-04
|
resolver: nightly-2022-08-14
|
||||||
|
|
||||||
packages:
|
packages:
|
||||||
- hledger-lib
|
- hledger-lib
|
||||||
@ -8,10 +8,11 @@ packages:
|
|||||||
- hledger-ui
|
- hledger-ui
|
||||||
- hledger-web
|
- hledger-web
|
||||||
|
|
||||||
# extra-deps:
|
extra-deps:
|
||||||
# for hledger-lib:
|
# for hledger-lib:
|
||||||
# for hledger:
|
# for hledger:
|
||||||
# for hledger-ui:
|
# for hledger-ui:
|
||||||
|
- brick-1.0
|
||||||
# for hledger-web:
|
# for hledger-web:
|
||||||
# for Shake.hs:
|
# for Shake.hs:
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user