@@ -3,11 +3,13 @@ module Page.Deployments
33
44import Control.Lens
55import Control.Monad
6+import Control.Monad.IO.Class
67import Data.Coerce
78import Data.Generics.Product (field)
89import Data.List as L (null)
910import Data.Map as M (Map, fromList, partition, filter)
10−import Data.Text as T (Text, toCaseFold, isPrefixOf)
11+import Data.Text as T (Text, toCaseFold, isPrefixOf, pack)
12+import Data.Time (getCurrentTime, diffUTCTime)
1113import Obelisk.Route.Frontend
1214import Reflex.Dom
1315import Servant.Reflex
@@ -44,16 +46,19 @@ deploymentsWidget
4446 -> m ()
4547deploymentsWidget updAllEv = do
4648 showNewStagingEv <- deploymentsWidgetWrapper $ mdo
47− (showNewStagingEv', termDyn) <- deploymentsHeadWidget
48− initDeploymentsListWidget updAllEv termDyn
49+ (showNewStagingEv', termDyn) <- deploymentsHeadWidget okUpdEv
50+ okUpdEv <- initDeploymentsListWidget updAllEv termDyn
4951 pure showNewStagingEv'
5052 void $ newStagingPopup showNewStagingEv never
5153
52−deploymentsHeadWidget :: MonadWidget t m => m (Event t (), Dynamic t Text)
53−deploymentsHeadWidget =
54+deploymentsHeadWidget
55+ :: MonadWidget t m
56+ => Event t ()
57+ -> m (Event t (), Dynamic t Text)
58+deploymentsHeadWidget okUpdEv =
5459 divClass "page__head" $ do
5560 elClass "h1" "page__heading title" $ text "All stagings"
56− divClass "page__note" $ text "Updated <n> mins ago"
61+ lastUpdateWidget okUpdEv
5762 termDyn <- divClass "page__action input input--search input--has-clear-type page__action--search" $ mdo
5863 termDyn' <- inputElement $ def
5964 & initialAttributes .~
@@ -68,6 +73,30 @@ deploymentsHeadWidget =
6873 "page__action button button--add popup-handler" $ text "New staging"
6974 pure $ (domEvent Click nsEl, value termDyn)
7075
76+lastUpdateWidget :: MonadWidget t m => Event t () -> m ()
77+lastUpdateWidget okUpdEv = do
78+ updTimeEv <- performEvent $ liftIO getCurrentTime <$ okUpdEv
79+ initTime <- liftIO getCurrentTime
80+ updTimeB <- hold initTime updTimeEv
81+ tickEv <- tickLossyFromPostBuildTime 1
82+ let
83+ diffEv = attachWith calcMins updTimeB tickEv
84+ calcMins lastUpd TickInfo{..} = let
85+ diffSec = diffUTCTime _tickInfo_lastUTC lastUpd
86+ diffMin = diffSec / 60
87+ in floor diffMin :: Int
88+ mkMsg ms
89+ | ms < 1 = "Updated just now"
90+ | isSingular ms = "Updated " <> (show' $ ms) <> " minute ago"
91+ | ms < 60 = "Updated " <> (show' $ ms) <> " minutes ago"
92+ | isSingular (ms `div` 60) =
93+ "Updated " <> (show'$ ms `div` 60) <> " hour ago"
94+ | otherwise = "Updated " <> (show' $ ms `div` 60) <> " hours ago"
95+ isSingular x = x `mod` 100 /= 11 && x `mod` 10 == 1
96+ show' = pack . show
97+ diffDyn <- holdDyn 0 diffEv
98+ divClass "page__note" $ dynText $ mkMsg <$> diffDyn
99+
71100initDeploymentsListWidget
72101 ::
73102 ( MonadWidget t m
@@ -75,16 +104,18 @@ initDeploymentsListWidget
75104 , SetRoute t (R Routes) m )
76105 => Event t ()
77106 -> Dynamic t Text
78− -> m ()
107+ -> m (Event t ())
79108initDeploymentsListWidget updAllEv termDyn = dataWidgetWrapper $ do
80109 pb <- getPostBuild
81110 respEv <- listEndpoint pb
82111 let
83112 okEv = fmapMaybe reqSuccess respEv
84113 errEv = fmapMaybe reqFailure respEv
85− widgetHold_ loadingDeploymentsWidget $ leftmost
114+ w m = m >> pure never
115+ okUpdEvDyn <- widgetHold (w loadingDeploymentsWidget) $ leftmost
86116 [ deploymentsListWidget updAllEv termDyn <$> okEv
87− , errDeploymentsWidget <$ errEv ]
117+ , (w errDeploymentsWidget) <$ errEv ]
118+ pure $ switchDyn okUpdEvDyn
88119
89120deploymentsListWidget
90121 ::
@@ -94,7 +125,7 @@ deploymentsListWidget
94125 => Event t ()
95126 -> Dynamic t Text
96127 -> [DeploymentFullInfo]
97− -> m ()
128+ -> m (Event t ())
98129deploymentsListWidget updAllEv termDyn ds = mdo
99130 updRespEv <- listEndpoint updAllEv
100131 let
@@ -110,6 +141,7 @@ deploymentsListWidget updAllEv termDyn ds = mdo
110141 clickedEv <- elementClick
111142 activeDeploymentsWidget clickedEv activeDsDyn
112143 archivedDeploymentsWidget clickedEv archivedDsDyn
144+ pure $ () <$ okUpdEv
113145
114146searchDeployments
115147 :: Text -> DeploymentFullInfo -> Bool