6846403 · typeable/octopod

git.iko.soy/typeable/octopod

frontend hotfixes (#120)

* Fixed override editing * Fixed debouncing overrides

commit6846403b7fb811f3ffc2ec126c959a9e445deee1 authoriko <ilyakooo0@gmail.com> dateWed 29 Sep 2021, 23:23 (5 years ago) parentc8ac911

4 files changed+41−20

compare with master

unifiedsplit

dev/default.nix+13−2 octopod-frontend/src/Data/WorkingOverrides.hs+6−1 octopod-frontend/src/Frontend/UIKit.hs+2−1 octopod-frontend/src/Frontend/Utils.hs+20−16

dev/default.nix+13−2

@@ -115,6 +115,17 @@ in

115115 exit 0

116116 '';

117117

118+ keysScript = pkgs.writeScript "keys.sh" ''

119+ #!${pkgs.bash}/bin/bash

120+

121+ sleep 4

122+

123+ echo "key"

124+ echo "key2"

125+

126+ exit 0

127+ '';

128+

118129 writeScript = pkgs.writeScript "write.sh" ''

119130 #!${pkgs.bash}/bin/bash

120131

@@ -145,9 +156,9 @@ in

145156 export INFO_COMMAND=${infoScript}

146157 export NOTIFICATION_COMMAND=${writeScript}

147158 export DEPLOYMENT_CONFIG_COMMAND=${infoScript}

148− export DEPLOYMENT_KEYS_COMMAND=${infoScript}

159+ export DEPLOYMENT_KEYS_COMMAND=${keysScript}

149160 export APPLICATION_CONFIG_COMMAND=${infoScript}

150− export APPLICATION_KEYS_COMMAND=${infoScript}

161+ export APPLICATION_KEYS_COMMAND=${keysScript}

151162 export UNARCHIVE_COMMAND=${writeScript}

152163 export POWER_AUTHORIZATION_HEADER="123"

153164 export CACHE_INVALIDATION_TIME="60"

octopod-frontend/src/Data/WorkingOverrides.hs+6−1

@@ -47,7 +47,12 @@ data WorkingOverrideValue' te

4747destructWorkingOverrides :: WorkingOverrides -> Overrides l

4848destructWorkingOverrides =

4949 Overrides

50− . OM.fromList

50+ . foldr

51+ ( \pair@(k, v) m -> case OM.lookup k m of

52+ Just _ | v == ValueDeleted -> m

53+ _ -> m OM.|> pair

54+ )

55+ OM.empty

5156 . mapMaybe

5257 ( \case

5358 (WorkingOverrideKey CustomWorkingOverrideKey k, getWorkingOverrideValue -> v) -> Just (k, v)

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

@@ -84,6 +84,7 @@ data OverrideField t = OverrideField

8484data OverrideFieldType

8585 = DefaultOverrideFieldType

8686 | EditedOverrideFieldType

87+ deriving stock (Show)

8788

8889overrideFieldTypeClasses :: OverrideFieldType -> Classes

8990overrideFieldTypeClasses DefaultOverrideFieldType = "input--default"

@@ -109,7 +110,7 @@ overrideField overrideKeyValues keyDyn valueDyn = do

109110 (pure [])

110111 (valueDyn ^. #fieldDisabled)

111112 ( do

112− t <- keyDyn ^. #fieldType

113+ t <- valueDyn ^. #fieldType

113114 pure $ "overrides__value" <> overrideFieldTypeClasses t

114115 )

115116 "value"

octopod-frontend/src/Frontend/Utils.hs+20−16

@@ -344,7 +344,7 @@ deploymentPopupBody ::

344344 m (Dynamic t (Maybe DeploymentUpdate))

345345deploymentPopupBody hReq defAppOv defDepOv errEv = mdo

346346 pb <- getPostBuild

347− (defDepEv, defApp, depCfgEv) <- deploymentConfigProgressiveComponents hReq deploymentOvsDyn

347+ (defDepEv, defApp, depCfgEv) <- deploymentConfigProgressiveComponents hReq deploymentOvsDynDebounced

348348 defAppM <- holdClearingWith defApp (unitEv deploymentOvsDyn)

349349 defDep <- holdDynMaybe defDepEv

350350 depKeys <- deploymentOverrideKeys pb >>= hReq

@@ -356,23 +356,26 @@ deploymentPopupBody hReq defAppOv defDepOv errEv = mdo

356356 Dynamic t [Text] ->

357357 Dynamic t (Maybe (DefaultConfig l)) ->

358358 Overrides l ->

359− m (Dynamic t (Overrides l), Dynamic t Bool)

359+ m (Dynamic t (Overrides l), Dynamic t (Overrides l), Dynamic t Bool)

360360 holdDCfg values dCfgDyn ovs = mdo

361361 ovsDyn <- holdDyn ovs ovsEv

362+ ovsDynDebounced <- holdDyn ovs ovsEvDebounced

362363 x <- attachDyn (current ovsDyn) dCfgDyn

363364 res <- dyn (x <&> \(ovs', dCfg) -> envVarsInput values dCfg ovs')

364− ovsEv <- switchHold never (fst <$> res) >>= debounce 0.5

365+ ovsEv <- switchHold never (fst <$> res)

366+ ovsEvDebounced <- debounce 2 ovsEv

365367 isValid <- join <$> holdDyn (pure True) (snd <$> res)

366− pure (ovsDyn, isValid)

368+ pure (ovsDyn, ovsDynDebounced, isValid)

367369

368370 depKeysDyn <- holdDyn [] depKeys

369− (deploymentOvsDyn, depValidDyn) <- deploymentSection "Deployment overrides" $ holdDCfg depKeysDyn defDep defDepOv

371+ (deploymentOvsDyn, deploymentOvsDynDebounced, depValidDyn) <-

372+ deploymentSection "Deployment overrides" $ holdDCfg depKeysDyn defDep defDepOv

370373

371374 appKeys <- waitForValuePromptly depCfgEv $ \deploymentCfg -> do

372375 pb' <- getPostBuild

373376 applicationOverrideKeys (pure $ Right deploymentCfg) pb' >>= hReq >>= immediateNothing

374377 appKeysDyn <- holdDyn [] $ catMaybes appKeys

375− (applicationOvsDyn, appValidDyn) <- deploymentSection "App overrides" $ holdDCfg appKeysDyn defAppM defAppOv

378+ (applicationOvsDyn, _, appValidDyn) <- deploymentSection "App overrides" $ holdDCfg appKeysDyn defAppM defAppOv

376379

377380 pure $ do

378381 depValid <- depValidDyn

@@ -388,6 +391,7 @@ deploymentPopupBody hReq defAppOv defDepOv errEv = mdo

388391 , deploymentOverrides = depCfg

389392 }

390393 else pure Nothing

394+

391395deploymentConfigProgressiveComponents ::

392396 MonadWidget t m =>

393397 RequestErrorHandler t m ->

@@ -520,7 +524,9 @@ validateWorkingOverrides ::

520524validateWorkingOverrides overrides =

521525 let (result, keyOccurrences :: MonoidalMap Text (Sum Int)) =

522526 flip runState mempty $ forM overrides \override@(WorkingOverrideKey _ key, value') -> do

523− modify (<> MM.singleton key (Sum 1))

527+ case value' of

528+ WorkingDeletedValue _ -> pure ()

529+ _ -> modify (<> MM.singleton key (Sum 1))

524530 pure . (override,) . mconcat $

525531 [ case MM.lookup key keyOccurrences of

526532 Just (Sum n)

@@ -623,19 +629,17 @@ performUserOverrideAction f i (UpdateValue v) = Endo $

623629 Just v' | v == v' -> WorkingDefaultValue v

624630 _ -> WorkingCustomValue v

625631 )

626−performUserOverrideAction f i (UpdateKey k) = Endo $ updateUniq i $ \(_, v) -> (WorkingOverrideKey t k, v)

627− where

628− t = case f >>= ($ k) of

629− Nothing -> CustomWorkingOverrideKey

630− Just _ -> DefaultWorkingOverrideKey

632+performUserOverrideAction _ i (UpdateKey k) = Endo $

633+ updateUniq i $

634+ \(_, v) -> (WorkingOverrideKey CustomWorkingOverrideKey k, v)

631635performUserOverrideAction f i DeleteOverride = Endo $ \m ->

632636 case f of

633637 Nothing -> updateUniq i (\(k, _) -> (k, WorkingDeletedValue Nothing)) m

634− Just f' -> case lookupUniq i m of

638+ Just _ -> case lookupUniq i m of

635639 Nothing -> m

636− Just (WorkingOverrideKey _ k, _) -> case f' k of

637− Nothing -> deleteUniq i m

638− Just v -> updateUniq i (const (WorkingOverrideKey DefaultWorkingOverrideKey k, WorkingDeletedValue (Just v))) m

640+ Just (WorkingOverrideKey DefaultWorkingOverrideKey k, _) ->

641+ updateUniq i (const (WorkingOverrideKey DefaultWorkingOverrideKey k, WorkingDeletedValue (f >>= ($ k)))) m

642+ Just (WorkingOverrideKey CustomWorkingOverrideKey _, _) -> deleteUniq i m

639643

640644holdDynMaybe :: (Reflex t, MonadHold t m) => Event t a -> m (Dynamic t (Maybe a))

641645holdDynMaybe ev = holdDyn Nothing $ fmapCheap Just ev