Commit 2f2c2eb7 authored by ecrombag's avatar ecrombag

- Updated 'make appointment' example. The appointments are now placed in an...

- Updated 'make appointment' example. The appointments are now placed in an open parallel (distribution among users) and a group (different time slots), instead of a list.
- Fixed the behavior of group-panels inside parallel panels.
- renamed 'displayInstruction' to 'showInstruction', more consistent with other naming
- made the description backgrounds more opaque, because some icons made the description badly readable.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@945 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 22575b31
......@@ -42,7 +42,7 @@ derive gUpdate InstructionMsg
mkInstruction :: Task Void
mkInstruction
= mkMsg
>>= \msg -> msg.InstructionMsg.worker @: ("Instructions regarding: "+++msg.InstructionMsg.title, displayInstructionAbout msg.InstructionMsg.title msg.instruction msg.attachments)
>>= \msg -> msg.InstructionMsg.worker @: ("Instructions regarding: "+++msg.InstructionMsg.title, showInstructionAbout msg.InstructionMsg.title msg.instruction msg.attachments)
where
mkMsg :: Task InstructionMsg
......@@ -68,7 +68,61 @@ derive gMakeLocalCopy Meeting, Appointment, UserName, Attending
}
:: Attending = Yes | No | Remark Note
:: MeetingDB :== (Appointment,[(Meeting,[(Maybe Attending,UserName)])])
import StdDebug, GenPrint
//mkAppointment :: Task (Appointment,Meeting,[UserName])
mkAppointment
= meetingGoal
>>= \goal -> defineParticipants
>>= \users -> defineOptions
>>= \dates -> let sharedData :: MeetingDB
sharedData = (goal,[(date,[(Nothing, user)\\ user <- users])\\ date <- dates])
in (createDB sharedData
>>= \dbid -> startup dbid users sharedData)
>>= showMessageAbout "Result"
where
startup :: (DBid MeetingDB) [UserName] MeetingDB -> Task MeetingDB
startup dbid [] data = return data
startup dbid users data
= let d = (length (snd data)-1)
in
allProc [{user = u, task = ("Meeting Request" @>> task n d)} \\ u <- users & n <- [0..]] Open
>>| readDB dbid
where
task :: Int Int -> Task [MeetingDB]
task uid len
= allTasks [updateShared "Meeting request" [ButtonAction (ActionOk,IfValid)] dbid [appointEditor idx] \\ idx <- [0..len]]
>>= \list -> return (map snd list)
where
appointEditor idx = editor {editorFrom = editorFrom idx, editorTo = editorTo idx}
editorFrom :: Int MeetingDB -> (Static (Meeting,[(Maybe Attending,UserName)]),(Static String,(Maybe Attending)))
editorFrom idx (goal, dates)
# (date,attlist) = dates !! idx
= let (att,user) = attlist !! uid in (Static (date,attlist),(Static(user +++> " can you attend?"),att))
editorTo :: Int (Static (Meeting,[(Maybe Attending,UserName)]),(Static String,(Maybe Attending))) MeetingDB -> MeetingDB
editorTo idx (info,(question,att)) (goal, dates)
= let (meeting,attlist) = dates !! idx
in (goal,updateAt idx (meeting, let (_,user) = attlist !! uid
in updateAt uid (att,user) attlist) dates)
//pred (Valid (_,props)) = and [let (att,user) = attlist!!n in isJust att \\ (_,attlist) <- props] // Lijkt deze niet te testen...
//pred _ = False
meetingGoal :: Task Appointment
meetingGoal = enterInformation "Describe the topic of the meeting:"
defineParticipants :: Task [UserName]
defineParticipants = enterInformation "Select participants:"
defineOptions :: Task [Meeting]
defineOptions = enterInformation "Define date and time options:"
/*
mkAppointment
= meetingGoal
>>= \goal -> defineParticipants
......@@ -113,6 +167,7 @@ where
defineOptions :: Task [Meeting]
defineOptions = enterInformation "Define date and time options:"
*/
// chat
......
......@@ -5,5 +5,5 @@ import Html, TSt
from InteractionTasks import class html(..)
displayInstruction :: !String !instruction -> Task Void | html instruction
displayInstructionAbout :: !String !instruction b -> Task Void | html instruction & iTask b
\ No newline at end of file
showInstruction :: !String !instruction -> Task Void | html instruction
showInstructionAbout :: !String !instruction b -> Task Void | html instruction & iTask b
\ No newline at end of file
......@@ -7,12 +7,12 @@ from InteractionTasks import class html(..)
//mkInstructionTask :: !String !(*TSt -> *(!TaskResult Void,!*TSt)) -> Task Void
//showInstruction
displayInstruction :: !String !instruction -> Task Void | html instruction
displayInstruction title instruction = mkInstructionTask title (makeInstructionTask instruction Nothing)
showInstruction :: !String !instruction -> Task Void | html instruction
showInstruction title instruction = mkInstructionTask title (makeInstructionTask instruction Nothing)
//showInstructionAbout
displayInstructionAbout :: !String !instruction b -> Task Void | html instruction & iTask b
displayInstructionAbout title instruction context = mkInstructionTask title (makeInstructionTask instruction (Just (visualizeAsHtmlDisplay context)))
showInstructionAbout :: !String !instruction b -> Task Void | html instruction & iTask b
showInstructionAbout title instruction context = mkInstructionTask title (makeInstructionTask instruction (Just (visualizeAsHtmlDisplay context)))
makeInstructionTask :: !instruction (Maybe [HtmlTag]) *TSt -> *(!TaskResult Void,!*TSt) | html instruction
makeInstructionTask instruction context tst
......
......@@ -99,6 +99,7 @@ derive JSONEncode TTCFormContainer, TTCMonitorContainer, TTCResultContainer, TTC
{ xtype :: !String
, taskId :: !String
, content :: ![GroupContainerElement]
, subtaskId :: !(Maybe String)
}
:: SubtaskInfo =
......
......@@ -95,6 +95,7 @@ buildTaskPanel tree menus currentUser tst = case tree of
| xtype = "itasks.ttc.group"
, taskId = ti.TaskInfo.taskId
, content = reverse containers
, subtaskId = Nothing
})
= (container,tst)
(TTParallelTask ti tpi tasks)
......@@ -119,25 +120,13 @@ where
(TTInteractiveTask ti _ ) = ti.TaskInfo.worker == currentUser
(TTMonitorTask ti _) = ti.TaskInfo.worker == currentUser
(TTRpcTask ti _) = ti.TaskInfo.worker == currentUser
(TTGroupedTask ti _) = ti.TaskInfo.worker == currentUser
(TTInstructionTask ti _ _) = ti.TaskInfo.worker == currentUser
(TTFinishedTask _ _) = True // always show finished tasks
(TTParallelTask _ _ _) = False // the parallel subtask itself should not become visible
(TTMainTask _ _ _ _ _) = False // a main-subtask should not become visible
(TTGroupedTask _ _) = False
_ = abort "Unknown panel type in parallel"
getGroupedBehaviour task
# info = case task of
(TTInteractiveTask ti _ ) = ti
(TTMonitorTask ti _) = ti
(TTRpcTask ti _) = ti
(TTFinishedTask ti _) = ti
(TTParallelTask ti _ _) = ti
(TTSequenceTask ti _) = ti
(TTMainTask ti _ _ _ _) = ti
(TTGroupedTask ti _) = ti
_ = abort "Unknown panel type in group"
= info.TaskInfo.groupedBehaviour
buildSubtaskPanels :: !TaskTree !SubtaskNr !(Maybe [Menu]) !UserName !TaskParallelType !Bool !(Maybe TaskProperties) !*TSt -> (![SubtaskContainer],!*TSt)
buildSubtaskPanels tree stnr menus manager partype inClosed procProps tst = case tree of
(TTInteractiveTask ti (Definition (def,buttons) acceptedA))
......@@ -248,13 +237,28 @@ buildSubtaskPanels tree stnr menus manager partype inClosed procProps tst = case
[t] = buildSubtaskPanels t stnr menus manager partype inClosed procProps tst
_ = abort "Multiple simultaneously active tasks in a sequence!"
(TTGroupedTask ti tasks)
# (containers,tst) = seqList [(\(p,tst) -> ({panel = p, behaviour = getGroupedBehaviour t, index = idx},tst)) o buildTaskPanel t menus manager \\ t <- tasks & idx <- [0..]] tst
= ([{SubtaskContainer
| subtaskNr = stnr
, manager = manager
, inClosedPar = inClosed
, tasktree = tree
, processProperties = procProps
, taskpanel = TTCGroupContainer {TTCGroupContainer
| xtype = "itasks.ttc.group"
, taskId = ti.TaskInfo.taskId
, content = reverse containers
, subtaskId = Just (subtaskNrToString stnr)
}
}], tst)
/*(TTGroupedTask ti tasks)
= build tasks 1 tst
where
build [] idx tst = ([],tst)
build [t:ts] idx tst
# (p,tst) = buildSubtaskPanels t [idx:stnr] menus manager partype inClosed procProps tst
# (ps,tst)= build ts (idx+1) tst
= (p++ps,tst)
= (p++ps,tst)*/
(TTParallelTask ti tpi tasks)
# children = zip2 [1..] tasks
# nmanager = ti.TaskInfo.worker
......@@ -303,13 +307,15 @@ where
= {SubtaskInfo | mkSti & finished = True, taskId = ti.TaskInfo.taskId, properties = container.processProperties, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString container.subtaskNr, delegatedTo = toString ti.TaskInfo.worker}
(TTParallelTask ti tpi _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, properties = container.processProperties, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString container.subtaskNr, delegatedTo = toString ti.TaskInfo.worker, description = tpi.TaskParallelInfo.description}
(TTGroupedTask ti _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, properties = container.processProperties, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString container.subtaskNr, delegatedTo = toString ti.TaskInfo.worker}
(TTMainTask ti mti _ _ _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, properties = container.processProperties, subject = ti.TaskInfo.taskLabel, subtaskId = subtaskNrToString container.subtaskNr, delegatedTo = toString ti.TaskInfo.worker}
mkSti :: SubtaskInfo
mkSti = {SubtaskInfo | finished = False, taskId = "", subject = "", delegatedTo = "", subtaskId = "", description = "", properties = Nothing}
//Only show subtasks of closed parallels if you are the manager of that task
//Only show subtasks of closed parallels if you are the manager of that task
filterClosedSubtasks :: !SubtaskContainer !UserName -> Bool
filterClosedSubtasks container manager
| container.inClosedPar = container.SubtaskContainer.manager == manager
......@@ -385,3 +391,18 @@ isFinished _ = False
allFinished :: [TaskTree] -> Bool
allFinished ts = and (map isFinished ts)
getGroupedBehaviour :: !TaskTree -> GroupedBehaviour
getGroupedBehaviour task
# info = case task of
(TTInteractiveTask ti _ ) = ti
(TTMonitorTask ti _) = ti
(TTRpcTask ti _) = ti
(TTFinishedTask ti _) = ti
(TTParallelTask ti _ _) = ti
(TTSequenceTask ti _) = ti
(TTMainTask ti _ _ _ _) = ti
(TTGroupedTask ti _) = ti
(TTInstructionTask ti _ _) = ti
_ = abort "Unknown panel type in group"
= info.TaskInfo.groupedBehaviour
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