diff options
Diffstat (limited to 'assignment-7/appointments.icl')
| -rw-r--r-- | assignment-7/appointments.icl | 54 |
1 files changed, 30 insertions, 24 deletions
diff --git a/assignment-7/appointments.icl b/assignment-7/appointments.icl index 54b2d86..c65ed71 100644 --- a/assignment-7/appointments.icl +++ b/assignment-7/appointments.icl @@ -45,16 +45,19 @@ derive class iTask Appointment derive JSEncode Appointment, User, Time, DateTime, Maybe instance == Appointment where == a b = a === b +// Some examples. Change the day fields (+7) if working later than 2017-11-18. +// For these tasks, no user tasks are created (this is done in addAppointment). +// They are just here to make it easier to develop the SVG calendar. appointments :: Shared [Appointment] appointments = sharedStore "appointments" - [ {title="Advanced Programming", when={DateTime|year=2017,mon=11,day= 6,hour=10,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} - , {title="Information Retrieval", when={DateTime|year=2017,mon=11,day= 6,hour=15,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} - , {title="Cultural Contacts", when={DateTime|year=2017,mon=11,day= 7,hour=13,min= 0,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} - , {title="Historical Grammar", when={DateTime|year=2017,mon=11,day= 7,hour=15,min= 0,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} - , {title="Text Mining", when={DateTime|year=2017,mon=11,day= 8,hour= 8,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} - , {title="Testing Techniques", when={DateTime|year=2017,mon=11,day= 8,hour= 8,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} - , {title="Testing Techniques", when={DateTime|year=2017,mon=11,day=10,hour= 8,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} - , {title="Advanced Programming", when={DateTime|year=2017,mon=11,day=10,hour=10,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + [ {title="Advanced Programming", when={DateTime|year=2017,mon=11,day=13,hour=10,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + , {title="Information Retrieval", when={DateTime|year=2017,mon=11,day=13,hour=15,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + , {title="Cultural Contacts", when={DateTime|year=2017,mon=11,day=14,hour=13,min= 0,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + , {title="Historical Grammar", when={DateTime|year=2017,mon=11,day=14,hour=15,min= 0,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + , {title="Text Mining", when={DateTime|year=2017,mon=11,day=15,hour= 8,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + , {title="Testing Techniques", when={DateTime|year=2017,mon=11,day=15,hour= 8,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + , {title="Testing Techniques", when={DateTime|year=2017,mon=11,day=17,hour= 8,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} + , {title="Advanced Programming", when={DateTime|year=2017,mon=11,day=17,hour=10,min=30,sec=0}, duration={Time|hour=2,min=0,sec=0}, owner=AuthenticatedUser "root" ["admin","manager"] (Just "Root user"), participants=[]} ] belongsTo :: User Appointment -> Bool @@ -85,8 +88,10 @@ 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 ())] + viewSharedInformation (Title app.Appointment.title) [ViewAs (const "Click 'Done' to finish this task.")] currentDateTime >>* + [ OnAction (Action "Done") (always $ return ()) + , OnValue (ifValue (\now -> now >= addTime app.duration app.when) (const $ return ())) + ] attrs :: User -> TaskAttributes attrs u = workerAttributes u @@ -129,7 +134,8 @@ addProposedAppointment papp=:{appointment={Appointment|title}} = where chooseTask :: Int User -> Task (Int, 'M'.Map Int ProposedAppointment) chooseTask idx user = - allTasks [updateInformation (toString w) [] Maybe \\ (w,_) <- papp.startOptions] >>= \avail -> + viewSharedInformation (Title title) [ViewUsing (fromJust o 'M'.get idx o snd) proposalViewer] proposedAppointments + ||- allTasks [updateInformation (toString w) [] Maybe \\ (w,_) <- papp.startOptions] >>= \avail -> upd (second $ 'M'.alter (fmap (setAvailability user avail)) idx) proposedAppointments where setAvailability :: User [Availability] ProposedAppointment -> ProposedAppointment @@ -156,13 +162,19 @@ where ] ) $> () where - proposalViewer :: Editor ProposedAppointment - proposalViewer = comapEditorValue toTuple $ container4 - (withLabelAttr "Title" gEditor{|*|}) - (withLabelAttr "Duration" gEditor{|*|}) - (withLabelAttr "Participants" usersViewer) - (withLabelAttr "Start options" grid) + schedule start = addAppointment {papp.appointment & when=start} >>| cancel + cancel = + allTasks (map (flip removeTask topLevelTasks) chooseTasks) >>| + upd (second $ 'M'.del idx) proposedAppointments + + proposalViewer :: Editor ProposedAppointment + proposalViewer = comapEditorValue toTuple $ container4 + (withLabelAttr "Title" gEditor{|*|}) + (withLabelAttr "Duration" gEditor{|*|}) + (withLabelAttr "Participants" usersViewer) + (withLabelAttr "Start options" grid) + where toTuple :: ProposedAppointment -> (String, Time, [User], (ChoiceGrid, [Int])) toTuple papp = ( papp.appointment.Appointment.title @@ -179,12 +191,6 @@ 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) @@ -214,7 +220,7 @@ showAppointments = appointments where editor = listEditor Nothing False False Nothing (bijectEditorValue toTuple fromTuple tupEdit) - tupEdit = toolbar5 gEditor{|*|} gEditor{|*|} gEditor{|*|} userViewer usersViewer + tupEdit = listitem5 gEditor{|*|} gEditor{|*|} gEditor{|*|} userViewer usersViewer <<@ directionAttr Horizontal userViewer = comapEditorValue 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} |