Commit 6d3d0156 authored by Steffen Michels's avatar Steffen Michels

added group-actions

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@970 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent ab3a4b9f
......@@ -28,10 +28,10 @@ getFile id =
Nothing = undef
(Just file) = return file
getAllFileNames :: Task [((DBRef TextFile), FileName)]
getAllFileNames :: Task [(FileName, Hidden (DBRef TextFile))]
getAllFileNames =
dbReadAll
>>= \files. return (map (\f -> (f.fileId, f.TextFile.name)) files)
>>= \files. return (map (\f -> (f.TextFile.name, Hidden f.fileId)) files)
:: AppState = AppState Note (Maybe TextFile)
......@@ -51,19 +51,16 @@ openFile id sid =
>>= \file. writeDB sid (AppState file.TextFile.content (Just file))
>>| stop
open :: (DBid AppState) -> Task GAction
open :: (DBid AppState) -> Task Void
open sid =
getAllFileNames
>>= \files. if (isEmpty files)
( showMessage "No files to open!"
>>| return GContinue
)
( enterChoiceA "Open File" [ButtonAction (ActionCancel, Always), ButtonAction (ActionOk, IfValid)] files
>>= \(action,(fid,name)). case action of
ActionOk = addToRecentlyOpened name fid
>>| openFile fid sid
>>| return GContinue
_ = return GContinue
(showMessage "No files to open!")
( enterChoiceA "Open File" [ButtonAction (ActionCancel, Always), ButtonAction (ActionOk, IfValid)] files
>>= \(action,(name, Hidden fid)). case action of
ActionOk = addToRecentlyOpened name fid
>>| openFile fid sid
_ = stop
)
save :: (DBid AppState) -> Task Void
......@@ -73,15 +70,15 @@ save sid =
>>= \file. writeDB sid (AppState ntxt (Just file))
>>| stop
saveAs :: (DBid AppState) -> Task GAction
saveAs :: (DBid AppState) -> Task Void
saveAs sid =
enterInformationA "Save As: enter name" [ButtonAction (ActionCancel, Always), ButtonAction (ActionOk, IfValid)]
>>= \(action,name). case action of
ActionOk = readDB sid
>>= \(AppState txt _). storeFile name txt
>>= \file. writeDB sid (AppState file.TextFile.content (Just file))
>>| return GContinue
_ = return GContinue
>>| stop
_ = stop
:: Replace = { searchFor :: String
, replaceWith :: String
......@@ -94,14 +91,16 @@ derive gUpdate Replace
ActionReplaceAll :== ActionLabel "Replace All"
ActionClose :== ActionLabel "Close"
replaceT :: (DBid AppState) -> Task GAction
replaceT sid =
enterInformationA "Replace..." [ButtonAction (ActionClose, Always), ButtonAction (ActionReplaceAll, IfValid)]
>>= \(action, v). case action of
ActionReplaceAll = readDB sid
>>= \(AppState (Note txt) file). writeDB sid (AppState (Note (replaceSubString v.searchFor v.replaceWith txt)) file)
>>| replaceT sid <<@ subtaskBehaviour
_ = return GContinue
replaceT :: (DBid AppState) -> Task Void
replaceT sid = replaceT` {searchFor = "", replaceWith = ""}
where
replaceT` repl =
updateInformationA "Replace..." [ButtonAction (ActionClose, Always), ButtonAction (ActionReplaceAll, IfValid)] repl
>>= \(action, v). case action of
ActionReplaceAll = readDB sid
>>= \(AppState (Note txt) file). writeDB sid (AppState (Note (replaceSubString v.searchFor v.replaceWith txt)) file)
>>| replaceT` v <<@ subtaskBehaviour
_ = stop
:: TextStatistics = { lines :: Int
, words :: Int
......@@ -112,73 +111,60 @@ derive gParse TextStatistics
derive gVisualize TextStatistics
derive gUpdate TextStatistics
statistics :: (DBid AppState) -> Task GAction
statistics sid =
updateShared "Statistics" [ButtonAction (ActionOk, Always)] sid [statsListener]
>>| return GContinue
statistics :: (DBid AppState) -> Task Void
statistics sid = ignoreResult (updateShared "Statistics" [ButtonAction (ActionOk, Always)] sid [statsListener])
where
statsListener = listener {listenerFrom = \(AppState (Note text) _) -> let txt = trim text in {lines = length (split "\n" txt), words = length (split " " (replaceSubString "\n" " " txt)), characters = textSize txt}}
about :: Task GAction
about =
showMessage "iTextEditor V0.01"
>>| return GContinue
initState :: AppState
initState = AppState (Note "") Nothing
actionOpenFile = "openFile"
recOpenedMenu = "recOpened"
addToRecentlyOpened :: String (DBRef TextFile) -> Task Void
addToRecentlyOpened name (DBRef id) =
getMenuItem "recOpened"
getMenuItem recOpenedMenu
>>= \item. case item of
Just (SubMenu label entries) = setMenuItem "recOpened" (SubMenu label (take 5[MenuItem name (ActionParam "openFile" (toString id)):entries]))
Just (SubMenu label entries) = setMenuItem recOpenedMenu (SubMenu label (take 5[MenuItem name (ActionParam actionOpenFile (toString id)):entries]))
_ = return Void
ActionReplace :== ActionLabel "replace"
ActionStats :== ActionLabel "stats"
textEditorMain :: (DBid AppState) -> Task GAction
textEditorMain sid = GBFixed @>> (
updateShared "Text Editor" [MenuParamAction ("openFile", Always):map MenuAction actions] sid [titleListener,mainEditor]
>>= \(action, _). case action of
ActionNew = writeDB sid initState >>| return (GExtend [textEditorMain sid])
ActionOpen = return (GExtend [textEditorMain sid, open sid <<@ GBModal])
ActionParam "openFile" fid = openFile (DBRef (toInt fid)) sid >>| return (GExtend [textEditorMain sid])
ActionSave = save sid >>| return (GExtend [textEditorMain sid])
ActionSaveAs = return (GExtend [textEditorMain sid, saveAs sid <<@ GBModal])
ActionReplace = return (GExtend [textEditorMain sid, replaceT sid <<@ subtaskBehaviour])
ActionStats = return (GExtend [textEditorMain sid, statistics sid <<@ subtaskBehaviour])
ActionShowAbout = return (GExtend [textEditorMain sid, about <<@ subtaskBehaviour])
_ = return GStop)
textEditorMain :: (DBid AppState) -> Task Void
textEditorMain sid = GBFixed @>> ignoreResult (updateShared "Text Editor" [] sid [titleListener,mainEditor])
where
actions = [ (ActionNew, Always)
, (ActionOpen, Always)
, (ActionSave, (Predicate (\(Valid (AppState _ file)) -> isJust file)))
, (ActionSaveAs, Always)
, (ActionQuit, Always)
, (ActionReplace, (Predicate (\(Valid (AppState (Note txt) _)) -> txt <> "")))
, (ActionStats, Always)
, (ActionShowAbout, Always)
]
titleListener = listener {listenerFrom = \(AppState _ file) -> mkTitle file}
titleListener = listener { listenerFrom = \(AppState _ file) -> case file of
Nothing = "New Text Document"
Just f = f.TextFile.name
}
mainEditor = editor { editorFrom = \(AppState txt _) -> txt
, editorTo = \ntxt (AppState _ file) -> AppState ntxt file
}
mkTitle file = case file of
Nothing = "New Text Document"
(Just f) = f.TextFile.name
textEditorApp :: Task Void
textEditorApp =
createDB initState
>>= \sid. dynamicGroup [textEditorMain sid]
>>= \sid. dynamicGroupAOnly [textEditorMain sid] (groupActions sid)
>>| deleteDB sid
where
groupActions sid = [ GroupAction ActionNew (GOExtend [ignoreResult (writeDB sid initState)]) GroupAlways
, GroupAction ActionOpen (GOExtend [open sid <<@ GBModal]) GroupAlways
, GroupActionParam actionOpenFile (\fid -> GOExtend [openFile (DBRef (toInt fid)) sid]) GroupAlways
, GroupAction ActionSave (GOExtend [save sid]) (SharedPredicate sid (\(SharedValue (AppState _ file)) -> isJust file))
, GroupAction ActionSaveAs (GOExtend [saveAs sid <<@ GBModal]) GroupAlways
, GroupAction ActionReplace (GOExtend [replaceT sid <<@ subtaskBehaviour]) (SharedPredicate sid (\(SharedValue (AppState (Note txt) _)) -> txt <> ""))
, GroupAction ActionStats (GOExtend [statistics sid <<@ subtaskBehaviour]) GroupAlways
, GroupAction ActionShowAbout (GOExtend [showMessage "iTextEditor V0.01" <<@ subtaskBehaviour]) GroupAlways
, GroupAction ActionQuit GOStop GroupAlways
]
initTextEditor :: Task Void
initTextEditor = setMenus
[ Menu "File" [ MenuItem "New" ActionNew
, MenuItem "Open..." ActionOpen
, MenuName "recOpened" (SubMenu "Recently Opened" [])
, MenuName recOpenedMenu (SubMenu "Recently Opened" [])
, MenuSeparator
, MenuItem "Save" ActionSave
, MenuItem "Save As..." ActionSaveAs
......
......@@ -534,7 +534,9 @@ getAction updates buttonActions tst
| index <> -1
= (Just (buttonActions !! index),tst)
| otherwise
= (parseString (http_getValue "menu" updates ""),tst)
= case parseString (http_getValue "menu" updates "") of
Nothing = (parseString (http_getValue "menuAndGroup" updates ""),tst)
res = (res,tst)
getButtonActions :: ![TaskAction a] -> [ActionWithCond a]
getButtonActions actions = map getAction (filter isButtonAction actions)
......
......@@ -13,12 +13,15 @@ from Types import :: User (..), :: UserName
:: LabeledTask a :== (!String,!Task a)
//Grouping composition
:: GAction = GStop | GContinue | GExtend [Task GAction]
derive gParse GAction
derive gPrint GAction
derive gVisualize GAction
derive gUpdate GAction
dynamicGroup :: ![Task GAction] -> Task Void
:: GAction = GStop | GContinue | GExtend [Task GAction]
:: GOnlyAction = GOStop | GOContinue | GOExtend [Task Void]
derive gParse GAction, GOnlyAction
derive gPrint GAction, GOnlyAction
derive gVisualize GAction, GOnlyAction
derive gUpdate GAction, GOnlyAction
dynamicGroup :: ![Task GAction] -> Task Void
dynamicGroupA :: ![Task GAction] ![GroupAction GAction Void s] -> Task Void | iTask s
dynamicGroupAOnly :: ![Task Void] ![GroupAction GOnlyAction Void s] -> Task Void | iTask s
(-||-) infixr 3 :: !(Task a) !(Task a) -> Task a | iTask a
(||-) infixr 3 :: !(Task a) !(Task b) -> Task b | iTask a & iTask b
......
......@@ -21,31 +21,46 @@ import GenVisualize, GenUpdate
derive gPrint Either
derive gParse Either
derive gParse GAction
derive gPrint GAction
derive gVisualize GAction
derive gUpdate GAction
derive gParse GAction, GOnlyAction, GroupedBehaviour
derive gPrint GAction, GOnlyAction, GroupedBehaviour
derive gVisualize GAction, GOnlyAction, GroupedBehaviour
derive gUpdate GAction, GOnlyAction, GroupedBehaviour
derive bimap Maybe, (,)
//Grouping combinators
emptyGActionL :: [GroupAction a b Void]
emptyGActionL = []
dynamicGroup :: ![Task GAction] -> Task Void
dynamicGroup initTasks = group "dynamicGroup" "A simple group with dynamically added tasks" procfun id Void initTasks
dynamicGroup initTasks = dynamicGroupA initTasks emptyGActionL
dynamicGroupA :: ![Task GAction] ![GroupAction GAction Void s] -> Task Void | iTask s
dynamicGroupA initTasks gActions = group "dynamicGroup" "A simple group with dynamically added tasks" procfun id Void initTasks gActions
where
procfun (action,_) _ = case action of
GStop = (Void, Stop)
GContinue = (Void, Continue)
GExtend tasks = (Void, Extend tasks)
dynamicGroupAOnly :: ![Task Void] ![GroupAction GOnlyAction Void s] -> Task Void | iTask s
dynamicGroupAOnly initTasks gActions = group "dynamicGroup" "A simple group with dynamically added tasks" procfun id Void (changeTasksType initTasks) gActions
where
procfun (action,_) _ = case action of
GOStop = (Void, Stop)
GOContinue = (Void, Continue)
GOExtend tasks = (Void, Extend (changeTasksType tasks))
changeTasksType tasks = map (\t -> (t >>| return GOContinue) <<@ getGroupedBehaviour t) tasks
getGroupedBehaviour (Task td=:{TaskDescription|groupedBehaviour} _ _) = groupedBehaviour
(-||-) infixr 3 :: !(Task a) !(Task a) -> (Task a) | iTask a
(-||-) taska taskb = group "-||-" "Done when either subtask is finished." orfunc hd [] [taska,taskb]
(-||-) taska taskb = group "-||-" "Done when either subtask is finished." orfunc hd [] [taska,taskb] emptyGActionL
where
orfunc (val,_) [] = ([val],Stop)
orfunc (val,_) _ = abort "Multiple results in OR"
(||-) infixr 3 :: !(Task a) !(Task b) -> Task b | iTask a & iTask b
(||-) taska taskb
= group "||-" "Done when the second subtask is finished." rorfunc hd [] [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)]
= group "||-" "Done when the second subtask is finished." rorfunc hd [] [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)] emptyGActionL
where
rorfunc (Right val,_) [] = ([val],Stop)
rorfunc (Left val, _) [] = ([],Continue)
......@@ -53,14 +68,14 @@ where
(-||) infixl 3 :: !(Task a) !(Task b) -> Task a | iTask a & iTask b
(-||) taska taskb
= group "||-" "Done when the first subtask is finished" lorfunc hd [] [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)]
= group "||-" "Done when the first subtask is finished" lorfunc hd [] [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)] emptyGActionL
where
lorfunc (Right val,_) [] = ([],Continue)
lorfunc (Left val, _) [] = ([val],Stop)
lorfunc _ _ = abort "Illegal result in -||"
(-&&-) infixr 4 :: !(Task a) !(Task b) -> (Task (a,b)) | iTask a & iTask b
(-&&-) taska taskb = group "-&&-" "Done when both subtasks are finished" andfunc parseresult (Nothing,Nothing) [(taska >>= \a -> return (Left a)),(taskb >>= \b -> return (Right b))]
(-&&-) taska taskb = group "-&&-" "Done when both subtasks are finished" andfunc parseresult (Nothing,Nothing) [(taska >>= \a -> return (Left a)),(taskb >>= \b -> return (Right b))] emptyGActionL
where
andfunc :: ((Either a b),Int) (Maybe a, Maybe b) -> ((Maybe a, Maybe b),PAction (Task (Either a b)))
andfunc (val,_) (left,right)
......@@ -81,13 +96,13 @@ where
anyTask :: ![Task a] -> Task a | iTask a
anyTask [] = getDefaultValue
anyTask tasks = group "any" "Done when any subtask is finished" anyfunc hd [] tasks
anyTask tasks = group "any" "Done when any subtask is finished" anyfunc hd [] tasks emptyGActionL
where
anyfunc (val,_) [] = ([val],Stop)
anyfunc (val,_) _ = abort "Multiple results in ANY"
allTasks :: ![Task a] -> Task [a] | iTask a
allTasks tasks = group "all" "Done when all subtasks are finished" (allfunc(length tasks)) sortByIndex [] tasks
allTasks tasks = group "all" "Done when all subtasks are finished" (allfunc(length tasks)) sortByIndex [] tasks emptyGActionL
where
allfunc tlen (val,idx) st
# st = st ++ [(idx,val)]
......@@ -95,7 +110,7 @@ where
| otherwise = (st,Continue)
eitherTask :: !(Task a) !(Task b) -> Task (Either a b) | iTask a & iTask b
eitherTask taska taskb = group "either" "Done when either subtask is finished" eitherfunc hd [] [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)]
eitherTask taska taskb = group "either" "Done when either subtask is finished" eitherfunc hd [] [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)] emptyGActionL
where
eitherfunc (val,idx) [] = ([val],Stop)
eitherfunc (val,idx) _ = abort "Multiple results in Either"
......@@ -150,7 +165,7 @@ where
//derive bimap (,)
oldParallel :: !String !([a] -> Bool) ([a] -> b) ([a] -> b) ![Task a] -> Task b | iTask a & iTask b
oldParallel label pred f_pred f_all tasks = group label label aggregate finalize (False,[]) tasks
oldParallel label pred f_pred f_all tasks = group label label aggregate finalize (False,[]) tasks emptyGActionL
where
aggregate x (match,xs) = let xs` = [x:xs] in
if (length xs` == length tasks)
......@@ -172,7 +187,7 @@ where
(-&?&-) infixr 4 :: !(Task (Maybe a)) !(Task (Maybe b)) -> Task (Maybe (a,b)) | iTask a & iTask b
(-&?&-) taska taskb
= group "-&?&-" "Done when both subtasks are finished. Yields only a result of both subtasks have a result" mbandfunc parsefunc (Nothing,Nothing) [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)]
= group "-&?&-" "Done when both subtasks are finished. Yields only a result of both subtasks have a result" mbandfunc parsefunc (Nothing,Nothing) [taska >>= \a -> return (Left a),taskb >>= \b -> return (Right b)] emptyGActionL
where
mbandfunc (val,_) (left,right)
= case val of
......
......@@ -6,6 +6,7 @@ definition module CoreCombinators
from Types import :: Task, :: TaskPriority
from Time import :: Timestamp
from TaskTree import :: TaskParallelType, :: GroupedBehaviour
from ProcessDB import :: Action
from iTasks import class iTask(..)
......@@ -111,10 +112,16 @@ class PActionClass t where
instance PActionClass AssignedTask
instance PActionClass Task
//parallel :: !TaskParallelType !String !String !((a,Int) b -> (b,PAction AssignedTask a)) (b -> c) !b ![AssignedTask a] -> Task c | iTask a & iTask b & iTask c
parallel :: !TaskParallelType !String !String !((a,Int) b -> (b,PAction (AssignedTask a))) (b -> c) !b ![AssignedTask a] -> Task c | iTask a & iTask b & iTask c
//group :: !String !String !((a,Int) b -> (b,PAction Task a)) (b -> c) !b ![Task a] -> Task c | iTask a & iTask b & iTask c
group :: !String !String !((a,Int) b -> (b,PAction (Task a))) (b -> c) !b ![Task a] -> Task c | iTask a & iTask b & iTask c
:: GroupAction a b s = GroupAction Action a (GroupCondition b s)
| GroupActionParam String (String -> a) (GroupCondition b s)
:: GroupCondition a b = GroupAlways
| StatePredicate (a -> Bool)
| SharedPredicate (DBid b) ((SharedValue b) -> Bool)
:: SharedValue a = SharedDeleted
| SharedValue a
parallel :: !TaskParallelType !String !String !((a,Int) b -> (b,PAction (AssignedTask a))) (b -> c) !b ![AssignedTask a] -> Task c | iTask a & iTask b & iTask c
group :: !String !String !((a,Int) b -> (b,PAction (Task a))) (b -> c) !b ![Task a] ![GroupAction a b s] -> Task c | iTask a & iTask b & iTask c & iTask s
// Multi-user workflows
......
......@@ -5,7 +5,7 @@ from StdFunc import id, const
from TaskTree import :: TaskParallelType
import TSt
import Util
import Util, Http
import GenUpdate
import UserDB, ProcessDB
import Store
......@@ -132,29 +132,55 @@ import GenPrint
derive gPrint PAction
parallel :: !TaskParallelType !String !String !((a,Int) b -> (b,PAction (AssignedTask a))) (b -> c) !b ![AssignedTask a] -> Task c | iTask a & iTask b & iTask c
//parallel :: !TaskParallelType !String !String !((a,Int) b -> (b,PAction AssignedTask a)) (b -> c) !b ![AssignedTask a] -> Task c | iTask a & iTask b & iTask c
parallel type label description procFun parseFun initState initTask = execInParallel (Just type) label description procFun parseFun initState initTask
parallel type label description procFun parseFun initState initTask = execInParallel (Just type) label description procFun parseFun initState initTask nothing
where
nothing :: Maybe [GroupAction a b Void]
nothing = Nothing
group :: !String !String !((a,Int) b -> (b,PAction (Task a))) (b -> c) !b ![Task a] -> Task c | iTask a & iTask b & iTask c
//group :: !String !String !((a,Int) b -> (b,PAction Task a)) (b -> c) !b ![Task a] -> Task c | iTask a & iTask b & iTask c
group label description procFun parseFun initState initTasks = execInParallel Nothing label description procFun parseFun initState initTasks
group :: !String !String !((a,Int) b -> (b,PAction (Task a))) (b -> c) !b ![Task a] ![GroupAction a b s] -> Task c | iTask a & iTask b & iTask c & iTask s
group label description procFun parseFun initState initTasks groupActions = execInParallel Nothing label description procFun parseFun initState initTasks (Just groupActions)
execInParallel :: !(Maybe TaskParallelType) !String !String !((a,Int) b -> (b,PAction (t a))) (b->c) !b ![t a] -> Task c | iTask a & iTask b & iTask c & PActionClass t
//execInParallel :: !(Maybe TaskParallelType) !String !String !((a,Int) b -> (b,PAction t a)) (b->c) !b ![t a] -> Task c | iTask a & iTask b & iTask c & PActionClass t
execInParallel mbParType label description procFun parseFun initState initTasks =
execInParallel :: !(Maybe TaskParallelType) !String !String !((a,Int) b -> (b,PAction (t a))) (b->c) !b ![t a] !(Maybe [GroupAction a b s]) -> Task c | iTask a & iTask b & iTask c & PActionClass t & iTask s
execInParallel mbParType label description procFun parseFun initState initTasks mbGroupActions =
case mbParType of
(Nothing) = makeTaskNode label Nothing execInParallel`
(Just pt) = makeTaskNode label (Just (mkTpi pt)) execInParallel`
where
execInParallel` tst=:{taskNr}
execInParallel` tst=:{taskNr,request}
# taskNr = drop 1 taskNr // get taskNr of group-task
# (updates,tst) = getChildrenUpdatesFor taskNr tst
# (pst,tst) = loadPSt taskNr tst
// check for group actions
# (gActionStop,pst) = case mbGroupActions of
Just gActions
# gAction = case parseString (http_getValue "_group" updates "") of
Nothing = parseString (http_getValue "menuAndGroup" updates "")
res = res
= case gAction of
Just action = case filter (\act -> (getAction act) == action) gActions of
[gAction:_]
# (nSt,act) = procFun (getResult action gAction,-1) pst.state
# pst = {pst & state = nSt}
= case act of
Stop = (True,pst)
Continue = (False,pst)
Extend tlist = (False,{PSt | pst & tasks = pst.tasks ++ [(assignTask task,False) \\ task <- tlist]})
_ = (False,pst)
Nothing = (False,pst)
Nothing = (False,pst)
# (result,pst,tst) = processAllTasks pst 0 tst
# tst = setTaskStoreFor taskNr "pst" pst tst
= case result of
TaskException e = (TaskException e, tst)
TaskFinished r = (TaskFinished (parseFun r), tst)
TaskBusy = (TaskBusy, tst)
TaskException e = (TaskException e,tst)
TaskFinished r = (TaskFinished (parseFun r),tst)
TaskBusy
| gActionStop = (TaskFinished (parseFun pst.state),tst)
| otherwise
# tst = case mbGroupActions of
Just gActions = setGroupActions (evaluateConditions gActions pst.state) tst
Nothing = tst
= (TaskBusy,tst)
processAllTasks pst idx tst
| (length pst.tasks) == idx = (TaskBusy,pst,tst)
# (task,done) = pst.tasks !! idx
......@@ -207,7 +233,30 @@ where
# (t,b) = pst.tasks !! idx
# tasks = updateAt idx (t,True) pst.tasks
= {PSt | pst & tasks = tasks}
evaluateConditions actions state = [(getAction a,evaluateCondition (getCond a)) \\ a <- actions]
where
evaluateCondition GroupAlways = Left True
evaluateCondition (StatePredicate p) = Left (p state)
evaluateCondition (SharedPredicate id p) = Right (checkSharedPred id p)
checkSharedPred id p tst=:{TSt|dataStore,world}
# (mbVal,dstore,world) = loadValue id dataStore world
# tst = {TSt|tst & dataStore = dstore, world = world}
= case mbVal of
Just val = (p (SharedValue val), tst)
Nothing = (p SharedDeleted, tst)
getAction (GroupAction a _ _) = a
getAction (GroupActionParam name _ _) = ActionParam name "?"
getCond (GroupAction _ _ cond) = cond
getCond (GroupActionParam _ _ cond) = cond
getResult (ActionParam _ param) (GroupActionParam _ f _) = f param
getResult _ (GroupAction _ res _) = res
/*
* When a task is assigned to a user a synchronous task instance process is created.
* It is created once and loaded and evaluated on later runs.
......
......@@ -17,7 +17,7 @@ determineRPCItems forest tst = (flatten [determineTreeRPCItems tree \\ tree <- f
determineTreeRPCItems :: !TaskTree -> [RPCExecute]
determineTreeRPCItems (TTMainTask _ _ _ _ child) = determineTreeRPCItems child
determineTreeRPCItems (TTParallelTask ti tpi children) = flatten [(determineTreeRPCItems child) \\ child <- children]
determineTreeRPCItems (TTGroupedTask ti children) = flatten [(determineTreeRPCItems child) \\ child <- children]
determineTreeRPCItems (TTGroupedTask ti children _) = flatten [(determineTreeRPCItems child) \\ child <- children]
determineTreeRPCItems (TTSequenceTask ti children) = flatten [(determineTreeRPCItems child) \\ child <- children]
determineTreeRPCItems (TTRpcTask ti rpci) = [rpci]
determineTreeRPCItems _ = []
......
......@@ -296,15 +296,16 @@ mkMainTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
*/
applyTask :: !(Task a) !*TSt -> (!TaskResult a,!*TSt) | iTask a
//// TASK CONTENT
//setTUIDef :: !(TUIDef,[TUIButton]) ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setTUIDef :: !(TUIDef,[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt
setTUIUpdates :: ![TUIUpdate] ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setTUIFunc :: (*TSt -> *(!InteractiveTask, !*TSt)) [HtmlTag] !*TSt -> *TSt //Only for interactive tasks
setTUIMessage :: !(TUIDef,[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setTUIDef :: !(TUIDef,[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt
setTUIUpdates :: ![TUIUpdate] ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setTUIFunc :: (*TSt -> *(!InteractiveTask, !*TSt)) [HtmlTag] !*TSt -> *TSt //Only for interactive tasks
setTUIMessage :: !(TUIDef,[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setStatus :: ![HtmlTag] !*TSt -> *TSt //Only for monitor tasks
setGroupActions :: ![(Action, (Either Bool (*TSt -> *(!Bool,!*TSt))))] !*TSt -> *TSt //Only for group tasks
setStatus :: ![HtmlTag] !*TSt -> *TSt //Only for monitor tasks
getUserUpdates :: !*TSt -> ([(String,String)],!*TSt)
anyUpdates :: !*TSt -> (Bool,!*TSt)
getUserUpdates :: !*TSt -> ([(String,String)],!*TSt)
getChildrenUpdatesFor :: !TaskNr !*TSt -> ([(String,String)],!*TSt)
anyUpdates :: !*TSt -> (Bool,!*TSt)
/**
* Writes a 'task scoped' value to the store
......
implementation module TSt
import StdEnv, StdMaybe
import Http, Util
import Http, Util, Text
import ProcessDB, SessionDB, ChangeDB, DocumentDB, UserDB, TaskTree
import CommonDomain
......@@ -561,7 +561,7 @@ mkGroupedTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
mkGroupedTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note "", groupedBehaviour = GBFixed} Nothing mkGroupedTask`
where
mkGroupedTask` tst=:{TSt|taskNr,taskInfo}
# tst = {tst & tree = TTGroupedTask taskInfo [], taskNr = [0:taskNr]}
# tst = {tst & tree = TTGroupedTask taskInfo [] [], taskNr = [0:taskNr]}
= taskfun tst
mkMainTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
......@@ -626,14 +626,14 @@ where
(TTMainTask ti mti menus inptype task) = {tst & tree = TTMainTask ti mti menus inptype node} //Just replace the subtree
(TTSequenceTask ti tasks) = {tst & tree = TTSequenceTask ti [node:tasks]} //Add the node to the sequence
(TTParallelTask ti tpi tasks) = {tst & tree = TTParallelTask ti tpi [node:tasks]} //Add the node to the parallel set
(TTGroupedTask ti tasks) = {tst & tree = TTGroupedTask ti [node:tasks]} //Add the node to the grouped set
(TTGroupedTask ti tasks gActions) = {tst & tree = TTGroupedTask ti [node:tasks] gActions} //Add the node to the grouped set
_ = {tst & tree = tree}
//Perform reversal of lists that have been accumulated in reversed order
finalizeTaskNode (TTSequenceTask ti tasks) = TTSequenceTask ti (reverse tasks)
finalizeTaskNode (TTParallelTask ti tpi tasks) = TTParallelTask ti tpi (reverse tasks)
finalizeTaskNode (TTGroupedTask ti tasks) = TTGroupedTask ti (reverse tasks)
finalizeTaskNode node = node
finalizeTaskNode (TTSequenceTask ti tasks) = TTSequenceTask ti (reverse tasks)
finalizeTaskNode (TTParallelTask ti tpi tasks) = TTParallelTask ti tpi (reverse tasks)
finalizeTaskNode (TTGroupedTask ti tasks gActions) = TTGroupedTask ti (reverse tasks) gActions
finalizeTaskNode node = node
/*setTUIDef :: !(TUIDef,[TUIButton]) ![(Action,Bool)] !*TSt -> *TSt */
setTUIDef :: !(TUIDef,[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt
......@@ -665,6 +665,12 @@ setStatus msg tst=:{tree}
= case tree of
(TTMonitorTask info _) = {tst & tree = TTMonitorTask info msg}
_ = tst
setGroupActions :: ![(Action, (Either Bool (*TSt -> *(!Bool,!*TSt))))] !*TSt -> *TSt
setGroupActions actions tst=:{tree}
= case tree of
(TTGroupedTask info tasks _) = {tst & tree = TTGroupedTask info tasks actions}
_ = tst
/**
* Store and load the result of a workflow instance
......@@ -708,13 +714,22 @@ where
storekey = "iTask_" +++ (taskNrToString taskNr) +++ "-" +++ key
getUserUpdates :: !*TSt -> ([(String,String)],!*TSt)
getUserUpdates tst=:{taskNr,request} = (updates request, tst);
getUserUpdates tst=:{taskNr,request} = (updates request, tst)
where
updates request
| http_getValue "_targettask" request.arg_post "" == taskNrToString taskNr
= [u \\ u =:(k,v) <- request.arg_post | k.[0] <> '_']
| otherwise
= []