Commit d1454313 authored by Steffen Michels's avatar Steffen Michels

Merge branch 'fixfromDynList' into 'master'

improvements dynamic editor

See merge request !442
parents 888a8e78 cf11b5c0
Pipeline #43982 passed with stage
in 8 minutes and 17 seconds
......@@ -317,7 +317,7 @@ where
= ((\(ui, st) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
CustomEditorCons editor
# editorMode = mapEditMode
(\(DEJSONValue json) -> fromMaybe (abort "Invalid dynamic editor state") $ fromJSON json)
(\(DEJSONValue json) -> fromMaybe (abort "Invalid dynamic editor state\n") $ fromJSON json)
mode
# (mbUi, vst) = editor.Editor.genUI 'Map'.newMap (dp ++ [0]) editorMode vst
= ((\(ui, st) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
......@@ -386,7 +386,7 @@ where
// first argument only used for type
childrenEditorList :: (a -> b) -> Editor (DynamicEditorValue a) | TC a
childrenEditorList _ = dynamicEditor (DynamicEditor elements)
listBuilderEditor _ = abort "dynamic editors: invalid list builder value"
listBuilderEditor _ = abort "dynamic editors: invalid list builder value\n"
uiContainer :: !UIAttributes ![UI] -> UI
uiContainer attr uis =
......@@ -404,7 +404,7 @@ where
// toJSON` is used to solve overloading, JSONEncode{|*|} is attached to CustomEditorCons
(editor, toJSON`) = case builder of
CustomEditorCons editor = (editor, toJSON)
_ = abort "corrupt dynamic editor state"
_ = abort "corrupt dynamic editor state\n"
valueFromState (Just (cid, type, True)) [_: childSts] =
mapMaybe (\childVals -> DynamicEditorValue cid $ DEApplication childVals) $ childValuesFor childSts` []
......@@ -461,7 +461,7 @@ where
valueCorrespondingTo :: !(DynamicEditor a) !(DynamicEditorValue a) -> a | TC a
valueCorrespondingTo dynEditor dynEditorValue = case valueCorrespondingToDyn dynEditor dynEditorValue of
(v :: a^) = v
_ = abort "corrupt dynamic editor value"
_ = abort "corrupt dynamic editor value\n"
stringCorrespondingTo :: !(DynamicEditor a) !(DynamicEditorValue a) -> String
stringCorrespondingTo (DynamicEditor elements) (DynamicEditorValue cid val) =
......@@ -483,13 +483,13 @@ where
[" ", cons.DynamicCons.label]
((\arg -> stringCorrespondingTo` arg []) <$> reverse args)
= listElStrs ++ [" "] ++ accum
_ = abort "corrupt dynamic editor value"
_ = abort "corrupt dynamic editor value\n"
DEJSONValue json = case cons.builder of
CustomEditorCons editor = [ " ", stringCorrespondingToGen editor json
, " ", cons.DynamicCons.label
: accum
]
_ = abort "corrupt dynamic editor value"
_ = abort "corrupt dynamic editor value\n"
where
(cons, _) = consWithId cid $ consesOf elements
......@@ -497,7 +497,7 @@ where
stringCorrespondingToGen editor json = toSingleLineText $ fromJSON` editor json
where
fromJSON` :: (Editor a) !JSONNode -> a | JSONDecode{|*|} a
fromJSON` _ json = fromMaybe (abort "corrupt dynamic editor value") $ fromJSON json
fromJSON` _ json = fromMaybe (abort "corrupt dynamic editor value\n") $ fromJSON json
:: DynamicCons =
{ consId :: !DynamicConsId
......@@ -569,48 +569,63 @@ where
DEApplication args = case cons.builder of
FunctionCons fbuilder = valueCorrespondingToFunc fbuilder args
ListCons lbuilder = valueCorrespondingToList lbuilder args
_ = abort "corrupt dynamic editor value"
_ = abort "corrupt dynamic editor value\n"
DEJSONValue json = case cons.builder of
CustomEditorCons editor = valueCorrespondingToGen editor json
_ = abort "corrupt dynamic editor value"
_ = abort "corrupt dynamic editor value\n"
where
(cons, _) = consWithId cid $ consesOf elements
valueCorrespondingToFunc :: !Dynamic ![(DynamicConsId, DEVal)] -> Dynamic
valueCorrespondingToFunc v [] = v
valueCorrespondingToFunc f [x : xs] = case (f, valueCorrespondingTo` x) of
valueCorrespondingToFunc f [x=:(consId, _) : xs] = case (f, dynValue) of
(f :: a -> b, x :: a) = valueCorrespondingToFunc (dynamic (f x)) xs
_ = abort "corrupt dynamic editor value"
_ =
abort $
concat
[ "Cannot unify demanded type with offered type for constructor '", toString consId, "':\n "
, firstArgString $ typeCodeOfDynamic f, "\n ", toString $ typeCodeOfDynamic dynValue, "\n"
]
where
dynValue = valueCorrespondingTo` x
firstArgString :: !TypeCode -> String
firstArgString (TypeScheme _ tc) = firstArgString tc
firstArgString (TypeApp (TypeApp _ fstArg) _) = toString fstArg
firstArgString _ = "no argument required"
valueCorrespondingToGen :: (Editor a) !JSONNode -> Dynamic | JSONDecode{|*|}, TC a
valueCorrespondingToGen editor json = dynamic (fromJSON` editor json)
where
fromJSON` :: (Editor a) !JSONNode -> a | JSONDecode{|*|} a
fromJSON` _ json = fromMaybe (abort "corrupt dynamic editor value") $ fromJSON json
fromJSON` _ json =
fromMaybe (abort $ corruptValueErrorString ["undecodable JSON ", toString json]) $ fromJSON json
valueCorrespondingToList :: !Dynamic ![(DynamicConsId, DEVal)] -> Dynamic
valueCorrespondingToList funcs args =
case [valueCorrespondingTo` val \\ val <- args] of
[] =
case funcs of
case [mappedArgument $ valueCorrespondingTo` val \\ val <- args] of
[]
-> case funcs of
((_, g) :: (a -> b, [b] -> c)) = dynamic g []
_ = abort "corrupt dynamic editor valueU"
// we have to use the first element to update the type,
// the `b` and `c` type variable is required to be equal for all list elements
args=:[fst: _] =
case (funcs, fst) of
((f, g) :: (a -> b, [b] -> c), _ :: a) = dynamic (g $ fromDynList (dynamic f) args)
_ = abort "corrupt dynamic editor value"
fromDynList :: !Dynamic ![Dynamic] -> [b] | TC b
fromDynList mapFunc dyns = fromDynList` dyns []
_ = abort "corrupt dynamic editor value\n"
// We use the first element to update the type,
// an arbitrary element can be used as the `b` and `c` type variable
// is required to be equal for all list elements.
args=:[fst: _]
-> case (funcs, fst) of
((f, g) :: (x, [b] -> c), _ :: b) -> dynamic (g $ fromJust $ fromDynList args)
_ -> abort "corrupt dynamic editor value\n"
where
fromDynList` [] acc = reverse acc
fromDynList` [dyn : dyns] acc =
case (mapFunc, dyn) of
(mapFunc :: a -> b^, a :: a) = fromDynList` dyns [mapFunc a: acc]
_ = abort "corrupt dynamic editor value"
fromDynList` _ _ = abort "corrupt dynamic editor value"
mappedArgument (val :: a)
= case funcs of
((f, _) :: (a^ -> b, x)) -> dynamic f val
_ -> abort "corrupt dynamic editor value\n"
fromDynList :: ![Dynamic] -> Maybe [b] | TC b
fromDynList dyns = fromDynList` dyns []
where
fromDynList` [] acc = Just $ reverse acc
fromDynList` [(val :: b^): dyns] acc = fromDynList` dyns [val: acc]
:: E = E.a: E (Editor (DynamicEditorValue a)) & TC a
:: ConsType = Function | List | CustomEditor
......@@ -630,6 +645,9 @@ where
consesOf (DynamicCons cons) = [(cons, Nothing)]
consesOf (DynamicConsGroup label conses) = (\cons -> (cons, Just label)) <$> conses
corruptValueErrorString :: ![String] -> String
corruptValueErrorString errorStrs = concat $ flatten [["Corrupt dynamic editor value: "], errorStrs, [".\n"]]
derive class iTask DynamicEditorValue, DEVal
derive JSONEncode ConsType
derive JSONDecode ConsType
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