Skip to content

annotations.stx

pdmosses/webdsl-statix/webdslstatix/trans/static-semantics/entities/annotations.stx

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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
module 

imports
  static-semantics/types/built-ins

  static-semantics/webdsl-actions
  static-semantics/webdsl-entities
  static-semantics/webdsl-types
  static-semantics/webdsl

signature

  sorts
    

  constructors
    // annotations on a property level
              : ANNOTATION
     : ANNOTATION
            : ANNOTATION
    TRANSIENT   : ANNOTATION
         : ANNOTATION
         : ANNOTATION

    // annotations on entity level
     : ANNOTATION
         : ANNOTATION

  relations
     : string * ANNOTATION

rules // annotation declaration and resolving

  // property level
  declareAnnotations maps declareAnnotation(*, *, list(*))
   : scope * string * ANNOTATION
  declareAnnotation(s, p, a) :-
    !annotation[p, a] in s.

   : scope * string -> list((path * (string * ANNOTATION)))
  resolveAnnotation(s, x) = ps :-
    query annotation filter P* F* EXTEND?
                     and { x' :- x' == (x, _) }
                     min $ < P, $ < F, $ < EXTEND, P < F, P < EXTEND, F < EXTEND
                     in s |-> ps.

   : scope * ANNOTATION -> list((path * (string * ANNOTATION)))
  resolveAnnotationByAnno(s, a) = ps :-
    query annotation filter P* F* EXTEND?
                     and { x' :- x' == (_, a) }
                     min $ < P, $ < F, $ < EXTEND, P < F, P < EXTEND, F < EXTEND
                     in s |-> ps.

   : scope * ANNOTATION -> list((path * (string * ANNOTATION)))
  resolveClosestAnnotationByAnno(s, a) = ps :-
    query annotation filter P* F* EXTEND? INHERIT* EXTEND?
                     and { x' :- x' == (_, a) }
                     min $ < P, $ < F, $ < EXTEND, $ < INHERIT,
                         P < F, P < EXTEND, P < INHERIT,
                         F < EXTEND, F < INHERIT,
                         EXTEND < INHERIT
                     and true
                     in s |-> ps.

  // entity level
   : scope * ANNOTATION
  declareEntityAnnotation(s, a) :-
    declareAnnotation(s, "_ENTITY", a).

   : scope -> list((path * (string * ANNOTATION)))
  resolveEntityAnnotation(s) = resolveAnnotation(s, "_ENTITY").

rules // annotations

   maps annotationOk(*, *, *, list(*))
   : scope * string * TYPE * Annotation
  annotationOk(_, _, _, a@SimpleAnno(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@InverseSlaveAnno(_, _)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@InlineAnno(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@SelectAnno(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@IndexEmptyAnno()) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@IndexAnno(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@CollationAnno(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@IdErrorAnno(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@IdEmptyErrorAnno(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.

  annotationOk(_, _, _, a@SearchableAnnoBoost(_, _)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@SearchableAnno2Annotation(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.
  annotationOk(_, _, _, a@SearchNamespaceAnno2Annotation(_)) :- try { false } | warning $[Static analysis not implemented for this annotation] @a.

  annotationOk(s, p, _, TransientAnno()) :-
    declareAnnotation(s, p, TRANSIENT()).

  annotationOk(, p, t, @IdAnno()) :-
    declareAnnotation(s, p, ID()),
    noDuplicateIdAnnotations(s) | error $[Only one id annotatation allowed in an entity] @a,
    equalType(t, string(s))     | error $[Id property must be of type String] @a,
    isTopLevelEntity(s)         | error $[Id annotation not allowed in sub-entities] @a,
    isNoSessionEntity(s)        | error $[Id annotation not allowed in session entities] @a.

  annotationOk(, p, _, NameAnno()) :-
    declareAnnotation(s, p, NAME()),
    noMultipleNameAnnotations(s).

  annotationOk(s, p, _, a@CacheAnno()) :-
    hasAnnotation(resolveAnnotation(s, p), DERIVED()) | error $[cached annotation can only be set on derived properties] @a.

  // inverse property on List<t>
  annotationOk(, p, LIST(t), InverseAnno(sort, )) :- {     }
    declareAnnotation(s, p, INVERSE()),
    new s_eval, s_eval -P-> s,
    sortType == typeOfInverseSort(s_eval, sort, t),
    noDoubleInverse(sortType, prop),
    thisType == typeOfThis(s),
    propType == typeOfProperty(s_eval, sortType, prop),
    inverseListAnnoTypeOk(propType, thisType, prop).

   : TYPE * TYPE * string
  inverseListAnnoTypeOk(T, T, _).
  inverseListAnnoTypeOk(LIST(_), _, prop) :- false | error $[Inverse between lists not allowed] @prop. // correct error message for tests
  inverseListAnnoTypeOk(_, _, prop) :- false | error $[Inverse property must be the same type as this entity] @prop.

  // inverse property on Set<t>
  annotationOk(, p, SET(t), InverseAnno(sort, )) :- {     }
    declareAnnotation(s, p, INVERSE()),
    new s_eval, s_eval -P-> s,
    sortType == typeOfInverseSort(s_eval, sort, t),
    noDoubleInverse(sortType, prop),
    thisType == typeOfThis(s),
    propType == typeOfProperty(s_eval, sortType, prop),
    or(
      equalTypeB(propType, thisType),
      equalTypeB(propType, SET(thisType))
    ) | error $[Inverse property must be the same type as this entity] @prop.

  // inverse property non-collection
  annotationOk(, p, t, InverseAnno(sort, )) :- {     }
    declareAnnotation(s, p, INVERSE()),
    new s_eval, s_eval -P-> s,
    sortType == typeOfInverseSort(s_eval, sort, t),
    noDoubleInverse(sortType, prop),
    thisType == typeOfThis(s),
    propType == typeOfProperty(s_eval, sortType, prop),
    or(orB(
      equalTypeB(propType, thisType),
      equalTypeB(propType, LIST(thisType))),
      equalTypeB(propType, SET(thisType))
    ) | error $[Inverse property must have (a collection of) the same type as this entity] @prop.

  annotationOk(s, p, _, a@InverseReferenceOnlyAnno()) :-
    hasAnnotation(resolveAnnotation(s, p), INVERSE())
      | error $[inverse-reference-only annotation is only allowed on properties that have an inverse specified] @a.

  annotationOk(_, _, _, NotNullAnno()).
  annotationOk(_, _, _, NotEmptyAnno()).
  annotationOk(s, _, propType, a@AllowedAnno(exp)) :- {   }
    t == stripOptionalSetOrListType(propType),
    t' == typeOfExp(s, exp),
    or(
      typeCompatibleB(t', LIST(t)),
      typeCompatibleB(t', SET(t))
    ) | error $[Allowed expression must be a list of set of type [t], [t'] given] @a.

  annotationOk(s, _, , a@DefaultAnno(exp)) :- {}
    t' == typeOfExp(s, exp),
    typeCompatible(t', t) | error $[Default value must be of type [t], [t'] given] @a.

  annotationOk(_, _, _, LengthAnno(_)).
  annotationOk(s, _, _, FormatAnno(str)) :- stringOk(s, str).

   : scope * string * TYPE -> TYPE
  typeOfInverseSort(s, , ) =  :-
    t == ENTITY(_, _) | error $[Inverse annotation only allowed on (collections of) entity types],
    resolveType(s, sort) == [(_, (_, sortType))] | error $[Cannot resolve sort [sort] to an entity],
    sortType == ENTITY(_, _) | error $[Cannot resolve sort [sort] to an entity],
    sortType == t | error $[Inverse entity must be the same as property type [t]].

rules // resolving entity.name

  typeOfProperty(_, ENTITY(_, s_ent), n@"name") = t :- {     }
    resolveClosestAnnotationByAnno(s_ent, NAME()) == [(path, (nameProp, _))],
    s_name == scopeFromPath(path),
    resolveLocalProperty(s_name, nameProp) == [(_, (n', t))],
    @n.ref := n'.

rules // validation

  annotationOk(s, _, _, ValidateCreateAnno(validateExp, messageExp)) :- validateOk(s, validateExp, messageExp).
  annotationOk(s, _, _, ValidateUpdateAnno(validateExp, messageExp)) :- validateOk(s, validateExp, messageExp).
  annotationOk(s, _, _, ValidateDeleteAnno(validateExp, messageExp)) :- validateOk(s, validateExp, messageExp).
  annotationOk(s, _, _, ValidateAnno(validateExp, messageExp)) :- validateOk(s, validateExp, messageExp).
  annotationOk(s, _, _, NamedValidateAnno(_, validateExp, messageExp)) :- validateOk(s, validateExp, messageExp).

   : scope * Exp * Exp
  validateOk(, validateExp, messageExp) :- {   }
    validateType == typeOfExp(s, validateExp),
    messageType == typeOfExp(s, messageExp),
    typeCompatible(validateType, bool(s)) | error $[The expression to be validated should be compatible with type Bool, [validateType] given],
    typeCompatible(messageType, string(s)) | error $[The error message should be compatible with type String, [messageType] given].

rules // predicates

   : scope
  isTopLevelEntity(s) :- doesNotHaveAnnotation(resolveEntityAnnotation(s), SUBENTITY()).

   : scope
  isNoSessionEntity(s) :- doesNotHaveAnnotation(resolveEntityAnnotation(s), SESSIONENTITY()).

   : scope
  noDuplicateIdAnnotations(s) :- resolveAnnotationByAnno(s, ID()) == [_].

   : scope
  noMultipleNameAnnotations(s) :- resolveAnnotationByAnno(s, NAME()) == [_] | error $[Found multiple properties called "name" or with a name annotation].

   : TYPE * string
  noDoubleInverse(ENTITY(_, s_ent), x) :-
    doesNotHaveAnnotation(resolveAnnotation(s_ent, x), INVERSE())
      | error $[Inverse annotations cannot be declared on both sides].

   : scope -> BOOL
  hasIdAnnotationB(s) = notB(emptyAnnotationResultB(resolveAnnotationByAnno(s, ID()))).

   : scope * string -> BOOL
  isMutableB(s, x) = notB(hasAnnotationB(resolveAnnotation(s, x), DERIVED())).

   : scope * string
  isMutable(s, x) :- hasAnnotationB(resolveAnnotation(s, x), DERIVED()) == FALSE().
  isMutable(s, x@"name") :- { t } propertyTypeNoRef(s, x) == t.      // only allow assignment if the property is overridden
  isMutable(s, x@"naturalId") :- { t } propertyTypeNoRef(s, x) == t. // only allow assignment if the property is overridden

   : TYPE * string
  isMutableProperty(_, _) :- false | error $[Can only check mutability of native class and entity properties].
  isMutableProperty(NATIVECLASS(_, _), _). // all native class properties are mutable
  isMutableProperty(ENTITY(_, s_entity), ) :- {}
    annotations == resolveAnnotation(s_entity, x),
    doesNotHaveAnnotation(annotations, DERIVED()) | error $[Property [x] is a derived property and hence cannot be edited]. // correct error message for tests

rules // utils

   : list((path * (string * ANNOTATION))) * ANNOTATION -> BOOL
  hasAnnotationB([], _) = FALSE().
  hasAnnotationB([(_, (_, a)) | tl], a) = TRUE().
  hasAnnotationB([(_, (_, _)) | tl], a) = hasAnnotationB(tl, a).

   : list((path * (string * ANNOTATION))) * ANNOTATION
  hasAnnotation(ps, a) :- hasAnnotationB(ps, a) == TRUE().

   : list((path * (string * ANNOTATION))) * ANNOTATION
  doesNotHaveAnnotation(ps, a) :- hasAnnotationB(ps, a) == FALSE().

  withAnnotation : list((path * (string * TYPE))) * ANNOTATION -> list((path * (string * TYPE)))
  withAnnotation(xs, a) = filterResultsWithBool(zipResultsWithHasAnnoBool(xs, a)).

   : list((path * (string * TYPE))) * ANNOTATION -> list((path * (string * TYPE)))
  withoutAnnotation(xs, a) = filterResultsWithBool(zipResultsWithNotHasAnnoBool(xs, a)).

  zipResultsWithHasAnnoBool maps zipResultWithHasAnnoBool(list(*), *) = list(*)
   : (path * (string * TYPE)) * ANNOTATION -> ((path * (string * TYPE)) * BOOL)
  zipResultWithHasAnnoBool(r@(p, (x, _)), a) = (r, hasAnnotationB(resolveAnnotation(scopeFromPath(p), x), a)).

  zipResultsWithNotHasAnnoBool maps zipResultWithNotHasAnnoBool(list(*), *) = list(*)
   : (path * (string * TYPE)) * ANNOTATION -> ((path * (string * TYPE)) * BOOL)
  zipResultWithNotHasAnnoBool(r@(p, (x, _)), a) = (r, notB(hasAnnotationB(resolveAnnotation(scopeFromPath(p), x), a))).

   : list(((path * (string * TYPE)) * BOOL)) -> list((path * (string * TYPE)))
  filterResultsWithBool([]) = [].
  filterResultsWithBool([(x, TRUE()) | xs]) = [x | filterResultsWithBool(xs)].
  filterResultsWithBool([(_, FALSE()) | xs]) = filterResultsWithBool(xs).

   : list((path * (string * ANNOTATION))) -> BOOL
  emptyAnnotationResultB([]) = TRUE().
  emptyAnnotationResultB(_) = FALSE().