Commit 5f2f8ed9 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

*** empty log message ***

parent d296cd3c
definition module iTaskDB
// super simple database creation and access based on iData
// (c) mjp 2007
// choose the kind of storage you want to use
db_prefix :== "iDBase-"
:: DBid a
import iTasks
/*
mkDBid :: create a typed database identificator
only Database and TxtFile are currently supported
readDB :: read the database
writeDB :: write the database
readDB2 :: read the database, each and everytime the application is evaluated
dangerous: not referential transparent, only use it if you know what you are doing !
*/
mkDBid :: String Lifespan -> (DBid a)
readDB :: (DBid a) -> Task a | iData a
writeDB :: (DBid a) a -> Task a | iData a
readDB2 :: (DBid a) -> Task a | iData a
implementation module iTaskDB
// super simple database creation and access based on iData
// (c) mjp 2007
import iTasks, iDataFormlib, StdEnv, iDataTrivial
::DBid a :== (String,Lifespan)
// Common db access
readDB :: (DBid a) -> Task a | iData a
readDB name=:(idn,_) = appHSt ("readDB " +++ idn) (DB name id)
writeDB :: (DBid a) a -> Task a | iData a
writeDB name=:(idn,_) value = appHSt ("writeDB " +++ idn) (DB name (const value))
readDB2 :: (DBid a) -> Task a | iData a
readDB2 name=:(idn,_) = appHSt2 ("readDB2 " +++ idn) (DB name id)
DB :: (DBid a) (a -> a) *HSt -> (a,*HSt) | iData a
DB (name,storageKind) fun hst
# (form,hst) = mkStoreForm (Init,nFormId (db_prefix +++ name) createDefault <@ storageKind <@ NoForm) fun hst
= (form.value,hst)
mkDBid :: String Lifespan -> (DBid a)
mkDBid s Database
| and (map isControl (mkList s)) = abort (s <+++ " contains control characters which is illegal!...\n\n")
mkDBid s attr = (s,attr)
......@@ -283,12 +283,6 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
]
,hst)
where
// wrap maintask = scheduleWorkflows (newTask "main" (assignTaskTo False 0 ("main",maintask)))
// where
// clearIStore hst=:{world} /* would be nice but don't know how to clear this */
// # world = if testModeOn deleteAllStateFiles id world
// = (Void,{hst & world = world})
determine_prefix:: !UserId ![TaskNr] -> String
determine_prefix user [] = ""
determine_prefix user [[-1]] = ""
......
......@@ -34,7 +34,8 @@ getWorkflowStatus :: get status of workflow
deleteWorkflow :: delete iTask workflow; returns False if workflow does not exist anymore
suspendWorkflow :: suspend iTask workflow, all corresponding tasks will vanish temporally; returns False if workflow does not exist anymore
activateWorkflow :: activate the iTask workflow again; returns False if workflow does not exist anymore
changeWorkflowUser :: transfer the workflow task to the indicated user; returns False if workflow does not exist anymore
changeWorkflowUser :: transfer the workflow task to the indicated user; returns False if workflow does not exist anymore
waitforWorkflowWid :: looks in process table to find a workflow process with the indicated name; waits if it does not exist; returns Nothing if name is not unique
suspendMe :: suspend current workflow process; no effect on start task
deleteMe :: delete current workflow process; no effect on start task
......@@ -47,6 +48,7 @@ activateWorkflow :: !(Wid a) -> Task Bool
suspendWorkflow :: !(Wid a) -> Task Bool
deleteWorkflow :: !(Wid a) -> Task Bool
changeWorkflowUser :: !UserId !(Wid a) -> Task Bool
waitForWorkflowWid :: !String -> Task (Maybe (Wid a)) | iData a
suspendMe :: (Task Void)
deleteMe :: (Task Void)
......
......@@ -216,6 +216,36 @@ where
(FinishedWorkflow _ (val::a^) _) -> (Just val,{tst & activated = True}) // finished
_ -> (Nothing,{tst & activated = False}) // not yet
/*
waitForWorkflowWithName :: !String -> Task (Maybe a) | iData a
waitForWorkflowWithName labelSearched = newTask ("waiting for " +++ labelSearched) waitForResult`
where
waitForResult` tst
# ((_,wfls),tst) = workflowProcessStore id tst // read workflow process administration
# foundEntries = [i \\ i <- [0 ..] & wfl <- wfls | thd3 (getWorkflowWid wfl) == labelSearched]
| isEmpty foundEntries
= (Nothing,{tst & activated = False}) // entry does not exist
# entry = hd foundEntries // entry found; first entry is taken
# wfl = wfls!!(entry - 1) // fetch entry
= case wfl of // update process administration
(FinishedWorkflow _ (val::a^) _) -> (Just val,{tst & activated = True}) // finished
_ -> (Nothing,{tst & activated = False}) // not yet
*/
waitForWorkflowWid :: !String -> Task (Maybe (Wid a)) | iData a
waitForWorkflowWid labelSearched = newTask ("waiting for " +++ labelSearched) waitForResult`
where
waitForResult` tst
# ((_,wfls),tst) = workflowProcessStore id tst // read workflow process administration
# foundEntries = [i \\ i <- [1 ..] & wfl <- wfls | thd3 (getWorkflowWid wfl) == labelSearched]
| isEmpty foundEntries
// set True as experiment...
= (Nothing,{tst & activated = True}) // entry does not (yet) exist
| length foundEntries <> 1
= (Nothing,{tst & activated = True}) // there are more; illegal action; it is assumed that there is only one
# entry = hd foundEntries
= (Just (Wid (entry,getWorkflowWid (wfls!!(entry - 1)))),{tst & activated = True}) // entry found
deleteMe :: (Task Void)
deleteMe = deleteMe`
where
......
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