Commit 73472fd4 authored by Steffen Michels's avatar Steffen Michels

add tuning combinators to add labels to dyn cons args

parent 87dc4ec3
Pipeline #24954 passed with stage
in 5 minutes and 50 seconds
...@@ -155,6 +155,7 @@ where ...@@ -155,6 +155,7 @@ where
-> Typed TaskContExpr (a -> Task b) -> Typed TaskContExpr (a -> Task b)
) )
<<@@@ HideIfOnlyChoice <<@@@ HideIfOnlyChoice
<<@@@ AddLabels [Just "name", Just "pred", Just "cont"]
] ]
, DynamicConsGroup "Editors" , DynamicConsGroup "Editors"
[ functionConsDyn "Apply" "apply" [ functionConsDyn "Apply" "apply"
......
...@@ -13,7 +13,7 @@ derive class iTask DynamicEditorValue ...@@ -13,7 +13,7 @@ derive class iTask DynamicEditorValue
:: DynamicEditorElement = DynamicCons !DynamicCons | DynamicConsGroup !String ![DynamicCons] :: DynamicEditorElement = DynamicCons !DynamicCons | DynamicConsGroup !String ![DynamicCons]
:: DynamicCons :: DynamicCons
:: DynamicConsOption = HideIfOnlyChoice | UseAsDefault | ApplyCssClasses ![String] :: DynamicConsOption = HideIfOnlyChoice | UseAsDefault | ApplyCssClasses ![String] | AddLabels ![Maybe String]
(<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons (<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons
(@@@>>) infixr 2 :: !DynamicConsOption !DynamicCons -> DynamicCons (@@@>>) infixr 2 :: !DynamicConsOption !DynamicCons -> DynamicCons
......
...@@ -17,6 +17,7 @@ import Data.Functor ...@@ -17,6 +17,7 @@ import Data.Functor
, showIfOnlyChoice :: !Bool , showIfOnlyChoice :: !Bool
, useAsDefault :: !Bool , useAsDefault :: !Bool
, uiAttributes :: !UIAttributes , uiAttributes :: !UIAttributes
, labels :: ![Maybe String]
} }
(<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons (<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons
...@@ -28,8 +29,9 @@ import Data.Functor ...@@ -28,8 +29,9 @@ import Data.Functor
tunedDynamicConsEditor :: !DynamicConsOption !DynamicCons -> DynamicCons tunedDynamicConsEditor :: !DynamicConsOption !DynamicCons -> DynamicCons
tunedDynamicConsEditor HideIfOnlyChoice cons = {cons & showIfOnlyChoice = False} tunedDynamicConsEditor HideIfOnlyChoice cons = {cons & showIfOnlyChoice = False}
tunedDynamicConsEditor UseAsDefault cons = {cons & useAsDefault = True} tunedDynamicConsEditor UseAsDefault cons = {cons & useAsDefault = True}
tunedDynamicConsEditor (ApplyCssClasses classes) cons tunedDynamicConsEditor (ApplyCssClasses classes) cons =
= {cons & uiAttributes = 'Map'.union (classAttr classes) cons.uiAttributes} {cons & uiAttributes = 'Map'.union (classAttr classes) cons.uiAttributes}
tunedDynamicConsEditor (AddLabels labels) cons = {cons & labels = labels}
functionCons :: !String !String !a -> DynamicCons | TC a functionCons :: !String !String !a -> DynamicCons | TC a
functionCons consId label func = functionConsDyn consId label (dynamic func) functionCons consId label func = functionConsDyn consId label (dynamic func)
...@@ -41,6 +43,7 @@ functionConsDyn consId label func = { consId = consId ...@@ -41,6 +43,7 @@ functionConsDyn consId label func = { consId = consId
, showIfOnlyChoice = True , showIfOnlyChoice = True
, useAsDefault = False , useAsDefault = False
, uiAttributes = 'Map'.newMap , uiAttributes = 'Map'.newMap
, labels = []
} }
listCons :: !String !String !([a] -> b) -> DynamicCons | TC a & TC b listCons :: !String !String !([a] -> b) -> DynamicCons | TC a & TC b
...@@ -53,6 +56,7 @@ listConsDyn consId label func = { consId = consId ...@@ -53,6 +56,7 @@ listConsDyn consId label func = { consId = consId
, showIfOnlyChoice = True , showIfOnlyChoice = True
, useAsDefault = False , useAsDefault = False
, uiAttributes = 'Map'.newMap , uiAttributes = 'Map'.newMap
, labels = []
} }
customEditorCons :: !String !String !(Editor a) -> DynamicCons customEditorCons :: !String !String !(Editor a) -> DynamicCons
...@@ -63,6 +67,7 @@ customEditorCons consId label editor = { consId = consId ...@@ -63,6 +67,7 @@ customEditorCons consId label editor = { consId = consId
, showIfOnlyChoice = True , showIfOnlyChoice = True
, useAsDefault = False , useAsDefault = False
, uiAttributes = 'Map'.newMap , uiAttributes = 'Map'.newMap
, labels = []
} }
// TODO: don't use aborts here // TODO: don't use aborts here
...@@ -211,7 +216,7 @@ where ...@@ -211,7 +216,7 @@ where
Enter = case matchingConses of Enter = case matchingConses of
[(onlyChoice, _)] | hideCons [(onlyChoice, _)] | hideCons
# (mbUis, _, type, _, vst) = genChildEditors dp onlyChoice.consId Enter vst # (mbUis, _, type, _, vst) = genChildEditors dp onlyChoice.consId Enter vst
# mbUis = ( \(uis, childSts) -> (uiContainer attr uis, Just (onlyChoice.consId, type, True), [nullState: childSts]) # mbUis = ( \(uis, childSts) -> (uiContainer attr onlyChoice.labels uis, Just (onlyChoice.consId, type, True), [nullState: childSts])
) <$> ) <$>
mbUis mbUis
= (mbUis, vst) = (mbUis, vst)
...@@ -221,10 +226,10 @@ where ...@@ -221,10 +226,10 @@ where
= case mbUis of = case mbUis of
Ok (uis, childSts) Ok (uis, childSts)
| hideCons | hideCons
= (Ok (uiContainer attr uis, Just (defaultChoice.consId, type, True), [nullState: childSts]), vst) = (Ok (uiContainer attr defaultChoice.labels uis, Just (defaultChoice.consId, type, True), [nullState: childSts]), vst)
| otherwise | otherwise
# (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx) # (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx)
= ( Ok ( uiContainer attr [consChooseUI: uis] = ( Ok ( uiContainer attr [Nothing: defaultChoice.labels] [consChooseUI: uis]
, Just (defaultChoice.consId, type, True) , Just (defaultChoice.consId, type, True)
, [chooseSt: childSts] , [chooseSt: childSts]
) )
...@@ -233,28 +238,30 @@ where ...@@ -233,28 +238,30 @@ where
Error e = (Error e, vst) Error e = (Error e, vst)
_ _
# (consChooseUI, chooseSt) = genConsChooseUI taskId dp Nothing # (consChooseUI, chooseSt) = genConsChooseUI taskId dp Nothing
= (Ok (uiContainer attr [consChooseUI], Nothing, [chooseSt]), vst) = (Ok (uiContainer attr [] [consChooseUI], Nothing, [chooseSt]), vst)
Update Undefined = genUI attr dp Enter vst Update Undefined = genUI attr dp Enter vst
Update (DynamicEditorValue cid val) Update (DynamicEditorValue cid val)
# (mbUis, idx, type, label, vst) = genChildEditors dp cid (Update val) vst # (mbUis, idx, type, label, vst) = genChildEditors dp cid (Update val) vst
# (cons, _) = consWithId cid matchingConses
= case mbUis of = case mbUis of
Ok (uis, childSts) Ok (uis, childSts)
| hideCons | hideCons
= (Ok (uiContainer attr uis, Just (cid, type, True), [nullState: childSts]), vst) = (Ok (uiContainer attr cons.labels uis, Just (cid, type, True), [nullState: childSts]), vst)
| otherwise | otherwise
# (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx) # (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx)
= (Ok (uiContainer attr [consChooseUI: uis], Just (cid, type, True), [chooseSt: childSts]), vst) = (Ok (uiContainer attr [Nothing: cons.labels] [consChooseUI: uis], Just (cid, type, True), [chooseSt: childSts]), vst)
Error e = (Error e, vst) Error e = (Error e, vst)
View (DynamicEditorValue cid val) View (DynamicEditorValue cid val)
# (mbUis, _, type, label, vst) = genChildEditors dp cid (View val) vst # (mbUis, _, type, label, vst) = genChildEditors dp cid (View val) vst
# (cons, _) = consWithId cid matchingConses
= case mbUis of = case mbUis of
Ok (uis, childSts) Ok (uis, childSts)
| hideCons | hideCons
= (Ok (uiContainer attr uis, Just (cid, type, True), [nullState: childSts]), vst) = (Ok (uiContainer attr cons.labels uis, Just (cid, type, True), [nullState: childSts]), vst)
| otherwise | otherwise
# consChooseUI = uia UITextView $ valueAttr $ JSONString label # consChooseUI = uia UITextView $ valueAttr $ JSONString label
= (Ok (uiContainer attr [consChooseUI: uis], Just (cid, type, True), [nullState: childSts]), vst) = (Ok (uiContainer attr [Nothing: cons.labels] [consChooseUI: uis], Just (cid, type, True), [nullState: childSts]), vst)
Error e = (Error e, vst) Error e = (Error e, vst)
genConsChooseUI taskId dp mbSelectedCons = (consChooseUI, consChooseSt) genConsChooseUI taskId dp mbSelectedCons = (consChooseUI, consChooseSt)
...@@ -466,8 +473,13 @@ where ...@@ -466,8 +473,13 @@ where
childrenEditorList _ = dynamicEditor (DynamicEditor elements) childrenEditorList _ = dynamicEditor (DynamicEditor elements)
listBuilderEditor _ = abort "dynamic editors: invalid list builder value" listBuilderEditor _ = abort "dynamic editors: invalid list builder value"
uiContainer :: !UIAttributes ![UI] -> UI uiContainer :: !UIAttributes ![Maybe String] ![UI] -> UI
uiContainer attr uis = UI UIContainer attr uis uiContainer attr labels uis =
UI UIRecord attr (withLabels <$> zip2 uis (labels ++ repeat Nothing))
where
withLabels :: !(!UI, !Maybe String) -> UI
withLabels (UI type attrs item, Just label) = UI type ('Map'.union attrs $ labelAttr label) item
withLabels (ui, Nothing) = ui
valueFromState :: !(Maybe (!DynamicConsId, !ConsType, !Bool)) ![EditState] -> *Maybe (DynamicEditorValue a) valueFromState :: !(Maybe (!DynamicConsId, !ConsType, !Bool)) ![EditState] -> *Maybe (DynamicEditorValue a)
valueFromState (Just (cid, CustomEditor, True)) [_: [editorSt]] = valueFromState (Just (cid, CustomEditor, True)) [_: [editorSt]] =
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment