summaryrefslogtreecommitdiff
path: root/assignment-7
diff options
context:
space:
mode:
Diffstat (limited to 'assignment-7')
-rw-r--r--assignment-7/appointments.icl18
1 files changed, 12 insertions, 6 deletions
diff --git a/assignment-7/appointments.icl b/assignment-7/appointments.icl
index 66d8623..6f5a6d9 100644
--- a/assignment-7/appointments.icl
+++ b/assignment-7/appointments.icl
@@ -110,18 +110,18 @@ where
]
manageTask :: Int [TaskId] -> Task ()
- manageTask idx chooseTasks = (
+ manageTask idx chooseTasks = ((
viewSharedInformation
(Title $ "Manage " +++ title)
[ViewUsing (fromJust o 'M'.get idx o snd) proposalViewer]
proposedAppointments
||-
enterChoice "Pick start time" [] (map fst papp.startOptions)
- ) >>= \start ->
- addAppointment {papp.appointment & when=start} >>= \_ ->
- allTasks (map (flip removeTask topLevelTasks) chooseTasks) >>= \_ ->
- upd (second $ 'M'.del idx) proposedAppointments $>
- ()
+ ) >>*
+ [ OnAction (Action "Schedule appointment") $ hasValue schedule
+ , OnAction (Action "Cancel appointment") $ always cancel
+ ]
+ ) $> ()
where
proposalViewer :: Editor ProposedAppointment
proposalViewer = comapEditorValue toTuple $ container4
@@ -146,6 +146,12 @@ where
)
)
+ schedule start = addAppointment {papp.appointment & when=start} >>| cancel
+
+ cancel =
+ allTasks (map (flip removeTask topLevelTasks) chooseTasks) >>|
+ upd (second $ 'M'.del idx) proposedAppointments
+
manageAttrs :: User -> TaskAttributes
manageAttrs u = workerAttributes u
[ ("title", "Manage " +++ title)