Commit 143e75f7 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 78646122
...@@ -17,7 +17,8 @@ derive gUpd Maybe ...@@ -17,7 +17,8 @@ derive gUpd Maybe
derive gForm Maybe derive gForm Maybe
derive gPrint Maybe derive gPrint Maybe
derive gParse Maybe derive gParse Maybe
derive read Maybe
derive write Maybe
// ****************************************************************************************************** // ******************************************************************************************************
// monads for combining iTasks // monads for combining iTasks
......
...@@ -13,7 +13,7 @@ db_prefix :== "iDBase-" ...@@ -13,7 +13,7 @@ db_prefix :== "iDBase-"
:: DBid a :: DBid a
/* /*
mkDBid :: create a typed database identificator; only Database and TxtFile are currently supported mkDBid :: either TxtFile or DataFile or Datbase (but switched on the appropriate options in iDataSettings)
readDB :: read the database readDB :: read the database
writeDB :: write the database writeDB :: write the database
*/ */
......
...@@ -17,11 +17,11 @@ derive gUpd Wid, WorkflowStatus, Maybe, [] ...@@ -17,11 +17,11 @@ derive gUpd Wid, WorkflowStatus, Maybe, []
derive gParse Wid, WorkflowStatus, Maybe derive gParse Wid, WorkflowStatus, Maybe
derive gPrint Wid, WorkflowStatus, Maybe derive gPrint Wid, WorkflowStatus, Maybe
derive gerda Wid, WorkflowStatus derive gerda Wid, WorkflowStatus
derive read Wid, WorkflowStatus derive read Wid, WorkflowStatus, Maybe
derive write Wid, WorkflowStatus derive write Wid, WorkflowStatus, Maybe
:: Wid a = Wid WorkflowLink // id of workflow process :: Wid a = Wid WorkflowLink // id of workflow process
:: WorflowProcess = ActiveWorkflow ProcessIds !(TCl !Dynamic) :: WorkflowProcess = ActiveWorkflow ProcessIds !(TCl !Dynamic)
| SuspendedWorkflow ProcessIds !(TCl !Dynamic) | SuspendedWorkflow ProcessIds !(TCl !Dynamic)
| FinishedWorkflow ProcessIds !Dynamic !(TCl !Dynamic) | FinishedWorkflow ProcessIds !Dynamic !(TCl !Dynamic)
| DeletedWorkflow ProcessIds | DeletedWorkflow ProcessIds
...@@ -36,10 +36,12 @@ where ...@@ -36,10 +36,12 @@ where
workflowProcessStoreName :== "Application" +++ "-ProcessTable" workflowProcessStoreName :== "Application" +++ "-ProcessTable"
derive gForm WorflowProcess derive gForm WorkflowProcess
derive gUpd WorflowProcess derive gUpd WorkflowProcess
derive gPrint WorflowProcess derive gPrint WorkflowProcess
derive gParse WorflowProcess derive gParse WorkflowProcess
derive read WorkflowProcess
derive write WorkflowProcess
gPrint{|Dynamic|} dyn pst = gPrint{|*|} (dynamic_to_string dyn) pst gPrint{|Dynamic|} dyn pst = gPrint{|*|} (dynamic_to_string dyn) pst
gParse{|Dynamic|} expr = case parseString expr of gParse{|Dynamic|} expr = case parseString expr of
...@@ -54,8 +56,18 @@ gUpd{|Dynamic|} (UpdSearch _ 0) a = (UpdDone,a) ...@@ -54,8 +56,18 @@ gUpd{|Dynamic|} (UpdSearch _ 0) a = (UpdDone,a)
gUpd{|Dynamic|} (UpdSearch v i) a = (UpdSearch v (i-1),a) gUpd{|Dynamic|} (UpdSearch v i) a = (UpdSearch v (i-1),a)
gUpd{|Dynamic|} (UpdCreate c) a = (UpdCreate c,dynamic 0) gUpd{|Dynamic|} (UpdCreate c) a = (UpdCreate c,dynamic 0)
gUpd{|Dynamic|} UpdDone a = (UpdDone,a) gUpd{|Dynamic|} UpdDone a = (UpdDone,a)
write{|Dynamic|} dyn pst = write{|*|} (dynamic_to_string dyn) pst
read{|Dynamic|} pst = case myread pst of
Read string i f = Read (string_to_dynamic {s` \\ s` <-: string}) i f
Fail f = Fail f
where
myread :: !*Write -> *Read .String
myread pst = read{|*|} pst
import DrupBasic
isValidWorkflowReference :: !WorflowProcess !ProcessIds -> Bool // checks whether pointer to workflow is still refering to to right entry in the table isValidWorkflowReference :: !WorkflowProcess !ProcessIds -> Bool // checks whether pointer to workflow is still refering to to right entry in the table
isValidWorkflowReference (ActiveWorkflow ids _) idsref = drop1tuple3 ids == drop1tuple3 idsref isValidWorkflowReference (ActiveWorkflow ids _) idsref = drop1tuple3 ids == drop1tuple3 idsref
isValidWorkflowReference (SuspendedWorkflow ids _) idsref = drop1tuple3 ids == drop1tuple3 idsref isValidWorkflowReference (SuspendedWorkflow ids _) idsref = drop1tuple3 ids == drop1tuple3 idsref
isValidWorkflowReference (FinishedWorkflow ids _ _) idsref = drop1tuple3 ids == drop1tuple3 idsref isValidWorkflowReference (FinishedWorkflow ids _ _) idsref = drop1tuple3 ids == drop1tuple3 idsref
...@@ -63,28 +75,28 @@ isValidWorkflowReference (DeletedWorkflow ids) idsref = drop1tuple3 ids == drop ...@@ -63,28 +75,28 @@ isValidWorkflowReference (DeletedWorkflow ids) idsref = drop1tuple3 ids == drop
drop1tuple3 (x,y,z) = (y,z) drop1tuple3 (x,y,z) = (y,z)
getWorkflowUser :: !WorflowProcess -> UserId // fetch user who should do the work getWorkflowUser :: !WorkflowProcess -> UserId // fetch user who should do the work
getWorkflowUser (ActiveWorkflow (userid,_,_) _) = userid getWorkflowUser (ActiveWorkflow (userid,_,_) _) = userid
getWorkflowUser (SuspendedWorkflow (userid,_,_) _) = userid getWorkflowUser (SuspendedWorkflow (userid,_,_) _) = userid
getWorkflowUser (FinishedWorkflow (userid,_,_) _ _) = userid getWorkflowUser (FinishedWorkflow (userid,_,_) _ _) = userid
getWorkflowUser (DeletedWorkflow (userid,_,_)) = userid getWorkflowUser (DeletedWorkflow (userid,_,_)) = userid
setWorkflowUser :: !UserId !WorflowProcess -> WorflowProcess // fetch user who should do the work setWorkflowUser :: !UserId !WorkflowProcess -> WorkflowProcess // fetch user who should do the work
setWorkflowUser nuserid (ActiveWorkflow (userid,procnr,wflab) task) = (ActiveWorkflow (nuserid,procnr,wflab) task) setWorkflowUser nuserid (ActiveWorkflow (userid,procnr,wflab) task) = (ActiveWorkflow (nuserid,procnr,wflab) task)
setWorkflowUser nuserid (SuspendedWorkflow (userid,procnr,wflab) task) = (SuspendedWorkflow (nuserid,procnr,wflab) task) setWorkflowUser nuserid (SuspendedWorkflow (userid,procnr,wflab) task) = (SuspendedWorkflow (nuserid,procnr,wflab) task)
setWorkflowUser nuserid (FinishedWorkflow (userid,procnr,wflab) dyn task) = (FinishedWorkflow (userid,procnr,wflab) dyn task) setWorkflowUser nuserid (FinishedWorkflow (userid,procnr,wflab) dyn task) = (FinishedWorkflow (userid,procnr,wflab) dyn task)
setWorkflowUser nuserid (DeletedWorkflow (userid,procnr,wflab)) = (DeletedWorkflow (nuserid,procnr,wflab)) setWorkflowUser nuserid (DeletedWorkflow (userid,procnr,wflab)) = (DeletedWorkflow (nuserid,procnr,wflab))
getTask :: !WorflowProcess -> Task Dynamic getTask :: !WorkflowProcess -> Task Dynamic
getTask (ActiveWorkflow (_,_,_) (TCl task)) = task getTask (ActiveWorkflow (_,_,_) (TCl task)) = task
getTask (SuspendedWorkflow (_,_,_) (TCl task)) = task getTask (SuspendedWorkflow (_,_,_) (TCl task)) = task
getTask (FinishedWorkflow (_,_,_) _ (TCl task)) = task getTask (FinishedWorkflow (_,_,_) _ (TCl task)) = task
isDeletedWorkflow :: !WorflowProcess -> Bool isDeletedWorkflow :: !WorkflowProcess -> Bool
isDeletedWorkflow (DeletedWorkflow _) = True isDeletedWorkflow (DeletedWorkflow _) = True
isDeletedWorkflow _ = False isDeletedWorkflow _ = False
workflowProcessStore :: !((!Int,![WorflowProcess]) -> (!Int,![WorflowProcess])) !*TSt -> (!(!Int,![WorflowProcess]),!*TSt) workflowProcessStore :: !((!Int,![WorkflowProcess]) -> (!Int,![WorkflowProcess])) !*TSt -> (!(!Int,![WorkflowProcess]),!*TSt)
workflowProcessStore wfs tst workflowProcessStore wfs tst
= IF_Ajax = IF_Ajax
(IF_ClientServer // we running both client and server (IF_ClientServer // we running both client and server
...@@ -147,7 +159,7 @@ where ...@@ -147,7 +159,7 @@ where
# (_,tst) = if active wfl (\tst -> (undef,tst)) tst // if new workflow is active, schedule it in # (_,tst) = if active wfl (\tst -> (undef,tst)) tst // if new workflow is active, schedule it in
= (Wid (entry,(userid,processid,label)),{tst & activated = True}) = (Wid (entry,(userid,processid,label)),{tst & activated = True})
findFreeEntry :: [WorflowProcess] Int -> (Bool,Int) findFreeEntry :: [WorkflowProcess] Int -> (Bool,Int)
findFreeEntry [] n = (False,n) findFreeEntry [] n = (False,n)
findFreeEntry [DeletedWorkflow _:wfls] n = (True,n) findFreeEntry [DeletedWorkflow _:wfls] n = (True,n)
findFreeEntry [_:wfls] n = findFreeEntry wfls (n + 1) findFreeEntry [_:wfls] n = findFreeEntry wfls (n + 1)
......
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