379c6ea · typeable/octopod

git.iko.soy/typeable/octopod

Quality of life frontend improvements (#169)

* Fixed buttons not opening links * Show empty values by default * Fixed formatting

commit379c6ea69286dffb202c7904af72d05d9b9f46d6 authoriko <ilyakooo0@gmail.com> dateFri 20 May 2022, 09:41 (4 years ago) parentb21e1bd

6 files changed+33−41

compare with master

unifiedsplit

.vscode/settings.json+2−1 dev/default.nix+2 octopod-frontend/src/Data/WorkingOverrides.hs+13−3 octopod-frontend/src/Frontend/UIKit.hs+13−6 octopod-frontend/src/Frontend/UIKit/Button/Common.hs+2−2 octopod-frontend/src/Frontend/Utils.hs+1−29

.vscode/settings.json+2−1

@@ -3,5 +3,6 @@

33 "haskell.formattingProvider": "fourmolu",

44 "haskell.plugin.hlint.diagnosticsOn": false,

55 "haskell.hlint.logLevel": "none",

6− "haskell.hlint.run": "never"

6+ "haskell.hlint.run": "never",

7+ "haskell.serverExecutablePath": "haskell-language-server"

78}

dev/default.nix+2

@@ -116,6 +116,8 @@ in

116116

117117 sleep 4

118118

119+ echo "foo.vat1.fjij.key1,"

120+

119121 for i in {1..10}

120122 do

121123 for j in {1..10}

octopod-frontend/src/Data/WorkingOverrides.hs+13−3

@@ -1,6 +1,7 @@

11module Data.WorkingOverrides

22 ( WorkingOverrides,

33 WorkingOverrideKey' (..),

4+ getConfigValueText,

45 WorkingOverrideKey,

56 WorkingOverrideKeyType (..),

67 destructWorkingOverrides,

@@ -42,29 +43,38 @@ data ConfigValue te

4243

4344newtype CustomKey v = CustomKey v

4445 deriving stock (Show, Generic, Eq, Ord)

46+

4547data CustomConfigValue te

4648 = CustomValue !te

4749 | DeletedValue !(Maybe te)

4850 deriving stock (Show, Generic, Eq, Ord)

4951

52+getConfigValueText :: ConfigValue te -> Maybe te

53+getConfigValueText (DefaultConfigValue t) = Just t

54+getConfigValueText (CustomConfigValue (Left (CustomKey t))) = Just t

55+getConfigValueText (CustomConfigValue (Right (CustomValue t))) = Just t

56+getConfigValueText (CustomConfigValue (Right (DeletedValue t))) = t

57+

5058-- Super inefficient but i dont care

5159configTreeHasLeaf ::

5260 forall m kv te.

53− ( MonadReader (Ref m (Map (ConfigTree kv te) Bool)) m

61+ ( MonadReader (Ref m (Map (Text, ConfigTree kv te) Bool)) m

5462 , MonadRef m

5563 , Ord kv

5664 , Ord te

5765 ) =>

66+ -- | The id of the predicate used for caching

67+ Text ->

5868 (te -> Bool) ->

5969 ConfigTree kv te ->

6070 m Bool

61−configTreeHasLeaf f = memo $ \(CT.ConfigTree x) -> go $ toList x

71+configTreeHasLeaf name f = memo (\(_, CT.ConfigTree x) -> go $ toList x) . (name,)

6272 where

6373 go :: [(Maybe te, ConfigTree kv te)] -> m Bool

6474 go [] = pure False

6575 go ((Just y, _) : _) | f y = pure True

6676 go ((_, ct) : rest) =

67− configTreeHasLeaf f ct >>= \case

77+ configTreeHasLeaf name f ct >>= \case

6878 True -> pure True

6979 False -> go rest

7080

octopod-frontend/src/Frontend/UIKit.hs+13−6

@@ -377,6 +377,7 @@ showNonEditableWorkingOverrideTree treeDyn = do

377377 untilReady (lift nonEditableLoading) $

378378 divClass "padded" $

379379 showWorkingOverrideTree'

380+ (const False)

380381 (is (_Ctor' @"CustomConfigValue"))

381382 (\_ _ -> ())

382383 (\_ k v -> renderRow k v $> pure ())

@@ -400,6 +401,8 @@ showOverrideTree ::

400401 , Ord tk

401402 , Ord tv

402403 ) =>

404+ -- | Value should be shown by default

405+ (tv -> Bool) ->

403406 -- | Value is modified

404407 (tv -> Bool) ->

405408 -- | Prepare the fixpoint data

@@ -409,19 +412,21 @@ showOverrideTree ::

409412 ConfigTree tk tv ->

410413 -- | Should we render anything

411414 m [Dynamic t x]

412−showOverrideTree isModified prepareData renderValue ct = do

415+showOverrideTree isShown isModified prepareData renderValue ct = do

413416 memoRef <- newRef mempty

414417 flip runReaderT memoRef $

415− showWorkingOverrideTree' isModified prepareData ((fmap . fmap . fmap) lift renderValue) ct (pure True) never

418+ showWorkingOverrideTree' isShown isModified prepareData ((fmap . fmap . fmap) lift renderValue) ct (pure True) never

416419

417420showWorkingOverrideTree' ::

418421 ( MonadWidget t m

419422 , Renderable tk

420423 , Show x

421− , MonadReader (Ref m (Map (ConfigTree tk tv) Bool)) m

424+ , MonadReader (Ref m (Map (Text, ConfigTree tk tv) Bool)) m

422425 , Ord tv

423426 , Ord tk

424427 ) =>

428+ -- | Value should be shown by default

429+ (tv -> Bool) ->

425430 -- | Value is modified

426431 (tv -> Bool) ->

427432 -- | Prepare the fixpoint data

@@ -434,7 +439,7 @@ showWorkingOverrideTree' ::

434439 -- | Force open/close all subtrees

435440 Event t Bool ->

436441 m [Dynamic t x]

437−showWorkingOverrideTree' isModified prepareData renderValue (ConfigTree m) shouldRenderDyn' forceSubtreesEv = do

442+showWorkingOverrideTree' isShown isModified prepareData renderValue (ConfigTree m) shouldRenderDyn' forceSubtreesEv = do

438443 shouldRenderDyn <- holdUniqDyn shouldRenderDyn'

439444 (appEndo . fold -> f) <- for (OM.assocs m) $ \(k, (mv, _)) -> do

440445 xMaybe <- for mv $ \v -> mdo

@@ -462,7 +467,8 @@ showWorkingOverrideTree' isModified prepareData renderValue (ConfigTree m) shoul

462467 then "collapse--expanded"

463468 else mempty

464469 (ovs, openDyn) <- elDynClass "div" wrapperClass $ do

465− modified <- configTreeHasLeaf isModified subtree

470+ modified <- configTreeHasLeaf "isModified" isModified subtree

471+ shown <- configTreeHasLeaf "isShown" isShown subtree

466472 (traceEvent "clickEv" -> clickEv) <-

467473 treeButton

468474 TreeButtonConfig

@@ -471,11 +477,12 @@ showWorkingOverrideTree' isModified prepareData renderValue (ConfigTree m) shoul

471477 , visible = shouldRenderDyn

472478 , forceState = forceSubtreesEv

473479 }

474− buttonIsOpen <- holdDyn False $ leftmost [forceSubtreesEv, fst <$> clickEv]

480+ buttonIsOpen <- holdDyn shown $ leftmost [forceSubtreesEv, fst <$> clickEv]

475481 let selfForceSubtrees = fst <$> ffilter (isRight . snd) clickEv

476482 ovs' <-

477483 divClass "collapse__inner" $

478484 showWorkingOverrideTree'

485+ isShown

479486 isModified

480487 prepareData

481488 renderValue

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

@@ -77,7 +77,7 @@ buttonEl cfg = do

7777 ( const

7878 EventFlags

7979 { _eventFlags_propagation = Propagation_StopImmediate

80− , _eventFlags_preventDefault = True

80+ , _eventFlags_preventDefault = False

8181 }

8282 )

8383 & elementConfig_eventSpec

@@ -87,7 +87,7 @@ buttonEl cfg = do

8787 ( const

8888 EventFlags

8989 { _eventFlags_propagation = Propagation_StopImmediate

90− , _eventFlags_preventDefault = True

90+ , _eventFlags_preventDefault = False

9191 }

9292 )

9393 (bEl, _) <- element t elCfg (unTextBuilder (cfg ^. #buttonText))

octopod-frontend/src/Frontend/Utils.hs+1−29

@@ -431,6 +431,7 @@ envVarsInput (traceDyn "values" -> values) lookupOverride ovs = divClass "padded

431431 envVarInput lookupOverride values emptyItem

432432 treeResCfg <-

433433 showOverrideTree

434+ ((== Just True) . fmap (T.null . T.strip) . getConfigValueText . snd)

434435 (isn't (_Ctor' @"DefaultConfigValue") . snd)

435436 (\_ v -> v)

436437 (\a _ _ -> envVarInput lookupOverride values (trace "a" a))

@@ -440,35 +441,6 @@ envVarsInput (traceDyn "values" -> values) lookupOverride ovs = divClass "padded

440441 addingIsEnabled = join $ fmap and . sequenceA . (fmap . fmap) (not . T.null . fst) <$> resCfg

441442 pure resCfg

442443

443−-- validateWorkingOverrides ::

444−-- forall f.

445−-- Traversable f =>

446−-- f WorkingOverride ->

447−-- f (WorkingOverride, OverrideErrors)

448−-- validateWorkingOverrides overrides =

449−-- let (result, keyOccurrences :: MonoidalMap Text (Sum Int)) =

450−-- flip runState mempty $ for overrides \override@(WorkingOverrideKey _ key, value') -> do

451−-- case value' of

452−-- WorkingDeletedValue _ -> pure ()

453−-- _ -> modify (<> MM.singleton key (Sum 1))

454−-- pure . (override,) . mconcat $

455−-- [ case MM.lookup key keyOccurrences of

456−-- Just (Sum n)

457−-- | n > 1 ->

458−-- overrideKeyErrors "You can not use the same key multiple times."

459−-- _ -> mempty

460−-- , if T.null key

461−-- then overrideKeyErrors "Keys can not be empty."

462−-- else mempty

463−-- , case value' of

464−-- WorkingCustomValue "" -> overrideValueErrors "Values can not be empty."

465−-- WorkingCustomValue _ -> mempty

466−-- WorkingDefaultValue "" -> overrideValueErrors "Values can not be empty."

467−-- WorkingDefaultValue _ -> mempty

468−-- WorkingDeletedValue _ -> mempty

469−-- ]

470−-- in result

471−

472444-- | Widget for entering a key-value pair.

473445envVarInput ::

474446 (MonadWidget t m) =>