Commit 0dff0aa8 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 52e551fc
...@@ -30,35 +30,57 @@ import InternaliTasksCommon ...@@ -30,35 +30,57 @@ import InternaliTasksCommon
instance == ThreadKind instance == ThreadKind
showThreadNr :: !TaskNr -> String // Setting of global information for a particular user
showThreadTable :: *TSt -> (HtmlCode,*TSt) // watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !!
setPUser :: !Int !(GlobalInfo -> GlobalInfo) !*HSt -> (!GlobalInfo,!*HSt)
setPUser :: !Int !(GlobalInfo -> GlobalInfo) !*HSt -> (!GlobalInfo,!*HSt) setPUserNr :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
setPUserNr :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt) clearIncPUser :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
clearIncPUser :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
// Displaying thread information
administrateNewThread :: UserId *TSt -> *TSt
mkTaskThread :: !SubPage !(Task a) -> Task a | iData a showThreadNr :: !TaskNr -> String
mkTaskThread2 :: !ThreadKind !(Task a) -> Task a // execute a thread showThreadTable :: !*TSt -> (!HtmlCode,!*TSt) // watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !!
evalTaskThread :: !TaskThread -> Task a // execute the thread !!!!
ThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads // Thread creation
ServerThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ClientThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads administrateNewThread :: !UserId !*TSt -> *TSt
ThreadTableStorageGen :: !String !Lifespan !(ThreadTable -> ThreadTable) -> (Task ThreadTable)// used to store Tasknr of callbackfunctions / threads mkTaskThread :: !SubPage !(Task a) -> Task a | iData a
copyThreadTableToClient :: !*TSt -> !*TSt // copies all threads for this user from server to client thread table mkTaskThread2 :: !ThreadKind !(Task a) -> Task a // execute a thread
splitServerThreadsByUser :: !*TSt -> !(!(!ThreadTable,!ThreadTable),!*TSt) // get all threads from a given user from the server thread table
copyThreadTableFromClient :: !GlobalInfo !*TSt -> !*TSt // copies all threads for this user from client to server thread table // Finding threads and evaluation of a thread
findThreadInTable :: !ThreadKind !TaskNr *TSt -> *(Maybe (!Int,!TaskThread),*TSt) // find thread that belongs to given tasknr
insertNewThread :: !TaskThread *TSt -> *TSt // insert new thread in table findThreadInTable :: !ThreadKind !TaskNr !*TSt -> *(Maybe !(!Int,!TaskThread),!*TSt) // find thread that belongs to given tasknr
deleteThreads :: !TaskNr !*TSt -> *TSt findParentThread :: !TaskNr !*TSt -> *([TaskThread],*TSt) // finds parent thread closest to given set of task numbers
findParentThread :: !TaskNr !*TSt -> *([TaskThread],*TSt) // finds parent thread closest to given set of task numbers evalTaskThread :: !TaskThread -> Task a // execute the thread !!!!
serializeThread :: !.(Task .a) -> .String // Thread table management
deserializeThread :: .String -> .(Task .a)
serializeThreadClient :: !(Task a) -> String insertNewThread :: !TaskThread !*TSt -> *TSt // insert new thread in table
deserializeThreadClient :: .String -> .(Task .a) deleteThreads :: !TaskNr !*TSt -> *TSt
deleteSubTasksAndThreads :: !TaskNr !*TSt -> *TSt
deleteAllSubTasksAndThreads :: ![TaskNr] !*TSt -> *TSt
deleteSubTasksAndThreads :: !TaskNr TSt -> TSt
deleteAllSubTasksAndThreads :: ![TaskNr] TSt -> TSt // Thread storages
ThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
ServerThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
ClientThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
ThreadTableStorageGen :: !String !Lifespan !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
// Copying thread tables from server to client and vica versa
copyThreadTableToClient :: !*TSt -> !*TSt // copies all threads for this user from server to client thread table
splitServerThreadsByUser :: !*TSt -> !(!(!ThreadTable,!ThreadTable),!*TSt)// get all threads from a given user from the server thread table
copyThreadTableFromClient :: !GlobalInfo !*TSt -> !*TSt // copies all threads for this user from client to server thread table
// Serialization an de-serialization of closures for Clean running on Server
serializeThread :: !.(Task .a) -> .String
deserializeThread :: !.String -> .(Task .a)
// Serialization an de-serialization of closures for Clean interpreted by Sapl on a Client
serializeThreadClient :: !(Task a) -> String
deserializeThreadClient :: !.String -> .(Task .a)
...@@ -9,7 +9,7 @@ implementation module InternaliTasksThreadHandling ...@@ -9,7 +9,7 @@ implementation module InternaliTasksThreadHandling
import StdList, StdFunc, StdEnv import StdList, StdFunc, StdEnv
import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string
import iDataTrivial, iDataFormlib import iDataTrivial, iDataFormlib
import InternaliTasksCommon, iTasksSettings, iTasksBasicCombinators import InternaliTasksCommon, iTasksSettings, iTasksBasicCombinators, iTasksLiftingCombinators
derive gForm Lifespan, GarbageCollect, StorageFormat, Mode, Options, GlobalInfo, TaskThread, ThreadKind, [] derive gForm Lifespan, GarbageCollect, StorageFormat, Mode, Options, GlobalInfo, TaskThread, ThreadKind, []
derive gUpd Lifespan, GarbageCollect, StorageFormat, Mode, Options, GlobalInfo, TaskThread, ThreadKind, [] derive gUpd Lifespan, GarbageCollect, StorageFormat, Mode, Options, GlobalInfo, TaskThread, ThreadKind, []
...@@ -206,14 +206,14 @@ where ...@@ -206,14 +206,14 @@ where
= (a,{tst & tasknr = tasknr, options = options, userId = userId,html = html +|+ DivCode (showTaskNr thrTaskNr) nhtml}) = (a,{tst & tasknr = tasknr, options = options, userId = userId,html = html +|+ DivCode (showTaskNr thrTaskNr) nhtml})
administrateNewThread :: UserId *TSt -> *TSt administrateNewThread :: !UserId !*TSt -> *TSt
administrateNewThread ouserId tst =: {tasknr,userId,options} administrateNewThread ouserId tst =: {tasknr,userId,options}
| ouserId == userId = tst | ouserId == userId = tst
# newTaskId = iTaskId userId tasknr "_newthread" # newTaskId = iTaskId userId tasknr "_newthread"
# (chosen,tst=:{hst}) = LiftHst (mkStoreForm (Init,storageFormId options newTaskId False) id) tst // first time here ? # (chosen,tst=:{hst}) = liftHst (mkStoreForm (Init,storageFormId options newTaskId False) id) tst // first time here ?
| not chosen.value | not chosen.value
# (_,hst) = setPUserNewThread userId hst // yes, new thread created # (_,hst) = setPUserNewThread userId hst // yes, new thread created
# (_,tst) = LiftHst (mkStoreForm (Init,storageFormId options newTaskId False) (\_ -> True)) {tst & hst = hst} # (_,tst) = liftHst (mkStoreForm (Init,storageFormId options newTaskId False) (\_ -> True)) {tst & hst = hst}
= tst = tst
= tst = tst
...@@ -258,7 +258,7 @@ ThreadTableStorageGen :: !String !Lifespan !(ThreadTable -> ThreadTable) -> (Tas ...@@ -258,7 +258,7 @@ ThreadTableStorageGen :: !String !Lifespan !(ThreadTable -> ThreadTable) -> (Tas
ThreadTableStorageGen tableid lifespan fun = handleTable // to handle the table on server as well as on client ThreadTableStorageGen tableid lifespan fun = handleTable // to handle the table on server as well as on client
where where
handleTable tst handleTable tst
# (table,tst) = LiftHst (mkStoreForm (Init,storageFormId # (table,tst) = liftHst (mkStoreForm (Init,storageFormId
{ tasklife = lifespan { tasklife = lifespan
, taskstorage = PlainString , taskstorage = PlainString
, taskmode = NoForm , taskmode = NoForm
...@@ -316,7 +316,7 @@ copyThreadTableFromClient` {newThread,deletedThreads} tst ...@@ -316,7 +316,7 @@ copyThreadTableFromClient` {newThread,deletedThreads} tst
# (serverThreads,tst) = ServerThreadTableStorage (\_ -> newtable) tst // store table on server # (serverThreads,tst) = ServerThreadTableStorage (\_ -> newtable) tst // store table on server
= tst = tst
findThreadInTable :: !ThreadKind !TaskNr *TSt -> *(Maybe (!Int,!TaskThread),*TSt)// find thread that belongs to given tasknr findThreadInTable :: !ThreadKind !TaskNr !*TSt -> *(Maybe !(!Int,!TaskThread),!*TSt)// find thread that belongs to given tasknr
findThreadInTable threadkind tasknr tst findThreadInTable threadkind tasknr tst
# (table,tst) = ThreadTableStorage id tst // read thread table # (table,tst) = ThreadTableStorage id tst // read thread table
# pos = lookupThread tasknr 0 table // look if there is an entry for this task # pos = lookupThread tasknr 0 table // look if there is an entry for this task
...@@ -345,7 +345,7 @@ where ...@@ -345,7 +345,7 @@ where
foundThread AnyThread _ = True foundThread AnyThread _ = True
foundThread _ _ = abort "ZOU NIET MOGEN\n" //False foundThread _ _ = abort "ZOU NIET MOGEN\n" //False
insertNewThread :: !TaskThread *TSt -> *TSt // insert new thread in table insertNewThread :: !TaskThread !*TSt -> *TSt // insert new thread in table
insertNewThread thread tst insertNewThread thread tst
# (table,tst) = ThreadTableStorage id tst // read thread table # (table,tst) = ThreadTableStorage id tst // read thread table
# (_,tst) = ThreadTableStorage (\_ -> [thread:table]) tst // insert the new thread # (_,tst) = ThreadTableStorage (\_ -> [thread:table]) tst // insert the new thread
...@@ -427,7 +427,7 @@ serializeThread task ...@@ -427,7 +427,7 @@ serializeThread task
) )
(abort "Threads cannot be created, Ajax is switched off\n") // this call should not happen (abort "Threads cannot be created, Ajax is switched off\n") // this call should not happen
deserializeThread :: .String -> .(Task .a) deserializeThread :: !.String -> .(Task .a)
deserializeThread thread deserializeThread thread
= IF_Ajax = IF_Ajax
(IF_ClientServer (IF_ClientServer
...@@ -451,7 +451,7 @@ serializeThreadClient task ...@@ -451,7 +451,7 @@ serializeThreadClient task
) )
(abort "Threads cannot be created, Ajax is switched off\n") // this call should not happen (abort "Threads cannot be created, Ajax is switched off\n") // this call should not happen
deserializeThreadClient :: .String -> .(Task .a) deserializeThreadClient :: !.String -> .(Task .a)
deserializeThreadClient thread deserializeThreadClient thread
= IF_Ajax = IF_Ajax
(IF_ClientServer (IF_ClientServer
...@@ -464,19 +464,19 @@ deserializeThreadClient thread ...@@ -464,19 +464,19 @@ deserializeThreadClient thread
deserializeSapl thread = string_to_graph thread deserializeSapl thread = string_to_graph thread
deleteSubTasksAndThreads :: !TaskNr TSt -> TSt deleteSubTasksAndThreads :: !TaskNr !*TSt -> *TSt
deleteSubTasksAndThreads tasknr tst deleteSubTasksAndThreads tasknr tst
# tst=:{hst,userId,options} = deleteThreads tasknr tst # tst=:{hst,userId,options} = deleteThreads tasknr tst
| options.gc == NoCollect = tst | options.gc == NoCollect = tst
| otherwise = {tst & hst = deleteIData (iTaskId userId tasknr "") hst} | otherwise = {tst & hst = deleteIData (iTaskId userId tasknr "") hst}
deleteAllSubTasksAndThreads :: ![TaskNr] TSt -> TSt deleteAllSubTasksAndThreads :: ![TaskNr] !*TSt -> *TSt
deleteAllSubTasksAndThreads [] tst = tst deleteAllSubTasksAndThreads [] tst = tst
deleteAllSubTasksAndThreads [tx:txs] tst deleteAllSubTasksAndThreads [tx:txs] tst
# tst = deleteSubTasksAndThreads tx tst # tst = deleteSubTasksAndThreads tx tst
= deleteAllSubTasksAndThreads txs tst = deleteAllSubTasksAndThreads txs tst
showThreadTable :: *TSt -> (HtmlCode,*TSt) // watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !! showThreadTable :: !*TSt -> (!HtmlCode,!*TSt) // watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !!
showThreadTable tst=:{staticInfo} showThreadTable tst=:{staticInfo}
# thisUser = staticInfo.currentUserId # thisUser = staticInfo.currentUserId
# (tableS,tst) = ThreadTableStorage id tst // read thread table from server # (tableS,tst) = ThreadTableStorage id tst // read thread table from server
...@@ -525,8 +525,3 @@ showThreadNr [-1] = "Root" ...@@ -525,8 +525,3 @@ showThreadNr [-1] = "Root"
showThreadNr [-1:is] = showTaskNr is showThreadNr [-1:is] = showTaskNr is
showThreadNr else = "*" <+++ showTaskNr else showThreadNr else = "*" <+++ showTaskNr else
LiftHst fun tst=:{hst}
# (form,hst) = fun hst
= (form,{tst & hst = hst})
...@@ -15,6 +15,7 @@ appIData :: lift iData editors to iTask domain ...@@ -15,6 +15,7 @@ appIData :: lift iData editors to iTask domain
appIData2 :: lift iData editors to iTask domain, and pass iDataTasknumber in addition for naming convenience appIData2 :: lift iData editors to iTask domain, and pass iDataTasknumber in addition for naming convenience
appHStOnce :: lift iData *HSt domain to TSt domain, will be executed only once; string used for tracing appHStOnce :: lift iData *HSt domain to TSt domain, will be executed only once; string used for tracing
appHSt :: lift iData *HSt domain to TSt domain, will be executed on each invocation; string used for tracing appHSt :: lift iData *HSt domain to TSt domain, will be executed on each invocation; string used for tracing
liftHst :: lift iData *HSt domain to the TSt domain
appWorldOnce :: lift *World domain to TSt domain, will be executed only once; string used for tracing appWorldOnce :: lift *World domain to TSt domain, will be executed only once; string used for tracing
appWorld :: lift *World domain to TSt domain, will be executed on each invocation; string used for tracing appWorld :: lift *World domain to TSt domain, will be executed on each invocation; string used for tracing
*/ */
...@@ -25,6 +26,7 @@ appIData :: !(IDataFun a) -> Task a | iData a ...@@ -25,6 +26,7 @@ appIData :: !(IDataFun a) -> Task a | iData a
appIData2 :: !(!String !*HSt -> *(!Form a!,!*HSt)) -> Task a | iData a appIData2 :: !(!String !*HSt -> *(!Form a!,!*HSt)) -> Task a | iData a
appHStOnce :: !String !(!*HSt -> (!a,!*HSt)) -> Task a | iData a appHStOnce :: !String !(!*HSt -> (!a,!*HSt)) -> Task a | iData a
appHSt :: !String !(!*HSt -> (!a,!*HSt)) -> Task a | iData a appHSt :: !String !(!*HSt -> (!a,!*HSt)) -> Task a | iData a
liftHst :: !(*HSt -> *(.a,*HSt)) !*TSt -> *(.a,*TSt)
appWorldOnce :: !String !(!*World -> *(!a,!*World)) -> Task a | iData a appWorldOnce :: !String !(!*World -> *(!a,!*World)) -> Task a | iData a
appWorld :: !String !(!*World -> *(!a,!*World)) -> Task a | iData a appWorld :: !String !(!*World -> *(!a,!*World)) -> Task a | iData a
......
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