-
Notifications
You must be signed in to change notification settings - Fork 7
/
Deployments.hs
628 lines (592 loc) · 21.8 KB
/
Deployments.hs
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
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
-- |
--Module : Page.Deployments
--Description : Deployments table page.
--
--This module contains the definition of the deployments table page.
module Page.Deployments (deploymentsPage) where
import Control.Lens
import Control.Lens.Extras
import Control.Monad
import Control.Monad.IO.Class
import Data.Generics.Product (field)
import Data.Generics.Sum (_Ctor)
import qualified Data.List as L
import Data.Text (Text)
import Data.Time (diffUTCTime, getCurrentTime)
import GHC.Generics (Generic)
import Obelisk.Route.Frontend
import Reflex.Dom
import Servant.Reflex
import Common.Types as CT
import Common.Utils
import Control.Applicative
import Control.Monad.Reader
import Data.Align
import Data.Char
import Data.Functor
import qualified Data.Semigroup as S
import qualified Data.Text as T
import Data.Text.Search
import Data.These
import Frontend.API
import Frontend.GHCJS
import Frontend.Route
import Frontend.UIKit
import Frontend.Utils
import Page.ClassicPopup
import Page.Elements.Links
import Page.Popup.EditDeployment
import Page.Popup.NewDeployment
import Reflex.Dom.Renderable
import Reflex.MultiEventWriter.Class
import Servant.Reflex.Extra
-- | The root widget of the deployments list page.
-- It requests data of all deployments.
-- If a request fails it shows an error, otherwise it calls 'deploymentsWidget',
-- passing a received data.
deploymentsPage ::
( MonadWidget t m
, SetRoute t (R Routes) m
, MonadReader ProjectConfig m
) =>
-- | Event notifying about the need to update data.
Event t () ->
m ()
deploymentsPage updAllEv = do
pb <- getPostBuild
respEv <- listEndpoint pb
let (okEv, errEv) = processResp respEv
widgetHold_ loadingDeploymentsWidget $
leftmost
[ deploymentsWidget updAllEv <$> okEv
, errDeploymentsWidget <$ errEv
]
-- | Widget that's shown after initial request succeeds.
-- It contains the header with an active search field,
-- deployments list and sidebars: \"new deployment\" and \"edit deployment\".
deploymentsWidget ::
( MonadWidget t m
, SetRoute t (R Routes) m
, MonadReader ProjectConfig m
) =>
-- | Event notifying about the need to update data.
Event t () ->
-- | Initial deployment data.
[DeploymentFullInfo] ->
m ()
deploymentsWidget updAllEv dfis = do
(showNewDeploymentEv, editEv) <- deploymentsWidgetWrapper $
wrapRequestErrors $ \hReq -> mdo
pageNotification $
leftmost
[ DPMError
"Deployment list update failed, deployment list\
\ may be slightly outdated."
<$ errUpdEv
, DPMClear <$ okUpdEv
]
(showNewDeploymentEv', termDyn') <- deploymentsHeadWidget True okUpdEv
termDyn <- debounceDyn 0.3 termDyn'
(okUpdEv, errUpdEv, editEv) <- deploymentsListWidget hReq updAllEv termDyn dfis
pure (showNewDeploymentEv', deSearch <$> editEv)
void $ newDeploymentPopup showNewDeploymentEv never
void $ editDeploymentPopup editEv never
-- | Div wrappers.
deploymentsWidgetWrapper :: MonadWidget t m => m a -> m a
deploymentsWidgetWrapper m =
divClass "page" $
divClass "page__wrap container" m
-- | Header of the current page. It contains a timer that shows
-- how much time has passed since the last update,
-- a search field and z button that opens \"New deployment\" sidebar.
deploymentsHeadWidget ::
MonadWidget t m =>
-- | Flag showing current state of search field.
Bool ->
-- | Event that fires after successful list update.
Event t () ->
-- | Returns an event notifying that the \"new deployment\" sidebar
-- should be open and the search term within it.
m (Event t (), Dynamic t Text)
deploymentsHeadWidget enabledSearch okUpdEv =
divClass "page__head" $ do
elClass "h1" "page__heading title" $ text "All deployments"
lastUpdateWidget okUpdEv
termDyn <- divClass
"page__action input input--search input--has-clear-type\
\ page__action--search"
$ mdo
let enabledSearchAttr = if enabledSearch then mempty else "disabled" =: ""
termDyn' <-
inputElement $
def
& initialAttributes
.~ ( "type" =: "text"
<> "class" =: "input__widget"
<> "placeholder" =: "Search for deployments"
<> "style" =: "width: 264px;"
<> enabledSearchAttr
)
& inputElementConfig_setValue .~ ("" <$ domEvent Click deleteEl)
(deleteEl, _) <-
elClass' "button" "input__clear-type spot spot--cancel" $
text "Delete"
pure termDyn'
(nsEl, _) <-
elClass'
"button"
"page__action button button--add popup-handler"
$ text "New deployment"
pure (domEvent Click nsEl, value termDyn)
-- ^ Widget that shows how much time has passed since the last update.
lastUpdateWidget :: MonadWidget t m => Event t () -> m ()
lastUpdateWidget okUpdEv = do
updTimeEv <- performEvent $ liftIO getCurrentTime <$ okUpdEv
initTime <- liftIO getCurrentTime
updTimeB <- hold initTime updTimeEv
tickEv <- tickLossyFromPostBuildTime 1
let diffEv = attachWith calcMins updTimeB tickEv
calcMins lastUpd TickInfo {..} =
let diffSec = diffUTCTime _tickInfo_lastUTC lastUpd
diffMin = diffSec / 60
in floor diffMin :: Int
mkMsg ms
| ms < 1 = "Updated just now"
| isSingular ms = "Updated " <> (showT $ ms) <> " minute ago"
| ms < 60 = "Updated " <> (showT $ ms) <> " minutes ago"
| isSingular (ms `div` 60) =
"Updated " <> (showT $ ms `div` 60) <> " hour ago"
| otherwise = "Updated " <> (showT $ ms `div` 60) <> " hours ago"
isSingular x = x `mod` 100 /= 11 && x `mod` 10 == 1
diffDyn <- holdDyn 0 diffEv
divClass "page__note" $ dynText $ mkMsg <$> diffDyn
-- | Widget with all available deployments. It updates
-- the deployment information every time when the supplied event fires.
-- If an update fails, a notification widget appears at the top of the page.
deploymentsListWidget ::
( MonadWidget t m
, SetRoute t (R Routes) m
, MonadReader ProjectConfig m
) =>
RequestErrorHandler t m ->
Event t () ->
Dynamic t Text ->
-- | Initial deployment data
[DeploymentFullInfo] ->
m (Event t (), Event t (), Event t SearchedDeploymentInfo)
deploymentsListWidget hReq updAllEv termDyn ds = dataWidgetWrapper $ mdo
retryEv <- delay 10 errUpdEv
updRespEv <- listEndpoint $ leftmost [updAllEv, () <$ retryEv]
let okUpdEv = fmapMaybe reqSuccess updRespEv
errUpdEv = fmapMaybe reqErrorBody updRespEv
dsDyn <- holdDyn ds okUpdEv
let searchedDyn = ffor2 termDyn dsDyn $ \term ds' ->
searchMany (T.filter (not . isSpace) term) ds'
(archivedDsDyn, activeDsDyn) =
splitDynPure $ L.partition isDeploymentArchived <$> searchedDyn
searchSorting = termDyn $> Nothing
clickedEv <- elementClick
editEv <- activeDeploymentsWidget hReq searchSorting clickedEv activeDsDyn
archivedDeploymentsWidget hReq searchSorting clickedEv archivedDsDyn
pure (() <$ okUpdEv, () <$ errUpdEv, editEv)
type SearchedDeploymentInfo = DeploymentFullInfo' SearchResult
-- | Table with active deployments.
activeDeploymentsWidget ::
( MonadWidget t m
, SetRoute t (R Routes) m
, MonadReader ProjectConfig m
) =>
RequestErrorHandler t m ->
Dynamic t (Maybe (SortDir DeploymentFullInfo)) ->
-- | Event that carries the clicked DOM element. This event is required by
-- `dropdownWidget'`.
Event t ClickedElement ->
Dynamic t [SearchedDeploymentInfo] ->
-- | Returns an event carrying editable deployment
-- to \"edit deployment\" sidebar.
m (Event t SearchedDeploymentInfo)
activeDeploymentsWidget hReq searchSorting clickedEv dsDyn =
divClass "data__primary" $
tableWrapper (updated searchSorting $> SortingChanged) $ \sortDyn -> do
sorting <- holdDyn Nothing (mergeWith (<|>) [updated sortDyn, updated searchSorting])
let emptyDyn' = L.null <$> dsDyn
dsSortedDyn = zipDynWith sortDeployments dsDyn sorting
emptyDyn <- holdUniqDyn emptyDyn'
editEvEv <-
dyn $
emptyDyn <&> \case
False -> do
editEvs <- simpleList dsSortedDyn (activeDeploymentWidget hReq clickedEv)
pure $ switchDyn $ leftmost <$> editEvs
True -> do
emptyTableBody noDeploymentsWidget
pure never
switchHold never editEvEv
-- | This type helps determine which item was selected
-- in the table row dropdown.
data DeploymentAction
= ArchiveDeployment
| EditDeployment
deriving stock (Show, Eq, Generic)
-- | Row of active deployment.
activeDeploymentWidget ::
( MonadWidget t m
, SetRoute t (R Routes) m
, MonadReader ProjectConfig m
) =>
RequestErrorHandler t m ->
-- | Event that carries the clicked DOM element. This event is required by
-- `dropdownWidget'`.
Event t ClickedElement ->
Dynamic t SearchedDeploymentInfo ->
-- | Returns event carrying editable deployment
-- that is required by \"edit deployment\" sidebar.
m (Event t SearchedDeploymentInfo)
activeDeploymentWidget hReq clickedEv dDyn' = do
dDyn <- holdUniqDyn dDyn'
editEvEv <- dyn $
ffor dDyn $ \d@DeploymentFullInfo {..} -> do
let desearchedDeployment = deSearch d
dName = desearchedDeployment ^. #deployment . #name
(linkEl, dropdownEv) <- el' "tr" $ do
el "td" $ do
rndr . unDeploymentName $ d ^. #deployment . #name
statusWidget $ constDyn status
el "td" $
divClass "listing" $
forM_ (unDeploymentMetadata metadata) (renderMetadataLink . pure)
el "td" $
deploymentOverridesWidgetSearched hReq (deployment ^. field @"deploymentOverrides" . coerced)
el "td" $
applicationOverridesWidgetSearched
hReq
(deployment ^. field @"deploymentOverrides" . coerced)
(deployment ^. field @"appOverrides" . coerced)
el "td" $
text $ formatPosixToDate createdAt
el "td" $
text $ formatPosixToDate updatedAt
el "td" $ do
let enabled = not . isPending . recordedStatus $ status
btn =
elAttr
"button"
( "class" =: "drop__handler"
<> "type" =: "button"
)
$ text "Actions"
body = do
btnEditEv <-
actionButton $
def
& #buttonText .~~ "Edit"
& #buttonEnabled .~~ pure enabled
& #buttonType .~~ Just EditActionButtonType
btnArcEv <-
actionButton $
def
& #buttonText .~~ "Move to archive"
& #buttonEnabled .~~ pure enabled
& #buttonType .~~ Just ArchiveActionButtonType
url' <- kubeDashboardUrl (pure desearchedDeployment)
void . dyn $
url'
<&> maybe
blank
( \url ->
void $
actionButton
def
{ buttonText = "Details"
, buttonType = Just LogsActionButtonType
, buttonBaseTag = ATag url
}
)
pure $
leftmost
[ArchiveDeployment <$ btnArcEv, EditDeployment <$ btnEditEv]
dropdownWidget' clickedEv btn body
let archEv = () <$ ffilter (is (_Ctor @"ArchiveDeployment")) dropdownEv
editEv = d <$ ffilter (is (_Ctor @"EditDeployment")) dropdownEv
delEv <- confirmArchivePopup archEv $ do
text "Are you sure you want to archive the"
el "br" blank
text $ unDeploymentName dName <> " deployment?"
void $ archiveEndpoint (constDyn . Right $ dName) delEv
let route = DashboardRoute :/ Just dName
setRoute $ route <$ domEvent Dblclick linkEl
pure editEv
switchHold never editEvEv
-- | Table with archived deployments.
archivedDeploymentsWidget ::
forall t m.
( MonadWidget t m
, SetRoute t (R Routes) m
) =>
RequestErrorHandler t m ->
Dynamic t (Maybe (SortDir DeploymentFullInfo)) ->
-- | Event that carries the clicked DOM element. This event is required by
-- `dropdownWidget'`.
Event t ClickedElement ->
Dynamic t [SearchedDeploymentInfo] ->
m ()
archivedDeploymentsWidget hReq searchSorting clickedEv dsDyn = do
showDyn <- toggleButton
let classDyn = ffor showDyn $ \case
True -> "data__archive data__archive--open"
False -> "data__archive"
elDynClass "div" classDyn $
tableWrapper (updated searchSorting $> SortingChanged) $ \sortDyn -> do
sorting <- holdDyn Nothing (mergeWith (<|>) [updated sortDyn, updated searchSorting])
let emptyDyn' = L.null <$> dsDyn
dsSortedDyn = zipDynWith sortDeployments dsDyn sorting
emptyDyn <- holdUniqDyn emptyDyn'
dyn_ $
emptyDyn <&> \case
False ->
void $
simpleList
dsSortedDyn
(archivedDeploymentWidget hReq clickedEv)
True -> emptyTableBody noDeploymentsWidget
-- | Row with archived deployment.
archivedDeploymentWidget ::
( MonadWidget t m
, SetRoute t (R Routes) m
) =>
RequestErrorHandler t m ->
Event t ClickedElement ->
Dynamic t SearchedDeploymentInfo ->
m ()
archivedDeploymentWidget hReq clickedEv dDyn' = do
dDyn <- holdUniqDyn dDyn'
dyn_ $
ffor dDyn $ \d@DeploymentFullInfo {..} -> do
let desearchedDeployment = deSearch d
dName = desearchedDeployment ^. #deployment . #name
(linkEl, _) <- el' "tr" $ do
el "td" $ do
rndr . unDeploymentName $ deployment ^. #name
statusWidget (pure status)
el "td" $ text "..."
el "td" $
deploymentOverridesWidgetSearched hReq (deployment ^. field @"deploymentOverrides" . coerced)
el "td" $
applicationOverridesWidgetSearched
hReq
(deployment ^. field @"deploymentOverrides" . coerced)
(deployment ^. field @"appOverrides" . coerced)
el "td" $
text $ formatPosixToDate createdAt
el "td" $
text $ formatPosixToDate updatedAt
el "td" $ do
let btn =
elAttr
"button"
( "class" =: "drop__handler"
<> "type" =: "button"
)
$ text "Actions"
body =
actionButton
def
{ buttonText = "Restore from archive"
, buttonType = Just ArchiveActionButtonType
}
btnEv <- dropdownWidget' clickedEv btn body
void $ restoreEndpoint (constDyn $ Right $ dName) btnEv
let route = DashboardRoute :/ Just dName
setRoute $ route <$ domEvent Dblclick linkEl
-- | Sort deployments by the supplied condition.
sortDeployments ::
[SearchedDeploymentInfo] ->
-- | Sorting condition.
Maybe (SortDir DeploymentFullInfo) ->
[SearchedDeploymentInfo]
sortDeployments items Nothing = items
sortDeployments items (Just (contramap deSearch -> s)) = L.sortBy sortFunc items
where
sortFunc a b = case s of
(SortAsc get) -> compare (get a) (get b)
(SortDesc get) -> compare (get b) (get a)
-- | Each constructor contains a getter
-- that extracts the field that is used for sorting.
data SortDir x where
SortAsc :: Ord a => (x -> a) -> SortDir x
SortDesc :: Ord a => (x -> a) -> SortDir x
deriving (Semigroup) via (S.Last (SortDir x))
instance Contravariant SortDir where
contramap f (SortAsc g) = SortAsc $ g . f
contramap f (SortDesc g) = SortDesc $ g . f
-- | Sorting toggler.
toggleSort :: SortDir a -> SortDir a
toggleSort = \case
SortAsc x -> SortDesc x
SortDesc x -> SortAsc x
-- | Header for a deployments table.
-- \"Name\",\"created\" and \"udpated\" columns support sorting.
tableHeader :: (MonadWidget t m, SortableTableGroup t m) => m ()
tableHeader = do
el "thead" $
el "tr" $ do
sortHeader (view dfiName) "Name" SortAsc
el "th" $ text "Links"
el "th" $ text "Deployment configuration"
el "th" $ text "App configuration"
sortHeader (view $ field @"createdAt") "Created" SortDesc
sortHeaderInitially (view $ field @"updatedAt") "Changed" SortDesc
el "th" $
elClass "span" "visuallyhidden" $ text "Menu"
data SortingChanged = SortingChanged
deriving (Semigroup) via (S.Last SortingChanged)
type SortableTableGroup t m =
( MonadReader (Event t SortingChanged) m
, MultiEventWriter t (SortDir DeploymentFullInfo) m
, MultiEventWriter t SortingChanged m
)
-- | Group all sortable headers ('sortHeader', 'sortHeaderInitially').
-- Makes sure that only one can be active at a time.
runSortableTableGroup ::
(Reflex t, MonadFix m) =>
Event t SortingChanged ->
ReaderT
(Event t SortingChanged)
(EventWriterT t (SortDir DeploymentFullInfo) (EventWriterT t SortingChanged m))
x ->
m (x, Event t (SortDir DeploymentFullInfo))
runSortableTableGroup sChanged m = mdo
((x, sDyn), changed) <-
runEventWriterT . runEventWriterT . flip runReaderT (leftmost [sChanged, changed]) $ m
return (x, sDyn)
type SortingDirection a = (DeploymentFullInfo -> a) -> SortDir DeploymentFullInfo
-- | Special column header with a sort button.
sortHeader ::
forall t m a.
(MonadWidget t m, SortableTableGroup t m) =>
(DeploymentFullInfo -> a) ->
Text ->
-- | The direction to sort when clicked
SortingDirection a ->
m ()
sortHeader f l defaultSorting =
sortHeaderWithInitial f l defaultSorting (Nothing @(SortingDirection a))
-- | Special column header with a sort button.
sortHeaderInitially ::
forall t m a.
(MonadWidget t m, SortableTableGroup t m) =>
(DeploymentFullInfo -> a) ->
Text ->
-- | The direction to sort when clicked and when the page loads
SortingDirection a ->
m ()
sortHeaderInitially f l defaultSorting =
sortHeaderWithInitial f l defaultSorting (Just @(SortingDirection a) defaultSorting)
-- | Special column header with a sort button.
sortHeaderWithInitial ::
forall t m a.
(MonadWidget t m, SortableTableGroup t m) =>
(DeploymentFullInfo -> a) ->
Text ->
-- | The direction to sort when clicked
SortingDirection a ->
-- | The direction to sort when the page loads
Maybe (SortingDirection a) ->
m ()
sortHeaderWithInitial f l defaultSorting initSortingM = do
let initSorting = case initSortingM of
Nothing -> Nothing
Just x -> Just $ x f
el "th" $ mdo
sortingChanged <- ask
sortDyn <-
foldDyn ($) initSorting $
alignWith
( curry $ \case
(That SortingChanged, _) -> Nothing -- Some other column has started sorting
(_, Nothing) -> Just $ defaultSorting f -- This column started sorting
(_, Just x) -> Just $ toggleSort x -- This column was sorting and was clicked
)
sortBtnEv
sortingChanged
tellMultiEvent . fmapMaybe id $ updated sortDyn
sortBtnEv <-
sortButton $
def
& #buttonText .~~ l
& #buttonState
.~~ ( sortDyn <&&> \case
SortDesc _ -> SortDescButtonState
SortAsc _ -> SortAscButtonState
)
tellMultiEvent $ sortBtnEv $> SortingChanged
pure ()
-- | A wrapper that adds a header to the table.
tableWrapper ::
(MonadWidget t m) =>
Event t SortingChanged ->
-- | Sorting direction is obtained from the table header.
(Dynamic t (Maybe (SortDir DeploymentFullInfo)) -> m a) ->
m a
tableWrapper sChanged ma =
divClass "table table--deployments table--clickable table--double-click" $
el "table" $ mdo
((), sDyn') <- runSortableTableGroup sChanged tableHeader
sDyn <- holdDyn Nothing $ Just <$> sDyn'
el "tbody" $ ma sDyn
-- | Table wrapper for a table with an \"error\" or a \"loading\ placeholder.
initTableWrapper :: MonadWidget t m => m () -> m ()
initTableWrapper ma = do
divClass "data_primary" $
tableWrapper never $
const $
emptyTableBody $ ma
-- | Widget with a loading spinner.
loadingDeploymentsWidget :: MonadWidget t m => m ()
loadingDeploymentsWidget =
deploymentsWidgetWrapper $ do
void $ deploymentsHeadWidget False never
dataWidgetWrapper $ initTableWrapper $ loadingCommonWidget
-- | Widget with an error message.
errDeploymentsWidget :: MonadWidget t m => m ()
errDeploymentsWidget =
deploymentsWidgetWrapper $
dataWidgetWrapper $
initTableWrapper $
errorCommonWidget
-- | Widget for an empty table with a custom message.
noDeploymentsWidget' ::
MonadWidget t m =>
-- | Text widget
m () ->
m ()
noDeploymentsWidget' h =
divClass "null null--search" $ do
elClass "b" "null__heading" h
divClass "null__message" blank
-- | Widget for an empty table.
noDeploymentsWidget :: MonadWidget t m => m ()
noDeploymentsWidget = noDeploymentsWidget' (text "No deployments")
-- | Table body wrapper.
emptyTableBody :: MonadWidget t m => m () -> m ()
emptyTableBody msg =
elClass "tr" "no-table" $
elAttr "td" ("colspan" =: "8") msg
-- | Div wrappers.
dataWidgetWrapper :: MonadWidget t m => m a -> m a
dataWidgetWrapper ma = divClass "page__body" $ divClass "data" ma
-- | Button that controls visibility of the archived deployments.
toggleButton :: MonadWidget t m => m (Dynamic t Bool)
toggleButton = mdo
showDyn <- toggle False $ domEvent Click archivedBtnEl
let btnClassDyn = ffor showDyn $ \case
True -> "data__show-archive expander expander--stand-alone expander--open"
False -> "data__show-archive expander expander--stand-alone"
btnAttrsDyn = ffor btnClassDyn $ \btnClass ->
( "class" =: btnClass
<> "type" =: "button"
)
(archivedBtnEl, _) <-
elDynAttr' "button" btnAttrsDyn $
text "Show Archived deployments"
pure showDyn