Various small frontend improvements (#140)

* Disabled spell checking

* Enter now submits forms

* Open deployment page after creation

octopod-frontend/src/Frontend/UIKit.hs

@@ -238,6 +238,7 @@ octopodTextInputDyn valuesDyn disabledDyn clssDyn placeholder inValDyn' errDyn =
             .~ ( "type" =: "text"
                   <> "class" =: "input__widget"
                   <> "placeholder" =: placeholder
+                  <> "spellcheck" =: "false"
                )
           & inputElementConfig_setValue .~ inValEv
           & inputElementConfig_initialValue .~ inVal

octopod-frontend/src/Frontend/Utils.hs

@@ -33,6 +33,7 @@ module Frontend.Utils
     applicationOverridesWidget,
     applicationOverridesWidgetSearched,
     debounceDyn,
+    catchReturns,
   )
 where
 
@@ -679,3 +680,8 @@ debounceDyn t d = do
   currD <- sample . current $ d
   ev <- debounce t (updated d)
   holdDyn currD ev
+
+catchReturns :: (DomBuilder t m, MonadFix m) => (Event t () -> m a) -> m a
+catchReturns f = mdo
+  (divEl, a) <- el' "div" $ f $ ($> ()) . ffilter (== 13) $ domEvent Keypress divEl
+  pure a

octopod-frontend/src/Page/Deployments.hs

@@ -93,7 +93,9 @@ deploymentsWidget updAllEv dfis = do
       termDyn <- debounceDyn 0.3 termDyn'
       (okUpdEv, errUpdEv, editEv) <- deploymentsListWidget hReq updAllEv termDyn dfis
       pure (showNewDeploymentEv', deSearch <$> editEv)
-  void $ newDeploymentPopup showNewDeploymentEv never
+  newDepEv <- newDeploymentPopup showNewDeploymentEv never
+  setRoute $ newDepEv <&> \newDep -> DashboardRoute :/ Just (newDep ^. #name)
+
   void $ editDeploymentPopup editEv never
 
 -- | Div wrappers.

octopod-frontend/src/Page/Popup/EditDeployment.hs

@@ -33,10 +33,10 @@ editDeploymentPopup ::
   Event t () ->
   -- | Event with a flag showing the current state of the request.
   m (Event t Bool)
-editDeploymentPopup showEv hideEv = sidebar showEv hideEv $ \dfi -> mdo
+editDeploymentPopup showEv hideEv = catchReturns $ \enterEv -> sidebar showEv hideEv $ \dfi -> mdo
   divClass "popup__body" $ mdo
     let dname = dfi ^. dfiName
-    (closeEv', saveEv) <- editDeploymentPopupHeader dname enabledDyn sentDyn
+    (closeEv', (enterEv <>) -> saveEv) <- editDeploymentPopupHeader dname enabledDyn sentDyn
     deploymentMDyn <- editDeploymentPopupBody dfi respEv
     respEv <-
       holdDyn (pure never) >=> networkView >=> switchHold never $

octopod-frontend/src/Page/Popup/NewDeployment.hs

@@ -8,7 +8,6 @@ module Page.Popup.NewDeployment (newDeploymentPopup) where
 import Control.Lens
 import Control.Monad
 import Data.Functor
-import Data.Generics.Sum
 import Data.Monoid
 import qualified Data.Text as T
 import Reflex.Dom as R
@@ -30,31 +29,35 @@ newDeploymentPopup ::
   Event t () ->
   -- | \"Close\" event.
   Event t () ->
-  m ()
-newDeploymentPopup showEv hideEv = void $
-  sidebar showEv hideEv $
-    const $ mdo
-      divClass "popup__body" $ mdo
-        (closeEv', saveEv) <- newDeploymentPopupHeader enabledDyn sentDyn
-        deploymentMDyn <- newDeploymentPopupBody respEv
-        respEv <-
-          holdDyn (pure never) >=> networkView >=> switchHold never $
-            tagMaybe (current deploymentMDyn) saveEv <&> \dep -> do
-              pb <- getPostBuild
-              createEndpoint
-                (pure $ Right dep)
-                pb
-        sentDyn <-
-          holdDyn False $
-            leftmost
-              [ True <$ saveEv
-              , False <$ respEv
-              ]
-        let successEv =
-              fmapMaybe (preview (_Ctor @"Success") <=< commandResponse) respEv
-            closeEv = leftmost [closeEv', successEv]
-            enabledDyn = zipDynWith (&&) (not <$> sentDyn) (isJust <$> deploymentMDyn)
-        pure (never, closeEv)
+  m (Event t Deployment)
+newDeploymentPopup showEv hideEv =
+  catchReturns $ \enterEv ->
+    sidebar showEv hideEv $
+      const $ mdo
+        divClass "popup__body" $ mdo
+          (closeEv', (enterEv <>) -> saveEv) <- newDeploymentPopupHeader enabledDyn sentDyn
+          deploymentMDyn <- newDeploymentPopupBody (snd <$> respEv)
+          respEv <-
+            holdDyn (pure never) >=> networkView >=> switchHold never $
+              tagMaybe (current deploymentMDyn) saveEv <&> \dep -> do
+                pb <- getPostBuild
+                fmap (dep,)
+                  <$> createEndpoint
+                    (pure $ Right dep)
+                    pb
+          sentDyn <-
+            holdDyn False $
+              leftmost
+                [ True <$ saveEv
+                , False <$ respEv
+                ]
+          let successEv =
+                respEv `fforMaybe` \case
+                  (dep, commandResponse -> Just Success {}) -> Just dep
+                  _ -> Nothing
+              closeEv = leftmost [closeEv', successEv $> ()]
+              enabledDyn = zipDynWith (&&) (not <$> sentDyn) (isJust <$> deploymentMDyn)
+          pure (successEv, closeEv)
 
 -- | The header of sidebar contains control buttons: \"Save\" and \"Close\".
 newDeploymentPopupHeader ::