diff options
| -rw-r--r-- | assignment-7/appointments.icl | 18 |
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) |