1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
-- The menu screen, showing other screens available in hledger-ui.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.UI.MenuScreen
(msNew
,msUpdate
,msDraw
,msHandle
,msSetSelectedScreen
)
where
import Brick
import Brick.Widgets.List
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Vector as V
import Data.Vector ((!?))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Lens.Micro.Platform
import System.Console.ANSI
import System.FilePath (takeFileName)
import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Hledger.UI.Editor (runIadd, runEditor, endPosition)
import Brick.Widgets.Edit (getEditContents, handleEditorEvent)
msDraw :: UIState -> [Widget Name]
msDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=_rspec}}
,ajournal=j
,aScreen=MS sst
,aMode=mode
} = dbgui "msDraw" $
case mode of
Help -> [helpDialog, maincontent]
_ -> [maincontent]
where
maincontent = Widget Greedy Greedy $ do
render $ defaultLayout toplabel bottomlabel $ renderList msDrawItem True (sst ^. mssList)
where
toplabel =
withAttr (attrName "border" <> attrName "filename") files
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions")
else str "")
where
files = case journalFilePaths j of
[] -> str ""
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)")
bottomlabel = case mode of
Minibuffer label ed -> minibuffer label ed
_ -> quickhelp
where
quickhelp = borderKeysStr' [
("DOWN/UP", str "select")
,("RIGHT", str "enter screen")
-- ,("t", renderToggle (tree_ ropts) "list" "tree")
-- ,("t", str "tree")
-- ,("l", str "list")
-- ,("-+", str "depth")
-- ,("H", renderToggle (not ishistorical) "end-bals" "changes")
-- ,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter")
--,("DEL", "unfilter")
--,("ESC", "cancel/top")
,("a", str "add txn")
-- ,("g", "reload")
,("?", str "help")
,("q", str "quit")
]
msDraw _ = dbgui "msDraw" $ errorWrongScreenType "draw function" -- PARTIAL:
-- msDrawItem :: (Int,Int) -> Bool -> MenuScreenItem -> Widget Name
-- msDrawItem (_acctwidth, _balwidth) _selected MenuScreenItem{..} =
msDrawItem :: Bool -> MenuScreenItem -> Widget Name
msDrawItem _selected MenuScreenItem{..} =
Widget Greedy Fixed $ do
render $ txt msItemScreenName
-- XXX clean up like asHandle
msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle ev = do
ui0 <- get'
dbguiEv "msHandle"
case ui0 of
ui@UIState{
aopts=UIOpts{uoCliOpts=copts}
,ajournal=j
,aMode=mode
,aScreen=MS sst
} -> do
let
-- save the currently selected account, in case we leave this screen and lose the selection
mselscr = case listSelectedElement $ _mssList sst of
Just (_, MenuScreenItem{..}) -> Just msItemScreen
Nothing -> Nothing
nonblanks = V.takeWhile (not . T.null . msItemScreenName) $ listElements $ _mssList sst
lastnonblankidx = max 0 (length nonblanks - 1)
d <- liftIO getCurrentDay
case mode of
Minibuffer _ ed ->
case ev of
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
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
VtyEvent e -> do
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent e)
put' ui{aMode=Minibuffer "filter" ed'}
AppEvent _ -> return ()
MouseDown{} -> return ()
MouseUp{} -> return ()
Help ->
case ev of
-- VtyEvent (EvKey (KChar 'q') []) -> halt
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
_ -> helpHandle ev
Normal ->
case ev of
VtyEvent (EvKey (KChar 'q') []) -> halt
-- EvKey (KChar 'l') [MCtrl] -> do
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 ->
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) >>= 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') []) -> 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') []) -> modify' (regenerateScreens j d . toggleHistorical) >> msCenterAndContinue
-- VtyEvent (EvKey (KChar 't') []) -> modify' (regenerateScreens j d . toggleTree) >> msCenterAndContinue
-- VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify' (regenerateScreens j d . toggleEmpty) >> msCenterAndContinue
-- VtyEvent (EvKey (KChar 'R') []) -> modify' (regenerateScreens j d . toggleReal) >> msCenterAndContinue
-- VtyEvent (EvKey (KChar 'U') []) -> modify' (regenerateScreens j d . toggleUnmarked) >> msCenterAndContinue
-- VtyEvent (EvKey (KChar 'P') []) -> modify' (regenerateScreens j d . togglePending) >> msCenterAndContinue
-- VtyEvent (EvKey (KChar 'C') []) -> modify' (regenerateScreens j d . toggleCleared) >> msCenterAndContinue
-- VtyEvent (EvKey (KChar 'F') []) -> modify' (regenerateScreens j d . toggleForecast d)
-- 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 (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_mssList sst) >> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
-- RIGHT enters selected screen if there is one
VtyEvent e | e `elem` moveRightEvents
, not $ isBlankElement $ listSelectedElement (_mssList sst) ->
msEnterScreen d (fromMaybe Accounts mselscr) ui
-- 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 $ (=="") clickedname -> do
put' ui{aScreen=MS sst} -- XXX does this do anything ?
where
item = listElements (_mssList sst) !? y
clickedname = maybe "" msItemScreenName item
-- mclickedscr = msItemScreen <$> item
-- and on MouseUp, enter the subscreen
MouseUp _n (Just BLeft) Location{loc=(_x,y)} -> -- | not $ (=="") clickedname ->
case mclickedscr of
Just scr -> msEnterScreen d scr ui
Nothing -> return ()
where
item = listElements (_mssList sst) !? y
-- clickedname = maybe "" msItemScreenName item
mclickedscr = msItemScreen <$> item
-- 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 $ (_mssList sst)^.listNameL) 1
where mnextelement = listSelectedElement $ listMoveDown (_mssList sst)
-- 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' <- nestEventM' (_mssList sst) $ listScrollPushingSelection name (msListSize (_mssList sst)) scrollamt
put' ui{aScreen=MS sst{_mssList=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
l <- nestEventM' (_mssList sst) $ handleListEvent e
if isBlankElement $ listSelectedElement l
then do
let l' = listMoveTo lastnonblankidx l
scrollSelectionToMiddle l'
put' ui{aScreen=MS sst{_mssList=l'}}
else
put' ui{aScreen=MS sst{_mssList=l}}
-- fall through to the list's event handler (handles up/down)
VtyEvent e -> do
list' <- nestEventM' (_mssList sst) $ handleListEvent (normaliseMovementKeys e)
put' ui{aScreen=MS $ sst & mssList .~ list'}
MouseDown{} -> return ()
MouseUp{} -> return ()
AppEvent _ -> return ()
_ -> dbguiEv "msHandle" >> errorWrongScreenType "event handler"
msEnterScreen :: Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen d scrname ui@UIState{ajournal=j, aopts=uopts} = do
dbguiEv "msEnterScreen"
let
scr = case scrname of
Accounts -> asNew uopts d j Nothing
CashScreen -> csNew uopts d j Nothing
Balancesheet -> bsNew uopts d j Nothing
Incomestatement -> isNew uopts d j Nothing
put' $ pushScreen scr ui
-- | Set the selected list item on the menu screen. Has no effect on other screens.
msSetSelectedScreen :: Int -> Screen -> Screen
msSetSelectedScreen selidx (MS mss@MSS{_mssList=l}) = MS mss{_mssList=listMoveTo selidx l}
msSetSelectedScreen _ s = s
isBlankElement mel = ((msItemScreenName . snd) <$> mel) == Just ""
msListSize = V.length . V.takeWhile ((/="").msItemScreenName) . listElements
|
