Show empty values by default

dev/default.nix

@@ -116,6 +116,8 @@ in
 
         sleep 4
 
+        echo "foo.vat1.fjij.key1,"
+
         for i in {1..10}
         do
         for j in {1..10}

octopod-frontend/src/Data/WorkingOverrides.hs

@@ -1,6 +1,7 @@
 module Data.WorkingOverrides
   ( WorkingOverrides,
     WorkingOverrideKey' (..),
+    getConfigValueText,
     WorkingOverrideKey,
     WorkingOverrideKeyType (..),
     destructWorkingOverrides,
@@ -42,29 +43,38 @@ data ConfigValue te
 
 newtype CustomKey v = CustomKey v
   deriving stock (Show, Generic, Eq, Ord)
+
 data CustomConfigValue te
   = CustomValue !te
   | DeletedValue !(Maybe te)
   deriving stock (Show, Generic, Eq, Ord)
 
+getConfigValueText :: ConfigValue te -> Maybe te
+getConfigValueText (DefaultConfigValue t) = Just t
+getConfigValueText (CustomConfigValue (Left (CustomKey t))) = Just t
+getConfigValueText (CustomConfigValue (Right (CustomValue t))) = Just t
+getConfigValueText (CustomConfigValue (Right (DeletedValue t))) = t
+
 -- Super inefficient but i dont care
 configTreeHasLeaf ::
   forall m kv te.
-  ( MonadReader (Ref m (Map (ConfigTree kv te) Bool)) m
+  ( MonadReader (Ref m (Map (Text, ConfigTree kv te) Bool)) m
   , MonadRef m
   , Ord kv
   , Ord te
   ) =>
+  -- | The id of the predicate used for caching
+  Text ->
   (te -> Bool) ->
   ConfigTree kv te ->
   m Bool
-configTreeHasLeaf f = memo $ \(CT.ConfigTree x) -> go $ toList x
+configTreeHasLeaf name f = memo (\(_, CT.ConfigTree x) -> go $ toList x)  . (name,)
   where
     go :: [(Maybe te, ConfigTree kv te)] -> m Bool
     go [] = pure False
     go ((Just y, _) : _) | f y = pure True
     go ((_, ct) : rest) =
-      configTreeHasLeaf f ct >>= \case
+      configTreeHasLeaf name f ct >>= \case
         True -> pure True
         False -> go rest
 

octopod-frontend/src/Frontend/UIKit.hs

@@ -377,6 +377,7 @@ showNonEditableWorkingOverrideTree treeDyn = do
           untilReady (lift nonEditableLoading) $
             divClass "padded" $
               showWorkingOverrideTree'
+                (const False)
                 (is (_Ctor' @"CustomConfigValue"))
                 (\_ _ -> ())
                 (\_ k v -> renderRow k v $> pure ())
@@ -400,6 +401,8 @@ showOverrideTree ::
   , Ord tk
   , Ord tv
   ) =>
+  -- | Value should be shown by default
+  (tv -> Bool) ->
   -- | Value is modified
   (tv -> Bool) ->
   -- | Prepare the fixpoint data
@@ -409,19 +412,21 @@ showOverrideTree ::
   ConfigTree tk tv ->
   -- | Should we render anything
   m [Dynamic t x]
-showOverrideTree isModified prepareData renderValue ct = do
+showOverrideTree isShown isModified prepareData renderValue ct = do
   memoRef <- newRef mempty
   flip runReaderT memoRef $
-    showWorkingOverrideTree' isModified prepareData ((fmap . fmap . fmap) lift renderValue) ct (pure True) never
+    showWorkingOverrideTree' isShown isModified prepareData ((fmap . fmap . fmap) lift renderValue) ct (pure True) never
 
 showWorkingOverrideTree' ::
   ( MonadWidget t m
   , Renderable tk
   , Show x
-  , MonadReader (Ref m (Map (ConfigTree tk tv) Bool)) m
+  , MonadReader (Ref m (Map (Text, ConfigTree tk tv) Bool)) m
   , Ord tv
   , Ord tk
   ) =>
+  -- | Value should be shown by default
+  (tv -> Bool) ->
   -- | Value is modified
   (tv -> Bool) ->
   -- | Prepare the fixpoint data
@@ -434,7 +439,7 @@ showWorkingOverrideTree' ::
   -- | Force open/close all subtrees
   Event t Bool ->
   m [Dynamic t x]
-showWorkingOverrideTree' isModified prepareData renderValue (ConfigTree m) shouldRenderDyn' forceSubtreesEv = do
+showWorkingOverrideTree' isShown isModified prepareData renderValue (ConfigTree m) shouldRenderDyn' forceSubtreesEv = do
   shouldRenderDyn <- holdUniqDyn shouldRenderDyn'
   (appEndo . fold -> f) <- for (OM.assocs m) $ \(k, (mv, _)) -> do
     xMaybe <- for mv $ \v -> mdo
@@ -462,7 +467,8 @@ showWorkingOverrideTree' isModified prepareData renderValue (ConfigTree m) shoul
                       then "collapse--expanded"
                       else mempty
         (ovs, openDyn) <- elDynClass "div" wrapperClass $ do
-          modified <- configTreeHasLeaf isModified subtree
+          modified <- configTreeHasLeaf "isModified" isModified subtree
+          shown <- configTreeHasLeaf "isShown" isShown subtree
           (traceEvent "clickEv" -> clickEv) <-
             treeButton
               TreeButtonConfig
@@ -471,11 +477,12 @@ showWorkingOverrideTree' isModified prepareData renderValue (ConfigTree m) shoul
                 , visible = shouldRenderDyn
                 , forceState = forceSubtreesEv
                 }
-          buttonIsOpen <- holdDyn False $ leftmost [forceSubtreesEv, fst <$> clickEv]
+          buttonIsOpen <- holdDyn shown $ leftmost [forceSubtreesEv, fst <$> clickEv]
           let selfForceSubtrees = fst <$> ffilter (isRight . snd) clickEv
           ovs' <-
             divClass "collapse__inner" $
               showWorkingOverrideTree'
+                isShown
                 isModified
                 prepareData
                 renderValue

octopod-frontend/src/Frontend/Utils.hs

@@ -431,6 +431,7 @@ envVarsInput (traceDyn "values" -> values) lookupOverride ovs = divClass "padded
       envVarInput lookupOverride values emptyItem
   treeResCfg <-
     showOverrideTree
+      ((== Just True) . fmap (T.null . T.strip) . getConfigValueText . snd)
       (isn't (_Ctor' @"DefaultConfigValue") . snd)
       (\_ v -> v)
       (\a _ _ -> envVarInput lookupOverride values (trace "a" a))
@@ -440,34 +441,6 @@ envVarsInput (traceDyn "values" -> values) lookupOverride ovs = divClass "padded
       addingIsEnabled = join $ fmap and . sequenceA . (fmap . fmap) (not . T.null . fst) <$> resCfg
   pure resCfg
 
--- validateWorkingOverrides ::
---   forall f.
---   Traversable f =>
---   f WorkingOverride ->
---   f (WorkingOverride, OverrideErrors)
--- validateWorkingOverrides overrides =
---   let (result, keyOccurrences :: MonoidalMap Text (Sum Int)) =
---         flip runState mempty $ for overrides \override@(WorkingOverrideKey _ key, value') -> do
---           case value' of
---             WorkingDeletedValue _ -> pure ()
---             _ -> modify (<> MM.singleton key (Sum 1))
---           pure . (override,) . mconcat $
---             [ case MM.lookup key keyOccurrences of
---                 Just (Sum n)
---                   | n > 1 ->
---                     overrideKeyErrors "You can not use the same key multiple times."
---                 _ -> mempty
---             , if T.null key
---                 then overrideKeyErrors "Keys can not be empty."
---                 else mempty
---             , case value' of
---                 WorkingCustomValue "" -> overrideValueErrors "Values can not be empty."
---                 WorkingCustomValue _ -> mempty
---                 WorkingDefaultValue "" -> overrideValueErrors "Values can not be empty."
---                 WorkingDefaultValue _ -> mempty
---                 WorkingDeletedValue _ -> mempty
---             ]
---    in result
 
 -- | Widget for entering a key-value pair.
 envVarInput ::