3720887 · typeable/octopod

octopod-frontend/src/Frontend/UIKit.hs+1

compare with master

unifiedsplit

@@ -238,6 +238,7 @@ octopodTextInputDyn valuesDyn disabledDyn clssDyn placeholder inValDyn' errDyn =

238 .~ ( "type" =: "text"

239 <> "class" =: "input__widget"

240 <> "placeholder" =: placeholder

241+ <> "spellcheck" =: "false"

241 )

242 )

242 & inputElementConfig_setValue .~ inValEv

243 & inputElementConfig_setValue .~ inValEv

243 & inputElementConfig_initialValue .~ inVal

244 & inputElementConfig_initialValue .~ inVal

octopod-frontend/src/Frontend/Utils.hs+6

@@ -33,6 +33,7 @@ module Frontend.Utils

33 applicationOverridesWidget,

34 applicationOverridesWidgetSearched,

35 debounceDyn,

36+ catchReturns,

36 )

37 )

37where

38where

38

39

@@ -679,3 +680,8 @@ debounceDyn t d = do

679 currD <- sample . current $ d

680 currD <- sample . current $ d

680 ev <- debounce t (updated d)

681 ev <- debounce t (updated d)

681 holdDyn currD ev

682 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

93 termDyn <- debounceDyn 0.3 termDyn'

94 (okUpdEv, errUpdEv, editEv) <- deploymentsListWidget hReq updAllEv termDyn dfis

95 pure (showNewDeploymentEv', deSearch <$> editEv)

96− void $ newDeploymentPopup showNewDeploymentEv never

96+ newDepEv <- newDeploymentPopup showNewDeploymentEv never

97+ setRoute $ newDepEv <&> \newDep -> DashboardRoute :/ Just (newDep ^. #name)

98+

97 void $ editDeploymentPopup editEv never

99 void $ editDeploymentPopup editEv never

98

100

99-- | Div wrappers.

101-- | Div wrappers.

octopod-frontend/src/Page/Popup/EditDeployment.hs+2−2

@@ -33,10 +33,10 @@ editDeploymentPopup ::

33 Event t () ->

34 -- | Event with a flag showing the current state of the request.

35 m (Event t Bool)

36−editDeploymentPopup showEv hideEv = sidebar showEv hideEv $ \dfi -> mdo

36+editDeploymentPopup showEv hideEv = catchReturns $ \enterEv -> sidebar showEv hideEv $ \dfi -> mdo

37 divClass "popup__body" $ mdo

38 let dname = dfi ^. dfiName

39− (closeEv', saveEv) <- editDeploymentPopupHeader dname enabledDyn sentDyn

39+ (closeEv', (enterEv <>) -> saveEv) <- editDeploymentPopupHeader dname enabledDyn sentDyn

40 deploymentMDyn <- editDeploymentPopupBody dfi respEv

41 respEv <-

42 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

8import Control.Lens

9import Control.Monad

10import Data.Functor

11−import Data.Generics.Sum

12import Data.Monoid

11import Data.Monoid

13import qualified Data.Text as T

12import qualified Data.Text as T

14import Reflex.Dom as R

13import Reflex.Dom as R

@@ -30,31 +29,35 @@ newDeploymentPopup ::

30 Event t () ->

29 Event t () ->

31 -- | \"Close\" event.

30 -- | \"Close\" event.

32 Event t () ->

31 Event t () ->

33− m ()

32+ m (Event t Deployment)

34−newDeploymentPopup showEv hideEv = void $

33+newDeploymentPopup showEv hideEv =

34+ catchReturns $ \enterEv ->

35− sidebar showEv hideEv $

35+ sidebar showEv hideEv $

36− const $ mdo

36+ const $ mdo

37− divClass "popup__body" $ mdo

37+ divClass "popup__body" $ mdo

38− (closeEv', saveEv) <- newDeploymentPopupHeader enabledDyn sentDyn

38+ (closeEv', (enterEv <>) -> saveEv) <- newDeploymentPopupHeader enabledDyn sentDyn

39− deploymentMDyn <- newDeploymentPopupBody respEv

39+ deploymentMDyn <- newDeploymentPopupBody (snd <$> respEv)

40− respEv <-

40+ respEv <-

41− holdDyn (pure never) >=> networkView >=> switchHold never $

41+ holdDyn (pure never) >=> networkView >=> switchHold never $

42− tagMaybe (current deploymentMDyn) saveEv <&> \dep -> do

42+ tagMaybe (current deploymentMDyn) saveEv <&> \dep -> do

43− pb <- getPostBuild

43+ pb <- getPostBuild

44+ fmap (dep,)

44− createEndpoint

45+ <$> createEndpoint

45− (pure $ Right dep)

46+ (pure $ Right dep)

46− pb

47+ pb

47− sentDyn <-

48+ sentDyn <-

48− holdDyn False $

49+ holdDyn False $

49− leftmost

50+ leftmost

50− [ True <$ saveEv

51+ [ True <$ saveEv

51− , False <$ respEv

52+ , False <$ respEv

52− ]

53+ ]

53− let successEv =

54+ let successEv =

54− fmapMaybe (preview (_Ctor @"Success") <=< commandResponse) respEv

55+ respEv `fforMaybe` \case

56+ (dep, commandResponse -> Just Success {}) -> Just dep

57+ _ -> Nothing

55− closeEv = leftmost [closeEv', successEv]

58+ closeEv = leftmost [closeEv', successEv $> ()]

56− enabledDyn = zipDynWith (&&) (not <$> sentDyn) (isJust <$> deploymentMDyn)

59+ enabledDyn = zipDynWith (&&) (not <$> sentDyn) (isJust <$> deploymentMDyn)

57− pure (never, closeEv)

60+ pure (successEv, closeEv)

58

61

59-- | The header of sidebar contains control buttons: \"Save\" and \"Close\".

62-- | The header of sidebar contains control buttons: \"Save\" and \"Close\".

60newDeploymentPopupHeader ::

63newDeploymentPopupHeader ::