Merge branch 'master' into typed-task-editor

Libraries/iTasks/Engine.icl

@@ -111,7 +111,7 @@ where
 			("Specify the HTTP port (default: " +++ toString defaults.serverPort +++ ")")
 		, Option [] ["timeout"] (OptArg (\mp->fmap \o->{o & timeout=fmap toInt mp}) "MILLISECONDS")
 			"Specify the timeout in ms (default: 500)\nIf not given, use an indefinite timeout."
-		, Option [] ["allowed-hosts"] (ReqArg (\p->fmap \o->{o & allowedHosts = split "," p}) "IPADRESSES")
+		, Option [] ["allowed-hosts"] (ReqArg (\p->fmap \o->{o & allowedHosts = if (p == "") [] (split "," p)}) "IPADRESSES")
 			("Specify a comma separated white list of hosts that are allowed to connected to this application\ndefault: "
 			 +++ join "," defaults.allowedHosts)
 		, Option [] ["keepalive"] (ReqArg (\p->fmap \o->{o & keepaliveTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
@@ -273,10 +273,13 @@ where
 	where
 		getTimeoutFromClock` :: (!SDSNotifyRequest, !Timespec) -> Maybe Timeout
 		getTimeoutFromClock` (snr=:{cmpParam=(ts :: ClockParameter Timespec)}, reqTimespec)
-			| startsWith "$IWorld:timespec$" snr.reqSDSId && ts.interval <> zero
+			| dependsOnClock snr && ts.interval <> zero
 				# fire = iworldTimespecNextFire now reqTimespec ts
 				= Just (max 0 (toMs fire - toMs now))
 			= mt
 		getTimeoutFromClock` _ = mt
 
+	dependsOnClock :: !SDSNotifyRequest -> Bool
+	dependsOnClock snr = indexOf "$IWorld:timespec$" snr.reqSDSId >= 0
+
 	toMs x = x.tv_sec * 1000 + x.tv_nsec / 1000000

Libraries/iTasks/Extensions/Email.dcl

@@ -2,6 +2,7 @@ definition module iTasks.Extensions.Email
 /**
 * This module provides basic SMTP email support
 */
+from Text.HTML import :: HtmlTag
 import iTasks
 
 /**
@@ -9,11 +10,22 @@ import iTasks
 *
 * @param Options: Mail server options, when left blank port 25 on localhost is used SMTP server
 * @param Sender: The sender address
-* @param Recipient: The recipient address
+* @param Recipients: The recipient addresses
 * @param Subject: The subject line of the e-mail message
 * @param Body: The body of the e-mail message
 */
-sendEmail :: ![EmailOpt] !String !String !String !String -> Task ()
+sendEmail :: ![EmailOpt] !String ![String] !String !String -> Task ()
+
+/**
+* Send an e-mail message with HTML body.
+*
+* @param Options: Mail server options, when left blank port 25 on localhost is used SMTP server
+* @param Sender: The sender address
+* @param Recipients: The recipient addresses
+* @param Subject: The subject line of the e-mail message
+* @param Body: The HTML body of the e-mail message
+*/
+sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag -> Task ()
 
 //Options for sendEmail
 :: EmailOpt

Libraries/iTasks/Extensions/Email.icl

 implementation module iTasks.Extensions.Email
+
 import iTasks
-import Text
+import Data.Functor
+import Text, Text.HTML
 
-sendEmail :: ![EmailOpt] !String !String !String !String -> Task ()
-sendEmail opts subject body sender recipient
-	= tcpconnect server port (constShare ()) {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
+sendEmail :: ![EmailOpt] !String ![String] !String !String -> Task ()
+sendEmail opts sender recipients subject body
+	= tcpconnect server port (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onDisconnect=onDisconnect,onShareChange = \l _ = (Ok l, Nothing, [], False), onDestroy= \s->(Ok s, [])}
 	@! ()
 where
 	server 	= getServerOpt opts
@@ -14,37 +16,43 @@ where
 	//but we send it in parts. After each part we get a response with a status code.
 	//After each message we check if it is a status code we expect.
 	messages =
-		[("",220) //Initially we don't send anything, but wait for the welcome message from the server
-		,(smtpHelo, 250)
-		,(smtpFrom sender, 250)
-		,(smtpTo recipient, 250)
-		,(smtpData, 354)
-		,(smtpBody sender recipient headers subject body, 250)
-		,(smtpQuit, 221)
-		]
+			[("",220) //Initially we don't send anything, but wait for the welcome message from the server
+			,(smtpHelo, 250)
+			,(smtpFrom sender, 250)
+			]
+		++
+			((\recipient -> (smtpTo recipient, 250)) <$> recipients)
+		++
+			[(smtpData, 354)
+			,(smtpBody sender recipients headers subject body, 250)
+			,(smtpQuit, 221)
+			]
 
 	//Send the first message
-    onConnect _ _
+	onConnect :: !ConnectionId !String !() -> (!MaybeErrorString [(!String, !Int)], !Maybe (), ![String], !Bool)
+    onConnect _ _ _
         = (Ok messages,Nothing,[],False)
 	//Response to last message: if ok, close connection
-    whileConnected (Just data) [(_,expectedCode)] _
+	onData :: !String ![(!String, !Int)] !() -> (!MaybeErrorString [(!String, !Int)], !Maybe (), ![String], !Bool)
+    onData data [(_,expectedCode)] _
 		| statusCode data == expectedCode
 			= (Ok [],Nothing,[],True)
         	= (Error data,Nothing,[],False)
 	//Response to other messages: if ok, send next message
-    whileConnected (Just data) [(_,expectedCode):ms] _ 
+    onData data [(_,expectedCode):ms] _
 		| statusCode data == expectedCode
         	= (Ok ms,Nothing,[fst (hd ms)],False)
         	= (Error data,Nothing,[],False)
-	//All other cases: just wait
-    whileConnected _ state _ 
-        = (Ok state,Nothing,[],False)
 
 	//We don't expect the server to disconnect before we close
 	//the connection ourselves
     onDisconnect _ _
 		= (Error "SMTP server disconnected unexpectedly",Nothing)
 
+sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag -> Task ()
+sendHtmlEmail opts sender recipients subject body =
+	sendEmail [EmailOptExtraHeaders [("content-type", "text/html")]: opts] sender recipients subject (toString body)
+
 // SMTP messages
 smtpHelo = "HELO localhost\r\n"
 smtpFrom email_from = "MAIL FROM:<" +++ (cleanupEmailString email_from) +++ ">\r\n"
@@ -53,8 +61,9 @@ smtpData = "DATA\r\n"
 smtpBody email_from email_to email_headers email_subject email_body 
 	= concat [k+++":"+++ v +++ "\r\n" \\ (k,v) <-
 				[("From",cleanupEmailString email_from)
-				,("To",cleanupEmailString email_to)
-				,("Subject",cleanupEmailString email_subject)
+				: (\email_to -> ("To",cleanupEmailString email_to)) <$> email_to
+				] ++
+				[("Subject",cleanupEmailString email_subject)
 				:email_headers]
 			 ]
 	+++ "\r\n" +++ email_body +++ "\r\n.\r\n"
@@ -79,5 +88,5 @@ getPortOpt [EmailOptSMTPServerPort s:xs]	= s
 getPortOpt [x:xs] 					= getPortOpt xs
 
 getHeadersOpt [] 							= []
-getHeadersOpt [EmailOptExtraHeaders s:xs]	= s
+getHeadersOpt [EmailOptExtraHeaders s:xs]	= s ++ getHeadersOpt xs
 getHeadersOpt [x:xs] 						= getHeadersOpt xs

Libraries/iTasks/Extensions/GIS/Leaflet.icl

@@ -179,6 +179,12 @@ where
 		# world            = (me .# "afterChildInsert" .= cb) world
 		# (cb,world)       = jsWrapFun (\a w -> onBeforeChildRemove me a w) me world
 		# world            = (me .# "beforeChildRemove" .= cb) world
+		# (cb,world)       = jsWrapFun (\a w -> onViewportChange me w) me world
+		# world            = (me .# "onViewportChange" .= cb) world
+		# (vp,world)       = (me .# "getViewport" .$ ()) world
+		# world            = (vp .# "addChangeListener" .$! me) world
+		# (cb,world)       = jsWrapFun (\a w -> beforeRemove me w) me world
+		# world            = (me .# "beforeRemove" .= cb) world
 		# world = case viewMode of
             True
 				= world
@@ -272,6 +278,16 @@ where
 			# (mapObj,world)    = me .# "map" .? world
 			= (mapObj.# "removeLayer" .$! popup) world
 
+	onViewportChange me world
+		# (mapObj,world) 	= me .# "map" .? world
+		# world             = (mapObj .# "invalidateSize" .$! ()) world
+		= world
+
+	beforeRemove me world
+		# (vp,world)       = (me .# "getViewport" .$ ()) world
+		# world            = (vp .# "removeChangeListener" .$! me) world
+		= world
+
     onWindowRemove me windowId _ world
         // remove children from iTasks component
         # (children,world)  = me .# "children" .? world

Libraries/iTasks/Internal/WebService.icl

@@ -134,11 +134,18 @@ httpServer port keepAliveTime requestProcessHandlers sds
     = wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect, onData=onData, onShareChange=onShareChange, onTick=onTick, onDisconnect=onDisconnect, onDestroy=onDestroy} sds
 where
     onConnect connId host r iworld=:{IWorld|world,clock,options={allowedHosts}}
-		| allowedHosts =: [] || isMember host allowedHosts
+		| isAllowed host allowedHosts
 			= (Ok (NTIdle host clock),Nothing,[],False,{IWorld|iworld & world = world})
 		| otherwise
 			//Close the connection immediately if the remote host is not in the whitelist
 			= (Ok (NTIdle host clock),Nothing,[],True,{IWorld|iworld & world = world})
+	where
+		//Simple check to also match (sub)networks such as 192.168.0.0 or 0.0.0.0
+		isAllowed host [] = True
+		isAllowed host hosts = any (allowedIP (split "." host)) (map (split ".") hosts)
+		allowedIP [h1,h2,h3,h4] [p1,p2,p3,p4]
+			= (p1 == "0" || h1 == p1) && (p2 == "0" || h2 == p2) && (p3 == "0" || h3 == p3) && (p4 == "0" || h4 == p4)
+		allowedIP _ _ = False
 
     onData data connState=:(NTProcessingRequest request localState) r env
         //Select handler based on request path

Libraries/iTasks/UI/JavaScript.icl

@@ -94,10 +94,12 @@ where
 				with
 					copy_elems :: !{#JSObjectElement} !Int !*{#Char} !Int -> (!.{#Char}, !Int)
 					copy_elems elems k dest i
+					# dest & [i]='"'
 					# {key,val} = elems.[k]
-					# (dest,i) = copy_chars key dest i
-					# dest & [i]=':'
-					# (dest,i) = copy val dest (i+1)
+					# (dest,i) = copy_chars key dest (i+1)
+					# dest & [i]='"'
+					# dest & [i+1]=':'
+					# (dest,i) = copy val dest (i+2)
 					| k+1>=size elems
 						= (dest,i)
 						= copy_elems elems (k+1) {dest & [i]=','} (i+1)
@@ -209,7 +211,7 @@ where
 			JSObject elems
 			| size elems==0
 				-> 2+l
-				-> count_elems (size elems-1) (l+(2*size elems)+1)
+				-> count_elems (size elems-1) (l+(4*size elems)+1)
 			where
 				count_elems :: !Int !Int -> Int
 				count_elems -1 l = l

Libraries/iTasks/UI/WebPublic/index.html

@@ -22,9 +22,7 @@
 	<!-- load iTasks viewport -->
 	<script type="text/javascript">
 	window.onload = function() {
-		ABC.loading_promise.finally(function(){
-			itasks.viewport({syncTitle: true}, document.body);
-		});
+		itasks.viewport({syncTitle: true}, document.body);
 	};
 	</script>
 </head>

Libraries/iTasks/UI/WebPublic/js/abc-interpreter.js

@@ -56,15 +56,28 @@ const ABC={
 			console.log(ABC.log_buffer);
 	},
 
-	deserialize: function (string, component) {
-		var max_words_needed=string.length/8*4; // rough upper bound
-		if (ABC.interpreter.instance.exports.get_hp_free() < max_words_needed) {
+	require_hp: function (needed_words) {
+		var free_words = ABC.interpreter.instance.exports.get_hp_free();
+
+		// Each gc iteration may free part of the ABC.js array, which may in turn
+		// free more nodes in Clean. Therefore we run gc as long as the number of
+		// free words decreases or until there is enough space. It will be possible
+		// to do this much neater in the future when JS has weak references /
+		// finalizers and/or when WebAssembly has GC access.
+		while (free_words < needed_words) {
 			console.warn('gc from js');
 			ABC.util.instance.exports.gc();
 
-			if (ABC.interpreter.instance.exports.get_hp_free() < max_words_needed)
-				throw 'not enough heap to deserialize: '+string;
+			var new_free_words=ABC.interpreter.instance.exports.get_hp_free();
+			if (new_free_words<=free_words)
+				throw new ABCError('out of memory');
+			free_words=new_free_words;
 		}
+	},
+
+	deserialize: function (string, component) {
+		var max_words_needed=string.length/8*4; // rough upper bound
+		ABC.require_hp(max_words_needed);
 
 		var array=new Int8Array(string.length);
 		for (var i in string)
@@ -166,12 +179,20 @@ const ABC={
 			} else if (typeof values[i]=='number') {
 				ABC.memory_array[store_ptrs/4]=hp;
 				if (Number.isInteger(values[i])) {
-					if (values[i]>2**31)
-						console.warn('Copying value',values[i],'>2^31 to Clean; truncating!');
 					ABC.memory_array[hp/4]=ABC.addresses.JSInt;
 					ABC.memory_array[hp/4+1]=0;
-					ABC.memory_array[hp/4+2]=values[i]; // TODO also support >32-bit
-					ABC.memory_array[hp/4+3]=0;
+					if (values[i]>2**31 || values[i]<0-2**31) {
+						if (typeof BigInt64Array!='undefined') {
+							const bigint_array=new BigInt64Array(ABC.memory_array.buffer, hp+8);
+							bigint_array[0]=BigInt(values[i]);
+						} else {
+							ABC.memory_array[hp/4+2]=values[i];
+							ABC.memory_array[hp/4+3]=Math.floor(values[i] / 2**32); // NB: >> is 32-bit in JS, can't use it here
+						}
+					} else {
+						ABC.memory_array[hp/4+2]=values[i];
+						ABC.memory_array[hp/4+3]=0;
+					}
 				} else {
 					ABC.memory_array[hp/4]=ABC.addresses.JSReal;
 					ABC.memory_array[hp/4+1]=0;
@@ -284,18 +305,11 @@ const ABC={
 			throw new ABCError('missing case in copy_js_to_clean');
 		}
 	},
-	copy_js_to_clean: function (value, store_ptrs, hp, hp_free) {
+	copy_js_to_clean: function (value, store_ptrs) {
 		var node_size=ABC.copied_node_size(value);
-		if (node_size>hp_free) {
-			console.warn('gc from js');
-			ABC.util.instance.exports.gc();
-			hp=ABC.interpreter.instance.exports.get_hp();
-			hp_free=ABC.interpreter.instance.exports.get_hp_free();
-			if (node_size>hp_free) {
-				console.error('not enough memory to copy',value);
-				throw new ABCError('out of memory');
-			}
-		}
+		ABC.require_hp(node_size);
+		var hp=ABC.interpreter.instance.exports.get_hp();
+		var hp_free=ABC.interpreter.instance.exports.get_hp_free();
 
 		var result=ABC._copy_js_to_clean([value], store_ptrs, hp, hp_free);
 
@@ -342,7 +356,7 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
 	ABC.memory=new WebAssembly.Memory({initial: blocks_needed});
 	ABC.memory_array=new Uint32Array(ABC.memory.buffer);
 
-	for (var i in ABC.prog)
+	for (var i=0; i<ABC.prog.length; i++)
 		ABC.memory_array[i]=ABC.prog[i];
 
 	(function(prog){
@@ -455,7 +469,7 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
 							if (ABC_DEBUG)
 								console.log('eval',string);
 							var result=eval('('+string+')'); // the parentheses are needed for {}, for instance
-							var copied=ABC.copy_js_to_clean(result, asp, hp, hp_free);
+							var copied=ABC.copy_js_to_clean(result, asp);
 							ABC.interpreter.instance.exports.set_hp(copied.hp);
 							ABC.interpreter.instance.exports.set_hp_free(copied.hp_free);
 							break;
@@ -639,7 +653,7 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
 		/* NB: the order here matters: copy_js_to_clean may trigger garbage
 		 * collection, so do that first, then set the rest of the arguments and
 		 * update asp. */
-		const copied=ABC.copy_js_to_clean(args, asp+8, hp, hp_free);
+		const copied=ABC.copy_js_to_clean(args, asp+8);
 		ABC.memory_array[asp/4]=(31+17*2)*8; // JSWorld: INT 17
 		ABC.memory_array[asp/4+4]=ABC.shared_clean_values[f.shared_clean_value_index].ref;
 		ABC.interpreter.instance.exports.set_asp(asp+16);

Libraries/iTasks/UI/WebPublic/js/itasks-core.js

@@ -26,30 +26,32 @@ itasks.Component = {
 	init: function() {
 		var me = this;
 		me.lastFire = 0;
-		me.initUI();
-		me.initComponent();
-		me.initChildren();
-		me.renderComponent();
 
-		me.initialized = true;
-		return me;
+		return Promise.resolve()
+			.then(me.initUI.bind(me))
+			.then(me.initComponent.bind(me))
+			.then(me.initChildren.bind(me))
+			.then(me.renderComponent.bind(me))
+			.then(function(){ me.initialized=true; });
 	},
 	initUI: function() {
 		var me=this;
-		if (me.attributes.initUI!=null && me.attributes.initUI!='') {
-			var initUI=ABC.deserialize(me.attributes.initUI,me);
-			ABC.interpret(initUI, [me, ABC.initialized ? 0 : 1]);
-		}
+		if (me.attributes.initUI!=null && me.attributes.initUI!='')
+			return ABC.loading_promise.then(function(){
+				var initUI=ABC.deserialize(me.attributes.initUI,me);
+				ABC.interpret(initUI, [me, ABC.initialized ? 0 : 1]);
+			});
 	},
 	initComponent: function() {}, //Abstract method: every component implements this differently
 	initChildren: function() {
 		var me = this;
-		me.children.forEach(function(spec,i) {
+		return me.children.reduce((promise,spec,i) => promise.then(function(){
 			me.beforeChildInsert(i,spec);
 			me.children[i] = me.createChild(spec);
-			me.children[i].init();
-			me.afterChildInsert(i,me.children[i]);
-		});
+			return me.children[i].init().then(function(){
+				me.afterChildInsert(i,me.children[i]);
+			});
+		}), Promise.resolve());
 	},
 	renderComponent: function() {
 		var me = this;
@@ -181,24 +183,29 @@ itasks.Component = {
 		//Add the child to the collection of children
 		me.children.splice(idx,0,child);
 
+		var finish_up=function(){
+			me.afterChildInsert(idx,child);
+			if (child.onResize)
+				child.onResize();
+		};
+
 		if(me.initialized) {
 			//Initialize, if we are already initialized
-			child.init();
-			//Add the child to the dom
-			if(child.domEl) {
-				if(isLast) {
-					me.containerEl.appendChild(child.domEl);
-				} else {
-					me.containerEl.insertBefore(child.domEl,me.containerEl.childNodes[idx]);
+			return child.init().then(function(){
+				//Add the child to the dom
+				if(child.domEl) {
+					if(isLast) {
+						me.containerEl.appendChild(child.domEl);
+					} else {
+						me.containerEl.insertBefore(child.domEl,me.containerEl.childNodes[idx]);
+					}
+					child.onShow();
 				}
-				child.onShow();
-			}
-		} 
-		me.afterChildInsert(idx,child);
 
-		//When the child is first added, we trigger a resize event
-		if(child.onResize) {
-			child.onResize();
+				finish_up();
+			});
+		} else {
+			finish_up();
 		}
 	},
 	beforeChildInsert: function(idx,spec) {},
@@ -218,7 +225,7 @@ itasks.Component = {
 		var me = this;
 		if(idx >= 0 && idx < me.children.length) {
 			me.removeChild(idx);
-			me.insertChild(idx,spec);
+			return me.insertChild(idx,spec);
 		}
 	},
 	moveChild: function(sidx,didx) {
@@ -265,24 +272,21 @@ itasks.Component = {
 		if(change) {
 			switch(change.type) {
 				case 'replace':
-					me.onReplaceUI(change.definition);
-					break;
+					return me.onReplaceUI(change.definition);
 				case 'change':
-					me.onChangeUI(change.attributes,change.children);
-					break;
+					return me.onChangeUI(change.attributes,change.children);
 			}
 		}
 	},
 	onReplaceUI: function(spec) {
-		var me = this, idx;
-
+		var me = this;
 		if(me.parentCmp) {
-			idx = me.parentCmp.findChild(me);
-			me.parentCmp.replaceChild(idx,spec);
+			var idx = me.parentCmp.findChild(me);
+			return me.parentCmp.replaceChild(idx,spec);
 		}
 	},
 	onChangeUI: function(attributeChanges,childChanges) {
-		var me = this, idx;
+		var me = this;
 
 		//Handle attribute changes
 		if(attributeChanges instanceof Array) {
@@ -292,19 +296,18 @@ itasks.Component = {
 		}
 		//Handle child changes
 		if (childChanges instanceof Array) {
-			childChanges.forEach(function(change) {
+			childChanges.reduce((promise,change) => promise.then(function(){
 				var idx = change[0];
 				switch(change[1]) {
 					case 'change':
 						if(idx >= 0 && idx < me.children.length) {
-							me.children[idx].onUIChange(change[2]);
+							return me.children[idx].onUIChange(change[2]);
 						} else {
 							console.log("UNKNOWN CHILD",idx,me.children.length,change);
 						}
 						break;
 					case 'insert':
-						me.insertChild(idx,change[2]);
-						break;
+						return me.insertChild(idx,change[2]);
 					case 'remove':
 						me.removeChild(idx);
 						break;
@@ -312,7 +315,7 @@ itasks.Component = {
 						me.moveChild(idx,change[2]);
 						break;
 				}
-			});
+			}), Promise.resolve());
 		}
 	},
 	onShow: function() {
@@ -324,6 +327,16 @@ itasks.Component = {
 	onResize: function() {
 		this.children.forEach(function(child) { if(child.onResize) {child.onResize();}});
 	},
+	getViewport: function() {
+		var me = this, vp = me.parentCmp;
+		while(vp) {
+			if(vp.cssCls == 'viewport') { //Bit of a hack...
+				return vp;
+			}
+			vp = vp.parentCmp;
+		}
+		return null;
+	}
 };
 itasks.Loader = {
 	cssCls: 'loader',
@@ -369,6 +382,8 @@ itasks.Viewport = {
 		var uiChangeCallback = me.onInstanceUIChange.bind(me);
 		var exceptionCallback = me.onException.bind(me);
 
+		me.changeListeners = [];
+
 		if('instanceNo' in me.attributes) {
 			//Connect to an existing task instance
 			me.connection.attachTaskInstance(
@@ -436,6 +451,20 @@ itasks.Viewport = {
 				});
 			}
 		}
+		//Trigger changelisteners
+		me.changeListeners.forEach(function(cl) {
+			cl.onViewportChange(change);
+		});
+	},
+	addChangeListener: function(cmp) {
+		var me = this;
+		me.changeListeners.push(cmp);
+	},
+	removeChangeListener: function(cmp) {
+		var me = this;
+		me.changeListeners = me.changeListeners.filter(function(el) {
+			return el != cmp;
+		});
 	},
 	onException: function(exception) {
 		var me = this;
@@ -461,7 +490,7 @@ itasks.Viewport = {
 //use the generic incremental change mechanism to update parts of a Component
 //This can be used for example to incrementally update the list of options in a dropdown component
 itasks.Data = {
-	init: function () { return this; },
+	init: function () { },
 	beforeRemove: function() {},
 	_beforeRemove: function() {},
 };

Libraries/iTasks/WF/Tasks/IO.icl

@@ -49,9 +49,10 @@ where
 	eval DestroyEvent evalOpts (TCBasic taskId ts jsonph _) iworld
 		# iworld = clearTaskSDSRegistrations ('DS'.singleton taskId) iworld
 		= apIWTransformer iworld
-		$             tuple (fjson jsonph)
-		>-= \(ph, _)->liftOSErr (terminateProcess ph)
-		>-= \_      ->tuple (Ok DestroyedResult)
+		$               tuple (fjson jsonph)
+		>-= \(ph, pio)->liftOSErr (terminateProcess ph)
+		>-= \_        ->liftOSErr (closeProcessIO pio)
+		>-= \_        ->tuple (Ok DestroyedResult)
 
 	//Destroyed when the task was already stable
 	eval DestroyEvent evalOpts tree iworld

Tests/Interactive/Editlets/TestLeafletResize.icl

+module TestLeafletResize
+import iTasks
+import iTasks.Extensions.GIS.Leaflet
+
+test =  (viewInformation "Map resizing" [] {LeafletMap|perspective=defaultValue,objects=objects,tilesUrls=[],icons=[]} <<@ FlexInner <<@ AddCSSClass "itasks-flex-height")
+	-|| (updateInformation "List to force resizing" [] [1,2,3,4] <<@ AddCSSClass "itasks-wrap-height")
+
+where
+	objects = [Polygon {polygonId = LeafletObjectID "poly", points = points,style=[], editable = True}]
+	points = [{LeafletLatLng|lat=52.0,lng=7.0},{LeafletLatLng|lat=54.0,lng=7.0},{LeafletLatLng|lat=52.0,lng=5.0}]
+
+FlexInner :== ApplyLayout (layoutSubUIs (SelectByPath [1]) (setUIAttributes (heightAttr FlexSize)))
+
+Start world = doTasks test world

Tests/Unit/iTasks/Internal/IWorld/UnitTests.icl

@@ -3,6 +3,9 @@ module iTasks.Internal.IWorld.UnitTests
 import Data.Either
 import iTasks.Util.Testing
 import iTasks.Internal.IWorld
+import System.Time
+
+derive gPrint Timespec
 
 testInitIWorld = assertWorld "Init IWorld" id sut
 where
@@ -16,6 +19,22 @@ where
 		# world = destroyIWorld iworld
 		= (True,world)
 
-tests = [testInitIWorld]
+testIworldTimespecNextFireZero = assertEqual "Next Fire Zero" exp sut
+where
+	exp = {tv_sec=12319,tv_nsec=100}
+	sut = iworldTimespecNextFire
+			{tv_sec=12319,tv_nsec=100}
+			{tv_sec=12314,tv_nsec=50}
+			{start={tv_sec=0,tv_nsec=1},interval={tv_sec=0,tv_nsec=0}}
+
+testIworldTimespecNextFireOne= assertEqual "Next Fire One" exp sut
+where
+	exp = {tv_sec=12315,tv_nsec=1}
+	sut = iworldTimespecNextFire
+			{tv_sec=12319,tv_nsec=100}
+			{tv_sec=12314,tv_nsec=50}
+			{start={tv_sec=0,tv_nsec=1},interval={tv_sec=1,tv_nsec=0}}
+
+tests = [testInitIWorld,testIworldTimespecNextFireZero, testIworldTimespecNextFireOne]
 
 Start world = runUnitTests tests world