Skip to content

Commit 96c343c

Browse files
mniipmniip
authored
Implement scrolling in the build output widget (#3)
1 parent ea24de6 commit 96c343c

2 files changed

Lines changed: 149 additions & 55 deletions

File tree

‎src/Cabal/Matrix/Tui.hs‎

Lines changed: 17 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -139,13 +139,15 @@ appHandleSchedulerMessage ev ast = case ev of
139139
OnDone -> ast
140140

141141
appHandleEvent
142-
:: TuiMatrix
142+
:: DisplayRegion
143+
-> TuiMatrix
143144
-> PerCabalStep Bool
144145
-> Maybe SchedulerHandle
145146
-> AppEvent
146147
-> AppState
147148
-> IO (Maybe AppState)
148-
appHandleEvent matrix enabledSteps mScheduler aev ast = case aev of
149+
appHandleEvent (width, height) matrix enabledSteps mScheduler aev ast
150+
= case aev of
149151
AppTimerEvent ev -> pure $ Just ast
150152
{ flavorStates = IntMap.map (flavorHandleTimerEvent ev) ast.flavorStates }
151153
VtyEvent (EvKey (isExitKey -> True) _)
@@ -157,6 +159,7 @@ appHandleEvent matrix enabledSteps mScheduler aev ast = case aev of
157159
-> pure Nothing
158160
VtyEvent ev
159161
| Just (flavorIndex, os) <- ast.openedCell
162+
, Just fs <- IntMap.lookup flavorIndex ast.flavorStates
160163
-> case ev of
161164
EvKey (KChar 'c') (elem MCtrl -> True) -> do
162165
for_ mScheduler $ flip signalScheduler InterruptFlavor { flavorIndex }
@@ -171,7 +174,10 @@ appHandleEvent matrix enabledSteps mScheduler aev ast = case aev of
171174
for_ mScheduler $ flip signalScheduler RestartFlavor { flavorIndex }
172175
pure $ Just ast
173176
_ -> pure $ Just ast
174-
{ openedCell = Just (flavorIndex, outputHandleEvent enabledSteps ev os)
177+
{ openedCell = Just
178+
( flavorIndex
179+
, outputHandleEvent (width, height - 1) enabledSteps ev fs os
180+
)
175181
}
176182
| Just headerEditor <- ast.headerEditor
177183
, (headerEditor', headers')
@@ -278,13 +284,14 @@ tuiMainLoop tuiMatrix ast0 steps queue mScheduler = do
278284
bounds <- vty.outputIface.displayBounds
279285
let (!ast', !image) = appWidget bounds tuiMatrix steps ast
280286
vty.update $ picForImage image
281-
go ast'
282-
283-
go !ast = atomically (readTBQueue queue) >>= \case
284-
Left msg -> go (appHandleSchedulerMessage msg ast)
285-
Right ev -> appHandleEvent tuiMatrix steps mScheduler ev ast >>= \case
286-
Just ast' -> goDisplay ast'
287-
Nothing -> vty.shutdown
287+
go bounds ast'
288+
289+
go bounds !ast = atomically (readTBQueue queue) >>= \case
290+
Left msg -> go bounds (appHandleSchedulerMessage msg ast)
291+
Right ev -> appHandleEvent bounds tuiMatrix steps mScheduler ev ast
292+
>>= \case
293+
Just ast' -> goDisplay ast'
294+
Nothing -> vty.shutdown
288295

289296
goDisplay ast0
290297

‎src/Cabal/Matrix/Tui/Flavor.hs‎

Lines changed: 132 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import Cabal.Matrix.ProcessRunner
2020
import Cabal.Matrix.Record
2121
import Cabal.Matrix.Scheduler
2222
import Cabal.Matrix.Tui.Common
23+
import Control.Monad
2324
import Data.Bifunctor
2425
import Data.ByteString (ByteString)
2526
import Data.Function
@@ -67,44 +68,73 @@ statusColor ss = case ss.exit of
6768
Just ExitSuccess -> brightGreen
6869
Just (ExitFailure _) -> brightRed
6970

70-
stepOutputWidget :: DisplayRegion -> StepState -> Image
71-
stepOutputWidget (width, height) ss = header <-> output
71+
data ComputedHeader = ComputedHeader
72+
{ height :: Int
73+
, image :: Image
74+
}
75+
76+
computeHeader :: DisplayRegion -> StepState -> ComputedHeader
77+
computeHeader (width, _height) ss = ComputedHeader
78+
{ image = vertCat
79+
[ horizCat $ padToCommonHeight
80+
[ ( headerBg
81+
, ' '
82+
, text' (headerBg `withForeColor` brightYellow) commandText
83+
)
84+
, ( headerBg
85+
, ' '
86+
, vertCat
87+
[ resizeWidthFill headerBg ' ' (width - safeWctwidth commandText)
88+
$ text' headerBg line
89+
| line <- wrappedCommandText
90+
]
91+
)
92+
]
93+
, resizeWidthFill headerBg ' ' width
94+
$ text' (headerBg `withForeColor` brightYellow) "Status: " <|>
95+
case ss.exit of
96+
_ | not ss.started -> text' status "Pending"
97+
Nothing -> text' status "Running"
98+
Just ExitSuccess -> text' status "Completed successfully"
99+
Just (ExitFailure code) -> text' status
100+
$ "Failed with exit code " <> Text.pack (show code)
101+
, charFill (headerBg `withForeColor` brightYellow) borderEW width 1
102+
]
103+
, height = length wrappedCommandText + 1 + 1
104+
-- ^ should be equal to @imageHeight image@
105+
}
72106
where
73107
commandText = "Command: "
74108
headerBg = defAttr `withBackColor` blue
109+
wrappedCommandText = wrap (width - safeWctwidth commandText)
110+
$ Text.unwords $ NonEmpty.toList ss.cmdline
75111
status = headerBg `withForeColor` statusColor ss
76-
header = vertCat
77-
[ horizCat $ padToCommonHeight
78-
[ ( headerBg
79-
, ' '
80-
, text' (headerBg `withForeColor` brightYellow) commandText
81-
)
82-
, ( headerBg
83-
, ' '
84-
, vertCat
85-
[ resizeWidthFill headerBg ' ' (width - safeWctwidth commandText)
86-
$ text' headerBg line
87-
| line <- wrap (width - safeWctwidth commandText)
88-
$ Text.unwords $ NonEmpty.toList ss.cmdline
89-
]
90-
)
91-
]
92-
, resizeWidthFill headerBg ' ' width
93-
$ text' (headerBg `withForeColor` brightYellow) "Status: " <|>
94-
case ss.exit of
95-
_ | not ss.started -> text' status "Pending"
96-
Nothing -> text' status "Running"
97-
Just ExitSuccess -> text' status "Completed successfully"
98-
Just (ExitFailure code) -> text' status
99-
$ "Failed with exit code " <> Text.pack (show code)
100-
, charFill (headerBg `withForeColor` brightYellow) borderEW width 1
101-
]
102-
output = resize width (height - imageHeight header) $ vertCat
103-
[ text' defAttr line
104-
| line <- reverse . take (height - imageHeight header) . reverse
105-
$ wrap width
106-
$ Text.concat $ Text.decodeUtf8Lenient . snd <$> reverse ss.revOutput
107-
]
112+
113+
data ComputedOutput = ComputedOutput
114+
{ wantedHeight :: Int
115+
, availableHeight :: Int
116+
, image :: Image
117+
}
118+
119+
computeOutput
120+
:: DisplayRegion
121+
-> ScrollState
122+
-> StepState
123+
-> ComputedOutput
124+
computeOutput (width, height) mScroll ss = ComputedOutput
125+
{ wantedHeight = length wrappedOutputLines
126+
, availableHeight = height
127+
, image = resize width height $ vertCat
128+
[ text' defAttr line
129+
| line <- wrappedOutputLines
130+
& case mScroll of
131+
Nothing -> reverse . take height . reverse
132+
Just scroll -> take height . drop scroll
133+
]
134+
}
135+
where
136+
wrappedOutputLines = wrap width
137+
$ Text.concat $ Text.decodeUtf8Lenient . snd <$> reverse ss.revOutput
108138

109139
data TimerEvent = TimerEvent
110140

@@ -149,8 +179,13 @@ flavorHandleTimerEvent :: TimerEvent -> FlavorState -> FlavorState
149179
flavorHandleTimerEvent ev fs
150180
= tabulateCabalStep' \step -> stepHandleTimerEvent ev $ indexCabalStep fs step
151181

152-
newtype OutputState = OutputState
182+
type ScrollState = Maybe Int
183+
-- ^ Nothing = scrolled to the bottom. Otherwise, number of word-wrapped
184+
-- lines to hide from the top.
185+
186+
data OutputState = OutputState
153187
{ selectedStep :: CabalStep
188+
, scrollState :: ScrollState
154189
}
155190

156191
initOutputState :: FlavorState -> OutputState
@@ -159,11 +194,26 @@ initOutputState fs = OutputState
159194
(\step -> indexCabalStep fs step
160195
& \ss -> ss.started && ss.exit /= Just ExitSuccess)
161196
[minBound..maxBound]
197+
, scrollState = Nothing
162198
}
163199

164-
outputWidget
165-
:: DisplayRegion -> PerCabalStep Bool -> FlavorState -> OutputState -> Image
166-
outputWidget (width, height) enabledSteps fs os = tabSwitcher <-> output
200+
data ComputedWidget = ComputedWidget
201+
{ wantedOutputHeight :: Int
202+
, availableOutputHeight :: Int
203+
, image :: Image
204+
}
205+
206+
computeOutputWidget
207+
:: DisplayRegion
208+
-> PerCabalStep Bool
209+
-> FlavorState
210+
-> OutputState
211+
-> ComputedWidget
212+
computeOutputWidget (width, height) enabledSteps fs os = ComputedWidget
213+
{ wantedOutputHeight = output.wantedHeight
214+
, availableOutputHeight = output.availableHeight
215+
, image = tabSwitcher <-> header.image <-> output.image
216+
}
167217
where
168218
stepName = \case
169219
DryRun -> "Planning"
@@ -175,22 +225,36 @@ outputWidget (width, height) enabledSteps fs os = tabSwitcher <-> output
175225
(if step == os.selectedStep
176226
then defAttr `withBackColor` blue
177227
else defAttr `withBackColor` brightBlack)
178-
(if ss.started && isNothing ss.exit
179-
then stepName step <> " " <> outputSpinner ss
228+
(if ss'.started && isNothing ss'.exit
229+
then stepName step <> " " <> outputSpinner ss'
180230
else stepName step)
181231
| step <- [minBound..maxBound]
182232
, indexCabalStep enabledSteps step || step == os.selectedStep
183-
, let ss = indexCabalStep fs step
233+
, let ss' = indexCabalStep fs step
184234
]
185-
output = stepOutputWidget (width, height - imageHeight tabSwitcher)
186-
(indexCabalStep fs os.selectedStep)
235+
tabSwitcherHeight = 1 -- should be equal to @imageHeight tabSwitcher@
236+
237+
ss = indexCabalStep fs os.selectedStep
238+
header = computeHeader (width, height - tabSwitcherHeight) ss
239+
output = computeOutput (width, height - tabSwitcherHeight - header.height)
240+
os.scrollState ss
241+
242+
outputWidget
243+
:: DisplayRegion -> PerCabalStep Bool -> FlavorState -> OutputState -> Image
244+
outputWidget displayRegion enabledSteps fs os
245+
= (computeOutputWidget displayRegion enabledSteps fs os).image
187246

188247
outputSpinner :: StepState -> Text
189248
outputSpinner ss = Text.singleton $ "|/-\\" !! (ss.outputCount `mod` 4)
190249

191250
outputHandleEvent
192-
:: PerCabalStep Bool -> Event -> OutputState -> OutputState
193-
outputHandleEvent enabledSteps ev os = case ev of
251+
:: DisplayRegion
252+
-> PerCabalStep Bool
253+
-> Event
254+
-> FlavorState
255+
-> OutputState
256+
-> OutputState
257+
outputHandleEvent displayRegion enabledSteps ev fs os = case ev of
194258
-- Make sure to do something sensible if all steps are disabled
195259
EvKey KLeft _ -> os
196260
{ selectedStep = fromMaybe os.selectedStep $ listToMaybe
@@ -199,6 +263,7 @@ outputHandleEvent enabledSteps ev os = case ev of
199263
, indexCabalStep enabledSteps step
200264
, step < os.selectedStep
201265
]
266+
, scrollState = Nothing
202267
}
203268
EvKey KRight _ -> os
204269
{ selectedStep = fromMaybe os.selectedStep $ listToMaybe
@@ -207,8 +272,30 @@ outputHandleEvent enabledSteps ev os = case ev of
207272
, indexCabalStep enabledSteps step
208273
, step > os.selectedStep
209274
]
275+
, scrollState = Nothing
276+
}
277+
EvKey KUp _ -> os
278+
{ scrollState = performScroll (-1)
279+
}
280+
EvKey KDown _ -> os
281+
{ scrollState = performScroll 1
282+
}
283+
EvKey KPageUp _ -> os
284+
{ scrollState = performScroll (-output.availableOutputHeight)
285+
}
286+
EvKey KPageDown _ -> os
287+
{ scrollState = performScroll output.availableOutputHeight
210288
}
211289
_ -> os
290+
where
291+
output = computeOutputWidget displayRegion enabledSteps fs os
292+
performScroll by
293+
= mfilter (<= output.wantedOutputHeight - output.availableOutputHeight)
294+
$ Just
295+
$ max 0
296+
$ (+ by)
297+
$ fromMaybe (output.wantedOutputHeight - output.availableOutputHeight)
298+
$ os.scrollState
212299

213300
outputKeybinds :: [(Text, Text)]
214301
outputKeybinds =

0 commit comments

Comments
 (0)