Commit 2584986d authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

*** empty log message ***


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@79 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 5b8bccd9
......@@ -25,7 +25,7 @@ derive write Void, TCl
defaultUser :== 0 // default id of user
// *********************************************************************************************************************************
// Setting options for any collection of iTask workflows
// Setting options for any collection of iTask workflows:
:: GarbageCollect = Collect // garbage collect iTask administration
| NoCollect // no garbage collection
......@@ -72,7 +72,7 @@ editTask :: create a task editor (with submit button) to edit a value of given
editTask :: !String !a -> Task a | iData a
editTaskPred :: !a !(a -> (Bool, [BodyTag])) -> Task a | iData a
/* standard monadic combinators on iTasks
/* standard monadic combinators on iTasks:
(=>>) :: for sequencing: bind
(#>>) :: for sequencing: bind, but no argument passed
return_V :: lift a value to the iTask domain and return it
......@@ -82,7 +82,7 @@ return_V :: lift a value to the iTask domain and return it
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b
return_V :: !a -> Task a | iCreateAndPrint a
/* prompting variants
/* prompting variants:
(?>>) :: prompt as long as task is active but not finished
(!>>) :: prompt when task is activated
(<<?) :: same as ?>>, except that prompt is displayed *after* task
......@@ -102,7 +102,7 @@ return_D :: return the value and show it in iData display format
return_VF :: ![BodyTag] !a -> Task a | iCreateAndPrint a
return_D :: !a -> Task a | gForm {|*|}, iCreateAndPrint a
/* Assign tasks to user with indicated id
/* Assign tasks to user with indicated id:
(@:) :: will prompt who is waiting for task with give name
(@::) :: same, default task name given
*/
......@@ -111,7 +111,7 @@ return_D :: !a -> Task a | gForm {|*|}, iCreateAndPrint a
(@:) infix 3 :: !(!String,!Int) !(Task a) -> Task a | iData a
(@::) infix 3 :: !Int !(Task a) -> Task a | iData a
/* Handling recursion and loops
/* Handling recursion and loops:
newTask :: use the to promote a (recursively) defined user function to as task
foreverTask :: infinitely repeating Task
repeatTask :: repeat Task until predict is valid
......@@ -125,7 +125,7 @@ seqTasks :: do all iTasks one after another, task completed when all done
*/
seqTasks :: ![(String,Task a)] -> Task [a] | iCreateAndPrint a
/* Choose Tasks
/* Choose Tasks:
buttonTask :: Choose the iTask when button pressed
chooseTask :: Choose one iTask from list, depending on button pressed, button horizontal displayed
chooseTaskV :: Choose one iTask from list, depending on button pressed, buttons vertical displayed
......@@ -171,7 +171,7 @@ waitForTimeTask :: !HtmlTime -> Task HtmlTime
waitForTimerTask:: !HtmlTime -> Task HtmlTime
waitForDateTask :: !HtmlDate -> Task HtmlDate
/* Experimental department
/* Experimental department:
Will not work when the tasks are garbage collected to soon !!
-!> :: a task, either finished or interrupted (by completion of the first task) is returned in the closure
if interrupted, the work done so far is returned (!) which can be continued somewhere else
......@@ -191,6 +191,14 @@ channel :: String (Task a) -> Task (TCl a,TCl a) | iCreateAndPrint a
closureTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a
closureLzTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a
/* Exception Handling:
<^> :: When exception of type e is Raised in Task a, catch it here and transfer it to type a.
Otherwise try a parent handler.
Raise :: Raises an exception; the type stored in the dynamic determines the handlers who can catch it
*/
(<^>) infix 1 :: !(e -> a) !(Task a) -> Task a | iData a & TC e // assigns an exception Handler
Raise :: e -> Task a | iCreate a & TC e // rases an exception
/* Lifting to iTask domain
(*>>) :: lift functions of type (TSt -> (a,TSt)) to iTask domain
......
......@@ -1329,8 +1329,8 @@ where
// Exception Handling
// ******************************************************************************************************
// to be implemented
// WORK IN PROGRESS
// the following implementation is not finished, nor tested, not working
serializeExceptionHandler :: !.(!Dynamic -> Task .a) -> .String
serializeExceptionHandler task = IF_Sapl (abort "Cannot serialize Server thread on Client\n") (copy_to_string task)
......@@ -1338,8 +1338,11 @@ serializeExceptionHandler task = IF_Sapl (abort "Cannot serialize Server thread
deserializeExceptionHandler :: .String -> .(!Dynamic -> Task a.)
deserializeExceptionHandler thread = IF_Sapl (abort "Cannot de-serialize Server thread on Client\n") (fst (copy_from_string {c \\ c <-: thread} ))
mkExceptionHandler :: !(a -> Bool) !(Task a) -> Task a | iData a // create an exception Handler
mkExceptionHandler pred task = newTask "exceptionHandler" evalTask
Raise :: e -> Task a | iCreate a & TC e
Raise e = RaiseDyn (dynamic e)
(<^>) infix 1 :: !(e -> a) !(Task a) -> Task a | iData a & TC e // create an exception Handler
(<^>) pred task = newTask "exceptionHandler" evalTask
where
evalTask tst=:{tasknr,activated,options,userId} // thread - task is not yet finished
# (mbthread,tst) = findThreadInTable tasknr tst // look if there is an entry for this task
......@@ -1347,31 +1350,47 @@ where
# tst = insertNewThread { thrTaskNr = tasknr
, thrUserId = userId
, thrOptions = options
, thrCallback = serializeExceptionHandler (Catch pred)
, thrCallbackClient = abort "no exceptions implemented" //serializeThreadClient (Catch pred)
, thrCallback = serializeExceptionHandler (Try pred)
, thrCallbackClient = "" //abort "no exceptions implemented" //serializeThreadClient (Catch pred)
, thrKind = ExceptionHandler
} tst
= task tst // do the regular task
= task tst // do the regular task
Catch :: !(a -> Bool) !Dynamic -> Task a | iData a
Catch pred (value :: a^)
| pred value = return_V value
Try :: !(e -> a) !Dynamic -> Task a | iData a & TC e
Try handler (exception :: e^) = catch1
with
catch1 tst=:{tasknr}
# tst = deleteSubTasks tasknr tst
= return_V (handler exception) tst
Try handler dyn = catch2
with
catch2 tst=:{tasknr}
# tst = deleteSubTasks tasknr tst
= RaiseDyn dyn tst
Raise :: !a -> Task a | iData a
Raise value = raise
RaiseDyn :: !Dynamic -> Task a | iCreate a
RaiseDyn value = raise
where
raise tst=:{tasknr}
# (mbthread,tst) = findParentThread tasknr tst // look for exception handler
| isNil mbthread = abort ("Exception raised, value: " +++ printToString value +++ ", but no handler installed") // no handler installed
/*
# thread = hd mbthread // thread found
| isMember thread.thrTaskNr versioninfo.deletedThreads // thread has been deleted is some past, version conflict
= ((True,Nothing,defaultUser,event,"Task does not exist anymore, please refresh",True,[tasknr]), tst)
*/
raise tst=:{tasknr,staticInfo,activated}
| not activated = (createDefault,tst)
# (mbthread,tst=:{hst}) = findParentThread tasknr tst // look for exception handler
| isNil mbthread = abort ("\nException raised, but no handler installed\n") // no handler installed
# thread = hd mbthread // thread found
# (version,hst) = setPUserNr staticInfo.currentUserId id hst // inspect global effects administration
| isMember thread.thrTaskNr version.value.deletedThreads // thread has been deleted is some past, version conflict
= abort ("\nException raised, but handler thread was deleted\n")
= evalException thread value {tst & html = BT [], hst = hst} // yes, *finally*, we heave found an handler
evalException :: !TaskThread !Dynamic -> Task a // execute the thread !!!!
evalException entry=:{thrTaskNr,thrUserId,thrOptions,thrCallback,thrCallbackClient} dynval = evalException`
where
evalException` tst=:{tasknr,options,userId,html}
# (doClient,noThread) = IF_Sapl (True,thrCallbackClient == "") (False,False)
| doClient && noThread = abort "Cannot execute thread on Client\n"
= IF_Sapl
(abort "exception handling not implemeneted") //(deserializeThreadClient thrCallbackClient)
(deserializeExceptionHandler thrCallback dynval {tst & tasknr = thrTaskNr, options = thrOptions, userId = thrUserId,html = BT []})
// ******************************************************************************************************
// Task Creation and Deletion Utilities
......
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