Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-libraries
Commits
0dff0aa8
Commit
0dff0aa8
authored
May 01, 2008
by
Rinus Plasmeijer
Browse files
*** empty log message ***
parent
52e551fc
Changes
3
Hide whitespace changes
Inline
Side-by-side
libraries/iTasks/InternaliTasksThreadHandling.dcl
View file @
0dff0aa8
...
...
@@ -30,35 +30,57 @@ import InternaliTasksCommon
instance
==
ThreadKind
showThreadNr
::
!
TaskNr
->
String
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
)
setPUserNr
::
!
Int
!(
Int
->
Int
)
!*
HSt
->
(!
GlobalInfo
,!*
HSt
)
clearIncPUser
::
!
Int
!(
Int
->
Int
)
!*
HSt
->
(!
GlobalInfo
,!*
HSt
)
administrateNewThread
::
UserId
*
TSt
->
*
TSt
mkTaskThread
::
!
SubPage
!(
Task
a
)
->
Task
a
|
iData
a
mkTaskThread2
::
!
ThreadKind
!(
Task
a
)
->
Task
a
// execute a thread
evalTaskThread
::
!
TaskThread
->
Task
a
// execute the thread !!!!
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
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
findThreadInTable
::
!
ThreadKind
!
TaskNr
*
TSt
->
*(
Maybe
(!
Int
,!
TaskThread
),*
TSt
)
// find thread that belongs to given tasknr
insertNewThread
::
!
TaskThread
*
TSt
->
*
TSt
// insert new thread in table
deleteThreads
::
!
TaskNr
!*
TSt
->
*
TSt
findParentThread
::
!
TaskNr
!*
TSt
->
*([
TaskThread
],*
TSt
)
// finds parent thread closest to given set of task numbers
serializeThread
::
!.(
Task
.
a
)
->
.
String
deserializeThread
::
.
String
->
.(
Task
.
a
)
serializeThreadClient
::
!(
Task
a
)
->
String
deserializeThreadClient
::
.
String
->
.(
Task
.
a
)
deleteSubTasksAndThreads
::
!
TaskNr
TSt
->
TSt
deleteAllSubTasksAndThreads
::
![
TaskNr
]
TSt
->
TSt
// Setting of global information for a particular user
setPUser
::
!
Int
!(
GlobalInfo
->
GlobalInfo
)
!*
HSt
->
(!
GlobalInfo
,!*
HSt
)
setPUserNr
::
!
Int
!(
Int
->
Int
)
!*
HSt
->
(!
GlobalInfo
,!*
HSt
)
clearIncPUser
::
!
Int
!(
Int
->
Int
)
!*
HSt
->
(!
GlobalInfo
,!*
HSt
)
// Displaying thread information
showThreadNr
::
!
TaskNr
->
String
showThreadTable
::
!*
TSt
->
(!
HtmlCode
,!*
TSt
)
// watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !!
// Thread creation
administrateNewThread
::
!
UserId
!*
TSt
->
*
TSt
mkTaskThread
::
!
SubPage
!(
Task
a
)
->
Task
a
|
iData
a
mkTaskThread2
::
!
ThreadKind
!(
Task
a
)
->
Task
a
// execute a thread
// Finding threads and evaluation of a thread
findThreadInTable
::
!
ThreadKind
!
TaskNr
!*
TSt
->
*(
Maybe
!(!
Int
,!
TaskThread
),!*
TSt
)
// find thread that belongs to given tasknr
findParentThread
::
!
TaskNr
!*
TSt
->
*([
TaskThread
],*
TSt
)
// finds parent thread closest to given set of task numbers
evalTaskThread
::
!
TaskThread
->
Task
a
// execute the thread !!!!
// Thread table management
insertNewThread
::
!
TaskThread
!*
TSt
->
*
TSt
// insert new thread in table
deleteThreads
::
!
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
)
libraries/iTasks/InternaliTasksThreadHandling.icl
View file @
0dff0aa8
...
...
@@ -9,7 +9,7 @@ implementation module InternaliTasksThreadHandling
import
StdList
,
StdFunc
,
StdEnv
import
dynamic_string
,
graph_to_string_with_descriptors
,
graph_to_sapl_string
import
iDataTrivial
,
iDataFormlib
import
InternaliTasksCommon
,
iTasksSettings
,
iTasksBasicCombinators
import
InternaliTasksCommon
,
iTasksSettings
,
iTasksBasicCombinators
,
iTasksLiftingCombinators
derive
gForm
Lifespan
,
GarbageCollect
,
StorageFormat
,
Mode
,
Options
,
GlobalInfo
,
TaskThread
,
ThreadKind
,
[]
derive
gUpd
Lifespan
,
GarbageCollect
,
StorageFormat
,
Mode
,
Options
,
GlobalInfo
,
TaskThread
,
ThreadKind
,
[]
...
...
@@ -206,14 +206,14 @@ where
=
(
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
}
|
ouserId
==
userId
=
tst
#
newTaskId
=
iTaskId
userId
tasknr
"_newthread"
#
(
chosen
,
tst
=:{
hst
})
=
L
iftHst
(
mkStoreForm
(
Init
,
storageFormId
options
newTaskId
False
)
id
)
tst
// first time here ?
#
(
chosen
,
tst
=:{
hst
})
=
l
iftHst
(
mkStoreForm
(
Init
,
storageFormId
options
newTaskId
False
)
id
)
tst
// first time here ?
|
not
chosen
.
value
#
(_,
hst
)
=
setPUserNewThread
userId
hst
// yes, new thread created
#
(_,
tst
)
=
L
iftHst
(
mkStoreForm
(
Init
,
storageFormId
options
newTaskId
False
)
(\_
->
True
))
{
tst
&
hst
=
hst
}
#
(_,
tst
)
=
l
iftHst
(
mkStoreForm
(
Init
,
storageFormId
options
newTaskId
False
)
(\_
->
True
))
{
tst
&
hst
=
hst
}
=
tst
=
tst
...
...
@@ -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
where
handleTable
tst
#
(
table
,
tst
)
=
L
iftHst
(
mkStoreForm
(
Init
,
storageFormId
#
(
table
,
tst
)
=
l
iftHst
(
mkStoreForm
(
Init
,
storageFormId
{
tasklife
=
lifespan
,
taskstorage
=
PlainString
,
taskmode
=
NoForm
...
...
@@ -316,7 +316,7 @@ copyThreadTableFromClient` {newThread,deletedThreads} tst
#
(
serverThreads
,
tst
)
=
ServerThreadTableStorage
(\_
->
newtable
)
tst
// store table on server
=
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
#
(
table
,
tst
)
=
ThreadTableStorage
id
tst
// read thread table
#
pos
=
lookupThread
tasknr
0
table
// look if there is an entry for this task
...
...
@@ -345,7 +345,7 @@ where
foundThread
AnyThread
_
=
True
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
#
(
table
,
tst
)
=
ThreadTableStorage
id
tst
// read thread table
#
(_,
tst
)
=
ThreadTableStorage
(\_
->
[
thread
:
table
])
tst
// insert the new thread
...
...
@@ -427,7 +427,7 @@ serializeThread task
)
(
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
=
IF_Ajax
(
IF_ClientServer
...
...
@@ -451,7 +451,7 @@ serializeThreadClient task
)
(
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
=
IF_Ajax
(
IF_ClientServer
...
...
@@ -464,19 +464,19 @@ deserializeThreadClient thread
deserializeSapl
thread
=
string_to_graph
thread
deleteSubTasksAndThreads
::
!
TaskNr
TSt
->
TSt
deleteSubTasksAndThreads
::
!
TaskNr
!*
TSt
->
*
TSt
deleteSubTasksAndThreads
tasknr
tst
#
tst
=:{
hst
,
userId
,
options
}
=
deleteThreads
tasknr
tst
|
options
.
gc
==
NoCollect
=
tst
|
otherwise
=
{
tst
&
hst
=
deleteIData
(
iTaskId
userId
tasknr
""
)
hst
}
deleteAllSubTasksAndThreads
::
![
TaskNr
]
TSt
->
TSt
deleteAllSubTasksAndThreads
::
![
TaskNr
]
!*
TSt
->
*
TSt
deleteAllSubTasksAndThreads
[]
tst
=
tst
deleteAllSubTasksAndThreads
[
tx
:
txs
]
tst
#
tst
=
deleteSubTasksAndThreads
tx
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
}
#
thisUser
=
staticInfo
.
currentUserId
#
(
tableS
,
tst
)
=
ThreadTableStorage
id
tst
// read thread table from server
...
...
@@ -525,8 +525,3 @@ showThreadNr [-1] = "Root"
showThreadNr
[
-1
:
is
]
=
showTaskNr
is
showThreadNr
else
=
"*"
<+++
showTaskNr
else
LiftHst
fun
tst
=:{
hst
}
#
(
form
,
hst
)
=
fun
hst
=
(
form
,{
tst
&
hst
=
hst
})
libraries/iTasks/iTasksLiftingCombinators.dcl
View file @
0dff0aa8
...
...
@@ -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
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
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
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
appIData2
::
!(!
String
!*
HSt
->
*(!
Form
a
!,!*
HSt
))
->
Task
a
|
iData
a
appHStOnce
::
!
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
appWorld
::
!
String
!(!*
World
->
*(!
a
,!*
World
))
->
Task
a
|
iData
a
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment