@@ -0,0 +1,270 @@
1+module Page.Deployments
2+ ( deploymentsPage ) where
3+
4+import Control.Lens
5+import Control.Monad
6+import Data.Coerce
7+import Data.Generics.Product
8+import Data.List as L (null, filter)
9+import Data.Text as T (pack)
10+import Data.Time
11+import Data.Time.Clock.POSIX
12+import Reflex.Dom
13+import Servant.Reflex
14+
15+import Common.Types
16+import Frontend.API
17+import Page.Utils
18+
19+deploymentsPage :: MonadWidget t m => m ()
20+deploymentsPage = do
21+ headWidget
22+ bodyLoadWidget
23+
24+headWidget :: MonadWidget t m => m ()
25+headWidget =
26+ elClass "header" "header" $
27+ divClass "header__wrap container" $ do
28+ elClass "b" "header__logo" $
29+ text "Deployment Manager"
30+ elClass "div" "header__project" $
31+ text "<Project name>"
32+
33+bodyLoadWidget :: MonadWidget t m => m ()
34+bodyLoadWidget = do
35+ pb <- getPostBuild
36+ respEv <- listEndpoint pb
37+ let
38+ okEv = fmapMaybe reqSuccess respEv
39+ errEv = fmapMaybe reqSuccess respEv
40+ widgetHold_ blank $ leftmost
41+ [ deploymentsWidget <$> okEv
42+ , errDeploymentsWidget <$ errEv ]
43+ blank
44+
45+errDeploymentsWidget :: MonadWidget t m => m ()
46+errDeploymentsWidget =
47+ divClass "no-page" $
48+ divClass "no-page__inner" $
49+ divClass "null null--data" $
50+ divClass "null__content" $
51+ divClass "null__heading" $
52+ text "Cannot retrieve the data"
53+
54+deploymentsWidgetWrapper :: MonadWidget t m => m a -> m a
55+deploymentsWidgetWrapper m =
56+ divClass "page" $
57+ divClass "page__wrap container" m
58+
59+deploymentsWidget :: MonadWidget t m => [DeploymentFullInfo] -> m ()
60+deploymentsWidget ds = deploymentsWidgetWrapper $ do
61+ dsDyn <- holdDyn ds never
62+ deploymentsHeadWidget
63+ deploymentsListWidget dsDyn
64+
65+deploymentsHeadWidget :: MonadWidget t m => m ()
66+deploymentsHeadWidget =
67+ divClass "page__head" $ do
68+ elClass "h1" "page__heading title" $ text "All stagings"
69+ divClass "page__note" $ text "Updated <n> mins ago"
70+ divClass "page__search input input--search input--has-clear-type" $ do
71+ _search <- inputElement $ def
72+ & initialAttributes .~
73+ ( "type" =: "text"
74+ <> "class" =: "input__widget"
75+ <> "placeholder" =: "Search for stagings" )
76+ (_, _delete) <- elClass' "button" "input__clear-type spot spot--cancel" $
77+ text "Delete"
78+ blank
79+ elClass "a" "page__add-staging button button--add popup-handler" $
80+ text "New staging"
81+
82+deploymentsListWidget
83+ :: MonadWidget t m
84+ => Dynamic t [DeploymentFullInfo]
85+ -> m ()
86+deploymentsListWidget dsDyn = do
87+ let
88+ emptyDyn' = L.null <$> dsDyn
89+ emptyDyn <- holdUniqDyn emptyDyn'
90+ divClass "page__body" $
91+ dyn_ $ ffor emptyDyn $ \case
92+ True -> noDeploymentsWidget
93+ False -> deploymentsListWidget' dsDyn
94+
95+noDeploymentsWidget :: MonadWidget t m => m ()
96+noDeploymentsWidget =
97+ divClass "no-data" $
98+ divClass "null null--search" $ do
99+ elClass "b" "null__heading" $ text "No results found"
100+ divClass "null__message" $ do
101+ text "It seems we can’t find any results"
102+ el "br" blank
103+ text "based on your search"
104+
105+
106+deploymentsListWidget'
107+ :: MonadWidget t m
108+ => Dynamic t [DeploymentFullInfo]
109+ -> m ()
110+deploymentsListWidget' dsDyn = divClass "data" $ mdo
111+ let
112+ isArchived = view (field @"archived")
113+ activeDsDyn = L.filter (not . isArchived) <$> dsDyn
114+ archivedDsDyn = L.filter isArchived <$> dsDyn
115+ activeDeploymentsWidget activeDsDyn
116+ showDyn <- toggle False $ domEvent Click archivedBtnEl
117+ let
118+ btnClassDyn = ffor showDyn $ \case
119+ True -> "data__show-archive expander expander--stand-alone expander--open"
120+ False -> "data__show-archive expander expander--stand-alone"
121+ btnAttrsDyn = ffor btnClassDyn $ \btnClass ->
122+ ( "class" =: btnClass
123+ <> "type" =: "button" )
124+ (archivedBtnEl, _) <- elDynAttr' "button" btnAttrsDyn $
125+ text "Show Archived stagings"
126+ archivedDeploymentsWidget showDyn archivedDsDyn
127+
128+
129+
130+activeDeploymentsWidget
131+ :: MonadWidget t m
132+ => Dynamic t [DeploymentFullInfo]
133+ -> m ()
134+activeDeploymentsWidget dsDyn =
135+ divClass "data__primary" $
136+ elClass "table" "stagings-table panel" $ do
137+ el "thead" $
138+ el "tr" $ do
139+ el "th" $ text "Name"
140+ el "th" $ text "Links"
141+ el "th" $ text "Tag"
142+ el "th" $ text "Overrides"
143+ el "th" $ do
144+ _sortBtn <- elAttr "button"
145+ ( "class" =: "sort sort--active sort--asc"
146+ <> "type" =: "button" ) $ text "Created"
147+ blank
148+ el "th" $ text "Changed"
149+ el "th" $
150+ elClass "span" "visuallyhidden" $ text "Menu"
151+ el "tbody" $
152+ void $ simpleList dsDyn activeDeploymentWidget
153+
154+activeDeploymentWidget
155+ :: MonadWidget t m
156+ => Dynamic t DeploymentFullInfo
157+ -> m ()
158+activeDeploymentWidget dDyn' = do
159+ dDyn <- holdUniqDyn dDyn'
160+ dyn_ $ ffor dDyn $ \DeploymentFullInfo{..} -> do
161+ el "tr" $ do
162+ el "td" $ do
163+ text $ coerce $ deployment ^. field @"name"
164+ divClass "status status--success" $ text "<Status>"
165+ el "td" $ do
166+ divClass "listing" $
167+ forM_ urls $ \(_, url) ->
168+ elAttr "a"
169+ ( "class" =: "listing__item external bar"
170+ <> "href" =: ("https://" <> url)
171+ <> "target" =: "_blank") $ text url
172+ el "td" $
173+ text $ coerce $ deployment ^. field @"tag"
174+ el "td" $ do
175+ divClass "listing" $
176+ forM_ (deployment ^. field @"envs") $ \(var, val) ->
177+ divClass "listing__item bar" $ do
178+ el "b" $ text $ var <> ": "
179+ text val
180+ el "td" $
181+ text $ pack $ formatTime defaultTimeLocale (iso8601DateFormat Nothing)
182+ $ intToUTCTime createdAt
183+ el "td" $
184+ text $ pack $ formatTime defaultTimeLocale (iso8601DateFormat Nothing)
185+ $ intToUTCTime updatedAt
186+ el "td" $ do
187+ let
188+ elId = "deployment_row_" <> (coerce $ deployment ^. field @"name")
189+ btn = elAttr "button"
190+ ( "class" =: "drop__handler"
191+ <> "type" =: "button"
192+ <> "id" =: elId) $ text "Actions"
193+ body = do
194+ elAttr "button"
195+ ( "class" =: "action action--edit"
196+ <> "type" =: "button") $ text "Edit"
197+ elAttr "button"
198+ ( "class" =: "action action--delete"
199+ <> "type" =: "button") $ text "Move to archive"
200+ dropdownWidget elId btn body
201+
202+intToUTCTime :: Int -> UTCTime
203+intToUTCTime = posixSecondsToUTCTime . realToFrac
204+
205+archivedDeploymentsWidget
206+ :: MonadWidget t m
207+ => Dynamic t Bool
208+ -> Dynamic t [DeploymentFullInfo]
209+ -> m ()
210+archivedDeploymentsWidget showDyn dsDyn = do
211+ let
212+ classDyn = ffor showDyn $ \case
213+ True -> "data__archive data__archive--open"
214+ False -> "data__archive"
215+ elDynClass "div" classDyn $
216+ elClass "table" "stagings-table panel" $ do
217+ el "thead" $
218+ el "tr" $ do
219+ el "th" $ text "Name"
220+ el "th" $ text "Links"
221+ el "th" $ text "Tag"
222+ el "th" $ text "Overrides"
223+ el "th" $ do
224+ _sortBtn <- elAttr "button"
225+ ( "class" =: "sort sort--active sort--asc"
226+ <> "type" =: "button" ) $ text "Created"
227+ blank
228+ el "th" $ text "Changed"
229+ el "th" $
230+ elClass "span" "visuallyhidden" $ text "Menu"
231+ el "tbody" $
232+ void $ simpleList dsDyn archivedDeploymentWidget
233+
234+archivedDeploymentWidget
235+ :: MonadWidget t m
236+ => Dynamic t DeploymentFullInfo
237+ -> m ()
238+archivedDeploymentWidget dDyn' = do
239+ dDyn <- holdUniqDyn dDyn'
240+ dyn_ $ ffor dDyn $ \DeploymentFullInfo{..} -> do
241+ el "tr" $ do
242+ el "td" $ do
243+ text $ coerce $ deployment ^. field @"name"
244+ divClass "status status--archived" $ text "Archived"
245+ el "td" $ text "..."
246+ el "td" $
247+ text $ coerce $ deployment ^. field @"tag"
248+ el "td" $ do
249+ divClass "listing" $
250+ forM_ (deployment ^. field @"envs") $ \(var, val) ->
251+ divClass "listing__item bar" $ do
252+ el "b" $ text $ var <> ": "
253+ text val
254+ el "td" $
255+ text $ pack $ formatTime defaultTimeLocale (iso8601DateFormat Nothing)
256+ $ intToUTCTime createdAt
257+ el "td" $
258+ text $ pack $ formatTime defaultTimeLocale (iso8601DateFormat Nothing)
259+ $ intToUTCTime updatedAt
260+ el "td" $ do
261+ let
262+ elId = "deployment_row_" <> (coerce $ deployment ^. field @"name")
263+ btn = elAttr "button"
264+ ( "class" =: "drop__handler"
265+ <> "type" =: "button"
266+ <> "id" =: elId) $ text "Actions"
267+ body = elAttr "button"
268+ ( "class" =: "action action--delete"
269+ <> "type" =: "button") $ text "Restore from archive"
270+ dropdownWidget elId btn body