Cancel proposed appointments

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)