Finish appointments and other improvements

1 files changed, 37 insertions, 8 deletions

diff --git a/assignment-7/appointments.icl b/assignment-7/appointments.icl
index ae23a6d..773e7d3 100644
--- a/assignment-7/appointments.icl
+++ b/assignment-7/appointments.icl
@@ -4,11 +4,15 @@ from StdFunc import flip, id, seq
 
 from Data.Func import $
 import Data.Functor
+import Data.List
+import qualified Data.Map as M
 import qualified Graphics.Scalable as G
 from Graphics.Scalable import class margin, instance margin Span
 import System.Time
+from Text import class Text(concat), instance Text String
 
 import iTasks
+import iTasks.UI.Editor.Common
 import iTasks.Extensions.DateTime
 import iTasks.Extensions.SVG.SVGEditor
 
@@ -26,10 +30,7 @@ derive class iTask Appointment
 derive JSEncode Appointment, User, Time, DateTime, Maybe
 
 appointments :: Shared [Appointment]
-appointments = sharedStore "appointments"
-	[ {title="Sunday", when={DateTime | year=2017,mon=10,day=29,hour=10,min=0,sec=0}, duration={Time | hour=1,min=0,sec=0}, owner=SystemUser, participants=[]}
-	, {title="Monday", when={DateTime | year=2017,mon=10,day=30,hour=12,min=0,sec=0}, duration={Time | hour=1,min=0,sec=0}, owner=SystemUser, participants=[]}
-	]
+appointments = sharedStore "appointments" []
 
 belongsTo :: User Appointment -> Bool
 belongsTo u a = isMember u [a.owner:a.participants]
@@ -40,6 +41,27 @@ where
 	(Timestamp tsapp) = utcDateTimeToTimestamp a.when
 	tsend = Timestamp $ tsapp + a.duration.Time.sec + 60 * (a.duration.Time.min + 60 * a.duration.Time.hour)
 
+addAppointment :: Appointment -> Task Appointment
+addAppointment app =
+	upd (flip (++) [app]) appointments >>|
+	allTasks [assign (attrs u) finishTask \\ u <- app.participants] $>
+	app
+where
+	finishTask :: Task ()
+	finishTask =
+		wait (Title "Wait for the start of this appointment") (\now -> now >= app.when) currentDateTime >>= \_ ->
+		viewInformation (Title app.Appointment.title) [] "Click 'Done' to finish this task." >>*
+		[OnAction (Action "Done") (always $ return ())]
+
+	attrs :: User -> TaskAttributes
+	attrs u = workerAttributes u
+		[ ("title",          app.Appointment.title)
+		, ("createdAt",      toString app.when)
+		, ("createdBy",      toString app.owner)
+		, ("createdFor",     toString u)
+		, ("completeBefore", toString (addTime app.duration app.when))
+		]
+
 :: ProposedAppointment =
 	{ appointment  :: Appointment
 	, startOptions :: [DateTime]
@@ -55,7 +77,7 @@ Start w = startEngine (loginAndManageWorkList "Scheduler" worklist) w
 where
 	worklist :: [Workflow]
 	worklist =
-		[ workflow          "Manage users"        "Manage users"        manageUsers
+		[ restrictedTransientWorkflow "Manage users" "Manage users" ["admin"] manageUsers
 		, transientWorkflow "Show appointments"   "Show appointments"   showAppointments
 		, transientWorkflow "Make appointment"    "Make appointment"    makeAppointment
 		, transientWorkflow "Propose appointment" "Propose appointment" proposeAppointment
@@ -67,8 +89,15 @@ showAppointments =
 	get currentDateTime >>= \now ->
 	viewSharedInformation
 		(Title "Future appointments")
-		[ViewAs (filter (\a -> belongsTo user a && inFuture now a))]
+		[ViewUsing (filter (\a -> belongsTo user a && inFuture now a)) editor]
 		appointments
+where
+	editor = listEditor Nothing False False Nothing (bijectEditorValue toTuple fromTuple tupEdit)
+	tupEdit = toolbar5 gEditor{|*|} gEditor{|*|} gEditor{|*|} userViewer usersViewer
+	userViewer = comapEditorValue toString gEditor{|*|}
+	usersViewer = comapEditorValue (concat o intersperse "; " o map toString) gEditor{|*|}
+	toTuple app = (app.Appointment.title, app.when, app.duration, app.owner, app.participants)
+	fromTuple (t,w,d,o,p) = {title=t, when=w, duration=d, owner=o, participants=p}
 
 /*showAppointments :: Task [Appointment]
 showAppointments =
@@ -114,8 +143,8 @@ makeAppointment =
 		, enterMultipleChoiceWithShared "Participants" [ChooseFromCheckGroup id] users @ \ps a -> {a & participants=ps}
 		]
 	@ flip seq {gDefault{|*|} & owner=user} >>*
-		[ OnAction (Action "Make") (hasValue \app -> upd (flip (++) [app]) appointments $> Just app)
-		, OnAction ActionCancel    (always $ return Nothing)
+		[ OnAction (Action "Make") (hasValue $ fmap Just o addAppointment)
+		, OnAction ActionCancel    (always   $ makeAppointment)
 		]
 where onehour = {Time | hour=1,min=0,sec=0}