pkg: ui: use/require brick 1.0+ (#1889)
This commit is contained in:
Simon Michael
parent
b636eb78a9
commit
2a594b7fb7
@ -152,7 +152,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
||||
ishistorical = balanceaccum_ ropts == Historical
|
||||
|
||||
toplabel =
|
||||
withAttr ("border" <> "filename") files
|
||||
withAttr (attrName "border" <> attrName "filename") files
|
||||
<+> toggles
|
||||
<+> str (" account " ++ if ishistorical then "balances" else "changes")
|
||||
<+> 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
|
||||
<+> str (" ("++curidx++"/"++totidx++")")
|
||||
<+> (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 "")
|
||||
where
|
||||
files = case journalFilePaths j of
|
||||
@ -168,7 +168,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
||||
f:_ -> 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)")
|
||||
toggles = withAttr ("border" <> "query") $ str $ unwords $ concat [
|
||||
toggles = withAttr (attrName "border" <> attrName "query") $ str $ unwords $ concat [
|
||||
[""]
|
||||
,if empty_ ropts then [] else ["nonzero"]
|
||||
,uiShowStatus copts $ statuses_ ropts
|
||||
@ -220,22 +220,24 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
||||
balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " "
|
||||
splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText
|
||||
renderamt :: T.Text -> Widget Name
|
||||
renderamt a | T.any (=='-') a = withAttr (sel $ "list" <> "balance" <> "negative") $ txt a
|
||||
| otherwise = withAttr (sel $ "list" <> "balance" <> "positive") $ txt a
|
||||
sel | selected = (<> "selected")
|
||||
renderamt a | T.any (=='-') a = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "negative") $ txt a
|
||||
| otherwise = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "positive") $ txt a
|
||||
sel | selected = (<> attrName "selected")
|
||||
| otherwise = id
|
||||
|
||||
asHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
||||
asHandle ui0@UIState{
|
||||
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||
asHandle ev = do
|
||||
ui0@UIState{
|
||||
aScreen=scr@AccountsScreen{..}
|
||||
,aopts=UIOpts{uoCliOpts=copts}
|
||||
,ajournal=j
|
||||
,aMode=mode
|
||||
} ev = do
|
||||
} <- get -- PARTIAL: should not fail
|
||||
let
|
||||
d = copts^.rsDay
|
||||
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
|
||||
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
|
||||
let
|
||||
@ -247,87 +249,81 @@ asHandle ui0@UIState{
|
||||
case mode of
|
||||
Minibuffer _ ed ->
|
||||
case ev of
|
||||
VtyEvent (EvKey KEsc []) -> continue $ closeMinibuffer ui
|
||||
VtyEvent (EvKey KEnter []) -> continue $ regenerateScreens j d $
|
||||
VtyEvent (EvKey KEsc []) -> put $ closeMinibuffer ui
|
||||
VtyEvent (EvKey KEnter []) -> put $ regenerateScreens j d $
|
||||
case setFilter s $ closeMinibuffer ui of
|
||||
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
|
||||
Right ui' -> ui'
|
||||
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 ev -> do
|
||||
ed' <- handleEditorEvent
|
||||
#if MIN_VERSION_brick(0,72,0)
|
||||
(VtyEvent ev)
|
||||
#else
|
||||
ev
|
||||
#endif
|
||||
ed
|
||||
continue $ ui{aMode=Minibuffer "filter" ed'}
|
||||
AppEvent _ -> continue ui
|
||||
MouseDown{} -> continue ui
|
||||
MouseUp{} -> continue ui
|
||||
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
||||
put ui{aMode=Minibuffer "filter" ed'}
|
||||
AppEvent _ -> return ()
|
||||
MouseDown{} -> return ()
|
||||
MouseUp{} -> return ()
|
||||
|
||||
Help ->
|
||||
case ev of
|
||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> helpHandle ui ev
|
||||
_ -> helpHandle ev
|
||||
|
||||
Normal ->
|
||||
case ev of
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
-- EvKey (KChar 'l') [MCtrl] -> do
|
||||
VtyEvent (EvKey KEsc []) -> continue $ resetScreens d ui
|
||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> continue $ setMode Help ui
|
||||
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||
-- XXX AppEvents currently handled only in Normal mode
|
||||
-- XXX be sure we don't leave unconsumed events piling up
|
||||
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
|
||||
p = reportPeriod ui
|
||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||
liftIO (uiReloadJournal copts d ui) >>= continue
|
||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||
liftIO (uiReloadJournal copts d ui) >>= put
|
||||
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 $ 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 'B') []) -> continue $ regenerateScreens j d $ toggleConversionOp ui
|
||||
VtyEvent (EvKey (KChar 'V') []) -> continue $ regenerateScreens j d $ toggleValue ui
|
||||
VtyEvent (EvKey (KChar '0') []) -> continue $ regenerateScreens j d $ setDepth (Just 0) ui
|
||||
VtyEvent (EvKey (KChar '1') []) -> continue $ regenerateScreens j d $ setDepth (Just 1) ui
|
||||
VtyEvent (EvKey (KChar '2') []) -> continue $ regenerateScreens j d $ setDepth (Just 2) ui
|
||||
VtyEvent (EvKey (KChar '3') []) -> continue $ regenerateScreens j d $ setDepth (Just 3) ui
|
||||
VtyEvent (EvKey (KChar '4') []) -> continue $ regenerateScreens j d $ setDepth (Just 4) ui
|
||||
VtyEvent (EvKey (KChar '5') []) -> continue $ regenerateScreens j d $ setDepth (Just 5) ui
|
||||
VtyEvent (EvKey (KChar '6') []) -> continue $ regenerateScreens j d $ setDepth (Just 6) ui
|
||||
VtyEvent (EvKey (KChar '7') []) -> continue $ regenerateScreens j d $ setDepth (Just 7) ui
|
||||
VtyEvent (EvKey (KChar '8') []) -> continue $ regenerateScreens j d $ setDepth (Just 8) ui
|
||||
VtyEvent (EvKey (KChar '9') []) -> continue $ regenerateScreens j d $ setDepth (Just 9) ui
|
||||
VtyEvent (EvKey (KChar '-') []) -> continue $ regenerateScreens j d $ decDepth ui
|
||||
VtyEvent (EvKey (KChar '_') []) -> continue $ regenerateScreens j d $ decDepth ui
|
||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> continue $ regenerateScreens j d $ incDepth ui
|
||||
VtyEvent (EvKey (KChar 'T') []) -> continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||
VtyEvent (EvKey (KChar 'B') []) -> put $ regenerateScreens j d $ toggleConversionOp ui
|
||||
VtyEvent (EvKey (KChar 'V') []) -> put $ regenerateScreens j d $ toggleValue ui
|
||||
VtyEvent (EvKey (KChar '0') []) -> put $ regenerateScreens j d $ setDepth (Just 0) ui
|
||||
VtyEvent (EvKey (KChar '1') []) -> put $ regenerateScreens j d $ setDepth (Just 1) ui
|
||||
VtyEvent (EvKey (KChar '2') []) -> put $ regenerateScreens j d $ setDepth (Just 2) ui
|
||||
VtyEvent (EvKey (KChar '3') []) -> put $ regenerateScreens j d $ setDepth (Just 3) ui
|
||||
VtyEvent (EvKey (KChar '4') []) -> put $ regenerateScreens j d $ setDepth (Just 4) ui
|
||||
VtyEvent (EvKey (KChar '5') []) -> put $ regenerateScreens j d $ setDepth (Just 5) ui
|
||||
VtyEvent (EvKey (KChar '6') []) -> put $ regenerateScreens j d $ setDepth (Just 6) ui
|
||||
VtyEvent (EvKey (KChar '7') []) -> put $ regenerateScreens j d $ setDepth (Just 7) ui
|
||||
VtyEvent (EvKey (KChar '8') []) -> put $ regenerateScreens j d $ setDepth (Just 8) ui
|
||||
VtyEvent (EvKey (KChar '9') []) -> put $ regenerateScreens j d $ setDepth (Just 9) ui
|
||||
VtyEvent (EvKey (KChar '-') []) -> put $ regenerateScreens j d $ decDepth ui
|
||||
VtyEvent (EvKey (KChar '_') []) -> put $ regenerateScreens j d $ decDepth ui
|
||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> put $ regenerateScreens j d $ incDepth ui
|
||||
VtyEvent (EvKey (KChar 'T') []) -> put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||
|
||||
-- display mode/query toggles
|
||||
VtyEvent (EvKey (KChar 'H') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui
|
||||
VtyEvent (EvKey (KChar 't') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleTree ui
|
||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> asCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui
|
||||
VtyEvent (EvKey (KChar 'R') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleReal ui
|
||||
VtyEvent (EvKey (KChar 'U') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
|
||||
VtyEvent (EvKey (KChar 'P') []) -> asCenterAndContinue $ regenerateScreens j d $ togglePending ui
|
||||
VtyEvent (EvKey (KChar 'C') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
|
||||
VtyEvent (EvKey (KChar 'F') []) -> continue $ regenerateScreens j d $ toggleForecast d ui
|
||||
VtyEvent (EvKey (KChar 'H') []) -> modify (regenerateScreens j d . toggleHistorical) >> asCenterAndContinue
|
||||
VtyEvent (EvKey (KChar 't') []) -> modify (regenerateScreens j d . toggleTree) >> asCenterAndContinue
|
||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify (regenerateScreens j d . toggleEmpty) >> asCenterAndContinue
|
||||
VtyEvent (EvKey (KChar 'R') []) -> modify (regenerateScreens j d . toggleReal) >> asCenterAndContinue
|
||||
VtyEvent (EvKey (KChar 'U') []) -> modify (regenerateScreens j d . toggleUnmarked) >> asCenterAndContinue
|
||||
VtyEvent (EvKey (KChar 'P') []) -> modify (regenerateScreens j d . togglePending) >> asCenterAndContinue
|
||||
VtyEvent (EvKey (KChar 'C') []) -> modify (regenerateScreens j d . toggleCleared) >> asCenterAndContinue
|
||||
VtyEvent (EvKey (KChar 'F') []) -> modify (regenerateScreens j d . toggleForecast d)
|
||||
|
||||
VtyEvent (EvKey (KDown) [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui
|
||||
VtyEvent (EvKey (KUp) [MShift]) -> continue $ regenerateScreens j d $ growReportPeriod d ui
|
||||
VtyEvent (EvKey (KRight) [MShift]) -> continue $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
||||
VtyEvent (EvKey (KLeft) [MShift]) -> continue $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
||||
VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
||||
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
|
||||
VtyEvent e | e `elem` moveLeftEvents -> continue $ popScreen ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> redraw ui
|
||||
VtyEvent (EvKey (KDown) [MShift]) -> put $ regenerateScreens j d $ shrinkReportPeriod d ui
|
||||
VtyEvent (EvKey (KUp) [MShift]) -> put $ regenerateScreens j d $ growReportPeriod d ui
|
||||
VtyEvent (EvKey (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
||||
VtyEvent (EvKey (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
||||
VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
||||
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui)
|
||||
VtyEvent e | e `elem` moveLeftEvents -> put $ popScreen ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
|
||||
-- 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
|
||||
-- just use it to move the selection
|
||||
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
|
||||
-- and on MouseUp, enter the subscreen
|
||||
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
|
||||
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
|
||||
|
||||
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
|
||||
-- pushing the selection when necessary.
|
||||
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
||||
let scrollamt = if btn==BScrollUp then -1 else 1
|
||||
list' <- listScrollPushingSelection name _asList (asListSize _asList) scrollamt
|
||||
continue ui{aScreen=scr{_asList=list'}}
|
||||
list' <- nestEventM' _asList $ listScrollPushingSelection name (asListSize _asList) scrollamt
|
||||
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
|
||||
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
||||
list <- handleListEvent e _asList
|
||||
list <- nestEventM' _asList $ handleListEvent e
|
||||
if isBlankElement $ listSelectedElement list
|
||||
then do
|
||||
let list' = listMoveTo lastnonblankidx 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
|
||||
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)
|
||||
VtyEvent ev -> do
|
||||
newitems <- handleListEvent (normaliseMovementKeys ev) _asList
|
||||
continue $ ui{aScreen=scr & asList .~ newitems
|
||||
& asSelectedAccount .~ selacct
|
||||
}
|
||||
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys ev)
|
||||
put $ ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct }
|
||||
|
||||
MouseDown{} -> continue ui
|
||||
MouseUp{} -> continue ui
|
||||
AppEvent _ -> continue ui
|
||||
|
||||
where
|
||||
journalspan = journalDateSpan False j
|
||||
|
||||
asHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
MouseDown{} -> put ui
|
||||
MouseUp{} -> put ui
|
||||
AppEvent _ -> put ui
|
||||
|
||||
asEnterRegister d selacct ui = do
|
||||
rsCenterAndContinue $
|
||||
@ -399,8 +388,9 @@ asSetSelectedAccount _ s = s
|
||||
|
||||
isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
|
||||
|
||||
asCenterAndContinue ui = do
|
||||
scrollSelectionToMiddle $ _asList $ aScreen ui
|
||||
continue ui
|
||||
asCenterAndContinue :: EventM Name UIState ()
|
||||
asCenterAndContinue = do
|
||||
ui <- get
|
||||
scrollSelectionToMiddle (_asList $ aScreen ui)
|
||||
|
||||
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements
|
||||
|
||||
@ -54,10 +54,10 @@ esDraw UIState{aopts=UIOpts{uoCliOpts=copts}
|
||||
_ -> [maincontent]
|
||||
where
|
||||
maincontent = Widget Greedy Greedy $ do
|
||||
render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError
|
||||
render $ defaultLayout toplabel bottomlabel $ withAttr (attrName "error") $ str $ esError
|
||||
where
|
||||
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")
|
||||
|
||||
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:
|
||||
|
||||
esHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
||||
esHandle ui@UIState{aScreen=ErrorScreen{..}
|
||||
esHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||
esHandle ev = do
|
||||
ui@UIState{aScreen=ErrorScreen{..}
|
||||
,aopts=UIOpts{uoCliOpts=copts}
|
||||
,ajournal=j
|
||||
,aMode=mode
|
||||
}
|
||||
ev =
|
||||
} <- get
|
||||
case mode of
|
||||
Help ->
|
||||
case ev of
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> helpHandle ui ev
|
||||
_ -> helpHandle ev
|
||||
|
||||
_ -> do
|
||||
let d = copts^.rsDay
|
||||
case ev of
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey KEsc []) -> continue $ uiCheckBalanceAssertions d $ resetScreens d ui
|
||||
VtyEvent (EvKey (KChar c) []) | c `elem` ['h','?'] -> continue $ setMode Help ui
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
VtyEvent (EvKey KEsc []) -> put $ uiCheckBalanceAssertions d $ resetScreens d 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)
|
||||
where
|
||||
(pos,f) = case parsewithString hledgerparseerrorpositionp esError of
|
||||
Right (f,l,c) -> (Just (l, Just c),f)
|
||||
Left _ -> (endPosition, journalFilePath j)
|
||||
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
|
||||
-- case ej of
|
||||
-- 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
|
||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui)
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
||||
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui)
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> continue ui
|
||||
|
||||
esHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
_ -> return ()
|
||||
|
||||
-- | 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
|
||||
|
||||
@ -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.
|
||||
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 {
|
||||
appStartEvent = return
|
||||
appStartEvent = return ()
|
||||
, appAttrMap = const $ fromMaybe defaultTheme $ getTheme =<< uoTheme uopts'
|
||||
, appChooseCursor = showFirstCursor
|
||||
, appHandleEvent = \ui ev -> sHandle (aScreen ui) ui ev
|
||||
, appDraw = \ui -> sDraw (aScreen ui) ui
|
||||
, appHandleEvent = sHandle (aScreen ui)
|
||||
, appDraw = sDraw (aScreen ui)
|
||||
}
|
||||
|
||||
-- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit
|
||||
|
||||
@ -4,7 +4,6 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
|
||||
|
||||
module Hledger.UI.RegisterScreen
|
||||
@ -199,7 +198,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
||||
-- inclusive = tree_ ropts || rsForceInclusive
|
||||
|
||||
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")
|
||||
<+> togglefilters
|
||||
<+> str " transactions"
|
||||
@ -212,7 +211,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
||||
<+> str "/"
|
||||
<+> total
|
||||
<+> 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
|
||||
togglefilters =
|
||||
case concat [
|
||||
@ -221,7 +220,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
||||
,if empty_ ropts then [] else ["nonzero"]
|
||||
] of
|
||||
[] -> str ""
|
||||
fs -> withAttr ("border" <> "query") (str $ " " ++ intercalate ", " fs)
|
||||
fs -> withAttr (attrName "border" <> attrName "query") (str $ " " ++ intercalate ", " fs)
|
||||
cur = str $ case rsList ^. listSelectedL of
|
||||
Nothing -> "-"
|
||||
Just i -> show (i + 1)
|
||||
@ -271,20 +270,21 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
|
||||
where
|
||||
changeAmt = wbToText rsItemChangeAmount
|
||||
balanceAmt = wbToText rsItemBalanceAmount
|
||||
changeattr | T.any (=='-') changeAmt = sel $ "list" <> "amount" <> "decrease"
|
||||
| otherwise = sel $ "list" <> "amount" <> "increase"
|
||||
balattr | T.any (=='-') balanceAmt = sel $ "list" <> "balance" <> "negative"
|
||||
| otherwise = sel $ "list" <> "balance" <> "positive"
|
||||
sel | selected = (<> "selected")
|
||||
changeattr | T.any (=='-') changeAmt = sel $ attrName "list" <> attrName "amount" <> attrName "decrease"
|
||||
| otherwise = sel $ attrName "list" <> attrName "amount" <> attrName "increase"
|
||||
balattr | T.any (=='-') balanceAmt = sel $ attrName "list" <> attrName "balance" <> attrName "negative"
|
||||
| otherwise = sel $ attrName "list" <> attrName "balance" <> attrName "positive"
|
||||
sel | selected = (<> attrName "selected")
|
||||
| otherwise = id
|
||||
|
||||
rsHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
||||
rsHandle ui@UIState{
|
||||
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||
rsHandle ev = do
|
||||
ui@UIState{
|
||||
aScreen=s@RegisterScreen{..}
|
||||
,aopts=UIOpts{uoCliOpts=copts}
|
||||
,ajournal=j
|
||||
,aMode=mode
|
||||
} ev = do
|
||||
} <- get
|
||||
let
|
||||
d = copts^.rsDay
|
||||
journalspan = journalDateSpan False j
|
||||
@ -294,50 +294,44 @@ rsHandle ui@UIState{
|
||||
case mode of
|
||||
Minibuffer _ ed ->
|
||||
case ev of
|
||||
VtyEvent (EvKey KEsc []) -> continue $ closeMinibuffer ui
|
||||
VtyEvent (EvKey KEnter []) -> continue $ regenerateScreens j d $
|
||||
VtyEvent (EvKey KEsc []) -> modify closeMinibuffer
|
||||
VtyEvent (EvKey KEnter []) -> put $ regenerateScreens j d $
|
||||
case setFilter s $ closeMinibuffer ui of
|
||||
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
|
||||
Right ui' -> ui'
|
||||
where s = chomp . unlines . map strip $ getEditContents ed
|
||||
-- VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
||||
-- VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
VtyEvent ev -> do
|
||||
ed' <- handleEditorEvent
|
||||
#if MIN_VERSION_brick(0,72,0)
|
||||
(VtyEvent ev)
|
||||
#else
|
||||
ev
|
||||
#endif
|
||||
ed
|
||||
continue $ ui{aMode=Minibuffer "filter" ed'}
|
||||
AppEvent _ -> continue ui
|
||||
MouseDown{} -> continue ui
|
||||
MouseUp{} -> continue ui
|
||||
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
||||
put ui{aMode=Minibuffer "filter" ed'}
|
||||
AppEvent _ -> return ()
|
||||
MouseDown{} -> return ()
|
||||
MouseUp{} -> return ()
|
||||
|
||||
Help ->
|
||||
case ev of
|
||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> helpHandle ui ev
|
||||
_ -> helpHandle ev
|
||||
|
||||
Normal ->
|
||||
case ev of
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey KEsc []) -> continue $ resetScreens d ui
|
||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> continue $ setMode Help ui
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||
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
|
||||
p = reportPeriod ui
|
||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||
liftIO (uiReloadJournal copts d ui) >>= continue
|
||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||
liftIO (uiReloadJournal copts d ui) >>= put
|
||||
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 $ 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
|
||||
where
|
||||
(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 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast d ui
|
||||
|
||||
VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
||||
VtyEvent (EvKey (KDown) [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui
|
||||
VtyEvent (EvKey (KUp) [MShift]) -> continue $ regenerateScreens j d $ growReportPeriod d ui
|
||||
VtyEvent (EvKey (KRight) [MShift]) -> continue $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
||||
VtyEvent (EvKey (KLeft) [MShift]) -> continue $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
||||
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> redraw ui
|
||||
VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
|
||||
VtyEvent (EvKey (KDown) [MShift]) -> put $ regenerateScreens j d $ shrinkReportPeriod d ui
|
||||
VtyEvent (EvKey (KUp) [MShift]) -> put $ regenerateScreens j d $ growReportPeriod d ui
|
||||
VtyEvent (EvKey (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
||||
VtyEvent (EvKey (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
||||
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui)
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
|
||||
-- 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.
|
||||
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.
|
||||
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
|
||||
|
||||
-- enter transaction screen on RIGHT
|
||||
VtyEvent e | e `elem` moveRightEvents ->
|
||||
case listSelectedElement rsList of
|
||||
Just _ -> continue $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
||||
Nothing -> continue ui
|
||||
Just _ -> put $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
||||
Nothing -> put ui
|
||||
-- or on transaction click
|
||||
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
||||
-- just use it to move the selection
|
||||
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
|
||||
-- and on MouseUp, enter the subscreen
|
||||
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
|
||||
|
||||
-- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
|
||||
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
|
||||
|
||||
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
|
||||
-- pushing the selection when necessary.
|
||||
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
||||
let scrollamt = if btn==BScrollUp then -1 else 1
|
||||
list' <- listScrollPushingSelection name rsList (rsListSize rsList) scrollamt
|
||||
continue ui{aScreen=s{rsList=list'}}
|
||||
list' <- nestEventM' rsList $ listScrollPushingSelection name (rsListSize rsList) scrollamt
|
||||
put ui{aScreen=s{rsList=list'}}
|
||||
|
||||
-- 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
|
||||
list <- handleListEvent e rsList
|
||||
list <- nestEventM' rsList $ handleListEvent e
|
||||
if isBlankElement $ listSelectedElement list
|
||||
then do
|
||||
let list' = listMoveTo lastnonblankidx list
|
||||
scrollSelectionToMiddle list'
|
||||
continue ui{aScreen=s{rsList=list'}}
|
||||
put ui{aScreen=s{rsList=list'}}
|
||||
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)
|
||||
VtyEvent ev -> do
|
||||
let ev' = normaliseMovementKeys ev
|
||||
newitems <- handleListEvent ev' rsList
|
||||
continue ui{aScreen=s{rsList=newitems}}
|
||||
newitems <- nestEventM' rsList $ handleListEvent ev'
|
||||
put ui{aScreen=s{rsList=newitems}}
|
||||
|
||||
MouseDown{} -> continue ui
|
||||
MouseUp{} -> continue ui
|
||||
AppEvent _ -> continue ui
|
||||
|
||||
rsHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
MouseDown{} -> put ui
|
||||
MouseUp{} -> put ui
|
||||
AppEvent _ -> put ui
|
||||
|
||||
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
|
||||
|
||||
rsCenterAndContinue ui = do
|
||||
scrollSelectionToMiddle $ rsList $ aScreen ui
|
||||
continue ui
|
||||
put ui
|
||||
|
||||
rsListSize = V.length . V.takeWhile ((/="").rsItemDate) . listElements
|
||||
|
||||
@ -65,42 +65,42 @@ select = black `on` selectbg
|
||||
themesList :: [(String, AttrMap)]
|
||||
themesList = [
|
||||
("default", attrMap (black `on` white) [
|
||||
("border" , white `on` black & dim)
|
||||
,("border" <> "bold" , currentAttr & bold)
|
||||
,("border" <> "depth" , active)
|
||||
,("border" <> "filename" , currentAttr)
|
||||
,("border" <> "key" , active)
|
||||
,("border" <> "minibuffer" , white `on` black & bold)
|
||||
,("border" <> "query" , active)
|
||||
,("border" <> "selected" , active)
|
||||
,("error" , fg red)
|
||||
,("help" , white `on` black & dim)
|
||||
,("help" <> "heading" , fg yellow)
|
||||
,("help" <> "key" , active)
|
||||
-- ,("list" , black `on` white)
|
||||
-- ,("list" <> "amount" , currentAttr)
|
||||
,("list" <> "amount" <> "decrease" , fg red)
|
||||
-- ,("list" <> "amount" <> "increase" , fg green)
|
||||
,("list" <> "amount" <> "decrease" <> "selected" , red `on` selectbg & bold)
|
||||
-- ,("list" <> "amount" <> "increase" <> "selected" , green `on` selectbg & bold)
|
||||
,("list" <> "balance" , currentAttr & bold)
|
||||
,("list" <> "balance" <> "negative" , fg red)
|
||||
,("list" <> "balance" <> "positive" , fg black)
|
||||
,("list" <> "balance" <> "negative" <> "selected" , red `on` selectbg & bold)
|
||||
,("list" <> "balance" <> "positive" <> "selected" , select & bold)
|
||||
,("list" <> "selected" , select)
|
||||
-- ,("list" <> "accounts" , white `on` brightGreen)
|
||||
-- ,("list" <> "selected" , black `on` brightYellow)
|
||||
(attrName "border" , white `on` black & dim)
|
||||
,(attrName "border" <> attrName "bold" , currentAttr & bold)
|
||||
,(attrName "border" <> attrName "depth" , active)
|
||||
,(attrName "border" <> attrName "filename" , currentAttr)
|
||||
,(attrName "border" <> attrName "key" , active)
|
||||
,(attrName "border" <> attrName "minibuffer" , white `on` black & bold)
|
||||
,(attrName "border" <> attrName "query" , active)
|
||||
,(attrName "border" <> attrName "selected" , active)
|
||||
,(attrName "error" , fg red)
|
||||
,(attrName "help" , white `on` black & dim)
|
||||
,(attrName "help" <> attrName "heading" , fg yellow)
|
||||
,(attrName "help" <> attrName "key" , active)
|
||||
-- ,(attrName "list" , black `on` white)
|
||||
-- ,(attrName "list" <> attrName "amount" , currentAttr)
|
||||
,(attrName "list" <> attrName "amount" <> attrName "decrease" , fg red)
|
||||
-- ,(attrName "list" <> attrName "amount" <> attrName "increase" , fg green)
|
||||
,(attrName "list" <> attrName "amount" <> attrName "decrease" <> attrName "selected" , red `on` selectbg & bold)
|
||||
-- ,(attrName "list" <> attrName "amount" <> attrName "increase" <> attrName "selected" , green `on` selectbg & bold)
|
||||
,(attrName "list" <> attrName "balance" , currentAttr & bold)
|
||||
,(attrName "list" <> attrName "balance" <> attrName "negative" , fg red)
|
||||
,(attrName "list" <> attrName "balance" <> attrName "positive" , fg black)
|
||||
,(attrName "list" <> attrName "balance" <> attrName "negative" <> attrName "selected" , red `on` selectbg & bold)
|
||||
,(attrName "list" <> attrName "balance" <> attrName "positive" <> attrName "selected" , select & bold)
|
||||
,(attrName "list" <> attrName "selected" , select)
|
||||
-- ,(attrName "list" <> attrName "accounts" , white `on` brightGreen)
|
||||
-- ,(attrName "list" <> attrName "selected" , black `on` brightYellow)
|
||||
])
|
||||
|
||||
,("greenterm", attrMap (green `on` black) [
|
||||
("list" <> "selected" , black `on` green)
|
||||
(attrName "list" <> attrName "selected" , black `on` green)
|
||||
])
|
||||
|
||||
,("terminal", attrMap defAttr [
|
||||
("border" , white `on` black),
|
||||
("list" , defAttr),
|
||||
("list" <> "selected" , defAttr & reverseVideo)
|
||||
(attrName "border" , white `on` black),
|
||||
(attrName "list" , defAttr),
|
||||
(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 (tindex t))
|
||||
<+> str " ("
|
||||
<+> withAttr ("border" <> "bold") (str $ show i)
|
||||
<+> withAttr (attrName "border" <> attrName "bold") (str $ show i)
|
||||
<+> str (" of "++show (length nts))
|
||||
<+> togglefilters
|
||||
<+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
|
||||
<+> 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
|
||||
togglefilters =
|
||||
case concat [
|
||||
@ -121,7 +121,7 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec
|
||||
,if empty_ ropts then [] else ["nonzero"]
|
||||
] of
|
||||
[] -> str ""
|
||||
fs -> withAttr ("border" <> "query") (str $ " " ++ intercalate ", " fs)
|
||||
fs -> withAttr (attrName "border" <> attrName "query") (str $ " " ++ intercalate ", " fs)
|
||||
|
||||
bottomlabel = quickhelp
|
||||
-- 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:
|
||||
|
||||
tsHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
||||
tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
|
||||
tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||
tsHandle ev = do
|
||||
ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
|
||||
,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
|
||||
,ajournal=j
|
||||
,aMode=mode
|
||||
}
|
||||
ev =
|
||||
} <- get
|
||||
case mode of
|
||||
Help ->
|
||||
case ev of
|
||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> helpHandle ui ev
|
||||
_ -> helpHandle ev
|
||||
|
||||
_ -> do
|
||||
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
|
||||
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
||||
case ev of
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
||||
VtyEvent (EvKey KEsc []) -> continue $ resetScreens d ui
|
||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> continue $ setMode Help ui
|
||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
||||
where
|
||||
(pos,f) = case tsourcepos t of
|
||||
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
|
||||
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
|
||||
p = reportPeriod ui
|
||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
|
||||
-- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return ()
|
||||
ej <- liftIO . runExceptT $ journalReload copts
|
||||
case ej of
|
||||
Left err -> continue $ screenEnter d errorScreen{esError=err} ui
|
||||
Right j' -> continue $ regenerateScreens j' d ui
|
||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||
Left err -> put $ screenEnter d errorScreen{esError=err} ui
|
||||
Right j' -> put $ regenerateScreens j' d ui
|
||||
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||
|
||||
-- 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
|
||||
-- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty ui
|
||||
-- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared ui
|
||||
-- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal ui
|
||||
VtyEvent (EvKey (KChar 'B') []) -> continue . regenerateScreens j d $ toggleConversionOp ui
|
||||
VtyEvent (EvKey (KChar 'V') []) -> continue . regenerateScreens j d $ toggleValue ui
|
||||
-- EvKey (KChar 'E') [] -> put $ regenerateScreens j d $ stToggleEmpty ui
|
||||
-- EvKey (KChar 'C') [] -> put $ regenerateScreens j d $ stToggleCleared ui
|
||||
-- EvKey (KChar 'R') [] -> put $ regenerateScreens j d $ stToggleReal ui
|
||||
VtyEvent (EvKey (KChar 'B') []) -> put . regenerateScreens j d $ toggleConversionOp 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` moveDownEvents -> continue $ tsSelect inext tnext ui
|
||||
VtyEvent e | e `elem` moveUpEvents -> put $ tsSelect iprev tprev ui
|
||||
VtyEvent e | e `elem` moveDownEvents -> put $ tsSelect inext tnext ui
|
||||
|
||||
-- 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.
|
||||
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.
|
||||
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
|
||||
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> continue ui
|
||||
|
||||
tsHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
_ -> return ()
|
||||
|
||||
-- | Select a new transaction and update the previous register screen
|
||||
tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of
|
||||
|
||||
@ -33,6 +33,7 @@ Brick.defaultMain brickapp st
|
||||
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
@ -100,7 +101,7 @@ data Screen =
|
||||
AccountsScreen {
|
||||
sInit :: Day -> Bool -> UIState -> UIState -- ^ function to initialise or update this screen's state
|
||||
,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:
|
||||
,_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 "")
|
||||
@ -108,7 +109,7 @@ data Screen =
|
||||
| RegisterScreen {
|
||||
sInit :: Day -> Bool -> UIState -> UIState
|
||||
,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
|
||||
,rsAccount :: AccountName -- ^ the account this register is for
|
||||
@ -119,7 +120,7 @@ data Screen =
|
||||
| TransactionScreen {
|
||||
sInit :: Day -> Bool -> UIState -> UIState
|
||||
,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
|
||||
,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through
|
||||
@ -128,7 +129,7 @@ data Screen =
|
||||
| ErrorScreen {
|
||||
sInit :: Day -> Bool -> UIState -> UIState
|
||||
,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
|
||||
}
|
||||
@ -154,6 +155,10 @@ data RegisterScreenItem = RegisterScreenItem {
|
||||
}
|
||||
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)
|
||||
|
||||
-- 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.Dialog
|
||||
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 Data.Bifunctor (second)
|
||||
import Data.List
|
||||
@ -60,6 +60,7 @@ suspendSignal :: IO ()
|
||||
suspendSignal = return ()
|
||||
#else
|
||||
import System.Posix.Signals
|
||||
import Data.Vector (Vector)
|
||||
suspendSignal :: IO ()
|
||||
suspendSignal = raiseSignal sigSTOP
|
||||
#endif
|
||||
@ -68,12 +69,12 @@ suspendSignal = raiseSignal sigSTOP
|
||||
-- like control-z in bash, returning to the original shell prompt,
|
||||
-- and when resumed, continue where we left off.
|
||||
-- On windows, does nothing.
|
||||
suspend :: s -> EventM a (Next s)
|
||||
suspend :: Ord a => s -> EventM a s ()
|
||||
suspend st = suspendAndResume $ suspendSignal >> return st
|
||||
|
||||
-- | Tell vty to redraw the whole screen, and continue.
|
||||
redraw :: s -> EventM a (Next s)
|
||||
redraw st = getVtyHandle >>= liftIO . refresh >> continue st
|
||||
-- | Tell vty to redraw the whole screen.
|
||||
redraw :: EventM a s ()
|
||||
redraw = getVtyHandle >>= liftIO . refresh
|
||||
|
||||
-- | Wrap a widget in the default hledger-ui screen layout.
|
||||
defaultLayout :: Widget Name -> Widget Name -> Widget Name -> Widget Name
|
||||
@ -90,14 +91,14 @@ helpDialog _copts =
|
||||
Widget Fixed Fixed $ do
|
||||
c <- getContext
|
||||
render $
|
||||
withDefAttr "help" $
|
||||
withDefAttr (attrName "help") $
|
||||
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) $
|
||||
vBox [
|
||||
hBox [
|
||||
padRight (Pad 1) $
|
||||
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", "")
|
||||
,str " move selection up/down"
|
||||
,renderKey ("RIGHT/l/C-f", "show txns, or txn detail")
|
||||
@ -105,23 +106,23 @@ helpDialog _copts =
|
||||
,renderKey ("ESC ", "cancel, or reset app state")
|
||||
|
||||
,str " "
|
||||
,withAttr ("help" <> "heading") $ str "Accounts screen"
|
||||
,withAttr (attrName "help" <> attrName "heading") $ str "Accounts screen"
|
||||
,renderKey ("1234567890-+ ", "set/adjust depth limit")
|
||||
,renderKey ("t ", "toggle accounts tree/list mode")
|
||||
,renderKey ("H ", "toggle historical balance/change")
|
||||
,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 ("H ", "toggle historical/period total")
|
||||
,str " "
|
||||
,withAttr ("help" <> "heading") $ str "Help"
|
||||
,withAttr (attrName "help" <> attrName "heading") $ str "Help"
|
||||
,renderKey ("? ", "toggle this help")
|
||||
,renderKey ("p/m/i", "while help is open:\nshow manual in pager/man/info")
|
||||
,str " "
|
||||
]
|
||||
,padLeft (Pad 1) $ padRight (Pad 0) $
|
||||
vBox [
|
||||
withAttr ("help" <> "heading") $ str "Filtering"
|
||||
withAttr (attrName "help" <> attrName "heading") $ str "Filtering"
|
||||
,renderKey ("/ ", "set a filter query")
|
||||
,renderKey ("F ", "show future & periodic txns")
|
||||
,renderKey ("R ", "show real/all postings")
|
||||
@ -132,7 +133,7 @@ helpDialog _copts =
|
||||
,renderKey ("T ", "set period to today")
|
||||
,renderKey ("DEL ", "reset filters")
|
||||
,str " "
|
||||
,withAttr ("help" <> "heading") $ str "Other"
|
||||
,withAttr (attrName "help" <> attrName "heading") $ str "Other"
|
||||
,renderKey ("a ", "add transaction (hledger add)")
|
||||
,renderKey ("A ", "add transaction (hledger-iadd)")
|
||||
,renderKey ("B ", "show amounts/costs")
|
||||
@ -160,39 +161,40 @@ helpDialog _copts =
|
||||
-- ]
|
||||
]
|
||||
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.
|
||||
-- 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 ui ev = do
|
||||
helpHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||
helpHandle ev = do
|
||||
ui <- get
|
||||
let ui' = setMode Normal ui
|
||||
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 'm') []) -> suspendAndResume $ runManForTopic "hledger-ui" Nothing >> return ui'
|
||||
VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume $ runInfoForTopic "hledger-ui" Nothing >> return ui'
|
||||
_ -> continue ui
|
||||
_ -> return ()
|
||||
where
|
||||
ui' = setMode Normal ui
|
||||
closeHelpEvents = moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') [], EvKey (KChar 'q') []]
|
||||
|
||||
-- | Draw the minibuffer with the given label.
|
||||
minibuffer :: T.Text -> Editor String Name -> Widget Name
|
||||
minibuffer string ed =
|
||||
forceAttr ("border" <> "minibuffer") $
|
||||
forceAttr (attrName "border" <> attrName "minibuffer") $
|
||||
hBox [txt $ string <> ": ", renderEditor (str . unlines) True ed]
|
||||
|
||||
borderQueryStr :: String -> Widget Name
|
||||
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 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 _ 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 = borderKeysStr' . map (second str)
|
||||
@ -201,7 +203,7 @@ borderKeysStr' :: [(String,Widget Name)] -> Widget Name
|
||||
borderKeysStr' keydescs =
|
||||
hBox $
|
||||
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
|
||||
-- sep = str " | "
|
||||
sep = str " "
|
||||
@ -209,7 +211,7 @@ borderKeysStr' keydescs =
|
||||
-- | Show both states of a toggle ("aaa/bbb"), highlighting the active one.
|
||||
renderToggle :: Bool -> String -> String -> Widget Name
|
||||
renderToggle isright l r =
|
||||
let bold = withAttr ("border" <> "selected") in
|
||||
let bold = withAttr (attrName "border" <> attrName "selected") in
|
||||
if isright
|
||||
then str (l++"/") <+> bold (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.
|
||||
renderToggle1 :: Bool -> String -> Widget Name
|
||||
renderToggle1 isactive l =
|
||||
let bold = withAttr ("border" <> "selected") in
|
||||
let bold = withAttr (attrName "border" <> attrName "selected") in
|
||||
if isactive
|
||||
then bold (str l)
|
||||
else str l
|
||||
@ -262,11 +264,11 @@ topBottomBorderWithLabels toplabel bottomlabel body =
|
||||
""
|
||||
-- " debug: "++show (_w,h')
|
||||
render $
|
||||
hBorderWithLabel (withAttr "border" $ toplabel <+> str debugmsg)
|
||||
hBorderWithLabel (withAttr (attrName "border") $ toplabel <+> str debugmsg)
|
||||
<=>
|
||||
body'
|
||||
<=>
|
||||
hBorderWithLabel (withAttr "border" bottomlabel)
|
||||
hBorderWithLabel (withAttr (attrName "border") bottomlabel)
|
||||
|
||||
---- XXX should be equivalent to the above, but isn't (page down goes offscreen)
|
||||
--_topBottomBorderWithLabel2 :: Widget Name -> Widget Name -> Widget Name
|
||||
@ -303,7 +305,7 @@ margin h v mcolour w = Widget Greedy Greedy $ do
|
||||
-- applyN n border
|
||||
|
||||
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.
|
||||
---- 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
|
||||
-- middle of the display area.
|
||||
scrollSelectionToMiddle :: List Name e -> EventM Name ()
|
||||
scrollSelectionToMiddle :: List Name item -> EventM Name UIState ()
|
||||
scrollSelectionToMiddle list = do
|
||||
case list^.listSelectedL of
|
||||
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
|
||||
-- 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.
|
||||
listScrollPushingSelection :: (Ord n, Foldable t, Splittable t) =>
|
||||
n -> GenericList n t e -> Int -> Int -> EventM n (GenericList n t e)
|
||||
listScrollPushingSelection name list listheight scrollamt = do
|
||||
listScrollPushingSelection :: Name -> Int -> Int -> EventM Name (List Name item) (GenericList Name Vector item)
|
||||
listScrollPushingSelection name listheight scrollamt = do
|
||||
list <- get
|
||||
viewportScroll name `vScrollBy` scrollamt
|
||||
mvp <- lookupViewport name
|
||||
case mvp of
|
||||
|
||||
@ -68,7 +68,7 @@ executable hledger-ui
|
||||
ansi-terminal >=0.9
|
||||
, async
|
||||
, base >=4.11 && <4.17
|
||||
, brick >=0.23
|
||||
, brick >=1.0
|
||||
, cmdargs >=0.8
|
||||
, containers >=0.5.9
|
||||
, data-default
|
||||
|
||||
@ -76,7 +76,7 @@ dependencies:
|
||||
- transformers
|
||||
- vector
|
||||
# not installable on windows, cf buildable flag below
|
||||
- brick >=0.23 && <1
|
||||
- brick >=1.0
|
||||
- vty >=5.15
|
||||
- unix
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
# stack build plan using GHC 9.2.4
|
||||
|
||||
resolver: nightly-2022-08-04
|
||||
resolver: nightly-2022-08-14
|
||||
|
||||
packages:
|
||||
- hledger-lib
|
||||
@ -8,10 +8,11 @@ packages:
|
||||
- hledger-ui
|
||||
- hledger-web
|
||||
|
||||
# extra-deps:
|
||||
extra-deps:
|
||||
# for hledger-lib:
|
||||
# for hledger:
|
||||
# for hledger-ui:
|
||||
- brick-1.0
|
||||
# for hledger-web:
|
||||
# for Shake.hs:
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user