git.iko.soy/typeable/octopod
on master help sign in
Various small frontend improvements (#140)

* Disabled spell checking * Enter now submits forms * Open deployment page after creation

commit37208871ca1a03f117015829728aaa9a6267b928 authoriko <ilyakooo0@gmail.com> dateThu 14 Oct 2021, 12:18 (5 years ago) parentab9aea9
5 files changed+41−29
compare with master
unifiedsplit
octopod-frontend/src/Frontend/UIKit.hs+1 octopod-frontend/src/Frontend/Utils.hs+6 octopod-frontend/src/Page/Deployments.hs+3−1 octopod-frontend/src/Page/Popup/EditDeployment.hs+2−2 octopod-frontend/src/Page/Popup/NewDeployment.hs+29−26
octopod-frontend/src/Frontend/UIKit.hs+1
@@ -238,6 +238,7 @@ octopodTextInputDyn valuesDyn disabledDyn clssDyn placeholder inValDyn' errDyn =
238238 .~ ( "type" =: "text"
239239 <> "class" =: "input__widget"
240240 <> "placeholder" =: placeholder
241+ <> "spellcheck" =: "false"
241242 )
242243 & inputElementConfig_setValue .~ inValEv
243244 & inputElementConfig_initialValue .~ inVal
octopod-frontend/src/Frontend/Utils.hs+6
@@ -33,6 +33,7 @@ module Frontend.Utils
3333 applicationOverridesWidget,
3434 applicationOverridesWidgetSearched,
3535 debounceDyn,
36+ catchReturns,
3637 )
3738where
3839
@@ -679,3 +680,8 @@ debounceDyn t d = do
679680 currD <- sample . current $ d
680681 ev <- debounce t (updated d)
681682 holdDyn currD ev
683+
684+catchReturns :: (DomBuilder t m, MonadFix m) => (Event t () -> m a) -> m a
685+catchReturns f = mdo
686+ (divEl, a) <- el' "div" $ f $ ($> ()) . ffilter (== 13) $ domEvent Keypress divEl
687+ pure a
octopod-frontend/src/Page/Deployments.hs+3−1
@@ -93,7 +93,9 @@ deploymentsWidget updAllEv dfis = do
9393 termDyn <- debounceDyn 0.3 termDyn'
9494 (okUpdEv, errUpdEv, editEv) <- deploymentsListWidget hReq updAllEv termDyn dfis
9595 pure (showNewDeploymentEv', deSearch <$> editEv)
96− void $ newDeploymentPopup showNewDeploymentEv never
96+ newDepEv <- newDeploymentPopup showNewDeploymentEv never
97+ setRoute $ newDepEv <&> \newDep -> DashboardRoute :/ Just (newDep ^. #name)
98+
9799 void $ editDeploymentPopup editEv never
98100
99101-- | Div wrappers.
octopod-frontend/src/Page/Popup/EditDeployment.hs+2−2
@@ -33,10 +33,10 @@ editDeploymentPopup ::
3333 Event t () ->
3434 -- | Event with a flag showing the current state of the request.
3535 m (Event t Bool)
36−editDeploymentPopup showEv hideEv = sidebar showEv hideEv $ \dfi -> mdo
36+editDeploymentPopup showEv hideEv = catchReturns $ \enterEv -> sidebar showEv hideEv $ \dfi -> mdo
3737 divClass "popup__body" $ mdo
3838 let dname = dfi ^. dfiName
39− (closeEv', saveEv) <- editDeploymentPopupHeader dname enabledDyn sentDyn
39+ (closeEv', (enterEv <>) -> saveEv) <- editDeploymentPopupHeader dname enabledDyn sentDyn
4040 deploymentMDyn <- editDeploymentPopupBody dfi respEv
4141 respEv <-
4242 holdDyn (pure never) >=> networkView >=> switchHold never $
octopod-frontend/src/Page/Popup/NewDeployment.hs+29−26
@@ -8,7 +8,6 @@ module Page.Popup.NewDeployment (newDeploymentPopup) where
88import Control.Lens
99import Control.Monad
1010import Data.Functor
11−import Data.Generics.Sum
1211import Data.Monoid
1312import qualified Data.Text as T
1413import Reflex.Dom as R
@@ -30,31 +29,35 @@ newDeploymentPopup ::
3029 Event t () ->
3130 -- | \"Close\" event.
3231 Event t () ->
33− m ()
34−newDeploymentPopup showEv hideEv = void $
35− sidebar showEv hideEv $
36− const $ mdo
37− divClass "popup__body" $ mdo
38− (closeEv', saveEv) <- newDeploymentPopupHeader enabledDyn sentDyn
39− deploymentMDyn <- newDeploymentPopupBody respEv
40− respEv <-
41− holdDyn (pure never) >=> networkView >=> switchHold never $
42− tagMaybe (current deploymentMDyn) saveEv <&> \dep -> do
43− pb <- getPostBuild
44− createEndpoint
45− (pure $ Right dep)
46− pb
47− sentDyn <-
48− holdDyn False $
49− leftmost
50− [ True <$ saveEv
51− , False <$ respEv
52− ]
53− let successEv =
54− fmapMaybe (preview (_Ctor @"Success") <=< commandResponse) respEv
55− closeEv = leftmost [closeEv', successEv]
56− enabledDyn = zipDynWith (&&) (not <$> sentDyn) (isJust <$> deploymentMDyn)
57− pure (never, closeEv)
32+ m (Event t Deployment)
33+newDeploymentPopup showEv hideEv =
34+ catchReturns $ \enterEv ->
35+ sidebar showEv hideEv $
36+ const $ mdo
37+ divClass "popup__body" $ mdo
38+ (closeEv', (enterEv <>) -> saveEv) <- newDeploymentPopupHeader enabledDyn sentDyn
39+ deploymentMDyn <- newDeploymentPopupBody (snd <$> respEv)
40+ respEv <-
41+ holdDyn (pure never) >=> networkView >=> switchHold never $
42+ tagMaybe (current deploymentMDyn) saveEv <&> \dep -> do
43+ pb <- getPostBuild
44+ fmap (dep,)
45+ <$> createEndpoint
46+ (pure $ Right dep)
47+ pb
48+ sentDyn <-
49+ holdDyn False $
50+ leftmost
51+ [ True <$ saveEv
52+ , False <$ respEv
53+ ]
54+ let successEv =
55+ respEv `fforMaybe` \case
56+ (dep, commandResponse -> Just Success {}) -> Just dep
57+ _ -> Nothing
58+ closeEv = leftmost [closeEv', successEv $> ()]
59+ enabledDyn = zipDynWith (&&) (not <$> sentDyn) (isJust <$> deploymentMDyn)
60+ pure (successEv, closeEv)
5861
5962-- | The header of sidebar contains control buttons: \"Save\" and \"Close\".
6063newDeploymentPopupHeader ::