forked from urweb/upo
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmeetingGrid.urs
144 lines (121 loc) · 6.82 KB
/
meetingGrid.urs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(* Scheduling meetings between two groups of users ("home" and "away").
* The set of legal meeting times (represented with a table) is another parameter. *)
functor Make(M : sig
con homeKey1 :: Name
type homeKeyT
con homeKeyR :: {Type}
constraint [homeKey1] ~ homeKeyR
con homeKey = [homeKey1 = homeKeyT] ++ homeKeyR
con homeOffice :: {Type}
con homeHardConst :: {Type}
con homeSoftConst :: {Type}
con homeRest :: {Type}
constraint homeKey ~ homeRest
constraint (homeKey ++ homeRest) ~ homeOffice
constraint (homeKey ++ homeRest ++ homeOffice) ~ homeSoftConst
constraint (homeKey ++ homeRest ++ homeOffice ++ homeSoftConst) ~ homeHardConst
con homeKeyName :: Name
con homeOtherConstraints :: {{Unit}}
constraint [homeKeyName] ~ homeOtherConstraints
val home : sql_table (homeKey ++ homeOffice ++ homeSoftConst ++ homeHardConst ++ homeRest) ([homeKeyName = map (fn _ => ()) homeKey] ++ homeOtherConstraints)
val homeInj : $(map sql_injectable_prim homeKey)
val homeKeyFl : folder homeKey
val homeKeyShow : show $homeKey
val homeKeyRead : read $homeKey
val homeKeyEq : $(map eq homeKey)
val homeKeyOrd : $(map ord homeKey)
val officeFl : folder homeOffice
val officeRender : $homeKey -> $homeOffice -> xbody
val homeSoftConstFl : folder homeSoftConst
val homeSoftConstInj : $(map sql_injectable homeSoftConst)
val homeSoftConst : $homeSoftConst
val homeHardConstFl : folder homeHardConst
val homeHardConstInj : $(map sql_injectable homeHardConst)
val homeHardConst : $homeHardConst
con awayKey1 :: Name
type awayKeyT
con awayKeyR :: {Type}
constraint [awayKey1] ~ awayKeyR
con awayKey = [awayKey1 = awayKeyT] ++ awayKeyR
con awayConst :: {Type}
con awayFilter :: {Type}
con awayRest :: {Type}
constraint awayKey ~ awayRest
constraint (awayKey ++ awayRest) ~ awayConst
constraint (awayKey ++ awayRest ++ awayConst) ~ awayFilter
con awayKeyName :: Name
con awayOtherConstraints :: {{Unit}}
constraint [awayKeyName] ~ awayOtherConstraints
val away : sql_table (awayKey ++ awayConst ++ awayFilter ++ awayRest) ([awayKeyName = map (fn _ => ()) awayKey] ++ awayOtherConstraints)
val awayInj : $(map sql_injectable_prim awayKey)
val awayKeyFl : folder awayKey
val awayKeyShow : show $awayKey
val awayKeyRead : read $awayKey
val awayKeyEq : $(map eq awayKey)
val awayKeyOrd : $(map ord awayKey)
val awayConstFl : folder awayConst
val awayConstInj : $(map sql_injectable awayConst)
val awayConst : $awayConst
val awayFilterFl : folder awayFilter
con timeKey1 :: Name
type timeKeyT
con timeKeyR :: {Type}
constraint [timeKey1] ~ timeKeyR
con timeKey = [timeKey1 = timeKeyT] ++ timeKeyR
con timeRest :: {Type}
constraint timeKey ~ timeRest
con timeKeyName :: Name
con timeOtherConstraints :: {{Unit}}
constraint [timeKeyName] ~ timeOtherConstraints
val time : sql_table (timeKey ++ timeRest) ([timeKeyName = map (fn _ => ()) timeKey] ++ timeOtherConstraints)
val timeInj : $(map sql_injectable_prim timeKey)
val timeKeyFl : folder timeKey
val timeKeyShow : show $timeKey
val timeKeyRead : read $timeKey
val timeKeyEq : $(map eq timeKey)
constraint homeKey ~ awayKey
constraint (homeKey ++ awayKey) ~ timeKey
constraint homeOffice ~ timeKey
constraint (homeKey ++ awayKey) ~ [ByHome, Channel]
val amHome : transaction (option $homeKey)
val amAway : transaction (option $awayKey)
(* We also allow for interleaving fixed events in individual schedules, calling this function to get the list. *)
val fixed : transaction (list {When : $timeKey, Descr : string})
val timeOrd : ord $timeKey
(* Sometimes we want to make the schedule read-only past some point. *)
val isNowReadOnly : transaction bool
end) : sig
(* Two nested modules provide views centered on the home and away perspectives, respectively. *)
structure Home : sig
(* Display a full, editable grid of all meetings (rows: homes, columns: times). *)
structure FullGrid : Ui.S0
(* Display a read-only record of all records for a home. *)
structure One : Ui.S where type input = $M.homeKey
(* Inputing meeting preferences for a home *)
structure Prefs : Ui.S where type input = $M.homeKey
(* Inputing schedule constraints for a home *)
structure Unavail : Ui.S where type input = $M.homeKey
(* Delete all of this person's meetings. *)
val deleteFor : $M.homeKey -> transaction unit
(* Display who asked to meet with a home. *)
structure WhoAskedFor : Ui.S where type input = $M.homeKey
end
structure Away : sig
(* Display a full, editable grid of all meetings (rows: aways, columns: times). *)
structure FullGrid : Ui.S where type input = $(M.awayKey ++ M.awayFilter) -> signal bool
(* Display a read-only record of all records for an away. *)
structure One : Ui.S where type input = $M.awayKey
(* Inputing meeting preferences for an away *)
structure Prefs : Ui.S where type input = $M.awayKey
(* Inputing schedule constraints for an away *)
structure Unavail : Ui.S where type input = $M.awayKey
(* Delete all of this person's meetings. *)
val deleteFor : $M.awayKey -> transaction unit
(* Display who asked to meet with an away. *)
structure WhoAskedFor : Ui.S where type input = $M.awayKey
end
(* Using preferences from both sides, try to schedule more meetings heuristically. *)
val scheduleSome : transaction unit
(* And if you really want an SQL view of the current meeting state, use this one. *)
view meetings : (M.homeKey ++ M.timeKey ++ M.awayKey)
end