Commit 890b8228 authored by Mart Lubbers's avatar Mart Lubbers

Add functionality to dynamically add and remove background tasks

parent ced4ec10
...@@ -92,7 +92,7 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC ...@@ -92,7 +92,7 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC
:: *IOTaskInstance :: *IOTaskInstance
= ListenerInstance !ListenerInstanceOpts !*TCP_Listener = ListenerInstance !ListenerInstanceOpts !*TCP_Listener
| ConnectionInstance !ConnectionInstanceOpts !*TCP_DuplexChannel | ConnectionInstance !ConnectionInstanceOpts !*TCP_DuplexChannel
| BackgroundInstance !BackgroundTask | BackgroundInstance !BackgroundInstanceOpts !BackgroundTask
:: ListenerInstanceOpts = :: ListenerInstanceOpts =
{ taskId :: !TaskId //Reference to the task that created the listener { taskId :: !TaskId //Reference to the task that created the listener
...@@ -112,6 +112,13 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC ...@@ -112,6 +112,13 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC
:: ConnectionId :== Int :: ConnectionId :== Int
:: BackgroundInstanceOpts =
{ bgInstId :: !BackgroundTaskId
}
:: BackgroundTaskId :== Int
:: IOStates :== Map TaskId IOState :: IOStates :== Map TaskId IOState
:: IOState :: IOState
= IOActive !(Map ConnectionId (!Dynamic,!Bool)) = IOActive !(Map ConnectionId (!Dynamic,!Bool))
......
...@@ -8,7 +8,7 @@ from Internet.HTTP import :: HTTPRequest, :: HTTPResponse ...@@ -8,7 +8,7 @@ from Internet.HTTP import :: HTTPRequest, :: HTTPResponse
from System.Time import :: Timestamp from System.Time import :: Timestamp
from Data.Error import :: MaybeError from Data.Error import :: MaybeError
from iTasks.API.Core.Types import :: TaskId from iTasks.API.Core.Types import :: TaskId
from iTasks._Framework.IWorld import :: IWorld from iTasks._Framework.IWorld import :: IWorld, :: BackgroundTaskId
from iTasks._Framework.Task import :: ConnectionTask, :: BackgroundTask, :: TaskException from iTasks._Framework.Task import :: ConnectionTask, :: BackgroundTask, :: TaskException
from iTasks._Framework.Engine import :: ConnectionType from iTasks._Framework.Engine import :: ConnectionType
...@@ -20,3 +20,9 @@ addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskE ...@@ -20,3 +20,9 @@ addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskE
//Dynamically add a connection //Dynamically add a connection
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld) addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
//Dynamically add a background task
addBackgroundTask :: !BackgroundTaskId !BackgroundTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
//Dynamically remove a background task
removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld)
...@@ -18,7 +18,7 @@ import iTasks._Framework.TaskEval ...@@ -18,7 +18,7 @@ import iTasks._Framework.TaskEval
:: *IOTaskInstanceDuringSelect :: *IOTaskInstanceDuringSelect
= ListenerInstanceDS !ListenerInstanceOpts = ListenerInstanceDS !ListenerInstanceOpts
| ConnectionInstanceDS !ConnectionInstanceOpts !*TCP_SChannel | ConnectionInstanceDS !ConnectionInstanceOpts !*TCP_SChannel
| BackgroundInstanceDS !BackgroundTask | BackgroundInstanceDS !BackgroundInstanceOpts !BackgroundTask
serve :: !Int !ConnectionTask ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld serve :: !Int !ConnectionTask ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
serve port ct bt determineTimeout iworld serve port ct bt determineTimeout iworld
...@@ -30,7 +30,7 @@ init port ct bt iworld=:{IWorld|ioTasks,world} ...@@ -30,7 +30,7 @@ init port ct bt iworld=:{IWorld|ioTasks,world}
| not success = abort ("Error: port "+++ toString port +++ " already in use.\n") | not success = abort ("Error: port "+++ toString port +++ " already in use.\n")
# opts = {ListenerInstanceOpts|taskId=TaskId 0 0, nextConnectionId=0, port=port, connectionTask=ct, removeOnClose = True} # opts = {ListenerInstanceOpts|taskId=TaskId 0 0, nextConnectionId=0, port=port, connectionTask=ct, removeOnClose = True}
# ioStates = 'DM'.fromList [(TaskId 0 0, IOActive 'DM'.newMap)] # ioStates = 'DM'.fromList [(TaskId 0 0, IOActive 'DM'.newMap)]
= {iworld & ioTasks = {done=[],todo=[ListenerInstance opts (fromJust mbListener):map BackgroundInstance bt]}, ioStates = ioStates, world = world} = {iworld & ioTasks = {done=[],todo=[ListenerInstance opts (fromJust mbListener):map (BackgroundInstance {bgInstId=0})bt]}, ioStates = ioStates, world = world}
loop :: !(*IWorld -> (!Maybe Timeout,!*IWorld)) !*IWorld -> *IWorld loop :: !(*IWorld -> (!Maybe Timeout,!*IWorld)) !*IWorld -> *IWorld
loop determineTimeout iworld loop determineTimeout iworld
...@@ -62,7 +62,7 @@ toSelectSet [i:is] ...@@ -62,7 +62,7 @@ toSelectSet [i:is]
= case i of = case i of
ListenerInstance opts l = ([l:ls],rs,[ListenerInstanceDS opts:is]) ListenerInstance opts l = ([l:ls],rs,[ListenerInstanceDS opts:is])
ConnectionInstance opts {rChannel,sChannel} = (ls,[rChannel:rs],[ConnectionInstanceDS opts sChannel:is]) ConnectionInstance opts {rChannel,sChannel} = (ls,[rChannel:rs],[ConnectionInstanceDS opts sChannel:is])
BackgroundInstance bt = (ls,rs,[BackgroundInstanceDS bt:is]) BackgroundInstance opts bt = (ls,rs,[BackgroundInstanceDS opts bt:is])
/* Restore the list of main loop instances. /* Restore the list of main loop instances.
In the same pass also update the indices in the select result to match the In the same pass also update the indices in the select result to match the
...@@ -98,9 +98,9 @@ where ...@@ -98,9 +98,9 @@ where
# (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners (numSeenReceivers+1) ls rs [(c,what):ch] is # (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners (numSeenReceivers+1) ls rs [(c,what):ch] is
= ([ConnectionInstance opts {rChannel=rChannel,sChannel=sChannel}:is],ch) = ([ConnectionInstance opts {rChannel=rChannel,sChannel=sChannel}:is],ch)
//Background tasks //Background tasks
fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [BackgroundInstanceDS bt:is] fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [BackgroundInstanceDS opts bt:is]
# (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners numSeenReceivers ls rs ch is # (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners numSeenReceivers ls rs ch is
= ([BackgroundInstance bt:is],ch) = ([BackgroundInstance opts bt:is],ch)
ulength [] = (0,[]) ulength [] = (0,[])
ulength [x:xs] ulength [x:xs]
...@@ -262,9 +262,9 @@ process i chList iworld=:{ioTasks={done,todo=[ConnectionInstance opts {rChannel, ...@@ -262,9 +262,9 @@ process i chList iworld=:{ioTasks={done,todo=[ConnectionInstance opts {rChannel,
# world = closeChannel sChannel world # world = closeChannel sChannel world
= process (i+1) chList {iworld & ioTasks={done=done,todo=todo}, ioStates = ioStates, world=world} = process (i+1) chList {iworld & ioTasks={done=done,todo=todo}, ioStates = ioStates, world=world}
process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance bt=:(BackgroundTask eval):todo]}} process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance opts bt=:(BackgroundTask eval):todo]}}
# iworld=:{ioTasks={done,todo}} = eval {iworld & ioTasks = {done=done,todo=todo}} # iworld=:{ioTasks={done,todo}} = eval {iworld & ioTasks = {done=done,todo=todo}}
= process (i+1) chList {iworld & ioTasks={done=[BackgroundInstance bt:done],todo=todo}} = process (i+1) chList {iworld & ioTasks={done=[BackgroundInstance opts bt:done],todo=todo}}
process i chList iworld=:{ioTasks={done,todo=[t:todo]}} process i chList iworld=:{ioTasks={done,todo=[t:todo]}}
= process (i+1) chList {iworld & ioTasks={done=[t:done],todo=todo}} = process (i+1) chList {iworld & ioTasks={done=[t:done],todo=todo}}
...@@ -319,6 +319,24 @@ addConnection taskId=:(TaskId instanceNo _) host port connectionTask iworld=:{io ...@@ -319,6 +319,24 @@ addConnection taskId=:(TaskId instanceNo _) host port connectionTask iworld=:{io
Error e = 'DM'.put taskId (IOException e) ioStates Error e = 'DM'.put taskId (IOException e) ioStates
= (Ok (),{iworld & ioTasks = {done=done,todo=todo}, ioStates = ioStates, world = world}) = (Ok (),{iworld & ioTasks = {done=done,todo=todo}, ioStates = ioStates, world = world})
//Dynamically add a background task
addBackgroundTask :: !BackgroundTaskId !BackgroundTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
addBackgroundTask btid bt iworld=:{ioTasks={done,todo}}
# todo = todo ++ [BackgroundInstance {BackgroundInstanceOpts|bgInstId=btid} bt]
= (Ok (), {iworld & ioTasks={done=done, todo=todo}})
//Dynamically remove a background task
removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld)
removeBackgroundTask btid iworld=:{ioTasks={done,todo}}
//We filter the tasks and use the boolean state to hold whether a task was dropped
# (r, todo) = foldr (\e (b, l)->let (b`, e`)=drop e in (b` || b, if b` l [e`:l])) (False, []) todo
# iworld = {iworld & ioTasks={done=done, todo=todo}}
| not r = (Error (exception "No backgroundtask with that id"), iworld)
= (Ok (), iworld)
where
drop a=:(BackgroundInstance {bgInstId} _) = (bgInstId == btid, a)
drop a = (False, a)
checkSelect :: !Int ![(!Int,!SelectResult)] -> (!Maybe SelectResult,![(!Int,!SelectResult)]) checkSelect :: !Int ![(!Int,!SelectResult)] -> (!Maybe SelectResult,![(!Int,!SelectResult)])
checkSelect i chList =:[(who,what):ws] | (i == who) = (Just what,ws) checkSelect i chList =:[(who,what):ws] | (i == who) = (Just what,ws)
checkSelect i chList = (Nothing,chList) checkSelect i chList = (Nothing,chList)
...@@ -332,6 +350,6 @@ halt iworld=:{ioTasks={todo=[ConnectionInstance _ {rChannel,sChannel}:todo],done ...@@ -332,6 +350,6 @@ halt iworld=:{ioTasks={todo=[ConnectionInstance _ {rChannel,sChannel}:todo],done
# world = closeRChannel rChannel world # world = closeRChannel rChannel world
# world = closeChannel sChannel world # world = closeChannel sChannel world
= halt {iworld & ioTasks = {todo=todo,done=done}} = halt {iworld & ioTasks = {todo=todo,done=done}}
halt iworld=:{ioTasks={todo=[BackgroundInstance _ :todo],done},world} halt iworld=:{ioTasks={todo=[BackgroundInstance _ _ :todo],done},world}
= halt {iworld & ioTasks= {todo=todo,done=done}} = halt {iworld & ioTasks= {todo=todo,done=done}}
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