Verified Commit 72960811 authored by Camil Staps's avatar Camil Staps 🚀

Use a Dynamic state (instead of JSON) in the dynamic editor

parent e614b6ea
Pipeline #45786 passed with stage
in 10 minutes and 39 seconds
......@@ -51,8 +51,9 @@ derive class iTask DynamicEditorValue
/**
* The value of a dynamic editor constructor.
*/
:: DEVal = DEApplication ![(DynamicConsId, DEVal)] //* A dynamic constructor applied to a number of arguments.
| DEJSONValue !JSONNode //* An ordinary, JSON-encoded value.
:: DEVal
= DEApplication ![(DynamicConsId, DEVal)] //* A dynamic constructor applied to a number of arguments.
| DEDynamicValue !Dynamic //* An ordinary value.
/**
* `DynamicEditor a` provides a dynamic editor definition for editing values of type `a`.
......@@ -126,7 +127,7 @@ listConsDyn :: !DynamicConsId !String !Dynamic -> DynamicCons
* `dynamicCons` is the dynamic constructor with identity `id` and `label` corresponding to the iTasks `editor`.
*/
customEditorCons ::
!DynamicConsId !String !(Editor a (?a)) -> DynamicCons | TC, JSONEncode{|*|}, JSONDecode{|*|}, gText{|*|} a
!DynamicConsId !String !(Editor a (?a)) -> DynamicCons | TC, gText{|*|} a
instance tune DynamicConsOption DynamicCons
......
......@@ -178,7 +178,7 @@ where
= ((\(ui, st, mbw) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
CustomEditorCons editor
# editorVal =
(\(DEJSONValue json) -> fromMaybe (abort "Invalid dynamic editor state\n") $ fromJSON json) <$> mbval
(\(DEDynamicValue dyn) -> fromMaybe (abort "Invalid dynamic editor state\n") $ fromDynamic dyn) <$> mbval
# (mbUi, vst) = editor.Editor.onReset 'Map'.newMap (dp ++ [0]) editorVal vst
= ((\(ui, st, mbw) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
where
......@@ -188,6 +188,10 @@ where
ListCons _ = List
CustomEditorCons _ = CustomEditor
fromDynamic :: Dynamic -> ?a | TC a
fromDynamic (v :: a^) = ?Just v
fromDynamic _ = ?None
onEdit ::
!DataPath
!(!DataPath, !JSONNode)
......@@ -404,14 +408,14 @@ where
writeValue :: !(?(!DynamicConsId, !ConsType, !Bool)) ![EditState] -> *MaybeErrorString (?(DynamicEditorValue a))
writeValue (?Just (cid, CustomEditor, True)) [_: [editorSt]] = case editor.Editor.writeValue editorSt of
Ok mbvalue = Ok $ (DynamicEditorValue cid o DEJSONValue o toJSON`) <$> mbvalue
Ok mbvalue = Ok $ (DynamicEditorValue cid o DEDynamicValue o toDynamic) <$> mbvalue
Error e = Error e
where
({builder}, _) = consWithId cid conses
// toJSON` is used to solve overloading, JSONEncode{|*|} is attached to CustomEditorCons
(editor, toJSON`) = case builder of
CustomEditorCons editor = (editor, toJSON)
// toDynamic is used to solve overloading, TC is attached to CustomEditorCons
(editor, toDynamic) = case builder of
CustomEditorCons editor = (editor, \x -> dynamic x)
_ = abort "corrupt dynamic editor state\n"
writeValue (?Just (cid, type, True)) [_: childSts] = case childValuesFor childSts` [] of
......@@ -496,8 +500,8 @@ where
((\arg -> stringCorrespondingTo` arg []) <$> reverse args)
= listElStrs ++ [" "] ++ accum
_ = abort "corrupt dynamic editor value\n"
DEJSONValue json = case cons.builder of
CustomEditorCons editor = [ " ", stringCorrespondingToGen editor json
DEDynamicValue dyn = case cons.builder of
CustomEditorCons editor = [ " ", stringCorrespondingToGen editor dyn
, " ", cons.DynamicCons.label
: accum
]
......@@ -505,12 +509,18 @@ where
where
(cons, _) = consWithId cid $ consesOf elements
stringCorrespondingToGen :: (Editor a (?a)) !JSONNode -> String | gText{|*|}, JSONDecode{|*|} a
stringCorrespondingToGen editor json = toSingleLineText $ fromJSON` editor json
stringCorrespondingToGen :: (Editor a (?a)) !Dynamic -> String | gText{|*|}, TC a
stringCorrespondingToGen editor (v :: a^) = toSingleLineText v
stringCorrespondingToGen editor dyn = abort $ concat
[ "corrupt dynamic editor value: expected type "
, toString (typeCodeOfDynamic (dynamic (undefWithEditorType editor)))
, "; got "
, toString (typeCodeOfDynamic dyn)
, "\n"
]
where
fromJSON` :: (Editor a (?a)) !JSONNode -> a | JSONDecode{|*|} a
fromJSON` _ json =
fromMaybe (abort $ concat ["corrupt dynamic editor value ", toString json, "\n"]) $ fromJSON json
undefWithEditorType :: (Editor a (?a)) -> a
undefWithEditorType _ = undef
htmlCorrespondingTo :: !(DynamicEditor a) !(DynamicEditorValue a) -> HtmlTag
htmlCorrespondingTo (DynamicEditor elements) (DynamicEditorValue cid val) =
......@@ -532,13 +542,13 @@ where
]
_ ->
abort "corrupt dynamic editor value\n"
DEJSONValue json -> case builder of
DEDynamicValue dyn -> case builder of
CustomEditorCons editor ->
DivTag [classAttr]
[ SpanTag [] [Text $
if (size label == 0)
(stringCorrespondingToGen editor json)
(concat3 label ": " (stringCorrespondingToGen editor json))]
(stringCorrespondingToGen editor dyn)
(concat3 label ": " (stringCorrespondingToGen editor dyn))]
]
_ ->
abort "corrupt dynamic editor value\n"
......@@ -561,7 +571,7 @@ where
:: DynamicConsBuilder
= FunctionCons !Dynamic
| E.a: CustomEditorCons !(Editor a (?a)) & JSONEncode{|*|}, JSONDecode{|*|}, gText{|*|}, TC a
| E.a: CustomEditorCons !(Editor a (?a)) & gText{|*|}, TC a
| ListCons !Dynamic //* must contain a value of type (a -> b, [b] -> c)
functionCons :: !DynamicConsId !String !a -> DynamicCons | TC a
......@@ -593,7 +603,7 @@ listConsDyn consId label func =
}
customEditorCons ::
!DynamicConsId !String !(Editor a (?a)) -> DynamicCons | TC, JSONEncode{|*|}, JSONDecode{|*|}, gText{|*|} a
!DynamicConsId !String !(Editor a (?a)) -> DynamicCons | TC, gText{|*|} a
customEditorCons consId label editor =
{ consId = consId
, label = label
......@@ -620,8 +630,8 @@ where
FunctionCons fbuilder = valueCorrespondingToFunc fbuilder args
ListCons lbuilder = valueCorrespondingToList lbuilder args
_ = abort "corrupt dynamic editor value\n"
DEJSONValue json = case cons.builder of
CustomEditorCons editor = valueCorrespondingToGen editor json
DEDynamicValue dyn = case cons.builder of
CustomEditorCons editor = dyn
_ = abort "corrupt dynamic editor value\n"
where
(cons, _) = consWithId cid $ consesOf elements
......@@ -644,13 +654,6 @@ where
firstArgString (TypeApp (TypeApp _ fstArg) _) = toString fstArg
firstArgString _ = "no argument required"
valueCorrespondingToGen :: (Editor a (?a)) !JSONNode -> Dynamic | JSONDecode{|*|}, TC a
valueCorrespondingToGen editor json = dynamic (fromJSON` editor json)
where
fromJSON` :: (Editor a (?a)) !JSONNode -> a | JSONDecode{|*|} a
fromJSON` _ json =
fromMaybe (abort $ corruptValueErrorString ["undecodable JSON ", toString json, "\n"]) $ fromJSON json
valueCorrespondingToList :: !Dynamic ![(DynamicConsId, DEVal)] -> Dynamic
valueCorrespondingToList funcs args =
case [mappedArgument $ valueCorrespondingTo` val \\ val <- args] of
......
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