Improved frontend performance (#156)

* Actually use -O2 * Inlined rendering * Switched to an external fuzzy finder * Added insane optimization flags to everything * Made searching async * pass system to dev * Use patched ghcjs * Slightly toned down the insanity * bumped all of nix stuff * tuned runtime * Made things even less intense since it doesn't make a difference * bumped everything * Made overrides faster and prettier * Removed hack for key search popup * Removed warnings
2024-10-03 18:27:13 +03:00 · 2021-12-08 14:00:48 +03:00 · 2021-12-08 14:00:48 +03:00 · c840c6e3ae
commit c840c6e3ae
parent be1f20cf3b
14 changed files with 328 additions and 145 deletions
--- a/3
+++ b/3
@ -36,5 +36,8 @@ run-backend-dev:
 run-frontend-dev:
 	`nix-build dev -A frontend -j auto`

+run-frontend-prod:
+	`nix-build dev -A frontend --arg prod true -j auto`
+
 run-caddy-for-ghcid:
 	`nix-build dev -A caddyForGhcid -j auto`
--- a/default.nix
+++ b/default.nix
@ -8,8 +8,15 @@
 }:
 let
  octopod-css = import ./octopod-css { inherit pkgsSrc; };
+  insaneOptimizationFlags = [
+    "-O2"
+    "-fexpose-all-unfoldings"
+    "-fspecialise-aggressively"
+  ];
  addLocalOptions = x:
-    if prod then x // { ghcOptions = [ "-Werror" ]; }
+    if prod then x // {
+      ghcOptions = [ "-Werror" ] ++ insaneOptimizationFlags;
+    }
    else x // { ghcOptions = [ "-O0" ]; };

  hsPkgs = pkgs.haskell-nix.cabalProject {
@ -28,7 +35,7 @@ let

    modules = [
      {
-        ghcOptions = [ "-O2" ];
+        ghcOptions = insaneOptimizationFlags;
        dontStrip = false;
        dontPatchELF = false;
        enableDeadCodeElimination = true;
--- a/dev/default.nix
+++ b/dev/default.nix
@ -1,10 +1,12 @@
 { pkgs ? hsPkgs.pkgs
 , sources ? import ../nix/sources.nix
 , nix-filter ? import sources.nix-filter
-, hsPkgs ? import ./.. { }
+, hsPkgs ? import ./.. { inherit prod system; }
 , migrations ? ../migrations
 , octopod-css ? import ../octopod-css { inherit pkgsSrc; }
 , pkgsSrc ? hsPkgs.pkgsSrc
+, prod ? false
+, system ? builtins.currentSystem
 }:
 let frontendConfig = pkgs.writeTextDir "config.json" ''
  {
@ -23,6 +25,8 @@ in
      caddyConfig = pkgs.writeText "caddy-config" ''
        http://localhost:8000

+        header Cache-Control no-cache
+
        reverse_proxy /api/* localhost:3002

        file_server /config.json {
@ -52,6 +56,8 @@ in
      caddyConfig = pkgs.writeText "caddy-config" ''
        http://localhost:8000

+        header Cache-Control no-cache
+
        reverse_proxy /api/* localhost:3002

        @notStatic {
@ -109,8 +115,10 @@ in

        sleep 4

-        echo "key,value"
-        echo "key2,value2"
+        for i in {1..50}
+        do
+          echo "key$i,value"
+        done

        exit 0
      '';
@ -120,8 +128,10 @@ in

        sleep 4

-        echo "key"
-        echo "key2"
+        for i in {1..50}
+        do
+          echo "key$i"
+        done

        exit 0
      '';
--- a/nix/sources.json
+++ b/nix/sources.json
@ -1,14 +1,14 @@
 {
    "haskellNix": {
-        "branch": "master",
+        "branch": "iko/ghcjs-patch",
        "description": "Alternative Haskell Infrastructure for Nixpkgs",
        "homepage": "https://input-output-hk.github.io/haskell.nix",
-        "owner": "input-output-hk",
+        "owner": "ilyakooo0",
        "repo": "haskell.nix",
-        "rev": "6d42cdee0f5e916119120232e72e4ce97f7156e9",
-        "sha256": "1w8k3723jx3bs98wswg3wxqdgwa3r4spar75gi5xas4kqwgp9c41",
+        "rev": "8cdc0f62f31be4f55bc7db88bdc0cec44bfd8ab9",
+        "sha256": "0l0xg0s2vn0lpc2m1gavrlzk691sgifjf6l6k5sfsnhw2xq77g48",
        "type": "tarball",
-        "url": "https://github.com/input-output-hk/haskell.nix/archive/6d42cdee0f5e916119120232e72e4ce97f7156e9.tar.gz",
+        "url": "https://github.com/ilyakooo0/haskell.nix/archive/8cdc0f62f31be4f55bc7db88bdc0cec44bfd8ab9.tar.gz",
        "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
    },
    "niv": {
@ -41,10 +41,10 @@
        "homepage": "",
        "owner": "NixOS",
        "repo": "nixpkgs",
-        "rev": "a7263f1291587a1bd271763cc864d3ef8fd227c1",
-        "sha256": "0jl35s5d1xjhifd5iy19wcf0rrhnhbwhf6z2g5lwak2v95p2lrb1",
+        "rev": "bb9bd465b625bfc971908c5d3d84ce517e1c0691",
+        "sha256": "1q558hjfxhbcj6n6kbahswvii95kz6gs5bbzh7ky86cmc2b0l38x",
        "type": "tarball",
-        "url": "https://github.com/NixOS/nixpkgs/archive/a7263f1291587a1bd271763cc864d3ef8fd227c1.tar.gz",
+        "url": "https://github.com/NixOS/nixpkgs/archive/bb9bd465b625bfc971908c5d3d84ce517e1c0691.tar.gz",
        "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
    }
 }
--- a/octopod-common/octopod-common.cabal
+++ b/octopod-common/octopod-common.cabal
@ -20,6 +20,7 @@ library
                     , Common.Validation
                     , Data.Map.Ordered.Strict.Extra
                     , Control.Searchable
+                     , Common.Orphans
  -- other-modules:
  -- other-extensions:
  default-extensions:  BlockArguments
@ -54,6 +55,7 @@ library
                     , ApplicativeDo
                     , UndecidableInstances
                     , FunctionalDependencies
+                     , QuantifiedConstraints
  build-depends:       base
                     , aeson
                     , cassava
@ -66,6 +68,7 @@ library
                     , containers
                     , time
                     , ordered-containers
+                     , deepseq
  hs-source-dirs:      src
  default-language:    Haskell2010
  ghc-options:
--- a/octopod-common/src/Common/Orphans.hs
+++ b/octopod-common/src/Common/Orphans.hs
@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Common.Orphans () where
+
+import Control.DeepSeq
+import Data.Map.Ordered
+
+-- better than nothing
+instance (NFData a, NFData b) => NFData (OMap a b) where
+  rnf = rnf . toMap
--- a/octopod-common/src/Common/Types.hs
+++ b/octopod-common/src/Common/Types.hs
@ -7,6 +7,8 @@
 -- This module contains common types between the backend and the frontend.
 module Common.Types where

+import Common.Orphans ()
+import Control.DeepSeq (NFData)
 import Control.Lens
 import Control.Searchable
 import Data.Aeson hiding (Result)
@ -46,6 +48,7 @@ instance Searchable needle t => Searchable needle (OverrideValue' t) where
 data OverrideValue' t = ValueAdded t | ValueDeleted
  deriving (ToJSON, FromJSON) via Snake (OverrideValue' t)
  deriving stock (Eq, Ord, Show, Generic)
+  deriving anyclass (NFData)

 type OverrideValue = OverrideValue' Text

@ -108,7 +111,7 @@ instance Searchable t x => Searchable t (Overrides' x l) where
  {-# INLINE searchWith #-}

 newtype Overrides' t (l :: OverrideLevel) = Overrides {unOverrides :: OMap t (OverrideValue' t)}
-  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON)
+  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON, NFData)

 type Overrides = Overrides' Text

@ -153,7 +156,7 @@ instance Searchable needle t => Searchable needle (DeploymentName' t) where

 newtype DeploymentName' t = DeploymentName {unDeploymentName :: t}
  deriving newtype
-    (Show, Read, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData, Eq, Ord)
+    (Show, Read, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData, Eq, Ord, NFData)

 type DeploymentName = DeploymentName' Text

@ -210,6 +213,7 @@ data DeploymentStatus
  | CleanupFailed
  deriving stock (Generic, Read, Show, Eq)
  deriving (FromJSON, ToJSON) via Snake DeploymentStatus
+  deriving anyclass (NFData)

 data FailureType
  = GenericFailure
@ -217,6 +221,7 @@ data FailureType
  | PartialAvailability
  deriving stock (Generic, Read, Show, Eq)
  deriving (FromJSON, ToJSON) via Snake FailureType
+  deriving anyclass (NFData)

 data PreciseDeploymentStatus
  = -- | The deployment is currently being processed by the server
@ -224,6 +229,7 @@ data PreciseDeploymentStatus
  | DeploymentNotPending {recordedStatus :: DeploymentStatus}
  deriving stock (Generic, Read, Show, Eq)
  deriving (FromJSON, ToJSON) via Snake PreciseDeploymentStatus
+  deriving anyclass (NFData)

 archivedStatuses :: [DeploymentStatus]
 archivedStatuses = [ArchivePending, Archived]
@ -238,6 +244,7 @@ data Deployment' t = Deployment
  }
  deriving stock (Generic, Show, Eq)
  deriving (FromJSON, ToJSON) via Snake (Deployment' t)
+  deriving anyclass (NFData)

 instance (Searchable needle t) => Searchable needle (Deployment' t) where
  type
@ -271,7 +278,7 @@ data DeploymentLog = DeploymentLog
  deriving (ToJSON, FromJSON) via Snake DeploymentLog

 newtype DeploymentMetadata = DeploymentMetadata {unDeploymentMetadata :: [DeploymentMetadatum]}
-  deriving newtype (Eq, Show, Ord, FromJSON, ToJSON)
+  deriving newtype (Eq, Show, Ord, FromJSON, ToJSON, NFData)

 data DeploymentMetadatum = DeploymentMetadatum
  { -- | The name of the link
@ -282,6 +289,7 @@ data DeploymentMetadatum = DeploymentMetadatum
  deriving stock (Generic, Show, Eq, Ord)
  deriving (FromJSON, ToJSON) via Snake DeploymentMetadatum
  deriving anyclass (FromRecord)
+  deriving anyclass (NFData)

 data DeploymentInfo = DeploymentInfo
  { deployment :: Deployment
@ -310,6 +318,7 @@ data DeploymentFullInfo' t = DeploymentFullInfo
  }
  deriving stock (Generic, Show, Eq)
  deriving (FromJSON, ToJSON) via Snake (DeploymentFullInfo' t)
+  deriving anyclass (NFData)

 type DeploymentFullInfo = DeploymentFullInfo' Text

--- a/octopod-frontend/octopod-frontend.cabal
+++ b/octopod-frontend/octopod-frontend.cabal
@ -23,6 +23,8 @@ flag development
 executable frontend
  if impl(ghcjs >= 0.2.1)
     ghcjs-options:     -dedupe
+  ghcjs-options: -DGHCJS_BUSY_YIELD=20
+                 -DGHCJS_GC_INTERVAL=60000
  if flag(development)
    cpp-options:       -DDEVELOPMENT
  main-is:             Main.hs
@ -51,6 +53,7 @@ executable frontend
                     , Frontend.UIKit.Button.Action
                     , Frontend.UIKit.Button.Sort
                     , Reflex.Dom.Renderable
+                     , Reflex.Dom.AsyncEvent
  ghc-options:
    -Weverything
    -Wno-implicit-prelude
@ -99,6 +102,7 @@ executable frontend
                     , ViewPatterns
                     , ApplicativeDo
                     , PartialTypeSignatures
+                     , DeriveAnyClass
  build-depends:       aeson
                     , base
                     , bytestring
@ -125,8 +129,11 @@ executable frontend
                     , reflex
                     , data-default
                     , free
-                     , parallel
                     , generic-data
                     , monoidal-containers
+                     , fuzzyfind
+                     , deepseq
+                     , patch
+                     , reflex-dom-core
  hs-source-dirs:      src
  default-language:    Haskell2010
--- a/octopod-frontend/src/Data/Text/Search.hs
+++ b/octopod-frontend/src/Data/Text/Search.hs
@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-}

 module Data.Text.Search
  ( fuzzySearch,
@ -12,75 +12,42 @@ module Data.Text.Search
  )
 where

-import Control.Applicative
 import Control.Applicative.Free.Fast
+import Control.DeepSeq (NFData)
 import Control.Lens
-import Control.Parallel.Strategies
 import Control.Searchable
-import Data.Bifunctor
-import Data.Char
-import Data.Function
 import qualified Data.List as L
-import Data.Maybe (catMaybes)
+import Data.Maybe (listToMaybe)
 import Data.Ord
 import Data.Semigroup
+import Data.Sequence (Seq (..))
 import Data.Text (Text)
 import qualified Data.Text as T
+import GHC.Generics (Generic)
 import Reflex.Dom
 import Reflex.Dom.Renderable
+import Text.FuzzyFind

-type Needle = Text
+type Needle = [String]
 type Haystack = Text
-type Running = Int
-type Penalty = Int

-fuzzySearch' :: Needle -> Haystack -> Running -> Penalty -> [([FuzzySearchStringChunk String], Int)]
-fuzzySearch' needle haystack i p = case (T.uncons needle, T.uncons haystack) of
-  (Just _, Nothing) -> []
-  (Just (n, eedle), Just (h, aystack)) ->
-    bimap (prependNotMatched h) (+ (i - p)) <$> fuzzySearch' needle aystack 0 p
-      <|> if toLower n == toLower h
-        then first (prependMatched h) <$> fuzzySearch' eedle aystack (i * 2 + 1) 1
-        else empty
-  (Nothing, Nothing) -> [([], i)]
-  (Nothing, Just _) -> [([NotMatched $ T.unpack haystack], i)]
+fuzzySearch :: Needle -> Haystack -> Maybe Alignment
+fuzzySearch [] h = Just (Alignment 0 $ Result $ pure $ Gap $ T.unpack h)
+fuzzySearch n h = listToMaybe $ fuzzyFind n [T.unpack h]

-prependMatched :: Char -> [FuzzySearchStringChunk String] -> [FuzzySearchStringChunk String]
-prependMatched c xs@(NotMatched _ : _) = Matched [c] : xs
-prependMatched c (Matched cs : xs) = Matched (c : cs) : xs
-prependMatched c [] = [Matched [c]]
-
-prependNotMatched :: Char -> [FuzzySearchStringChunk String] -> [FuzzySearchStringChunk String]
-prependNotMatched c xs@(Matched _ : _) = NotMatched [c] : xs
-prependNotMatched c (NotMatched cs : xs) = NotMatched (c : cs) : xs
-prependNotMatched c [] = [NotMatched [c]]
-
-fuzzySearch :: Needle -> Haystack -> Maybe ([FuzzySearchStringChunk Text], Int)
-fuzzySearch "" h = Just ([NotMatched h], 0)
-fuzzySearch n h = case fuzzySearch' n h 0 0 of
-  [] -> Nothing
-  xs@(_ : _) -> Just . (first . fmap . fmap) T.pack $ L.maximumBy (compare `on` snd) xs
-
-fuzzySearchMany :: Needle -> [Haystack] -> [(Haystack, [FuzzySearchStringChunk Text])]
-fuzzySearchMany needle haystacks =
-  fmap fst . L.sortOn (Down . snd) $
-    mapMaybe
-      ( \haystack ->
-          fuzzySearch needle haystack
-            <&> \(res, score) -> ((haystack, res), score)
-      )
-      haystacks
+fuzzySearchMany :: Needle -> [Haystack] -> [(Seq FuzzySearchStringChunk, Haystack)]
+fuzzySearchMany [] ts = ts <&> \t -> (pure $ NotMatched t, t)
+fuzzySearchMany n h =
+  (\(unAlignment -> (res, _), initial) -> (res, T.pack initial))
+    <$> L.sortOn (Down . score . fst) (fuzzyFindOn id n (T.unpack <$> h))

 searchMany ::
  (Searchable Text x, SearchableConstraint Text x SearchResult) =>
-  Text ->
+  [String] ->
  [x] ->
  [Searched x SearchResult]
-searchMany "" = fmap wrapResult
-searchMany t =
-  fmap snd . L.sortOn (Down . fst) . catMaybes
-    . withStrategy (parListChunk 3 rpar)
-    . fmap (search t)
+searchMany [] = fmap wrapResult
+searchMany t = fmap snd . L.sortOn (Down . fst) . mapMaybe (search t)
 {-# INLINE searchMany #-}

 -- | Extract initial structure from search result.
@ -100,7 +67,7 @@ wrapResult =

 search ::
  (Searchable Text x, SearchableConstraint Text x SearchResult) =>
-  Text ->
+  Needle ->
  x ->
  Maybe (Int, Searched x SearchResult)
 search needle x = runSearchApplicative $ searchWith searchSingle x
@ -108,14 +75,22 @@ search needle x = runSearchApplicative $ searchWith searchSingle x
    searchSingle :: Text -> SearchApplicative SearchResult
    searchSingle t = case fuzzySearch needle t of
      Nothing -> pure $ SearchResult t Nothing
-      Just (res, score) -> liftAp $ TextSearch t res score
+      Just (unAlignment -> (res, score)) -> liftAp $ TextSearch t res score
 {-# INLINE search #-}

+unAlignment :: Alignment -> (Seq FuzzySearchStringChunk, Score)
+unAlignment (Alignment score (Result res)) = (unResultSegment <$> res, score)
+
+unResultSegment :: ResultSegment -> FuzzySearchStringChunk
+unResultSegment (Gap x) = NotMatched $ T.pack x
+unResultSegment (Match x) = Matched $ T.pack x
+
 data SearchResult = SearchResult
  { initialSearchText :: !Text
-  , searchResult :: !(Maybe [FuzzySearchStringChunk Text])
+  , searchResult :: !(Maybe (Seq FuzzySearchStringChunk))
  }
-  deriving stock (Eq, Ord)
+  deriving stock (Eq, Ord, Generic)
+  deriving anyclass (NFData)

 instance Searchable SearchResult SearchResult where
  type Searched SearchResult res = res
@ -125,9 +100,10 @@ instance Searchable SearchResult SearchResult where
 instance Renderable SearchResult where
  rndr (SearchResult _ (Just cs)) = rndr cs
  rndr (SearchResult t Nothing) = rndr t
+  {-# INLINE rndr #-}

 data SearchF x where
-  TextSearch :: Text -> [FuzzySearchStringChunk Text] -> !Int -> SearchF SearchResult
+  TextSearch :: Text -> Seq FuzzySearchStringChunk -> !Int -> SearchF SearchResult

 type SearchApplicative = Ap SearchF

@ -145,10 +121,13 @@ runSearchApplicative x = case findMaxResult x of
  where
    findMaxResult :: SearchApplicative a -> Maybe Int
    findMaxResult = fmap getMax . runAp_ (\(TextSearch _ _ i) -> Just $ Max i)
+{-# INLINE runSearchApplicative #-}

-data FuzzySearchStringChunk a = NotMatched !a | Matched !a
-  deriving stock (Show, Eq, Ord, Functor)
+data FuzzySearchStringChunk = NotMatched !Text | Matched !Text
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData)

-instance Renderable a => Renderable (FuzzySearchStringChunk a) where
+instance Renderable FuzzySearchStringChunk where
  rndr (NotMatched a) = rndr a
  rndr (Matched a) = elAttr "span" ("style" =: "text-decoration: underline;") (rndr a)
+  {-# INLINE rndr #-}
--- a/octopod-frontend/src/Frontend/UIKit.hs
+++ b/octopod-frontend/src/Frontend/UIKit.hs
@ -18,12 +18,21 @@ module Frontend.UIKit
    deletedOverride,
    showNonEditableWorkingOverride,
    NonEditableWorkingOverrideStyle (..),
+    untilReadyEv',
+    untilReady',
+    runWithReplace',
+    joinEvM,
  )
 where

 import Control.Lens
+  ( ASetter',
+    (%~),
+    (<>~),
+    (?~),
+    (^.),
+  )
 import Control.Monad
-import Control.Monad.IO.Class
 import Data.Align
 import Data.Default
 import Data.Functor
@ -33,8 +42,10 @@ import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as M
 import Data.Maybe (isNothing, maybeToList)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Search
 import Data.These
+import Data.Witherable
 import Data.WorkingOverrides
 import Frontend.Classes as X
 import Frontend.UIKit.Button.Action as X
@ -45,6 +56,7 @@ import Frontend.UIKit.Button.Sort as X
 import Frontend.UIKit.Button.Static as X
 import GHC.Generics (Generic)
 import Reflex.Dom
+import Reflex.Dom.AsyncEvent
 import Reflex.Dom.Renderable
 import Reflex.Network

@ -193,7 +205,7 @@ octopodTextInput' valuesDyn disabledDyn clssDyn placeholder inValDyn' errEv = md
 octopodTextInputDyn ::
  MonadWidget t m =>
  -- | Value to suggest
-  (Dynamic t [Text]) ->
+  Dynamic t [Text] ->
  -- | Disabled?
  Dynamic t Bool ->
  -- | Input field classes.
@ -201,7 +213,7 @@ octopodTextInputDyn ::
  -- | Placeholder for input field.
  Text ->
  -- | Init value.
-  (Dynamic t Text) ->
+  Dynamic t Text ->
  -- | Event carrying the error message.
  Dynamic t (Maybe (NonEmpty Text)) ->
  m (InputElement EventResult GhcjsDomSpace t)
@ -256,36 +268,39 @@ octopodTextInputDyn valuesDyn disabledDyn clssDyn placeholder inValDyn' errDyn =
      simpleList ((maybeToList >=> NE.toList) <$> errDyn) $ \err ->
        divClass "input__output" $ dynText err

-    delayedFalseFocus <- delayFalse $ _inputElement_hasFocus inp'
-    selectedValue' <- networkView >=> switchHoldPromptly never $ do
-      hasFocus <- delayedFalseFocus
-      values <- valuesDyn
-      case hasFocus of
-        True | (_ : _) <- values -> do
+    let searchValuesEv = catMaybes . updated $ do
+          hasFocus <- _inputElement_hasFocus inp'
+          values <- valuesDyn
          currVal <- valDyn
-          case fuzzySearchMany currVal values of
-            [] -> pure $ pure never
-            ress ->
-              pure $ do
-                elClass "ul" "overrides__search" $ do
-                  fmap leftmost $
-                    forM ress $ \(initialText, res) -> do
-                      (resEl, ()) <- elClass' "li" "overrides__search-item" $
-                        forM_ res $ \case
-                          Matched t -> elAttr "span" ("style" =: "font-weight: bold;") $ text t
-                          NotMatched t -> text t
-                      pure $ domEvent Click resEl $> initialText
-        _ -> pure $ pure never
-    pure (inp', selectedValue')
-  pure inp
+          pure $ case hasFocus of
+            True | (_ : _) <- values -> Just (values, currVal)
+            _ -> Nothing
+    searchResultEv <- asyncEventLast searchValuesEv $ \(values, currVal) ->
+      fuzzySearchMany [T.unpack currVal] values
+    selectedValueEv <-
+      (>>= joinEvM) $
+        runWithReplace' (pure ()) $
+          updated (_inputElement_hasFocus inp') <&> \case
+            False -> pure never
+            True ->
+              (>>= joinEvM) $
+                runWithReplace' (pure ()) $
+                  searchResultEv <&> \case
+                    [] -> pure never
+                    searchResult -> do
+                      elClass "ul" "overrides__search" $ do
+                        fmap leftmost $
+                          forM searchResult $ \(res, initialText) -> do
+                            (resEl, ()) <- elClass' "li" "overrides__search-item" $
+                              forM_ res $ \case
+                                Matched t -> elAttr "span" ("style" =: "font-weight: bold;") $ text t
+                                NotMatched t -> text t
+                            -- Because 'Click' would fire after the text field loses
+                            -- focus and the popup disappears.
+                            pure $ domEvent Mousedown resEl $> initialText

-delayFalse :: (MonadHold t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m)) => Dynamic t Bool -> m (Dynamic t Bool)
-delayFalse x = do
-  initVal <- sample . current $ x
-  let trueEv = ffilter id $ updated x
-      falseEv = ffilter not $ updated x
-  delayedFalseEv <- delay 0.1 falseEv
-  holdDyn initVal $ leftmost [trueEv, delayedFalseEv]
+    pure (inp', selectedValueEv)
+  pure inp

 -- | Dark unclickable background for opened sidebar.
 popupOverlay :: DomBuilder t m => m ()
@ -346,3 +361,29 @@ showNonEditableWorkingOverride loading loaded style cfg =
        divClass "listing__item" $ do
          elClass "div" "listing__placeholder" $ pure ()
          elClass "div" "listing__spinner" $ pure ()
+
+untilReadyEv' ::
+  (Adjustable t m, PostBuild t m, MonadHold t m) =>
+  m a ->
+  m (Event t b) ->
+  m (Event t b)
+untilReadyEv' m m' = do
+  (_, bEvEv) <- untilReady m m'
+  switchHold never bEvEv
+
+untilReady' ::
+  (Adjustable t m, PostBuild t m) =>
+  m a ->
+  m b ->
+  m (Event t b)
+untilReady' m m' = do
+  (_, bEv) <- untilReady m m'
+  pure bEv
+
+runWithReplace' :: Adjustable t m => m a -> Event t (m b) -> m (Event t b)
+runWithReplace' ma mbEv = do
+  (_, bEv) <- runWithReplace ma mbEv
+  pure bEv
+
+joinEvM :: (MonadHold t m, Reflex t) => Event t (Event t a) -> m (Event t a)
+joinEvM = switchHold never
--- a/octopod-frontend/src/Frontend/Utils.hs
+++ b/octopod-frontend/src/Frontend/Utils.hs
@ -42,17 +42,23 @@ import Control.Lens
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.State.Strict
+import qualified Data.Bifunctor as Bi
 import qualified Data.Foldable as F
 import Data.Functor
+import Data.Functor.Misc
 import Data.Generics.Labels ()
 import Data.List.NonEmpty (NonEmpty)
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Map.Monoidal.Strict (MonoidalMap)
 import qualified Data.Map.Monoidal.Strict as MM
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Monoid
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text as T (Text, null, pack)
 import Data.Text.Search
+import Data.These
 import Data.Time
 import Data.UniqMap
 import Data.Unique
@ -362,10 +368,13 @@ deploymentPopupBody hReq defAppOv defDepOv errEv = mdo
        ovsDyn <- holdDyn ovs ovsEv
        ovsDynDebounced <- holdDyn ovs ovsEvDebounced
        x <- attachDyn (current ovsDyn) dCfgDyn
-        res <- dyn (x <&> \(ovs', dCfg) -> envVarsInput values dCfg ovs')
-        ovsEv <- switchHold never (fst <$> res)
+        (splitE -> (ovsEvEv, isValidDynEv)) <-
+          (>>= joinEvM) $
+            runWithReplace' loadingOverrides $
+              updated x <&> \(ovs', dCfg) -> untilReady' loadingOverrides $ envVarsInput values dCfg ovs'
+        ovsEv <- joinEvM ovsEvEv
        ovsEvDebounced <- debounce 2 ovsEv
-        isValid <- join <$> holdDyn (pure True) (snd <$> res)
+        isValid <- join <$> holdDyn (pure False) isValidDynEv
        pure (ovsDyn, ovsDynDebounced, isValid)

  depKeysDyn <- holdDyn [] depKeys
@ -494,8 +503,16 @@ envVarsInput ::
  -- | Updated deployment overrides.
  m (Event t (Overrides l), Dynamic t Bool)
 envVarsInput values dCfg ovs = mdo
-  envsDyn <- foldDyn appEndo (constructWorkingOverrides dCfg ovs) $ leftmost [addEv, updEv]
-  let addEv = clickEv $> Endo (fst . insertUniqStart newWorkingOverride)
+  let initialOverrides = constructWorkingOverrides dCfg ovs
+  (envsDyn, addedKeys) <-
+    mapAccumDyn
+      ( \prevOvs -> \case
+          Left () ->
+            Bi.second S.singleton $ insertUniqStart newWorkingOverride prevOvs
+          Right (Endo f) -> (f prevOvs, S.empty)
+      )
+      initialOverrides
+      $ leftmost [Left <$> clickEv, Right <$> updEv]
  clickEv <-
    dashButton
      DashButtonConfig
@ -505,18 +522,58 @@ envVarsInput values dCfg ovs = mdo
        , buttonStyle = OverridesDashButtonStyle
        }
  let workingOverridesWithErrors = validateWorkingOverrides . uniqMap <$> envsDyn
-      isValid = all ((== mempty) . snd) <$> workingOverridesWithErrors
-  updEv <-
+      erroredOverride = M.filter ((/= mempty) . snd) <$> workingOverridesWithErrors
+      isValid = M.null <$> erroredOverride
+  (_, changedValues) <-
+    mapAccumDyn
+      ( \prev new ->
+          ( fmap (\(v, _) -> (v, mempty)) new
+          , new <> prev
+          )
+      )
+      mempty
+      (updated erroredOverride)
+  let updatedValues = restrictMapEv updatedKeys (updated workingOverridesWithErrors)
+      valChangedEvSelector = fanMap (clearedOvs <> changedValues <> updatedValues)
+      (splitE -> (clearedOvs, deletedOvs)) =
+        alignEventWithMaybe
+          ( \case
+              These keys m ->
+                Just $
+                  let cleared = M.restrictKeys m keys
+                   in (cleared, M.fromSet (const Nothing) (keys `S.difference` M.keysSet cleared))
+              _ -> Nothing
+          )
+          removedKeys
+          (updated workingOverridesWithErrors)
+      listChange =
+        deletedOvs <> (fmap . fmap) Just (restrictMapEv addedKeys (updated workingOverridesWithErrors))
+
+  (splitE3 -> (updEv, removedKeys, updatedKeys)) <-
    switchDyn . fmap F.fold
-      <$> listWithKey
-        workingOverridesWithErrors
-        (\i x -> fmap (performUserOverrideAction (lookupDefaultConfig <$> dCfg) i) <$> envVarInput values x)
+      <$> listHoldWithKey
+        (validateWorkingOverrides . uniqMap $ initialOverrides)
+        listChange
+        ( \i val -> do
+            valDyn <- holdDyn val $ select valChangedEvSelector $ Const2 i
+            userActionEv <- envVarInput values valDyn
+            pure $ performUserOverrideAction (lookupDefaultConfig <$> dCfg) i <$> userActionEv
+        )
  let addingIsEnabled = all (\(WorkingOverrideKey _ x, _) -> not . T.null $ x) . elemsUniq <$> envsDyn
  case dCfg of
    Just _ -> pure ()
    Nothing -> loadingOverrides
  pure (updated $ destructWorkingOverrides <$> envsDyn, isValid)

+restrictMapEv :: (Reflex t, Ord k) => Event t (Set k) -> Event t (Map k v) -> Event t (Map k v)
+restrictMapEv =
+  alignEventWithMaybe
+    ( \case
+        These keys _ | S.null keys -> Nothing
+        These keys m -> Just $ M.restrictKeys m keys
+        _ -> Nothing
+    )
+
 validateWorkingOverrides ::
  forall f.
  Traversable f =>
@ -567,7 +624,7 @@ envVarInput ::
  -- | Current variable key and value.
  Dynamic t (WorkingOverride, OverrideErrors) ->
  m (Event t UserOverrideAction)
-envVarInput values val = do
+envVarInput values val = untilReadyEv' loadingOverride $ do
  let kDyn = val <&> fst <&> \(WorkingOverrideKey _ x, _) -> x
  -- Either <override present> <override deleted>
  d <-
@ -622,25 +679,29 @@ performUserOverrideAction ::
  Maybe (Text -> Maybe Text) ->
  Int ->
  UserOverrideAction ->
-  Endo WorkingOverrides
-performUserOverrideAction f i (UpdateValue v) = Endo $
-  updateUniq i $ \(k@(WorkingOverrideKey _ kt), _) ->
-    ( k
-    , case f >>= ($ kt) of
-        Just v' | v == v' -> WorkingDefaultValue v
-        _ -> WorkingCustomValue v
-    )
-performUserOverrideAction _ i (UpdateKey k) = Endo $
-  updateUniq i $
-    \(_, v) -> (WorkingOverrideKey CustomWorkingOverrideKey k, v)
-performUserOverrideAction f i DeleteOverride = Endo $ \m ->
-  case f of
-    Nothing -> updateUniq i (\(k, _) -> (k, WorkingDeletedValue Nothing)) m
-    Just _ -> case lookupUniq i m of
-      Nothing -> m
-      Just (WorkingOverrideKey DefaultWorkingOverrideKey k, _) ->
-        updateUniq i (const (WorkingOverrideKey DefaultWorkingOverrideKey k, WorkingDeletedValue (f >>= ($ k)))) m
-      Just (WorkingOverrideKey CustomWorkingOverrideKey _, _) -> deleteUniq i m
+  -- | (endo, removed/cleared keys, updatedKeys)
+  (Endo WorkingOverrides, Set Int, Set Int)
+performUserOverrideAction f i (UpdateValue v) = (,S.empty,S.singleton i) $
+  Endo $
+    updateUniq i $ \(k@(WorkingOverrideKey _ kt), _) ->
+      ( k
+      , case f >>= ($ kt) of
+          Just v' | v == v' -> WorkingDefaultValue v
+          _ -> WorkingCustomValue v
+      )
+performUserOverrideAction _ i (UpdateKey k) = (,S.empty,S.singleton i) $
+  Endo $
+    updateUniq i $
+      \(_, v) -> (WorkingOverrideKey CustomWorkingOverrideKey k, v)
+performUserOverrideAction f i DeleteOverride = (,S.singleton i,S.empty) $
+  Endo $ \m ->
+    case f of
+      Nothing -> updateUniq i (\(k, _) -> (k, WorkingDeletedValue Nothing)) m
+      Just _ -> case lookupUniq i m of
+        Nothing -> m
+        Just (WorkingOverrideKey DefaultWorkingOverrideKey k, _) ->
+          updateUniq i (const (WorkingOverrideKey DefaultWorkingOverrideKey k, WorkingDeletedValue (f >>= ($ k)))) m
+        Just (WorkingOverrideKey CustomWorkingOverrideKey _, _) -> deleteUniq i m

 holdDynMaybe :: (Reflex t, MonadHold t m) => Event t a -> m (Dynamic t (Maybe a))
 holdDynMaybe ev = holdDyn Nothing $ fmapCheap Just ev
@ -685,3 +746,6 @@ 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
+
+splitE3 :: Reflex t => Event t (a, b, c) -> (Event t a, Event t b, Event t c)
+splitE3 e = ((\(a, _, _) -> a) <$> e, (\(_, b, _) -> b) <$> e, (\(_, _, c) -> c) <$> e)
--- a/octopod-frontend/src/Page/Deployments.hs
+++ b/octopod-frontend/src/Page/Deployments.hs
@ -24,7 +24,6 @@ import Common.Utils
 import Control.Applicative
 import Control.Monad.Reader
 import Data.Align
-import Data.Char
 import Data.Functor
 import qualified Data.Semigroup as S
 import qualified Data.Text as T
@ -39,6 +38,7 @@ import Page.ClassicPopup
 import Page.Elements.Links
 import Page.Popup.EditDeployment
 import Page.Popup.NewDeployment
+import Reflex.Dom.AsyncEvent
 import Reflex.Dom.Renderable
 import Reflex.MultiEventWriter.Class
 import Servant.Reflex.Extra
@ -190,9 +190,11 @@ deploymentsListWidget hReq updAllEv termDyn ds = dataWidgetWrapper $ mdo
  let okUpdEv = fmapMaybe reqSuccess updRespEv
      errUpdEv = fmapMaybe reqErrorBody updRespEv
  dsDyn <- holdDyn ds okUpdEv
-  let searchedDyn = ffor2 termDyn dsDyn $ \term ds' ->
-        searchMany (T.filter (not . isSpace) term) ds'
-      (archivedDsDyn, activeDsDyn) =
+  let searchInput = updated $ ffor2 termDyn dsDyn (,)
+  searchedEv <- asyncEventLast searchInput $ \(term, ds') ->
+    searchMany (T.unpack <$> T.words term) ds'
+  searchedDyn <- holdDyn (wrapResult <$> ds) searchedEv
+  let (archivedDsDyn, activeDsDyn) =
        splitDynPure $ L.partition isDeploymentArchived <$> searchedDyn
      searchSorting = termDyn $> Nothing
  clickedEv <- elementClick
--- a/octopod-frontend/src/Reflex/Dom/AsyncEvent.hs
+++ b/octopod-frontend/src/Reflex/Dom/AsyncEvent.hs
@ -0,0 +1,30 @@
+module Reflex.Dom.AsyncEvent
+  ( NFData,
+    asyncEventLast,
+  )
+where
+
+import Control.Concurrent
+import Control.DeepSeq (NFData, force)
+import Control.Exception (evaluate)
+import Control.Monad.IO.Class
+import Data.Functor
+import Data.IORef
+import Reflex
+
+asyncEventLast ::
+  (TriggerEvent t m, PerformEvent t m, MonadIO (Performable m), MonadIO m, NFData b) =>
+  Event t a ->
+  (a -> b) ->
+  m (Event t b)
+asyncEventLast aEv f = do
+  lastThreadIdRef <- liftIO $ newIORef Nothing
+  performEventAsync $
+    aEv <&> \a fire -> liftIO $ do
+      readIORef lastThreadIdRef >>= \case
+        Nothing -> pure ()
+        Just lastThreadId -> killThread lastThreadId
+      newThreadId <- forkIO $ do
+        b <- evaluate $ force $ f a
+        fire b
+      writeIORef lastThreadIdRef (Just newThreadId)
--- a/octopod-frontend/src/Reflex/Dom/Renderable.hs
+++ b/octopod-frontend/src/Reflex/Dom/Renderable.hs
@ -3,15 +3,33 @@ module Reflex.Dom.Renderable
  )
 where

+import Data.Sequence (Seq (..))
 import Data.Text (Text)
+import qualified Data.Text as T
 import Reflex.Dom

 class Renderable a where
  rndr :: DomBuilder t m => a -> m ()
+  rndrList :: DomBuilder t m => [a] -> m ()
+  rndrList [] = pure ()
+  rndrList (a : aa) = rndr a >> rndr aa
+  {-# INLINE rndrList #-}

 instance Renderable Text where
  rndr = text
+  {-# INLINE rndr #-}

 instance Renderable a => Renderable [a] where
-  rndr [] = pure ()
-  rndr (a : aa) = rndr a >> rndr aa
+  rndr = rndrList
+  {-# INLINE rndr #-}
+
+instance Renderable Char where
+  rndr = text . T.singleton
+  {-# INLINE rndr #-}
+  rndrList = text . T.pack
+  {-# INLINE rndrList #-}
+
+instance Renderable a => Renderable (Seq a) where
+  rndr Empty = pure ()
+  rndr (a :<| aa) = rndr a >> rndr aa
+  {-# INLINE rndr #-}