git.iko.soy/typeable/octopod
on master help sign in
show last update (#63)
dd6e12dNikita
dm-frontend/src/Page/Deployments.hs+42−10
compare with master
unifiedsplit
@@ -3,11 +3,13 @@ module Page.Deployments
3
3
4import Control.Lens
4import Control.Lens
5import Control.Monad
5import Control.Monad
6+import Control.Monad.IO.Class
6import Data.Coerce
7import Data.Coerce
7import Data.Generics.Product (field)
8import Data.Generics.Product (field)
8import Data.List as L (null)
9import Data.List as L (null)
9import Data.Map as M (Map, fromList, partition, filter)
10import 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)
11import Obelisk.Route.Frontend
13import Obelisk.Route.Frontend
12import Reflex.Dom
14import Reflex.Dom
13import Servant.Reflex
15import Servant.Reflex
@@ -44,16 +46,19 @@ deploymentsWidget
44 -> m ()
46 -> m ()
45deploymentsWidget updAllEv = do
47deploymentsWidget updAllEv = do
46 showNewStagingEv <- deploymentsWidgetWrapper $ mdo
48 showNewStagingEv <- deploymentsWidgetWrapper $ mdo
47− (showNewStagingEv', termDyn) <- deploymentsHeadWidget
49+ (showNewStagingEv', termDyn) <- deploymentsHeadWidget okUpdEv
48− initDeploymentsListWidget updAllEv termDyn
50+ okUpdEv <- initDeploymentsListWidget updAllEv termDyn
49 pure showNewStagingEv'
51 pure showNewStagingEv'
50 void $ newStagingPopup showNewStagingEv never
52 void $ newStagingPopup showNewStagingEv never
51
53
52−deploymentsHeadWidget :: MonadWidget t m => m (Event t (), Dynamic t Text)
54+deploymentsHeadWidget
55+ :: MonadWidget t m
56+ => Event t ()
57+ -> m (Event t (), Dynamic t Text)
53−deploymentsHeadWidget =
58+deploymentsHeadWidget okUpdEv =
54 divClass "page__head" $ do
59 divClass "page__head" $ do
55 elClass "h1" "page__heading title" $ text "All stagings"
60 elClass "h1" "page__heading title" $ text "All stagings"
56− divClass "page__note" $ text "Updated <n> mins ago"
61+ lastUpdateWidget okUpdEv
57 termDyn <- divClass "page__action input input--search input--has-clear-type page__action--search" $ mdo
62 termDyn <- divClass "page__action input input--search input--has-clear-type page__action--search" $ mdo
58 termDyn' <- inputElement $ def
63 termDyn' <- inputElement $ def
59 & initialAttributes .~
64 & initialAttributes .~
@@ -68,6 +73,30 @@ deploymentsHeadWidget =
68 "page__action button button--add popup-handler" $ text "New staging"
73 "page__action button button--add popup-handler" $ text "New staging"
69 pure $ (domEvent Click nsEl, value termDyn)
74 pure $ (domEvent Click nsEl, value termDyn)
70
75
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+
71initDeploymentsListWidget
100initDeploymentsListWidget
72 ::
101 ::
73 ( MonadWidget t m
102 ( MonadWidget t m
@@ -75,16 +104,18 @@ initDeploymentsListWidget
75 , SetRoute t (R Routes) m )
104 , SetRoute t (R Routes) m )
76 => Event t ()
105 => Event t ()
77 -> Dynamic t Text
106 -> Dynamic t Text
78− -> m ()
107+ -> m (Event t ())
79initDeploymentsListWidget updAllEv termDyn = dataWidgetWrapper $ do
108initDeploymentsListWidget updAllEv termDyn = dataWidgetWrapper $ do
80 pb <- getPostBuild
109 pb <- getPostBuild
81 respEv <- listEndpoint pb
110 respEv <- listEndpoint pb
82 let
111 let
83 okEv = fmapMaybe reqSuccess respEv
112 okEv = fmapMaybe reqSuccess respEv
84 errEv = fmapMaybe reqFailure respEv
113 errEv = fmapMaybe reqFailure respEv
114+ w m = m >> pure never
85− widgetHold_ loadingDeploymentsWidget $ leftmost
115+ okUpdEvDyn <- widgetHold (w loadingDeploymentsWidget) $ leftmost
86 [ deploymentsListWidget updAllEv termDyn <$> okEv
116 [ deploymentsListWidget updAllEv termDyn <$> okEv
87− , errDeploymentsWidget <$ errEv ]
117+ , (w errDeploymentsWidget) <$ errEv ]
118+ pure $ switchDyn okUpdEvDyn
88
119
89deploymentsListWidget
120deploymentsListWidget
90 ::
121 ::
@@ -94,7 +125,7 @@ deploymentsListWidget
94 => Event t ()
125 => Event t ()
95 -> Dynamic t Text
126 -> Dynamic t Text
96 -> [DeploymentFullInfo]
127 -> [DeploymentFullInfo]
97− -> m ()
128+ -> m (Event t ())
98deploymentsListWidget updAllEv termDyn ds = mdo
129deploymentsListWidget updAllEv termDyn ds = mdo
99 updRespEv <- listEndpoint updAllEv
130 updRespEv <- listEndpoint updAllEv
100 let
131 let
@@ -110,6 +141,7 @@ deploymentsListWidget updAllEv termDyn ds = mdo
110 clickedEv <- elementClick
141 clickedEv <- elementClick
111 activeDeploymentsWidget clickedEv activeDsDyn
142 activeDeploymentsWidget clickedEv activeDsDyn
112 archivedDeploymentsWidget clickedEv archivedDsDyn
143 archivedDeploymentsWidget clickedEv archivedDsDyn
144+ pure $ () <$ okUpdEv
113
145
114searchDeployments
146searchDeployments
115 :: Text -> DeploymentFullInfo -> Bool
147 :: Text -> DeploymentFullInfo -> Bool