Skip to content

GitLab

Commit 52e551fc authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent c1da1286
Hide whitespace changes
Inline Side-by-side
libraries/iTasks/InternaliTasksCommon.dcl
View file @ 52e551fc
......@@ -47,17 +47,28 @@ import iTasksHandler
// Here follow some commonly used internal functions
/* Support for user defined combinators
mkTask :: for making a user defined combinator, name will appear intrace
incNr :: increment task number
mkTask :: to promote a function of proper type to a task
mkParSubTask :: create a subtask with indicated task nr
iTaskId :: generate an id based on the task nr, important for garbage collection and family relation
showTaskNr :: for identifier generation
deleteAllSubTasks :: collects all related tasks
printTrace2 :: show task tree trace
*/
incNr :: !TaskNr -> TaskNr
mkTask :: !String !(Task a) -> Task a | iCreateAndPrint a
mkParSubTask :: !String !Int (Task a) -> (Task a) | iCreateAndPrint a // two shifts are needed
incNr :: !TaskNr -> TaskNr
mkTask :: !String !(Task a) -> Task a | iCreateAndPrint a
mkParSubTask :: !String !Int (Task a) -> (Task a) | iCreateAndPrint a // two shifts are needed
iTaskId :: !Int !TaskNr !String -> String
showTaskNr :: !TaskNr -> String
deleteAllSubTasks :: ![TaskNr] TSt -> TSt
printTrace2 :: !(Maybe ![Trace]) -> BodyTag
showTaskNr :: !TaskNr -> String
printTrace2 :: !(Maybe ![Trace]) -> BodyTag
iTaskId :: !Int !TaskNr !String -> String
deleteAllSubTasks :: ![TaskNr] TSt -> TSt
// general iTask store, session store, page store, store but no form generation
cFormId :: !Options !String !a -> FormId a
sessionFormId :: !Options !String !a -> FormId a
......
libraries/iTasks/InternaliTasksCommon.icl
View file @ 52e551fc
......@@ -9,7 +9,6 @@ import iDataHandler, iDataFormData, iDataTrivial
import iTasksSettings
import iTasksHandler, InternaliTasksThreadHandling
showTaskNr :: !TaskNr -> String
showTaskNr [] = ""
showTaskNr [i] = toString i
......@@ -30,7 +29,6 @@ deleteAllSubTasks [tx:txs] tst=:{hst,userId}
# hst = deleteIData (iTaskId userId (tl tx) "") hst
= deleteAllSubTasks txs {tst & hst = hst}
// ******************************************************************************************************
// Task creation and printing
// ******************************************************************************************************
......@@ -73,13 +71,10 @@ where
where
mysubtask tst=:{tasknr} = task {tst & tasknr = [-1:tasknr], activated = True} // shift once again!
// ******************************************************************************************************
// Trace Printing...
// ******************************************************************************************************
InsertTrace :: !Bool !TaskNr !Int !Options String !String ![Trace] -> [Trace]
InsertTrace finished idx who options taskname val trace = InsertTrace` ridx who val trace
where
......
libraries/iTasks/StdiTasks.dcl
View file @ 52e551fc
......@@ -6,7 +6,6 @@ definition module StdiTasks
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
//
import
// iTask End User modules:
......
libraries/iTasks/iTasksHandler.dcl
View file @ 52e551fc
......@@ -19,8 +19,6 @@ derive gerda Void
derive read Void
derive write Void
iTaskVersion :== "0.991 - May 2008 - "
defaultWorkflowName :== "start" // name of initial workflow process
// iTask main task types:
......
libraries/iTasks/iTasksHandler.icl
View file @ 52e551fc
......@@ -8,10 +8,8 @@ implementation module iTasksHandler
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
//
import StdEnv, StdBimap, StdOrdList
import iDataSettings, iDataHandler, iDataTrivial, iDataButtons, iDataFormlib, iDataStylelib
import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string
import DrupBasic
import StdEnv
import iDataSettings, iDataHandler, iDataTrivial, iDataButtons, iDataFormlib
import iTasksSettings, InternaliTasksCommon, InternaliTasksThreadHandling
import iTasksBasicCombinators, iTasksProcessHandling, iTasksHtmlSupport
......@@ -41,8 +39,6 @@ where
// Initial values
defaultUser :== 0 // default id of user
defaultWorkflowName :== "start" // name of initial workflow process
//defaultWid :== 0 // initial workflow process id
initTst :: !UserId !Lifespan !Lifespan !*HSt -> *TSt
initTst thisUser itaskstorage threadstorage hst
......@@ -120,22 +116,6 @@ where (@>>) UseAjax task = \tst -> IF_Ajax
(mkTaskThread OnClient task tst)
(newTask "Client Thread Disabled" task tst)
determineUserOptions :: ![StartUpOptions] -> UserStartUpOptions
determineUserOptions startUpOptions = determineUserOptions` startUpOptions defaultStartUpOptions
where
determineUserOptions` [] options = options
determineUserOptions` [TraceOn:xs] options = determineUserOptions` xs {options & traceOn = True}
determineUserOptions` [TraceOff:xs] options = determineUserOptions` xs {options & traceOn = False}
determineUserOptions` [ThreadStorage nloc:xs] options = determineUserOptions` xs {options & threadStorageLoc = nloc}
determineUserOptions` [ShowUsers max:xs] options = determineUserOptions` xs {options & showUsersOn = if (max <= 0) Nothing (Just max)}
determineUserOptions` [VersionCheck:xs] options = determineUserOptions` xs {options & versionCheckOn = True}
determineUserOptions` [NoVersionCheck:xs] options = determineUserOptions` xs {options & versionCheckOn = False}
determineUserOptions` [MyHeader bodytag:xs] options = determineUserOptions` xs {options & headerOff = Just bodytag}
determineUserOptions` [TestModeOn:xs] options = determineUserOptions` xs {options & testModeOn = True}
determineUserOptions` [TestModeOff:xs] options = determineUserOptions` xs {options & testModeOn = False}
// ******************************************************************************************************
// *** wrappers for the end user, to be used in combination with an iData wrapper...
// ******************************************************************************************************
......@@ -164,17 +144,18 @@ multiUserTask startUpOptions maintask hst
workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b) !*HSt -> (!Bool,Html,*HSt) | iData b
workFlowTask startUpOptions taska userTask hst
# userOptions = determineUserOptions startUpOptions
# tst = initTst -1 Session userOptions.threadStorageLoc hst
# (((new,i),a),tst=:{activated,html,hst}) = taska tst // for doing the login
# userOptions = determineUserOptions startUpOptions
# tst = initTst -1 Session userOptions.threadStorageLoc hst
# (((new,i),a),tst=:{activated,html,hst})
= taska tst // for doing the login
| not activated
# iTaskHeader = [showHighLight "i-Task", showLabel " - Multi-User Workflow System ",Hr []]
# iTaskInfo = mkDiv "iTaskInfo" [showText "Login procedure... ", Hr []]
# iTaskHeader = [showHighLight "i-Task", showLabel " - Multi-User Workflow System ",Hr []]
# iTaskInfo = mkDiv "iTaskInfo" [showText "Login procedure... ", Hr []]
= mkHtmlExcep "workFlow" True [Ajax [ ("thePage",iTaskHeader ++ iTaskInfo ++ noFilter html) // Login ritual cannot be handled by client
]] hst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# tst = initTst i Session userOptions.threadStorageLoc hst
# (exception,body,hst) = startTstTask i True (False,[]) userOptions (newUserTask ((new,i),a) <<@ TxtFile) tst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# tst = initTst i Session userOptions.threadStorageLoc hst
# (exception,body,hst) = startTstTask i True (False,[]) userOptions (newUserTask ((new,i),a) <<@ TxtFile) tst
= mkHtmlExcep "workFlow" exception body hst
where
noFilter :: HtmlTree -> HtmlCode
......@@ -188,9 +169,22 @@ where
newUserTask ((True,i),a) = (spawnWorkflow i True (userTask i a)) =>> \_ -> return_V Void
newUserTask _ = return_V Void
determineUserOptions :: ![StartUpOptions] -> UserStartUpOptions
determineUserOptions startUpOptions = determineUserOptions` startUpOptions defaultStartUpOptions
where
determineUserOptions` [] options = options
determineUserOptions` [TraceOn:xs] options = determineUserOptions` xs {options & traceOn = True}
determineUserOptions` [TraceOff:xs] options = determineUserOptions` xs {options & traceOn = False}
determineUserOptions` [ThreadStorage nloc:xs] options = determineUserOptions` xs {options & threadStorageLoc = nloc}
determineUserOptions` [ShowUsers max:xs] options = determineUserOptions` xs {options & showUsersOn = if (max <= 0) Nothing (Just max)}
determineUserOptions` [VersionCheck:xs] options = determineUserOptions` xs {options & versionCheckOn = True}
determineUserOptions` [NoVersionCheck:xs] options = determineUserOptions` xs {options & versionCheckOn = False}
determineUserOptions` [MyHeader bodytag:xs] options = determineUserOptions` xs {options & headerOff = Just bodytag}
determineUserOptions` [TestModeOn:xs] options = determineUserOptions` xs {options & testModeOn = True}
determineUserOptions` [TestModeOff:xs] options = determineUserOptions` xs {options & testModeOn = False}
// ******************************************************************************************************
// Main routine for the creation of the workflow page
// *THE* main routine for the determination of the current state and the creation of a new workflow page
// ******************************************************************************************************
startTstTask :: !Int !Bool !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!Bool,!HtmlCode,!*HSt) | iData a
......@@ -198,7 +192,6 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
// prologue
| thisUser < 0 = abort "Users should have id's >= 0 !\n"
# (refresh,hst) = simpleButton refreshId "Refresh" id hst
# (traceAsked,hst) = simpleButton traceId "ShowTrace" (\_ -> True) hst
......@@ -218,13 +211,11 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
[Hr []]
| versionconflict
# iTaskInfo = mkDiv "iTaskInfo" [showLabel "Cannot apply request. Version conflict. Please refresh the page!", Hr []]
= (True,[Ajax [ ("thePage",iTaskHeader ++ iTaskInfo)
]
],hst)
= (True,[Ajax [("thePage",iTaskHeader ++ iTaskInfo)]],hst)
// Here the iTasks are evaluated ...
# maintask = scheduleWorkflows maintask // schedule all active tasks, not only maintask
# maintask = scheduleWorkflows maintask // schedule all active tasks, not only maintask
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{html,hst,trace,activated})
= ((IF_Ajax (startAjaxApplication thisUser pversion) startMainTask)
maintask) {tst & hst = hst, trace = if doTrace (Just []) Nothing, activated = True, html = BT []}
......@@ -316,14 +307,6 @@ where
[showTrace (IF_DataFile "" " - DataFile" )] ++
[Br,Hr []]
mkSTable2 :: [HtmlCode] -> BodyTag
mkSTable2 table
= Table [] (mktable table)
where
mktable table = [Tr [] (mkrow rows) \\ rows <- table]
mkrow rows = [Td [Td_VAlign Alo_Top] [row] \\ row <- rows]
Filter :: !Bool !UserId !HtmlTree !*HSt -> *(![BodyTag],![BodyTag],![BodyTag],![BodyTag],![BodyTag],!*HSt)
Filter wholepage thrOwner tree hst
# startuser = if wholepage defaultUser thrOwner
......@@ -390,28 +373,6 @@ where
// Any action requiering the calculation of the Task Tree from scratch will be done one the server
// Watch it: the Client cannot create new Server threads
startFromRoot :: !GlobalInfo !TaskNr ![TaskNr] !String !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
startFromRoot versioninfo eventnr tasknrs message maintask tst
= IF_ClientServer // we are running client server
(IF_ClientTasks
(stopClient eventnr tasknrs message) // client cannot evaluate from root of task tree, give it up
(evaluateFromRoot versioninfo eventnr tasknrs message maintask) tst // sever can evaluate from scratch
)
(evaluateFromRoot versioninfo eventnr tasknrs message maintask tst) // ajax can evaluate from scratch as well
where
stopClient :: !TaskNr ![TaskNr] !String !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
stopClient eventnr tasknrs message tst
= ((True,defaultUser,eventnr,message,tasknrs), tst)
evaluateFromRoot :: !GlobalInfo !TaskNr ![TaskNr] !String !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
evaluateFromRoot versioninfo eventnr tasknrs message maintask tst
# tst = deleteAllSubTasks versioninfo.deletedThreads tst // delete subtasks being obsolute
# (_,tst) = maintask tst // evaluate main application from scratch
# tst=:{activated} = copyThreadTableToClient tst // copy thread table to client, if applicable
# message = if activated "iTask application finished" message
= (((True,defaultUser,eventnr,message,tasknrs), {tst & activated = activated}))
startAjaxApplication :: !Int !GlobalInfo !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt) // determines which threads to execute and calls them..
startAjaxApplication thisUser versioninfo maintask tst=:{tasknr,options,html,trace,userId}
# tst = copyThreadTableFromClient versioninfo tst // synchronize thread tables of client and server, if applicable
......@@ -463,6 +424,27 @@ where
# (mbthread,tst) = findParentThread (tl parent.thrTaskNr) tst // look for thread to evaluate
= doParent mbthread maintask event [parent.thrTaskNr:accu] {tst & options = options}// continue with grand parent ...
startFromRoot :: !GlobalInfo !TaskNr ![TaskNr] !String !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
startFromRoot versioninfo eventnr tasknrs message maintask tst
= IF_ClientServer // we are running client server
(IF_ClientTasks
(stopClient eventnr tasknrs message) // client cannot evaluate from root of task tree, give it up
(evaluateFromRoot versioninfo eventnr tasknrs message maintask) tst // sever can evaluate from scratch
)
(evaluateFromRoot versioninfo eventnr tasknrs message maintask tst) // ajax can evaluate from scratch as well
where
stopClient :: !TaskNr ![TaskNr] !String !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
stopClient eventnr tasknrs message tst
= ((True,defaultUser,eventnr,message,tasknrs), tst)
evaluateFromRoot :: !GlobalInfo !TaskNr ![TaskNr] !String !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
evaluateFromRoot versioninfo eventnr tasknrs message maintask tst
# tst = deleteAllSubTasks versioninfo.deletedThreads tst // delete subtasks being obsolute
# (_,tst) = maintask tst // evaluate main application from scratch
# tst=:{activated} = copyThreadTableToClient tst // copy thread table to client, if applicable
# message = if activated "iTask application finished" message
= (((True,defaultUser,eventnr,message,tasknrs), {tst & activated = activated}))
......
libraries/iTasks/iTasksLiftingCombinators.dcl
View file @ 52e551fc
......@@ -10,21 +10,23 @@ import iTasksHandler
/*
(*>>) :: lift functions of type (TSt -> (a,TSt)) to iTask domain
(@>>) :: lift functions of (TSt -> TSt) to iTask domain
(*#>) :: lift functions of (TSt -> TSt) to iTask domain
appIData :: lift iData editors to iTask domain
appIData2 :: lift iData editors to iTask domain, and pass iDataTasknumber for naming convenience
appHStOnce :: lift HSt domain to TSt domain, will be executed only once; string used for tracing
appHSt :: lift HSt domain to TSt domain, will be executed on each invocation; string used for tracing
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
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
*/
(*=>) infix 4 :: (TSt -> (a,TSt)) (a -> Task b) -> Task b
(*#>) infix 4 :: (TSt -> TSt) (Task a) -> Task a
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
appWorldOnce :: !String (*World -> *(a,*World)) -> Task a | iData a
appWorld :: !String (*World -> *(a,*World)) -> Task a | iData a
(*=>) infix 4 :: !(!TSt -> (!a,!TSt)) !(a -> Task b) -> Task b
(*#>) infix 4 :: !(!TSt -> TSt) !(Task a) -> Task a
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
appWorldOnce :: !String !(!*World -> *(!a,!*World)) -> Task a | iData a
appWorld :: !String !(!*World -> *(!a,!*World)) -> Task a | iData a
......
libraries/iTasks/iTasksLiftingCombinators.icl
View file @ 52e551fc
......@@ -8,33 +8,21 @@ implementation module iTasksLiftingCombinators
//
import iTasksHandler, iTasksEditors, iTasksBasicCombinators
/*
(*>>) :: lift functions of type (TSt -> (a,TSt)) to iTask domain
(@>>) :: lift functions of (TSt -> TSt) to iTask domain
appIData :: lift iData editors to iTask domain
appIData2 :: lift iData editors to iTask domain, and pass iDataTasknumber for naming convenience
appHStOnce :: lift HSt domain to TSt domain, will be executed only once; string used for tracing
appHSt :: lift HSt domain to TSt domain, will be executed on each invocation; string used for tracing
*/
// ******************************************************************************************************
// lifters to iTask state
// Lifting HSt domain to the TSt domain, for convenience
(*=>) infix 4 :: (TSt -> (a,TSt)) (a -> Task b) -> (Task b)
(*=>) infix 4 :: !(TSt -> (!a,!TSt)) !(a -> Task b) -> (Task b)
(*=>) ftst b = doit
where
doit tst
# (a,tst) = ftst tst
= b a tst
(*#>) infix 4 :: (TSt -> TSt) (Task a) -> Task a
(*#>) infix 4 :: !(TSt -> TSt) !(Task a) -> Task a
(*#>) ftst b = doit
where
doit tst
# tst = ftst tst
= b tst
appIData :: (IDataFun a) -> (Task a) | iData a
appIData :: !(IDataFun a) -> (Task a) | iData a
appIData idatafun = \tst -> mkTask "appIData" (appIData` idatafun) tst
where
appIData` idata tst=:{tasknr,html,hst}
......@@ -43,7 +31,7 @@ where
= (idata.value,{tst & tasknr = tasknr,activated = activated, html = html +|+
(if activated (BT idata.form) (BT idata.form +|+ ahtml)), hst = hst})
appIData2 :: (String *HSt -> *(Form a,*HSt)) -> (Task a) | iData a
appIData2 :: !(!String !*HSt -> *(!Form a,!*HSt)) -> (Task a) | iData a
appIData2 idatafun = \tst -> mkTask "appIData" (appIData` idatafun) tst
where
appIData` idata tst=:{tasknr,html,hst,userId}
......@@ -53,23 +41,24 @@ where
= (idata.value,{tst & tasknr = tasknr,activated = activated, html = html +|+
(if activated (BT idata.form) (BT idata.form +|+ ahtml)), hst = hst})
appHStOnce :: !String (HSt -> (a,HSt)) -> (Task a) | iData a
appHStOnce :: !String !(HSt -> (!a,!HSt)) -> (Task a) | iData a
appHStOnce label fun = Once label (liftHst fun)
appHSt :: !String (HSt -> (a,HSt)) -> (Task a) | iData a
appHSt :: !String !(!HSt -> (!a,!HSt)) -> (Task a) | iData a
appHSt label fun = mkTask label (liftHst fun)
liftHst :: !(*HSt -> *(.a,*HSt)) !*TSt -> *(.a,*TSt)
liftHst fun tst=:{hst}
# (fvalue,hst) = fun hst
= (fvalue,{tst & hst = hst})
# (form,hst) = fun hst
= (form,{tst & hst = hst})
appWorldOnce :: !String (*World -> *(a,*World)) -> (Task a) | iData a
appWorldOnce :: !String !(!*World -> *(!a,!*World)) -> (Task a) | iData a
appWorldOnce label fun = Once label (liftWorld fun)
appWorld :: !String (*World -> *(a,*World)) -> (Task a) | iData a
appWorld :: !String !(*World -> *(!a,!*World)) -> (Task a) | iData a
appWorld label fun = mkTask label (liftWorld fun)
liftWorld :: (*World -> *(a,*World)) *TSt -> *(a,*TSt)
liftWorld :: !(*World -> !*(!a,!*World)) !*TSt -> !*(!a,!*TSt)
liftWorld fun tst=: {hst = hst=:{world = world=:{worldC}}}
# (fvalue,theWorld) = fun worldC
= (fvalue,{tst & hst = {hst & world = {world & worldC = theWorld}}})
......
libraries/iTasks/iTasksSettings.dcl
View file @ 52e551fc
definition module iTasksSettings
// *********************************************************************************************************************************
// Costumize the iTasks
// Costumize some global constants
// *********************************************************************************************************************************
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
......@@ -9,6 +9,8 @@ definition module iTasksSettings
import StdOverloaded
import iDataHtmlDef, iDataStylelib, iDataTrivial
iTaskVersion :== "0.991 - May 2008 - "
defaultWorkflowName :== "start"
traceId :== "User_Trace"
refreshId :== "User_refresh"
applicationVersionNr :== ThisExe <+++ "_Version"
......
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