@@ -2,14 +2,17 @@ module Page.Deployments
22 ( deploymentsPage ) where
33
44import Control.Lens
5+import Control.Lens.Extras
56import Control.Monad
67import Control.Monad.IO.Class
78import Data.Coerce
89import Data.Generics.Product (field)
10+import Data.Generics.Sum (_Ctor)
911import Data.List as L (null, sortBy)
1012import Data.Map as M (Map, fromList, partition, filter, elems)
1113import Data.Text as T (Text, toCaseFold, isPrefixOf, pack)
1214import Data.Time (getCurrentTime, diffUTCTime)
15+import GHC.Generics (Generic)
1316import Obelisk.Route.Frontend
1417import Reflex.Dom
1518import Servant.Reflex
@@ -19,6 +22,7 @@ import Common.Utils
1922import Frontend.API
2023import Frontend.Route
2124import Page.ClassicPopup
25+import Page.Popup.EditStaging
2226import Page.Popup.NewStaging
2327import Page.Utils
2428
@@ -45,11 +49,12 @@ deploymentsWidget
4549 => Event t ()
4650 -> m ()
4751deploymentsWidget updAllEv = do
48− showNewStagingEv <- deploymentsWidgetWrapper $ mdo
52+ (showNewStagingEv, editEv) <- deploymentsWidgetWrapper $ mdo
4953 (showNewStagingEv', termDyn) <- deploymentsHeadWidget okUpdEv
50− okUpdEv <- initDeploymentsListWidget updAllEv termDyn
51− pure showNewStagingEv'
54+ (okUpdEv, editEv) <- initDeploymentsListWidget updAllEv termDyn
55+ pure (showNewStagingEv', editEv)
5256 void $ newStagingPopup showNewStagingEv never
57+ void $ editStagingPopup editEv never
5358
5459deploymentsHeadWidget
5560 :: MonadWidget t m
@@ -105,18 +110,18 @@ initDeploymentsListWidget
105110 , SetRoute t (R Routes) m )
106111 => Event t ()
107112 -> Dynamic t Text
108− -> m (Event t ())
113+ -> m (Event t (), Event t DeploymentFullInfo)
109114initDeploymentsListWidget updAllEv termDyn = dataWidgetWrapper $ do
110115 pb <- getPostBuild
111116 respEv <- listEndpoint pb
112117 let
113118 okEv = fmapMaybe reqSuccess respEv
114119 errEv = fmapMaybe reqFailure respEv
115− w m = m >> pure never
116− okUpdEvDyn <- widgetHold (w loadingDeploymentsWidget) $ leftmost
120+ w m = m >> pure (never, never)
121+ evsDyn <- widgetHold (w loadingDeploymentsWidget) $ leftmost
117122 [ deploymentsListWidget updAllEv termDyn <$> okEv
118123 , (w errDeploymentsWidget) <$ errEv ]
119− pure $ switchDyn okUpdEvDyn
124+ pure (switchDyn $ fst <$> evsDyn, switchDyn $ snd <$> evsDyn)
120125
121126deploymentsListWidget
122127 ::
@@ -126,7 +131,7 @@ deploymentsListWidget
126131 => Event t ()
127132 -> Dynamic t Text
128133 -> [DeploymentFullInfo]
129− -> m (Event t ())
134+ -> m (Event t (), Event t DeploymentFullInfo)
130135deploymentsListWidget updAllEv termDyn ds = mdo
131136 updRespEv <- listEndpoint updAllEv
132137 let
@@ -140,9 +145,9 @@ deploymentsListWidget updAllEv termDyn ds = mdo
140145 (archivedDsDyn, activeDsDyn) = splitDynPure $ M.partition isArchived
141146 <$> filteredDyn
142147 clickedEv <- elementClick
143− activeDeploymentsWidget clickedEv activeDsDyn
148+ editEv <- activeDeploymentsWidget clickedEv activeDsDyn
144149 archivedDeploymentsWidget clickedEv archivedDsDyn
145− pure $ () <$ okUpdEv
150+ pure (() <$ okUpdEv, editEv)
146151
147152searchDeployments
148153 :: Text -> DeploymentFullInfo -> Bool
@@ -160,9 +165,8 @@ activeDeploymentsWidget
160165 , RouteToUrl (R Routes) m
161166 , SetRoute t (R Routes) m )
162167 => Event t ClickedElement
163− -> Dynamic t
164− (Map DeploymentName DeploymentFullInfo)
165− -> m ()
168+ -> Dynamic t (Map DeploymentName DeploymentFullInfo)
169+ -> m (Event t DeploymentFullInfo)
166170activeDeploymentsWidget clickedEv dsDyn =
167171 divClass "data__primary" $
168172 tableWrapper $ \sortDyn -> do
@@ -170,10 +174,19 @@ activeDeploymentsWidget clickedEv dsDyn =
170174 emptyDyn' = L.null <$> dsDyn
171175 dsSortedDyn = zipDynWith sortDeployments dsDyn sortDyn
172176 emptyDyn <- holdUniqDyn emptyDyn'
173− dyn_ $ emptyDyn <&> \case
174− False -> void $ list dsSortedDyn
175− (activeDeploymentWidget clickedEv)
176− True -> emptyTableBody $ noDeploymentsWidget
177+ editEvEv <- dyn $ emptyDyn <&> \case
178+ False -> do
179+ editEvs <- simpleList dsSortedDyn (activeDeploymentWidget clickedEv)
180+ pure $ switchDyn $ leftmost <$> editEvs
181+ True -> do
182+ emptyTableBody $ noDeploymentsWidget
183+ pure never
184+ switchHold never editEvEv
185+
186+data StagingAction
187+ = ArchiveStaging
188+ | EditStaging
189+ deriving (Show, Eq, Generic)
177190
178191activeDeploymentWidget
179192 ::
@@ -182,12 +195,12 @@ activeDeploymentWidget
182195 , SetRoute t (R Routes) m )
183196 => Event t ClickedElement
184197 -> Dynamic t (DeploymentFullInfo)
185− -> m ()
198+ -> m (Event t DeploymentFullInfo)
186199activeDeploymentWidget clickedEv dDyn' = do
187200 dDyn <- holdUniqDyn dDyn'
188− dyn_ $ ffor dDyn $ \DeploymentFullInfo{..} -> do
201+ editEvEv <- dyn $ ffor dDyn $ \d@DeploymentFullInfo{..} -> do
189202 let dname = deployment ^. field @"name"
190− (linkEl, btnEv) <- el' "tr" $ do
203+ (linkEl, dropdownEv) <- el' "tr" $ do
191204 el "td" $ do
192205 text $ coerce dname
193206 statusWidget $ constDyn status
@@ -218,17 +231,23 @@ activeDeploymentWidget clickedEv dDyn' = do
218231 <> "id" =: elId
219232 <> disabledAttr) $ text "Actions"
220233 body = do
221− _ <- buttonClass "action action--edit" "Edit"
234+ btnEditEv <- buttonClass "action action--edit" "Edit"
222235 btnArcEv <- buttonClass "action action--delete" "Move to archive"
223− pure btnArcEv
236+ pure $
237+ leftmost [ ArchiveStaging <$ btnArcEv, EditStaging <$ btnEditEv ]
224238 dropdownWidget' clickedEv btn body
225− delEv <- confirmDeletePopup btnEv $ do
226− text "Are you sure you want to delete"
239+ let
240+ archEv = () <$ ffilter (is (_Ctor @"ArchiveStaging")) dropdownEv
241+ editEv = d <$ ffilter (is (_Ctor @"EditStaging")) dropdownEv
242+ delEv <- confirmDeletePopup archEv $ do
243+ text "Are you sure you want to delete"
227244 el "br" blank
228245 text $ coerce dname <> " staging?"
229246 void $ deleteEndpoint (constDyn $ Right $ dname) delEv
230247 let route = DashboardRoute :/ Just dname
231248 setRoute $ route <$ domEvent Dblclick linkEl
249+ pure editEv
250+ switchHold never editEvEv
232251
233252archivedDeploymentsWidget
234253 ::
@@ -252,15 +271,15 @@ archivedDeploymentsWidget clickedEv dsDyn = do
252271 dsSortedDyn = zipDynWith sortDeployments dsDyn sortDyn
253272 emptyDyn <- holdUniqDyn emptyDyn'
254273 dyn_ $ emptyDyn <&> \case
255− False -> void $ list dsSortedDyn
274+ False -> void $ simpleList dsSortedDyn
256275 (archivedDeploymentWidget clickedEv)
257276 True -> emptyTableBody $ noDeploymentsWidget
258277
259278sortDeployments
260279 :: Map DeploymentName DeploymentFullInfo
261280 -> SortDir
262− -> Map Int DeploymentFullInfo
263−sortDeployments ds s = M.fromList $ zip [1..] $ L.sortBy sortFunc items
281+ -> [DeploymentFullInfo]
282+sortDeployments ds s = L.sortBy sortFunc items
264283 where
265284 items = M.elems ds
266285 sortFunc a b = case s of