diff --git a/Libraries/iTasks/Extensions/Editors/DynamicEditor.icl b/Libraries/iTasks/Extensions/Editors/DynamicEditor.icl index 0c3cbf9fe5a709a142a5bdfe780b05398005d5b0..ffd7072f566528d901f04eaa1b9d31b3d4e28068 100644 --- a/Libraries/iTasks/Extensions/Editors/DynamicEditor.icl +++ b/Libraries/iTasks/Extensions/Editors/DynamicEditor.icl @@ -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