Merge branch 'onDestroy-io' into 'master'

Add ondestroy handler for tcp connections

See merge request !240

Examples/Applications/Incidone/Incidone/Util/TaskPatterns.icl

@@ -212,7 +212,7 @@ where
 
 syncNetworkChannel      :: String Int String (String -> m) (m -> String) (Shared sds ([m],Bool,[m],Bool)) -> Task () | iTask m & RWShared sds
 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
-    = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect} @! ()
+    = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])} @! ()
 where
     onConnect _ _ (received,receiveStopped,send,sendStopped)
         = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)

Libraries/iTasks/Extensions/Device/_Common.icl

@@ -15,6 +15,7 @@ deviceRequest request close
 		, onData	 = onData
 		, onShareChange  = onShareChange
 		, onDisconnect   = onDisconnect
+		, onDestroy= \s->(Ok s, [])
 		} 
 	>>= \{DeviceRequestState|result} -> return result            
 where

Libraries/iTasks/Extensions/Distributed/Authentication.icl

@@ -38,6 +38,7 @@ authServer port = tcplisten port True authServerShare {ConnectionHandlers
 	, onData		= onData
 	, onShareChange		= onShareChange
 	, onDisconnect 		= onDisconnect
+	, onDestroy         = \s->(Ok s, [])
 	} -|| (process authServerShare) @! ()
 where
 	onConnect :: ConnectionId String AuthShare -> (MaybeErrorString AuthServerState, Maybe AuthShare, [String], Bool)
@@ -134,6 +135,7 @@ where
                         , onData	 = onData
 			, onShareChange  = onShareChange
                         , onDisconnect   = onDisconnect
+                        , onDestroy      = \s->(Ok s, [])
                         }) @? taskResult)
 		>>- \(resps,_) -> case resps of
 					[resp:_]  -> return (fromJSON (fromString (base64Decode resp)))

Libraries/iTasks/Extensions/Email.icl

@@ -4,7 +4,7 @@ import Text
 
 sendEmail :: ![EmailOpt] !String !String !String !String -> Task ()
 sendEmail opts subject body sender recipient
-	= tcpconnect server port (constShare ()) {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect}
+	= tcpconnect server port (constShare ()) {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
 	@! ()
 where
 	server 	= getServerOpt opts

Libraries/iTasks/Extensions/Web.icl

@@ -62,7 +62,7 @@ serveWebService port handler
 where
 	manageConnections io
 		= tcplisten port False (currentTimespec |*< io)
-			{ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect}
+			{ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
 			
     onConnect connId client_name (now,io)
 		= (Ok (Idle client_name now), Nothing, [], False)
@@ -185,7 +185,7 @@ where
 
 callHTTP :: !HTTPMethod !URI !String !(HTTPResponse -> (MaybeErrorString a)) -> Task a | iTask a
 callHTTP method url=:{URI|uriScheme,uriRegName=Just uriRegName,uriPort,uriPath,uriQuery,uriFragment} data parseFun
-    =   tcpconnect uriRegName port (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect}
+    =   tcpconnect uriRegName port (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
     @?  taskResult
 where
     port = fromMaybe 80 uriPort

Libraries/iTasks/Internal/AsyncSDS.icl

@@ -31,6 +31,8 @@ onData data (Left acc) _ = (Ok (Left (acc ++ [data])), Nothing, [], False)
 
 onShareChange acc _ = (Ok acc, Nothing, [], False)
 
+onDestroy s = (Ok s, [])
+
 queueSDSRequest :: !(SDSRequest p r w) !String !Int !TaskId !{#Symbol} !*IWorld -> (!MaybeError TaskException ConnectionId, !*IWorld) | TC r
 queueSDSRequest req host port taskId symbols iworld
 = case addConnection taskId host port connectionTask iworld of
@@ -43,7 +45,8 @@ where
 	handlers _ = {ConnectionHandlers| onConnect = onConnect req,
 		onData = onData,
 		onShareChange = onShareChange,
-		onDisconnect = onDisconnect}
+		onDisconnect = onDisconnect,
+		onDestroy = onDestroy}
 
 	onDisconnect (Left acc) _
 	# textResponse = concat acc
@@ -61,7 +64,8 @@ where
 	handlers _ = {ConnectionHandlers| onConnect = onConnect req,
 		onData = onData,
 		onShareChange = onShareChange,
-		onDisconnect = onDisconnect}
+		onDisconnect = onDisconnect,
+		onDestroy=onDestroy}
 
 	onDisconnect (Left acc) _
 	# textResponse = concat acc
@@ -79,7 +83,8 @@ where
 	handlers req = {ConnectionHandlers| onConnect = onConnect req,
 		onData = onData,
 		onShareChange = onShareChange,
-		onDisconnect = onDisconnect}
+		onDisconnect = onDisconnect,
+		onDestroy = onDestroy}
 
 	onDisconnect (Left acc) _
 	# textResponse = concat acc
@@ -98,7 +103,8 @@ where
 	handlers req = {ConnectionHandlers| onConnect = onConnect,
 		onData = onData,
 		onShareChange = onShareChange,
-		onDisconnect = onDisconnect}
+		onDisconnect = onDisconnect,
+		onDestroy = onDestroy}
 
 	onConnect _ _ _
 	# req = createRequest p
@@ -127,7 +133,8 @@ where
 	handlers = {ConnectionHandlers| onConnect = onConnect,
 		onData = onData,
 		onShareChange = onShareChange,
-		onDisconnect = onDisconnect}
+		onDisconnect = onDisconnect,
+		onDestroy = onDestroy}
 
 	onConnect connId _ _	= (Ok (Nothing, []), Nothing, [createMessage p +++ "\n"], False)
 
@@ -160,6 +167,7 @@ where
 				, onData 		= onData
 				, onShareChange = onShareChange
 				, onDisconnect 	= onDisconnect
+				, onDestroy  	= onDestroy
 				}
 	onConnect connId _ _
 	# req = toWriteRequest p w
@@ -191,7 +199,8 @@ where
 	handlers = {ConnectionHandlers| onConnect = onConnect,
 		onData = onData,
 		onShareChange = onShareChange,
-		onDisconnect = onDisconnect}
+		onDisconnect = onDisconnect,
+		onDestroy = onDestroy}
 
 	onConnect connId _ _	= (Ok (Left ""), Nothing, [toWriteMessage p w +++ "\n"], False)
 

Libraries/iTasks/Internal/Distributed/Instance.icl

@@ -88,6 +88,7 @@ instanceServer port domain = tcplisten port True instanceServerShared {Connectio
 	, onData		= onData
 	, onShareChange		= onShareChange
 	, onDisconnect 		= onDisconnect
+	, onDestroy= \s->(Ok s, [])
 	} -|| (instanceClient` "127.0.0.1" port domain True) -|| (process instanceServerShared) @! ()
 where
 	onConnect :: ConnectionId String InstanceServerShare -> (MaybeErrorString InstanceServerState, Maybe InstanceServerShare, [String], Bool)
@@ -472,6 +473,7 @@ where
                                                       , onData         = onData
 						      , onShareChange  = onShareChange
                                                       , onDisconnect   = onDisconnect
+                                                      , onDestroy      = \s->(Ok s, [])
                                                       } @! Nothing)
                 -||- (viewInformation () [] () >>* [OnAction (Action "reset") (always (return Nothing))])
 

Libraries/iTasks/Internal/SDSService.icl

@@ -66,6 +66,7 @@ where
     	, onShareChange = onShareChange
     	, onTick = onTick
     	, onDisconnect = onDisconnect
+    	, onDestroy = \s iw->(Ok s, [], iw)
 		}
 
 	reevaluateShares :: !{#Symbol} !TaskId ![(ConnectionId, (Bool, String, String))] *IWorld -> (MaybeErrorString [(ConnectionId, (Bool, String, String))], *IWorld)

Libraries/iTasks/Internal/Task.dcl

@@ -34,6 +34,7 @@ derive gEq				Task
     , onShareChange :: !(                    l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
     , onTick        :: !(       			 l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
     , onDisconnect  :: !(       			 l r *IWorld -> *(!MaybeErrorString l, Maybe w,                   !*IWorld))
+    , onDestroy     :: !(                    l   *IWorld -> *(!MaybeErrorString l,          ![String],        !*IWorld))
     }
 
 /**

Libraries/iTasks/Internal/Task.icl

@@ -45,8 +45,8 @@ where
 	error = "Creating default task functions is impossible"
 
 wrapConnectionTask :: (ConnectionHandlers l r w) (sds () r w) -> ConnectionTask | TC l & TC r & TC w & RWShared sds
-wrapConnectionTask ch=:{ConnectionHandlers|onConnect,onData,onShareChange,onDisconnect} sds
-	= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`} (toDynamic sds)
+wrapConnectionTask ch=:{ConnectionHandlers|onConnect,onData,onShareChange,onDisconnect,onDestroy} sds
+	= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`,onDestroy=onDestroy`} (toDynamic sds)
 where
 	onConnect` connId host (r :: r^) env
 		# (mbl, mbw, out, close) = onConnect connId host r
@@ -71,10 +71,14 @@ where
 		# (mbl, mbw) = onDisconnect l r
 		= (toDyn <$> mbl, toDyn <$> mbw, env)
 	onDisconnect` l r env = abort ("onDisconnect does not match with type l=" +++ toString (typeCodeOfDynamic l) +++ ", r=" +++ toString (typeCodeOfDynamic r))
+	onDestroy` (l :: l^) env
+		# (mbl, out) = onDestroy l
+		= (toDyn <$> mbl, out, env)
+	onDestroy` l env = abort ("onDestroy does not match with type l=" +++ toString (typeCodeOfDynamic l))
 
 wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (sds () r w) -> ConnectionTask | TC l & TC r & TC w & RWShared sds
-wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect,onData,onShareChange,onTick,onDisconnect} sds
-	= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`} (toDynamic sds)
+wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect,onData,onShareChange,onTick,onDisconnect,onDestroy} sds
+	= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`,onDestroy=onDestroy`} (toDynamic sds)
 where
 	onConnect` connId host (r :: r^) env
 		# (mbl, mbw, out, close, env) = onConnect connId host r env
@@ -102,6 +106,10 @@ where
 		# (mbl, mbw, env) = onDisconnect l r env
 		= (toDyn <$> mbl, toDyn <$> mbw, env)
 	onDisconnect` l r env = abort ("onDisconnect does not match with type l=" +++ toString (typeCodeOfDynamic l) +++ ", r=" +++ toString (typeCodeOfDynamic r))
+	onDestroy` (l :: l^) env
+		# (mbl, out, env) = onDestroy l env
+		= (toDyn <$> mbl, out, env)
+	onDestroy` l env = abort ("onDestroy does not match with type l=" +++ toString (typeCodeOfDynamic l))
 
 mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -> Task a | iTask a
 mkInstantTask iworldfun = Task (evalOnce iworldfun)

Libraries/iTasks/Internal/TaskServer.icl

@@ -226,13 +226,16 @@ process i chList iworld=:{ioTasks={done, todo=[ConnectionInstance opts duplexCha
 	# iworld = processIOTask
 		i chList opts.ConnectionInstanceOpts.taskId opts.ConnectionInstanceOpts.connectionId
 		opts.ConnectionInstanceOpts.removeOnClose sds tcpConnectionIOOps
-		(\_ -> handlers.ConnectionHandlersIWorld.onDisconnect) handlers.ConnectionHandlersIWorld.onData
-		handlers.ConnectionHandlersIWorld.onShareChange handlers.ConnectionHandlersIWorld.onTick (ConnectionInstance opts) duplexChannel iworld
+		(\_ -> handlers.ConnectionHandlersIWorld.onDisconnect)
+		handlers.ConnectionHandlersIWorld.onData
+		handlers.ConnectionHandlersIWorld.onShareChange
+		handlers.ConnectionHandlersIWorld.onTick
+		handlers.ConnectionHandlersIWorld.onDestroy
+		(ConnectionInstance opts) duplexChannel iworld
 	= process (i+1) chList iworld
 where
 	(ConnectionTask handlers sds) = opts.ConnectionInstanceOpts.connectionTask
 
-
 process i chList iworld=:{ioTasks={done,todo=[t:todo]}}
 	= (process (i+1) chList {iworld & ioTasks={done=[t:done],todo=todo}})
 
@@ -286,15 +289,16 @@ processIOTask :: !Int
 				 !(readData Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
 				 !(Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
 				 !(Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
+				 !(Dynamic *IWorld -> (!MaybeErrorString Dynamic, ![String], !*IWorld))
 				 !(.ioChannels -> *IOTaskInstance)
 				 !.ioChannels
 				 !*IWorld
 			  -> *IWorld
 processIOTask i chList taskId connectionId removeOnClose sds ioOps onCloseHandler onDataHandler
-			  onShareChangeHandler onTickHandler mkIOTaskInstance ioChannels iworld=:{ioStates}
+			  onShareChangeHandler onTickHandler onDestroyHandler mkIOTaskInstance ioChannels iworld=:{ioStates}
+	# (TaskId instanceNo _) = taskId
 	= case get taskId ioStates of
 		Just (IOActive taskStates)
-			# (TaskId instanceNo _) = taskId
 			// get task state
 			# mbTaskState = get connectionId taskStates
 			| isNothing mbTaskState
@@ -377,6 +381,18 @@ processIOTask i chList taskId connectionId removeOnClose sds ioOps onCloseHandle
 						# {done, todo} = iworld.ioTasks
 						= {iworld & ioStates = ioStates, ioTasks = {done = [mkIOTaskInstance ioChannels : done], todo = todo}}
 		Just (IODestroyed taskStates)
+			// get task state one last time
+			# mbTaskState = get connectionId taskStates
+			| isNothing mbTaskState
+				# iworld   = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
+				# ioStates = put taskId (IOException "Missing IO task state for task ") ioStates
+				= ioOps.closeIO (ioChannels, {iworld & ioStates = ioStates})
+			# (Just (taskState, _)) = mbTaskState
+			//Ondestroy handler
+			# (mbTaskState, out, iworld) = onDestroyHandler taskState iworld
+			| mbTaskState =: (Error _) = taskStateException mbTaskState instanceNo ioStates ioOps.closeIO (ioChannels, iworld)
+			// write data
+			# (ioChannels, iworld) = foldl (flip ioOps.writeData) (ioChannels, iworld) out
 			# iworld = ioOps.closeIO (ioChannels, iworld)
 			//Remove the state for this connection
 			//If this is the last connection for this task, we can clean up.

Libraries/iTasks/Internal/Tonic/Server.icl

@@ -313,6 +313,7 @@ acceptTonicTraces tonicShare
                                    , onData        = onData
                                    , onShareChange = onShareChange
                                    , onDisconnect  = onDisconnect
+                                   , onDestroy     = onDestroy
                                    }
   where
     onConnect :: ConnectionId String TMessageStore
@@ -353,3 +354,4 @@ acceptTonicTraces tonicShare
     onDisconnect st lines
         = (Ok st, Just lines)
 
+	onDestroy st = (Ok st, [])

Libraries/iTasks/Internal/WebService.icl

@@ -131,7 +131,7 @@ wsockTextMsg payload = [wsockMsgFrame WS_OP_TEXT True payload]
 
 httpServer :: !Int !Timespec ![WebService r w] (sds () r w) -> ConnectionTask | TC r & TC w & RWShared sds
 httpServer port keepAliveTime requestProcessHandlers sds
-    = wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect, onData=onData, onShareChange=onShareChange, onTick=onTick, onDisconnect=onDisconnect} 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}
         = (Ok (NTIdle host clock),Nothing,[],False,{IWorld|iworld & world = world})
@@ -235,6 +235,8 @@ where
 				= (Ok connState, mbW, env)
     onDisconnect connState r env = (Ok connState, Nothing, env)
 
+	onDestroy s iw = (Ok s, [], iw)
+
 	selectHandler req [] = Nothing
 	selectHandler req [h:hs]
 		| h.urlMatchPred req.HTTPRequest.req_path = Just h

Libraries/iTasks/WF/Tasks/IO.dcl

@@ -13,9 +13,10 @@ from Data.Error import :: MaybeError, :: MaybeErrorString
 
 :: ConnectionHandlers l r w =
     { onConnect         :: !(ConnectionId String   r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
-    , onData            :: !(			  String l r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
+    , onData            :: !(             String l r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
     , onShareChange     :: !(                    l r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
-    , onDisconnect      :: !(       		     l r -> (!MaybeErrorString l, Maybe w                  ))
+    , onDisconnect      :: !(                    l r -> (!MaybeErrorString l, Maybe w                  ))
+    , onDestroy         :: !(                    l   -> (!MaybeErrorString l,          ![String]       ))
 	}
 
 /**