Merge remote-tracking branch 'origin/master' into...

Merge remote-tracking branch 'origin/master' into server-and-client-side-svg-rendering-with-abc-interpreter

Config/iTasks.prt

+Version: 1.5
+Global
+	ProjectRoot:	.
+	Target:	iTasks
+	CodeGen
+		CheckStacks:	False
+		CheckIndexes:	True
+		OptimiseABC:	True
+		GenerateByteCode:	True
+	Application
+		HeapSize:	167772160
+		StackSize:	1048576
+		ExtraMemory:	81920
+		IntialHeapSize:	204800
+		HeapSizeMultiplier:	4096
+		ShowExecutionTime:	False
+		ShowGC:	False
+		ShowStackSize:	False
+		MarkingCollector:	False
+		DisableRTSFlags:	False
+		StandardRuntimeEnv:	True
+		Profile
+			Memory:	False
+			MemoryMinimumHeapSize:	0
+			Time:	False
+			Stack:	False
+			Dynamics:	True
+			GenericFusion:	False
+			DescExL:	True
+		Output
+			Output:	ShowConstructors
+			Font:	Courier
+			FontSize:	9
+			WriteStdErr:	False
+	Link
+		LinkMethod:	Static
+		GenerateRelocations:	False
+		GenerateSymbolTable:	False
+		GenerateLinkMap:	False
+		LinkResources:	False
+		ResourceSource:	
+		GenerateDLL:	False
+		ExportedNames:	
+		StripByteCode:	True
+		KeepByteCodeSymbols:	True
+		PrelinkByteCode:	True
+	Paths
+		Path:	{Project}
+	Precompile:	
+	Postlink:	

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, Data.Func
+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,47 @@ 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 htmlString
+where
+	// avoid too long lines (SMTP allows a max length of 1000 characters only)
+	// by inserting a newline (\r\n is required for mails) after each tag
+	htmlString = replaceSubString ">" ">\r\n" $ toString body
+
 // SMTP messages
 smtpHelo = "HELO localhost\r\n"
 smtpFrom email_from = "MAIL FROM:<" +++ (cleanupEmailString email_from) +++ ">\r\n"
@@ -53,8 +65,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 +92,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/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

@@ -389,7 +389,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){

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

@@ -26,32 +26,35 @@ 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);
-			var ref=ABC.share_clean_value(initUI,me);
-			ABC.interpret(SharedCleanValue(ref), [me, ABC.initialized ? 0 : 1]);
-			ABC.clear_shared_clean_value(ref);
+			return ABC.loading_promise.then(function(){
+				var initUI=ABC.deserialize(me.attributes.initUI);
+				var ref=ABC.share_clean_value(initUI,me);
+				ABC.interpret(SharedCleanValue(ref), [me, ABC.initialized ? 0 : 1]);
+				ABC.clear_shared_clean_value(ref);
+			});
 		}
 	},
 	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;
@@ -183,24 +186,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) {},
@@ -220,7 +228,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) {
@@ -267,24 +275,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) {
@@ -294,19 +299,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;
@@ -314,7 +318,7 @@ itasks.Component = {
 						me.moveChild(idx,change[2]);
 						break;
 				}
-			});
+			}), Promise.resolve());
 		}
 	},
 	onShow: function() {
@@ -326,6 +330,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',
@@ -371,6 +385,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(
@@ -438,6 +454,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;
@@ -463,7 +493,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 () { return Promise.resolve(); },
 	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