Commit ed61dc27 authored by Steffen Michels's avatar Steffen Michels

added tasks for having different views on shared value & some small examples

does not work for Google maps and documents yet
also gVisualize still has to be improved (for now all values are updated for shared editors)

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@840 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent cf7eb64f
......@@ -556,7 +556,10 @@ itasks.TaskFormPanel = Ext.extend(Ext.Panel, {
case "TUISetValue":
var ct = Ext.getCmp(update[1]);
if(ct && ct.setValue) {
// suspend events to prevent check-event for checkbox
ct.suspendEvents();
ct.setValue(update[2]);
ct.resumeEvents();
}
break;
}
......
......@@ -43,6 +43,8 @@ import FormEditor
import FlowEditor
import LaunchFlow
//Shared Value Examples
import SharedValues
Start :: *World -> *World
Start world = startEngine workflows world
......@@ -75,4 +77,5 @@ where
, showStoredDefinitions
, launchFlow
]
, sharedValueExamples
]
\ No newline at end of file
implementation module SharedValues
import iTasks, CommonDomain, Text
derive bimap Maybe, (,)
quitButton = ButtonAction (ActionQuit, Always)
//Text-Lines Examples
noteEditor = editor {editorFrom = (\txt -> Note txt), editorTo = (\(Note txt) _ -> txt)}
listEditor = editor {editorFrom = (\txt -> split "\n" txt), editorTo = (\l _ -> join "\n" l)}
trimAction = ActionLabel "Trim"
linesPar :: Task Void
linesPar =
createShared ""
>>= \sid. ignoreResult (noteE sid -||- ignoreResult (updateShared "Lines" [quitButton] sid [listEditor]))
where
noteE sid =
updateShared "Text" [ButtonAction (trimAction, Always), quitButton] sid [noteEditor]
>>= \(action,txt). case action of
trimAction = setShared sid (trim txt)
>>| noteE sid
_ = stop
linesSingle :: Task Void
linesSingle = ignoreResult (updateSharedLocal "Text & Lines" [quitButton] "" [noteEditor,listEditor])
//Calculate Sum Example
calculateSum :: Task Void
calculateSum = ignoreResult (updateSharedLocal "Sum" [quitButton] (0,0) [idEditor, listener {listenerFrom = (\(x,y) -> x + y)}])
//Tree Example
:: Tree a = Leaf | Node (Node a)
:: Node a = { rightChildren :: Tree a
, value :: a
, leftChildren :: Tree a
}
derive gPrint Tree, Node
derive gParse Tree, Node
derive gVisualize Tree, Node
derive gUpdate Tree, Node
toTree :: [a] -> (Tree a) | Ord a
toTree list = makeTree (sort list)
where
makeTree :: [a] -> (Tree a)
makeTree [] = Leaf
makeTree [el:[]] = Node {rightChildren = Leaf, value = el, leftChildren = Leaf}
makeTree list = Node {rightChildren = makeTree end, value = middle, leftChildren = makeTree begin}
where
middlePos = (length list) / 2
begin = take (middlePos) list
middle = list !! (middlePos)
end = drop (middlePos + 1) list
tree :: Task Void
tree = ignoreResult (updateSharedLocal "List & Balanced Binary Tree" [quitButton] emptyL [idEditor, listener {listenerFrom = toTree}])
where
emptyL :: [Int]
emptyL = []
//Merge Test
mergeTest :: Task Void
mergeTest =
getCurrentUser
>>= \user. createShared emptyL
>>= \sid. ignoreResult ((user @: ("1st View", view sid)) -||- (user @: ("2nd View", view sid)))
where
view sid = updateShared "List" [quitButton] sid [idEditor]
emptyL :: [String]
emptyL = []
import StdMaybe, GeoDomain
sharedValueExamples :: [Workflow]
sharedValueExamples = [ workflow "Examples/Shared Values/Text-Lines (parallel tasks)" linesPar
, workflow "Examples/Shared Values/Text-Lines (single editor)" linesSingle
, workflow "Examples/Shared Values/Calculate Sum" calculateSum
, workflow "Examples/Shared Values/Balanced Binary Tree" tree
, workflow "Examples/Shared Values/Merge Test" mergeTest
]
\ No newline at end of file
definition module InteractionTasks
from TSt import :: Task
from TSt import :: Task, :: SharedID
from Types import :: Role
from Html import :: HtmlTag
from iTasks import class iTask(..)
from ProcessDB import :: Action
import GenPrint, GenParse, GenVisualize, GenUpdate
import GenPrint, GenParse, GenVisualize, GenUpdate, GenMerge
// This type class contains types that may be used as
// messages and questions: plain strings and html.
......@@ -81,6 +81,23 @@ showStickyMessageAbout :: message a -> Task Void | html message & iTa
notifyUser :: message UserName -> Task Void | html message
notifyGroup :: message Role -> Task Void | html message
//*** Shared value tasks ***//
:: Editor s a = {editorFrom :: s -> a, editorTo :: a s -> s}
:: Listener s a = {listenerFrom :: s -> a}
:: View s
listener :: !(Listener s a) -> View s | iTask a & iTask s & gMerge{|*|} s
editor :: !(Editor s a) -> View s | iTask a & iTask s & gMerge{|*|} s
idEditor :: View s | iTask s & gMerge{|*|} s
idListener :: View s | iTask s & gMerge{|*|} s
createShared :: a -> Task (SharedID a) | iTask a
getShared :: (SharedID a) -> Task a | iTask a
setShared :: (SharedID a) a -> Task Void | iTask a
updateShared :: question ![TaskAction s] !(SharedID s) ![View s] -> Task (!Action, !s) | html question & iTask s & gMerge{|*|} s
updateSharedLocal :: question ![TaskAction s] !s ![View s] -> Task (!Action, !s) | html question & iTask s & gMerge{|*|} s
//*** Utility Functions ***//
//Generate a set of action buttons by joining the buttons that are always shown and those only active when valid
makeButtons :: !String ![(Action, Bool)] -> [(!Action,!String,!String,!String,!Bool)]
......
......@@ -3,7 +3,7 @@ definition module CommonDomain
* This module provides a series of data types, their iTask generics obligations and utility
* functions for common data in workflows.
*/
import GenPrint, GenParse, GenVisualize, GenUpdate
import GenPrint, GenParse, GenVisualize, GenUpdate, GenMerge
import StdString
from Html import :: HtmlTag
......@@ -46,6 +46,7 @@ derive gPrint EmailAddress, Password, Note, Date, Time, DateTime, Currency
derive gParse EmailAddress, Password, Note, Date, Time, DateTime, Currency
derive gVisualize EmailAddress, Password, Note, Date, Time, DateTime, Currency
derive gUpdate EmailAddress, Password, Note, Date, Time, DateTime, Currency
derive gMerge EmailAddress, Password, Note, Date, Time, DateTime, Currency
instance html Note
......
......@@ -9,46 +9,66 @@ derive gPrint EmailAddress, Password, Note, Date, Time, DateTime, Currency
derive gParse EmailAddress, Password, Note, Date, Time, DateTime, Currency
derive gVisualize EmailAddress, Password, DateTime
derive gUpdate EmailAddress, Password, Note, DateTime
derive gMerge EmailAddress, Password, Note, Date, Time, DateTime, Currency
derive gLexOrd Currency
derive bimap Maybe, (,)
gVisualize{|Date|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid}
gVisualize{|Date|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid,namePrefix,updateValues}
= case vizType of
VEditorDefinition = ([TUIFragment (TUIDateField {TUIDateField|name = dp2s currentPath, id = dp2id idPrefix currentPath, value = value2s currentPath old, format = "d-m-Y", fieldLabel = label2s optional label, hideLabel = not useLabels})]
VEditorDefinition = ([TUIFragment (TUIDateField {TUIDateField|name = namePrefix +++ (dp2s currentPath), id = id, value = value2s currentPath old, format = "d-m-Y", fieldLabel = label2s optional label, hideLabel = not useLabels})]
, 1
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath old optional valid})
VEditorUpdate
| updateValues = ([TUIUpdate (TUISetValue id (value2s currentPath new))]
, 1
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath new optional valid})
_ = ([TextFragment (toString old)],1,{VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath new optional valid})
gVisualize{|Time|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid}
where
id = dp2id idPrefix currentPath
gVisualize{|Time|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid,namePrefix,updateValues}
= case vizType of
VEditorDefinition = ([TUIFragment (TUITimeField {TUITimeField|name = dp2s currentPath, id = dp2id idPrefix currentPath, value = value2s currentPath old, format = "H:i:s", fieldLabel = label2s optional label, hideLabel = not useLabels})]
VEditorDefinition = ([TUIFragment (TUITimeField {TUITimeField|name = namePrefix +++ (dp2s currentPath), id = id, value = value2s currentPath old, format = "H:i:s", fieldLabel = label2s optional label, hideLabel = not useLabels})]
, 1
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath old optional valid})
VEditorUpdate
| updateValues = ([TUIUpdate (TUISetValue id (value2s currentPath new))]
, 1
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath new optional valid})
_ = ([TextFragment (toString old)],1,{VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath new optional valid})
gVisualize{|Note|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid}
where
id = dp2id idPrefix currentPath
gVisualize{|Note|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid,namePrefix,updateValues}
= case vizType of
VEditorDefinition = ([TUIFragment (TUITextArea {TUITextArea|name = dp2s contentPath, id = dp2id idPrefix contentPath, value = value2s contentPath old, fieldLabel = label2s optional label, hideLabel = not useLabels, width = 400, height = 150 })]
, 2
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid contentPath old optional valid})
VEditorDefinition = ([TUIFragment (TUITextArea {TUITextArea|name = namePrefix +++ (dp2s contentPath), id = id, value = value2s contentPath old, fieldLabel = label2s optional label, hideLabel = not useLabels, width = 400, height = 150 })]
, 2
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid contentPath old optional valid})
VEditorUpdate
| updateValues = ([TUIUpdate (TUISetValue id (value2s currentPath new))]
, 2
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath new optional valid})
_ = ([TextFragment (toString old)]
, 2
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid contentPath new optional valid})
, 2
, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid contentPath new optional valid})
where
// Use the path to the inner constructor instead of the current path.
// This way the generic gUpdate will work for this type
contentPath = shiftDataPath currentPath
contentPath = shiftDataPath currentPath
id = dp2id idPrefix contentPath
gVisualize{|Currency|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid}
gVisualize{|Currency|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid,namePrefix,updateValues}
= case vizType of
VEditorDefinition
= ([TUIFragment combinedPanel], 1, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath old optional valid})
_
= ([TextFragment (toString old)], 1, {VSt|vst & valid= stillValid currentPath new optional valid})
VEditorDefinition = ([TUIFragment combinedPanel], 1, {VSt|vst & currentPath = stepDataPath currentPath, valid= stillValid currentPath old optional valid})
VEditorUpdate
| updateValues = ([TUIUpdate (TUISetValue id (value currentPath new))]
, 1
, {VSt|vst & valid= stillValid currentPath new optional valid})
_ = ([TextFragment (toString old)], 1, {VSt|vst & valid= stillValid currentPath new optional valid})
where
combinedPanel = TUIPanel {TUIPanel| layout = "hbox", autoHeight = True, autoWidth = True, fieldLabel = label2s optional label, items = [currencyLabel,numberField], buttons = Nothing, border = False, bodyCssClass = "", renderingHint = 1, unstyled=True}
numberField = TUINumberField {TUINumberField|name = dp2s currentPath, id = dp2id idPrefix currentPath
numberField = TUINumberField {TUINumberField|name = namePrefix +++ (dp2s currentPath), id = id
, value = value currentPath old, fieldLabel = Nothing, hideLabel = True, allowDecimals = True, numDecimals = 2}
currencyLabel = TUICustom (JSON ("{xtype : \"displayfield\", value : \"" +++ curLabel old +++ "\", style : \"padding: 3px 5px 2px 2px;\"}"))
curLabel (VValue (EUR _) _) = "€"
......@@ -58,7 +78,9 @@ where
curLabel _ = ""
value dp VBlank = ""
value dp (VValue v dm) = if (isMasked dp dm) (decFormat (toInt v)) ""
value dp (VValue v dm) = if (isMasked dp dm) (decFormat (toInt v)) ""
id = dp2id idPrefix currentPath
gUpdate{|Date|} _ ust=:{USt|mode=UDCreate,world}
# (date,world) = currentDate world
......
......@@ -6,6 +6,7 @@ derive gPrint GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gParse GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
derive gVisualize GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
derive gUpdate GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
derive gMerge GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
//API Key for http://localhost
GOOGLE_API_KEY :== "ABQIAAAAaZ6XgbNqm4h_DL45IQMnSRT2yXp_ZAY8_ufC3CFXhHIE1NvwkxT4lboFdTKu2o9gr_i8kRV0Pn1fNw"
......
......@@ -9,6 +9,7 @@ derive gPrint GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gParse GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
derive gVisualize GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gUpdate GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
derive gMerge GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
derive bimap Maybe, (,)
......
definition module GenMerge
import StdGeneric, StdMaybe, Void, Either, Types
mergeValues :: a a a -> a | gMerge{|*|} a
:: MergeMode
:: MergeResult a
generic gMerge a :: MergeMode a a a -> MergeResult a
derive gMerge OBJECT, CONS, PAIR, FIELD, EITHER, UNIT
derive gMerge Int, Real, Char, Bool, String
derive gMerge Document, [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
derive bimap MergeResult
\ No newline at end of file
implementation module GenMerge
import StdGeneric, StdInt, StdReal, StdChar, StdBool, StdString, StdMisc, StdMaybe, Void, Either, Types
mergeValues :: a a a -> a | gMerge{|*|} a
mergeValues old cur new = getValue (gMerge{|*|} Merge old cur new)
:: MergeMode = Merge | Compare
:: MergeResult a = IsEqual Bool | Value a
derive gMerge Document, [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
derive bimap MergeResult
generic gMerge a :: MergeMode a a a -> MergeResult a
gMerge{|Int|} Merge old cur new = mergeBasic old cur new
gMerge{|Int|} Compare x y _ = IsEqual (x == y)
gMerge{|Real|} Merge old cur new = mergeBasic old cur new
gMerge{|Real|} Compare x y _ = IsEqual (x == y)
gMerge{|Char|} Merge old cur new = mergeBasic old cur new
gMerge{|Char|} Compare x y _ = IsEqual (x == y)
gMerge{|Bool|} Merge old cur new = mergeBasic old cur new
gMerge{|Bool|} Compare x y _ = IsEqual (x == y)
gMerge{|String|} Merge old cur new = mergeBasic old cur new
gMerge{|String|} Compare x y _ = IsEqual (x == y)
gMerge{|OBJECT|} f Merge (OBJECT old) (OBJECT cur) (OBJECT new) = Value (OBJECT (getValue (f Merge old cur new)))
gMerge{|OBJECT|} f Compare (OBJECT x) (OBJECT y) _ = IsEqual (isEqual (f Compare x y undef))
gMerge{|CONS|} f Merge (CONS old) (CONS cur) (CONS new) = Value (CONS (getValue (f Merge old cur new)))
gMerge{|CONS|} f Compare (CONS x) (CONS y) _ = IsEqual (isEqual (f Compare x y undef))
gMerge{|FIELD|} f Merge (FIELD old) (FIELD cur) (FIELD new) = Value (FIELD (getValue (f Merge old cur new)))
gMerge{|FIELD|} f Compare (FIELD x) (FIELD y) _ = IsEqual (isEqual (f Compare x y undef))
gMerge{|PAIR|} fx fy Merge (PAIR old0 old1) (PAIR cur0 cur1) (PAIR new0 new1) = Value (PAIR (getValue (fx Merge old0 cur0 new0)) (getValue (fy Merge old1 cur1 new1)))
gMerge{|PAIR|} fx fy Compare (PAIR x1 y1) (PAIR x2 y2) _ = IsEqual (isEqual (fx Compare x1 x2 undef) && isEqual (fy Compare y1 y2 undef))
gMerge{|EITHER|} fx fy Merge (LEFT old) (LEFT cur) (LEFT new) = Value (LEFT (getValue (fx Merge old cur new)))
gMerge{|EITHER|} fx fy Merge (RIGHT old) (RIGHT cur) (RIGHT new) = Value (RIGHT (getValue (fy Merge old cur new)))
gMerge{|EITHER|} fx fy Merge (RIGHT old) (LEFT cur) _ = Value (LEFT cur)
gMerge{|EITHER|} fx fy Merge (LEFT old) (RIGHT cur) _ = Value (RIGHT cur)
gMerge{|EITHER|} fx fy Merge (LEFT old) (LEFT cur) new
| isEqual (fx Compare old cur undef) = Value new
| otherwise = Value (LEFT cur)
gMerge{|EITHER|} fx fy Merge (RIGHT old) (RIGHT cur) new
| isEqual (fy Compare old cur undef) = Value new
| otherwise = Value (RIGHT cur)
gMerge{|EITHER|} fl fr Compare (LEFT x) (LEFT y) _ = IsEqual (isEqual (fl Compare x y undef))
gMerge{|EITHER|} fl fr Compare (RIGHT x) (RIGHT y) _ = IsEqual (isEqual (fr Compare x y undef))
gMerge{|EITHER|} fl fr Compare _ _ _ = IsEqual False
gMerge{|UNIT|} Merge UNIT UNIT UNIT = Value UNIT
gMerge{|UNIT|} Compare UNIT UNIT _ = IsEqual True
mergeBasic :: a a a -> MergeResult a | == a
mergeBasic old cur new
| old == cur = Value new
| otherwise = Value cur
getValue :: (MergeResult a) -> a
getValue (Value a) = a
isEqual :: (MergeResult a) -> Bool
isEqual (IsEqual equal) = equal
\ No newline at end of file
......@@ -13,14 +13,14 @@ derive gVisualize Int, Real, Char, Bool, String, Document
derive gVisualize Dynamic, [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
//Wrapper functions for visualization
visualizeAsEditor :: String DataMask a -> ([TUIDef],Bool) | gVisualize{|*|} a
visualizeAsEditor :: String String DataMask a -> ([TUIDef],Bool) | gVisualize{|*|} a
visualizeAsHtmlDisplay :: a -> [HtmlTag] | gVisualize{|*|} a
visualizeAsTextDisplay :: a -> String | gVisualize{|*|} a
visualizeAsHtmlLabel :: a -> [HtmlTag] | gVisualize{|*|} a
visualizeAsTextLabel :: a -> String | gVisualize{|*|} a
//Wrapper function for calculating form delta's
determineEditorUpdates :: String DataMask DataMask ListMask a a -> ([TUIUpdate],Bool) | gVisualize{|*|} a
determineEditorUpdates :: String String DataMask DataMask ListMask a a Bool -> ([TUIUpdate],Bool) | gVisualize{|*|} a
//Hint for the layout engine how to render the different panels in case of a
//horizontal layout (tuples) (0 = full width, 1 = inline, 2 = medium, 4 = large)
......@@ -45,6 +45,8 @@ derive bimap VisualizationValue
, optional :: !Bool // Create optional form fields
, valid :: !Bool // Is the form valid
, listMask :: ListMask // Indicating which parts of a list have changed
, updateValues :: !Bool // Generate updates for basic values
, namePrefix :: !String // Prefix for names of generated elements
}
:: VisualizationType
......
This diff is collapsed.
......@@ -19,9 +19,9 @@ handleWorkTabRequest req tst=:{staticInfo}
(TTMainTask ti properties tasks)
# subject = [properties.managerProps.TaskManagerProperties.subject]
# (Just p=:{Process | menus}, tst) = getProcess taskId tst
# panels = case [t \\ t <- tasks | not (isFinished t)] of
[] = if (allFinished tasks) [TaskDone] [TaskRedundant]
[t] = buildTaskPanels t menus
# (panels,tst) = case [t \\ t <- tasks | not (isFinished t)] of
[] = if (allFinished tasks) ([TaskDone],tst) ([TaskRedundant],tst)
[t] = buildTaskPanels t menus tst
_ = abort "Multiple simultaneously active tasks in a main task!"
// Collect debug information
......@@ -215,53 +215,71 @@ JSONEncode{|TaskPanel|} (TaskRedundant) c = ["\"redundant\"" : c]
//JSON specialization for Timestamp: Ignore the constructor
JSONEncode{|Timestamp|} (Timestamp x) c = JSONEncode{|*|} x c
buildTaskPanels :: TaskTree !(Maybe [Menu]) -> [TaskPanel]
buildTaskPanels (TTInteractiveTask ti (Left def) acceptedA) menus
= [FormPanel {FormPanel | xtype = "itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, items = [def], tbar = (makeMenuBar menus acceptedA ti)}]
buildTaskPanels (TTInteractiveTask ti (Right upd) acceptedA) menus
= [FormUpdate {FormUpdate | xtype = "itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, updates = (determineUpdates upd menus acceptedA ti)}]
buildTaskPanels (TTMonitorTask ti html) _
= [MonitorPanel {MonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] html)}]
buildTaskPanels (TTRpcTask ti rpc) _
= [MonitorPanel {MonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] [Text rpc.RPCExecute.operation.RPCOperation.name, Text ": ", Text rpc.RPCExecute.status])}]
buildTaskPanels (TTMainTask ti mti _) _
= [MainTaskPanel {MainTaskPanel | xtype = "itasks.task-waiting", taskId = ti.TaskInfo.taskId, properties = mti}]
buildTaskPanels (TTSequenceTask ti tasks) menus
buildTaskPanels :: TaskTree !(Maybe [Menu]) !*TSt -> *([TaskPanel],!*TSt)
buildTaskPanels (TTInteractiveTask ti (Definition def acceptedA)) menus tst
= ([FormPanel {FormPanel | xtype = "itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, items = [def], tbar = (makeMenuBar menus acceptedA ti)}],tst)
buildTaskPanels (TTInteractiveTask ti (Updates upd acceptedA)) menus tst
= ([FormUpdate {FormUpdate | xtype = "itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, updates = (determineUpdates upd menus acceptedA ti)}] ,tst)
buildTaskPanels (TTInteractiveTask ti (Func f)) menus tst
# (fres,tst) = f tst
= buildTaskPanels (TTInteractiveTask ti fres) menus tst
buildTaskPanels (TTMonitorTask ti html) _ tst
= ([MonitorPanel {MonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] html)}],tst)
buildTaskPanels (TTRpcTask ti rpc) _ tst
= ([MonitorPanel {MonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] [Text rpc.RPCExecute.operation.RPCOperation.name, Text ": ", Text rpc.RPCExecute.status])}],tst)
buildTaskPanels (TTMainTask ti mti _) _ tst
= ([MainTaskPanel {MainTaskPanel | xtype = "itasks.task-waiting", taskId = ti.TaskInfo.taskId, properties = mti}],tst)
buildTaskPanels (TTSequenceTask ti tasks) menus tst
= case [t \\ t <- tasks | not (isFinished t)] of
[] = if (allFinished tasks) [TaskDone][TaskRedundant]
[t] = buildTaskPanels t menus
[] = if (allFinished tasks) ([TaskDone],tst) ([TaskRedundant],tst)
[t] = buildTaskPanels t menus tst
_ = (abort "Multiple simultaneously active tasks in a sequence!")
buildTaskPanels (TTParallelTask ti tasks) menus
# cpanels = flatten [buildSubtaskPanels child [i] menus \\ child <- tasks & i <- [1..]]
buildTaskPanels (TTParallelTask ti tasks) menus tst
#(cpanels,tst) = createPanels tasks [] 1 menus tst
# cpanels = reverse (flatten cpanels)
# ipanel = (ParallelInfoPanel {ParallelInfoPanel | xtype = "itasks.task-parallel", taskId = ti.TaskInfo.taskId, label = "This is a parallel", subtaskInfo = flatten [getSubtaskInfo t [i] \\ t <- tasks & i <- [1..]]})
= [ipanel:cpanels]
buildTaskPanels (TTFinishedTask _) _
= [TaskDone]
= ([ipanel:cpanels],tst)
where
createPanels [] acc i menus tst = (acc,tst)
createPanels [task:tasks] acc i menus tst
#(panels,tst) = buildSubtaskPanels task [i] menus tst
= createPanels tasks [panels:acc] (i+1) menus tst
buildTaskPanels (TTFinishedTask _) _ tst
= ([TaskDone],tst)
//Incorperate Open / Closed Behaviour.. etc
buildSubtaskPanels :: TaskTree SubtaskNr !(Maybe [Menu]) -> [TaskPanel]
buildSubtaskPanels (TTInteractiveTask ti (Left def) acceptedA) stnr menus
= [STFormPanel {STFormPanel | xtype="itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, items = [def], subtaskId = subtaskNrToString stnr, tbar = (makeMenuBar menus acceptedA ti)}]
buildSubtaskPanels (TTInteractiveTask ti (Right upd) acceptedA) stnr menus
= [STFormUpdate {STFormUpdate | xtype = "itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, updates = (determineUpdates upd menus acceptedA ti), subtaskId = subtaskNrToString stnr}]
buildSubtaskPanels (TTMonitorTask ti html) stnr _
= [STMonitorPanel {STMonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] html), subtaskId = subtaskNrToString stnr}]
buildSubtaskPanels (TTRpcTask ti rpc) stnr _
= [STMonitorPanel {STMonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] [Text rpc.RPCExecute.operation.RPCOperation.name, Text ": ", Text rpc.RPCExecute.status]), subtaskId = subtaskNrToString stnr}]
buildSubtaskPanels (TTMainTask ti mti tasks) stnr _
= [STMainTaskPanel {STMainTaskPanel | xtype = "itasks.task-waiting", taskId = ti.TaskInfo.taskId, properties = mti, subtaskId = subtaskNrToString stnr}]
buildSubtaskPanels (TTSequenceTask ti tasks) stnr menus
buildSubtaskPanels :: TaskTree SubtaskNr !(Maybe [Menu]) !*TSt -> *([TaskPanel], !*TSt)
buildSubtaskPanels (TTInteractiveTask ti (Definition def acceptedA)) stnr menus tst
= ([STFormPanel {STFormPanel | xtype="itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, items = [def], subtaskId = subtaskNrToString stnr, tbar = (makeMenuBar menus acceptedA ti)}],tst)
buildSubtaskPanels (TTInteractiveTask ti (Updates upd acceptedA)) stnr menus tst
= ([STFormUpdate {STFormUpdate | xtype = "itasks.task-form", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, updates = (determineUpdates upd menus acceptedA ti), subtaskId = subtaskNrToString stnr}],tst)
buildSubtaskPanels (TTInteractiveTask ti (Func f)) stnr menus tst
#(fres, tst) = f tst
= buildSubtaskPanels (TTInteractiveTask ti fres) stnr menus tst
buildSubtaskPanels (TTMonitorTask ti html) stnr _ tst
= ([STMonitorPanel {STMonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] html), subtaskId = subtaskNrToString stnr}],tst)
buildSubtaskPanels (TTRpcTask ti rpc) stnr _ tst
= ([STMonitorPanel {STMonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] [Text rpc.RPCExecute.operation.RPCOperation.name, Text ": ", Text rpc.RPCExecute.status]), subtaskId = subtaskNrToString stnr}],tst)
buildSubtaskPanels (TTMainTask ti mti tasks) stnr _ tst
= ([STMainTaskPanel {STMainTaskPanel | xtype = "itasks.task-waiting", taskId = ti.TaskInfo.taskId, properties = mti, subtaskId = subtaskNrToString stnr}],tst)
buildSubtaskPanels (TTSequenceTask ti tasks) stnr menus tst
= case [t \\ t <- tasks | not (isFinished t)] of
[] = if (allFinished tasks) [TaskDone][TaskRedundant]
[t] = buildSubtaskPanels t stnr menus
[] = if (allFinished tasks) ([TaskDone],tst) ([TaskRedundant],tst)
[t] = buildSubtaskPanels t stnr menus tst
_ = (abort "Multiple simultaneously active tasks in a sequence!")
buildSubtaskPanels (TTParallelTask ti tasks) stnr menus
= flatten [buildSubtaskPanels t [i:stnr] menus\\ t <- tasks & i <- [1..]]
buildSubtaskPanels (TTFinishedTask _) stnr _
= [TaskDone]
buildSubtaskPanels (TTParallelTask ti tasks) stnr menus tst
#(panels, tst) = createPanels tasks [] stnr 1 menus tst
= (reverse (flatten panels), tst)
where
createPanels [] acc stnr i menus tst = (acc,tst)
createPanels [task:tasks] acc stnr i menus tst
#(panels,tst) = buildSubtaskPanels task [i:stnr] menus tst
= createPanels tasks [panels:acc] stnr (i+1) menus tst
buildSubtaskPanels (TTFinishedTask _) stnr _ tst
= ([TaskDone],tst)
getSubtaskInfo :: TaskTree SubtaskNr -> [SubtaskInfo]
getSubtaskInfo (TTInteractiveTask ti _ _) stnr = [{SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString stnr}]
getSubtaskInfo (TTInteractiveTask ti _) stnr = [{SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString stnr}]
getSubtaskInfo (TTMonitorTask ti _) stnr = [{SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString stnr}]
getSubtaskInfo (TTRpcTask ti _) stnr = [{SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString stnr}]
getSubtaskInfo (TTFinishedTask ti) stnr = [{SubtaskInfo | mkSti & finished = True, taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString stnr}]
......
......@@ -269,9 +269,9 @@ mkMainTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
*/
applyTask :: !(Task a) !*TSt -> (!TaskResult a,!*TSt) | iTask a
//// TASK CONTENT
setTUIDef :: !TUIDef !*TSt -> *TSt //Only for interactive tasks
setTUIUpdates :: ![TUIUpdate] !*TSt -> *TSt //Only for interactive tasks
setAccActions :: ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setTUIDef :: !TUIDef ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setTUIUpdates :: ![TUIUpdate] ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks