Verified Commit 12da2412 authored by Camil Staps's avatar Camil Staps 🙂

Fix server roundtrip; wasm-in-wasm; and Pikaday extension

parent b7fe60a9
Pipeline #20891 failed with stage
in 1 minute and 14 seconds
......@@ -5,6 +5,7 @@
*.prp
*.exe
*.bc
*.pbc
.sass-cache
BasicAPIExamples.icl
.ctest-results.json
......@@ -14,11 +14,17 @@ import iTasks.WF.Tasks.Interaction
Start w = doTasks task w
import iTasks.Extensions.DateTime
import iTasks.Internal.SDS
import iTasks.SDS.Sources.System
import iTasks.WF.Combinators.Common
import iTasks.WF.Combinators.SDS
task :: Task Date
task = enterInformation "date" []
task = withShared {Date|year=2019,mon=4,day=9} \sds ->
viewSharedInformation "view" [] sds -||-
updateSharedInformation "update 1" [] sds -||-
updateSharedInformation "update 2" [] sds
task = updateInformation "test"
[ UpdateUsing (\m -> m) (\_ v -> v) $ leafEditorToEditor
......@@ -43,14 +49,14 @@ where
# w = (comp .# "afterInitDOM" .= jsAfterInitDOM) w
= w
where
initDOMEl :: !(JSObj ()) !*JSWorld -> *JSWorld
initDOMEl comp w
initDOMEl :: !(JSObj ()) !{!JSVal a} !*JSWorld -> *JSWorld
initDOMEl comp _ w
# w = (comp .# "domEl.value" .= toJS (MyReverse 1000)) w
# w = (comp .# "afterInitDOM" .$! ()) w
= w
afterInitDOM :: !*JSWorld -> *JSWorld
afterInitDOM w
afterInitDOM :: !{!JSVal a} !*JSWorld -> *JSWorld
afterInitDOM _ w
# w = (jsGlobal "console.log" .$! "element initialized") w
= w
......
implementation module iTasks.Extensions.Form.Pikaday
import StdEnv
import iTasks, Data.Func
import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.JS.Interface
import iTasks.UI.Editor.Modifiers, iTasks.UI.Editor.Controls
......@@ -28,16 +30,19 @@ where
# world = (me .# "beforeRemove" .= cb) world
= world
beforeRemove me = snd o (me .# "picker" .# "destroy" .$ ())
beforeRemove me args = snd o (me .# "picker" .# "destroy" .$ ())
initDOMEl me world
//Load javascript library first, then start
initDOMEl me args world
# (cb,world) = jsWrapFun (initDOMEl` me) world
# world = addJSFromUrl MOMENT_JS_URL Nothing world
# world = addJSFromUrl MOMENT_JS_URL (Just cb) world
= world
initDOMEl` me args world
# (cb,world) = jsWrapFun (initDOMEl`` me) world
# world = addJSFromUrl PIKADAY_JS_URL (Just cb) world
= world
initDOMEl` me world
initDOMEl`` me args world
//Create pikaday object
# (value,world) = me .# "attributes.value" .? world
# (domEl,world) = me .# "domEl" .? world
......@@ -54,38 +59,39 @@ where
# (picker,world) = jsNew "Pikaday" cfg world
# world = (me .# "picker" .= picker) world
//Handle attribute changes
# (cb,world) = jsWrapFun (\n v w -> onAttributeChange picker me n v w) world
# (cb,world) = jsWrapFun (onAttributeChange picker me) world
# world = (me .# "onAttributeChange" .= cb) world
//React to selects
= world
onAttributeChange :: !(JSObj ()) !(JSObj ()) !String !String !*JSWorld -> *JSWorld
onAttributeChange picker me name value world
# world = (me.# "noEvents" .= True ) world
# (_,world) = (picker .# "setDate" .$ value) world
# world = (me.# "noEvents" .= False) world
onAttributeChange picker me {[0]=name,[1]=value} world
| jsValToString name <> Just "value"
= world
# world = (me.# "noEvents" .= True ) world
# world = (picker .# "setDate" .$! value) world
# world = (me.# "noEvents" .= False) world
= world
onSelect me world
onSelect me args world
# (noEvents,world) = me .# "noEvents" .? world
| (not (jsIsUndefined noEvents)) // TODO && jsValToBool noEvents
| not (jsIsUndefined noEvents) && jsValToBool noEvents == Just True
= world
# (picker,world) = me .# "picker" .? world
# (value,world) = (picker .# "toString" .$ "YYYY-MM-DD" ) world
# (taskId,world) = me .# "attributes.taskId" .? world
# (value,world) = (me .# "picker.toString" .$ "YYYY-MM-DD") world
# value = jsValToString value
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
# (_,world) = (me .# "doEditEvent" .$ (taskId,editorId,Just value)) world
# (_,world) = (me .# "doEditEvent" .$ (taskId, editorId, toString (toJSON value))) world
= world
onKeyup me world
onKeyup me args world
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
# (value,world) = me .# "domEl.value" .? world
//# value = if (jsValToString value == "") Nothing (Just value) // TODO
# (_,world) = (me .# "doEditEvent" .$ (taskId, editorId,value)) world
# value = jsValToString value
# world = (me .# "doEditEvent" .$! (taskId, editorId, toString (toJSON value))) world
= world
onEdit dp (tp,e) _ vst = (Ok (NoChange, e),vst)
onEdit dp (tp,e) _ vst = (Ok (ChangeUI [SetAttribute "value" (JSONString (fromMaybe "" e))] [], e),vst)
onRefresh dp new st vst=:{VSt| optional}
| st === Just new = (Ok (NoChange, st), vst)
......
......@@ -54,12 +54,12 @@ from Control.GenBimap import generic bimap, :: Bimap
, valueFromState :: !st -> Maybe a
}
leafEditorToEditor :: !(LeafEditor edit st a) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} st
leafEditorToEditor :: !(LeafEditor edit st a) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} st & JSONDecode{|*|} edit
//Version without overloading, for use in generic case
//The first two argument should be JSONEncode{|*|} and JSONDecode{|*|} which cannot be used by overloading within generic functions
leafEditorToEditor_ :: !(Bool st -> [JSONNode]) !(Bool [JSONNode] -> (!Maybe st, ![JSONNode])) !(LeafEditor edit st a)
-> Editor a
-> Editor a | JSONDecode{|*|} edit
/*
* Definition of a compound editor using an additional typed state, next to the children's states.
......
......@@ -13,20 +13,20 @@ derive JSONEncode EditState, LeafState, EditMode
derive JSONDecode EditState, LeafState, EditMode
derive gEq EditState, LeafState
leafEditorToEditor :: !(LeafEditor edit st a) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} st
leafEditorToEditor :: !(LeafEditor edit st a) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} st & JSONDecode{|*|} edit
leafEditorToEditor leafEditor = leafEditorToEditor_ JSONEncode{|*|} JSONDecode{|*|} leafEditor
leafEditorToEditor_ :: !(Bool st -> [JSONNode]) !(Bool [JSONNode] -> (!Maybe st, ![JSONNode])) !(LeafEditor edit st a)
-> Editor a
-> Editor a | JSONDecode{|*|} edit
leafEditorToEditor_ jsonEncode jsonDecode leafEditor =
{Editor| genUI = genUI, onEdit = onEdit, onRefresh = onRefresh, valueFromState = valueFromState}
where
genUI attr dp val vst = mapRes False $ leafEditor.LeafEditor.genUI attr dp val vst
onEdit dp (tp, jsone) (LeafState {state}) vst = case fromJSON` state of
Just st = undef /*case decodeOnServer jsone of // FIXME: decodeOnServer
Just st = case fromJSON jsone of
Just e = mapRes True $ leafEditor.LeafEditor.onEdit dp (tp, e) st vst
_ = (Error ("Invalid edit event for leaf editor: " +++ toString jsone), vst) */
_ = (Error ("Invalid edit event for leaf editor: " +++ toString jsone), vst)
_ = (Error "Corrupt internal state in leaf editor", vst)
onEdit _ _ _ vst = (Error "Corrupt editor state in leaf editor", vst)
......@@ -152,7 +152,7 @@ withClientSideInit ::
!(UIAttributes DataPath a *VSt -> *(!MaybeErrorString (!UI, !st), !*VSt))
!UIAttributes !DataPath !a !*VSt -> *(!MaybeErrorString (!UI, !st), !*VSt)
withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case genUI attr dp val vst of
(Ok (UI type attr items,mask),vst=:{VSt|iworld}) -> case serialize_for_client initUI` iworld of
(Ok (UI type attr items,mask),vst=:{VSt|iworld}) -> case serialize_for_client (wrapInitUIFunction initUI) iworld of
(Ok initUI,iworld)
# extraAttr = 'DM'.fromList
[("taskId", JSONString taskId)
......@@ -163,6 +163,3 @@ withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case genUI attr
(Error e,iworld)
-> (Error e, {VSt|vst & iworld = iworld})
e -> e
where
initUI` :: !Int !*JSWorld -> *JSWorld
initUI` ref_to_js_elem world = initUI (referenceToJS ref_to_js_elem) world
......@@ -16,6 +16,10 @@ instance toJS Int, Bool, String, (JSVal b), (Maybe b) | toJS b
jsIsUndefined :: !(JSVal a) -> Bool
jsValToInt :: !(JSVal a) -> Maybe Int
jsValToBool :: !(JSVal a) -> Maybe Bool
jsValToString :: !(JSVal a) -> Maybe String
/**
* Access properties of a JavaScript value.
*/
......@@ -49,16 +53,9 @@ jsThis :== jsGlobal "this"
jsWindow :== jsGlobal "window"
jsDocument :== jsGlobal "document"
/**
* Should not be used outside this library. The argument is a reference to a
* DOM element stored somewhere in JavaScript.
*/
referenceToJS :: !Int -> JSVal a
jsWrapFun :: !({!JSVal a} *JSWorld -> *JSWorld) !*JSWorld -> *(!JSFun f, !*JSWorld)
/**
* @param A function of the type (a b .. z *JSWorld -> *JSWorld)
*/
jsWrapFun :: !f !*JSWorld -> *(!JSFun f, !*JSWorld)
wrapInitUIFunction :: !((JSObj ()) *JSWorld -> *JSWorld) -> {!JSVal a} -> *JSWorld -> *JSWorld
/**
* Load external CSS stylesheet by its URL.
......
......@@ -40,6 +40,31 @@ where
jsIsUndefined :: !(JSVal a) -> Bool
jsIsUndefined v = v=:JSUndefined
jsValToInt :: !(JSVal a) -> Maybe Int
jsValToInt v = case v of
JSInt i -> Just i
JSString s -> case toInt s of
0 -> if (s=="0") (Just 0) Nothing
i -> Just i
_ -> Nothing
jsValToBool :: !(JSVal a) -> Maybe Bool
jsValToBool v = case v of
JSBool b -> Just b
JSInt i -> Just (i<>0)
JSString s -> case s of
"true" -> Just True
"false" -> Just False
_ -> Nothing
_ -> Nothing
jsValToString :: !(JSVal a) -> Maybe String
jsValToString v = case v of
JSString s -> Just s
JSInt i -> Just (toString i)
JSBool b -> Just (if b "true" "false")
_ -> Nothing
instance toJS Int where toJS i = JSInt i
instance toJS Bool where toJS b = JSBool b
instance toJS String where toJS s = JSString s
......@@ -109,8 +134,20 @@ jsEmptyObject w = (eval_js_with_return_value "{}", w)
jsGlobal :: !String -> JSVal a
jsGlobal s = JSVar s
jsWrapFun :: !f !*JSWorld -> *(!JSFun f, !*JSWorld)
jsWrapFun f world = (cast (share f), world)
jsWrapFun :: !({!JSVal a} *JSWorld -> *JSWorld) !*JSWorld -> *(!JSFun f, !*JSWorld)
jsWrapFun f world = (cast (share casting_f), world)
where
casting_f :: !{!a} !*JSWorld -> *JSWorld
casting_f args w = f {cast_value_from_js a \\ a <-: args} w
wrapInitUIFunction :: !((JSObj ()) *JSWorld -> *JSWorld) -> {!JSVal a} -> *JSWorld -> *JSWorld
wrapInitUIFunction f = \args
| size args<>1
-> abort ("failed to get iTasks component from JavaScript (args.size="+++toString (size args)+++")\n")
-> case cast_value_from_js args.[0] of
r=:(JSRef _)
-> f r
-> abort "failed to get iTasks component from JavaScript\n"
referenceToJS :: !Int -> JSVal a
referenceToJS ref = JSRef ref
......@@ -149,15 +186,26 @@ eval_js s = code {
}
eval_js_with_return_value :: !String -> JSVal a
eval_js_with_return_value s = code {
instruction 2
eval_js_with_return_value s = cast_value_from_js (eval s)
where
eval :: !String -> a
eval _ = code {
instruction 2
}
cast_value_from_js :: !a -> JSVal b
cast_value_from_js _ = code {
eq_desc dINT 0 0
jmp_true return_int
eq_desc BOOL 0 0
jmp_true return_bool
eq_desc _STRING_ 0 0
jmp_true return_string
pushD_a 0
pushI 5290 | 661*8+2; DOMNode (bcprelink.c)
eqI
jmp_true return_ref
print "eval_js_with_return_value: return type unknown:\n"
print "cast_value_from_js: return type unknown:\n"
print_symbol_sc 0
print "\n"
halt
......@@ -172,16 +220,29 @@ eval_js_with_return_value s = code {
eqI
jmp_true return_undefined
fill_r e_iTasks.UI.JS.Interface_kJSInt 0 1 0 0 0
pop_b 1
jmp return
:return_null
fillh e_iTasks.UI.JS.Interface_dJSNull 0 0
pop_b 1
jmp return
:return_undefined
fillh e_iTasks.UI.JS.Interface_dJSUndefined 0 0
pop_b 1
jmp return
:return_bool
repl_r_args 0 1
fill_r e_iTasks.UI.JS.Interface_kJSBool 0 1 0 0 0
pop_b 1
jmp return
:return_string
fill_r e_iTasks.UI.JS.Interface_kJSString 1 0 1 0 0
pop_a 1
jmp return
:return_ref
repl_r_args 0 1
fill_r e_iTasks.UI.JS.Interface_kJSRef 0 1 0 0 0
pop_b 1
jmp return
:return
}
......
"use strict";
var MAX_INSTRUCTIONS=-1;
const JSWorld={
abc_type: 'JSWorld'
};
......@@ -76,21 +78,21 @@ const abc_interpreter={
apply_to_clean_value: function (index) {
return function () {
var args=[SharedCleanValue(index)];
var args=[];
for (var i=0; i<arguments.length; i++)
args[i+1]=arguments[i];
args.push(JSWorld);
return abc_interpreter.interpret.apply(null, args);
args[i]=arguments[i];
abc_interpreter.interpret(SharedCleanValue(index), args);
};
},
copy_js_to_clean: function (values, asp, hp, hp_free) {
for (var i=values.length-1; i>=0; i--) {
for (var i=0; i<values.length; i++) {
asp+=8;
console.log('copy',values[i]);
//console.log('copy',values[i]);
if (values[i]===null) {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=26*8+2; // INT
abc_interpreter.memory_array[hp/4+1]=0;
abc_interpreter.memory_array[hp/4+2]=0;
abc_interpreter.memory_array[hp/4+3]=1<<30;
hp+=16;
......@@ -98,8 +100,9 @@ const abc_interpreter={
} else if (typeof values[i]=='undefined') {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=26*8+2; // INT
abc_interpreter.memory_array[hp/4+2]=0;
abc_interpreter.memory_array[hp/4+3]=(1<<30)+1;
abc_interpreter.memory_array[hp/4+1]=0;
abc_interpreter.memory_array[hp/4+2]=1;
abc_interpreter.memory_array[hp/4+3]=1<<30;
hp+=16;
hp_free-=2;
} else if (typeof values[i]=='number') {
......@@ -108,12 +111,53 @@ const abc_interpreter={
if (Number.isInteger(values[i])) {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=26*8+2; // INT
abc_interpreter.memory_array[hp/4+1]=0;
abc_interpreter.memory_array[hp/4+2]=values[i]; // TODO also support >32-bit
abc_interpreter.memory_array[hp/4+3]=0;
hp+=16;
hp_free-=2;
} else {
throw 'Cannot pass non-integral numbers to Clean yet'; // TODO
}
} else if (typeof values[i]=='boolean') {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=11*8+2; // BOOL
abc_interpreter.memory_array[hp/4+1]=0;
abc_interpreter.memory_array[hp/4+2]=values[i] ? 1 : 0;
abc_interpreter.memory_array[hp/4+3]=0;
hp+=16;
hp_free-=2;
} else if (typeof values[i]=='string') {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=6*8+2; // _STRING_
abc_interpreter.memory_array[hp/4+1]=0;
abc_interpreter.memory_array[hp/4+2]=values[i].length;
abc_interpreter.memory_array[hp/4+3]=0;
var array=new Int8Array(((values[i].length+3)>>2)<<2);
for (var j in values[i])
array[j]=values[i].charCodeAt(j);
array=new Uint32Array(array.buffer);
for (var j=0; j<((values[i].length+3)>>2); j++)
abc_interpreter.memory_array[hp/4+4+j]=array[j];
hp+=16+(((values[i].length+7)>>3)<<3);
hp_free-=2+((values[i].length+7)>>3);
} else if (Array.isArray(values[i])) {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=2; // fake ARRAY, needed because we use jmp_ap
abc_interpreter.memory_array[hp/4+1]=0;
abc_interpreter.memory_array[hp/4+2]=hp+16;
abc_interpreter.memory_array[hp/4+3]=0;
abc_interpreter.memory_array[hp/4+4]=1*8+2; // _ARRAY_
abc_interpreter.memory_array[hp/4+5]=0;
abc_interpreter.memory_array[hp/4+6]=values[i].length;
abc_interpreter.memory_array[hp/4+7]=0;
abc_interpreter.memory_array[hp/4+8]=0;
abc_interpreter.memory_array[hp/4+9]=0;
hp+=40;
hp_free-=5;
var copied=abc_interpreter.copy_js_to_clean(values[i], hp-8, hp+8*values[i].length, hp_free);
hp=copied.hp;
hp_free=copied.hp_free-values[i].length;
} else if ('abc_type' in values[i]) {
switch (values[i].abc_type) {
case 'SharedCleanValue':
......@@ -129,7 +173,9 @@ const abc_interpreter={
// TODO: check if garbage collection is needed
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=661*8+2; // DOMNode type
abc_interpreter.memory_array[hp/4+1]=0;
abc_interpreter.memory_array[hp/4+2]=abc_interpreter.shared_js_values.length;
abc_interpreter.memory_array[hp/4+3]=0;
abc_interpreter.shared_js_values.push(values[i]);
hp+=16;
hp_free-=2;
......@@ -219,6 +265,8 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
memory: abc_interpreter.memory,
debug_instr: function (addr, instr) {
if (MAX_INSTRUCTIONS-- == 0)
throw 'MAX_INSTRUCTIONS ran out';
console.log(addr,(addr/8-abc_interpreter.code_offset)+'\t'+abc_instructions[instr]);
},
handle_illegal_instr: function (pc, instr, asp, bsp, csp, hp, hp_free) {
......@@ -358,12 +406,13 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
abc_interpreter.interpreter.instance.exports.set_hp_free(abc_interpreter.hp_size/8);
abc_interpreter.interpreter.instance.exports.set_hp_size(abc_interpreter.hp_size);
abc_interpreter.interpret=function(){
abc_interpreter.interpret=function (f, args) {
var asp=abc_interpreter.interpreter.instance.exports.get_asp();
const old_asp=asp;
var hp=abc_interpreter.interpreter.instance.exports.get_hp();
var hp_free=abc_interpreter.interpreter.instance.exports.get_hp_free();
var copied=abc_interpreter.copy_js_to_clean(arguments, asp, hp, hp_free);
const copied=abc_interpreter.copy_js_to_clean([JSWorld, args, f], asp, hp, hp_free);
asp=copied.asp;
hp=copied.hp;
hp_free=copied.hp_free;
......@@ -372,18 +421,16 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
abc_interpreter.memory_array[csp/4]=659*8; // instruction 0; to return
csp+=8;
var start=(97+arguments.length)*8; // jmp_apn as appropriate; TODO: fix for case where arguments.length=1
// TODO: it would be useful to have a check here whether the jmp_ap will be saturated.
// If not, that may indicate a bug in the Clean code, but the type system cannot not catch that.
// See for instance the removal of the 'a' argument in the initDOMEl of Pikaday.
abc_interpreter.interpreter.instance.exports.set_pc(start);
const old_pc=abc_interpreter.interpreter.instance.exports.get_pc();
abc_interpreter.interpreter.instance.exports.set_pc(100*8); // jmp_ap2
abc_interpreter.interpreter.instance.exports.set_asp(asp);
abc_interpreter.interpreter.instance.exports.set_csp(csp);
abc_interpreter.interpreter.instance.exports.set_hp(hp);
abc_interpreter.interpreter.instance.exports.set_hp_free(hp_free);
abc_interpreter.interpreter.instance.exports.interpret();
abc_interpreter.interpreter.instance.exports.set_pc(old_pc);
abc_interpreter.interpreter.instance.exports.set_asp(old_asp);
};
});
......@@ -43,7 +43,7 @@ itasks.Component = {
var me=this;
if (me.attributes.initUI!=null && me.attributes.initUI!='') {
var initUI=abc_interpreter.deserialize(me.attributes.initUI);
abc_interpreter.interpret(initUI, me, JSWorld);
abc_interpreter.interpret(initUI, [me]);
}
},
initComponent: function() {}, //Abstract method: every component implements this differently
......@@ -521,6 +521,7 @@ itasks.Viewport = {
},
doEditEvent: function (taskId, editorId, value) {
var me = this, taskNo = taskId.split("-")[1];
value = JSON.parse(value);
if(editorId) {
me.connection.sendEditEvent(me.attributes.instanceNo, taskNo, editorId, value);
} else {
......
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