Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/rlmdb/lexical.lisp

KindCoveredAll%
expression50269 18.6
branch012 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.rdf.lmdb.implementation)
4
 
5
 (:documentation "lexical operators for temporal revision designators:
6
   A designator may include base, interval and repetition components.
7
   Resolve the base component to its UUID (optionally offset).
8
   Interpret the relative components wrt that to yield one of
9
   - a second (offset) UUID
10
   - an interval as duration or count
11
   - a repetition as a duration or count
12
 
13
   Offsets follow the convention
14
   - signed ordinals are interpreted as given
15
   - unsigned ordinals or a simple ‘~’ is sign inverted
16
   - durations are interpreted as given
17
  ")
18
 
19
 
20
 (setf (cl-ppcre:parse-tree-synonym 'revision-name)
21
       '(:alternation "HEAD" "TAIL"))
22
 
23
 (setf (cl-ppcre:parse-tree-synonym 'revision-ordinal)
24
       'integer)
25
 
26
 (setf (cl-ppcre:parse-tree-synonym 'revision-timestamp)
27
       '(:sequence (:alternation #\t #\T) (:register integer) (:greedy-repetition 0 1 (:alternation #\z #\Z))))
28
 
29
 (setf (cl-ppcre:parse-tree-synonym 'revision-offset)
30
       '(:sequence (:register #\~) (:greedy-repetition 0 1
31
                                                       (:alternation (:register integer)
32
                                                                     (:register spocq.i::day-time-duration-string)))))
33
 
34
 (setf (cl-ppcre:parse-tree-synonym 'revision-designator)
35
       ;; allow for uuid, symbolic and date with optional relation
36
       '(:sequence (:alternation (:register spocq.i::uuid)
37
                                 (:register spocq.i::date-time-string)
38
                                 (:register revision-name)
39
                                 revision-timestamp ;; includes registers
40
                                 (:register revision-ordinal))
41
                   (:greedy-repetition 0 1 revision-offset)))
42
 
43
 (setf (cl-ppcre:parse-tree-synonym 'compound-revision-designator)
44
       ;; allow for revision designator combination with 
45
       ;; fixed internval ("--")
46
       ;; interval as time duration or count
47
       ;; - repetition as time duration or count
48
       ; start
49
       '(:sequence (:greedy-repetition 0 1 (:sequence (:alternation #\r #\R) (:register integer) #\/))
50
                   revision-designator ;; includes registers
51
                   ;end
52
                   (:greedy-repetition 0 1 (:sequence "--" revision-designator))
53
                   ;window
54
                   (:greedy-repetition 0 1 (:sequence #\/ (:alternation (:register spocq.i::date-time-string)
55
                                                                        (:register spocq.i::day-time-duration-string)
56
                                                                        (:register revision-ordinal))
57
                                                      ; repeat
58
                                                      (:greedy-repetition 0 1 (:sequence #\/ (:alternation (:register spocq.i::day-time-duration-string)
59
                                                                                                           (:register revision-ordinal))))))))
60
 
61
 
62
 (defparameter *revision-uuid-scanner*
63
   (cl-ppcre:create-scanner '(:sequence :start-anchor
64
                                        (:register spocq.i::uuid)
65
                                        (:greedy-repetition 0 1 revision-offset)
66
                                        :end-anchor)))
67
 
68
 (defun parse-revision-uuid (designator)
69
   (multiple-value-bind (match components)
70
                        (cl-ppcre:scan-to-strings *revision-uuid-scanner* designator)
71
     (when match
72
       (values (aref components 0)
73
               (when (aref components 1)
74
                 (let ((offset (aref components 2)))
75
                   (if offset
76
                       (case (char offset 0)
77
                         ((#\+ #\-) (parse-integer offset))
78
                         (t (- (parse-integer offset))))
79
                       -1)))))))
80
 
81
 
82
 (defparameter *revision-name-scanner*
83
   (cl-ppcre:create-scanner '(:sequence (:register revision-name)
84
                                        (:greedy-repetition 0 1 revision-offset))
85
                            :case-insensitive-mode t))
86
 
87
 (defun revision-symbol (designator)
88
   (find-symbol (string-upcase designator) :keyword))
89
 
90
 (defun parse-revision-name (designator)
91
   (multiple-value-bind (match components)
92
                        (cl-ppcre:scan-to-strings *revision-name-scanner* designator)
93
     (when match
94
       (values (revision-symbol (aref components 0))
95
               (when (aref components 1)
96
                 (let ((offset (aref components 2)))
97
                   (if offset
98
                       (case (char offset 0)
99
                         ((#\+ #\-) (parse-integer offset))
100
                         (t (- (parse-integer offset))))
101
                       -1)))))))
102
 
103
 
104
 (defparameter *revision-date-time-scanner*
105
   (cl-ppcre:create-scanner '(:sequence :start-anchor
106
                                        (:register spocq.i::date-time)
107
                                        (:greedy-repetition 0 1 revision-offset)
108
                                        :end-anchor)))
109
 
110
 (defun parse-revision-date-time (designator)
111
   (multiple-value-bind (match components)
112
                        (cl-ppcre:scan-to-strings *revision-date-time-scanner* designator)
113
     (when match
114
       (values (spocq.i::|-yyyy-MM-ddTHH:mm:ss(ZZZZZZ)?| (aref components 0))
115
               (when (aref components 14)
116
                 (cond ((aref components 15) (let ((offset (aref components 15)))
117
                                               (case (char offset 0)
118
                                                 ((#\+ #\-) (parse-integer offset))
119
                                                 (t (- (parse-integer offset))))))
120
                       ((aref components 16) (spocq.i::|PnDTnHnMnS| (aref components 16)))
121
                       (t -1)))))))
122
 
123
 
124
 (defun parse-revision-timestamp (designator)
125
   (multiple-value-bind (match components)
126
                        (cl-ppcre:scan-to-strings (load-time-value (cl-ppcre:create-scanner '(:sequence :start-anchor
127
                                                                                                        revision-timestamp
128
                                                                                                        (:greedy-repetition 0 1 (:sequence (:register #\~)
129
                                                                                                                                           (:greedy-repetition 0 1 (:register integer))))
130
                                                                                                        :end-anchor)))
131
                                                  designator)
132
     (when match
133
       (values (parse-integer (aref components 0))
134
               (when (aref components 1)
135
                 (let ((offset (aref components 2)))
136
                   (if offset
137
                       (case (char offset 0)
138
                         ((#\+ #\-) (parse-integer offset))
139
                         (t (- (parse-integer offset))))
140
                     -1)))))))
141
 
142
 
143
 
144
 (defparameter *revision-designator-scanner*
145
   (cl-ppcre:create-scanner '(:sequence :start-anchor
146
                                        revision-designator
147
                                        :end-anchor)
148
                            :case-insensitive-mode t))
149
 
150
 (defun parse-revision-designator (designator)
151
   (cl-ppcre:register-groups-bind (min-uuid min-date-time min-name min-timestamp min-ordinal
152
                                            min-offset-indicator min-offset-ordinal min-offset-duration)
153
                                  ('(:sequence :start-anchor
154
                                               revision-designator
155
                                               :end-anchor)
156
                                   designator)
157
     (values (cond (min-uuid)
158
                   (min-date-time (spocq.i::|-yyyy-MM-ddTHH:mm:ss(ZZZZZZ)?| min-date-time))
159
                   (min-name (revision-symbol min-name))
160
                   (min-timestamp (rlmdb:make-temporal-location :timeline-location (parse-integer min-timestamp)))
161
                   (min-ordinal (parse-integer min-ordinal)))
162
             (cond (min-offset-ordinal (case (char min-offset-ordinal 0)
163
                                         ((#\+ #\-) (parse-integer min-offset-ordinal))
164
                                         (t (- (parse-integer min-offset-ordinal)))))
165
                   (min-offset-duration (spocq.i::|PnDTnHnMnS| min-offset-duration))
166
                   (min-offset-indicator -1)))))
167
 
168
 (defparameter *compound-revision-designator-scanner*
169
   (cl-ppcre:create-scanner '(:sequence :start-anchor
170
                                        compound-revision-designator
171
                                        :end-anchor)
172
                            :case-insensitive-mode t))
173
 
174
 (defun compound-revision-designator-plist (revision-expression)
175
   "Deconstruct a compound revision designator into a component property list."
176
   (cl-ppcre:register-groups-bind (repeat-count
177
                                   min-uuid min-date-time min-name min-timestamp min-ordinal
178
                                   min-offset-indicator min-offset-ordinal min-offset-duration
179
                                   max-uuid max-date-time max-name max-timestamp max-ordinal
180
                                   max-offset-indicator max-offset-ordinal max-offset-duration
181
                                   interval-date-time interval-duration interval-ordinal repeat-duration repeat-ordinal)
182
                                  ('(:sequence :start-anchor :case-insensitive-p
183
                                               compound-revision-designator
184
                                               :end-anchor)
185
                                   revision-expression)
186
        (append (when repeat-count `(:repeat-count ,(parse-integer repeat-count)))
187
                (when min-uuid `(:min-uuid ,min-uuid))
188
                (when min-date-time `(:min-date-time ,(spocq.i::|-yyyy-MM-ddTHH:mm:ss(ZZZZZZ)?| min-date-time)))
189
                (when min-name `(:min-name ,(revision-symbol min-name)))
190
                (when min-timestamp `(:min-timestamp ,(rlmdb:make-temporal-location :timeline-location (parse-integer min-timestamp))))
191
                (when min-ordinal `(:min-ordinal ,(parse-integer min-ordinal)))
192
                (when min-offset-indicator `(:min-offset-indicator t))
193
                (when min-offset-ordinal `(:min-offset-value ,(case (char min-offset-ordinal 0)
194
                                                                ((#\+ #\-) (parse-integer min-offset-ordinal))
195
                                                                (t (- (parse-integer min-offset-ordinal))))))
196
                (when min-offset-duration `(:min-offset-value ,(spocq.i::|PnDTnHnMnS| min-offset-duration)))
197
                (when max-uuid `(:max-uuid ,max-uuid))
198
                (when max-date-time `(:max-date-time ,(spocq.i::|-yyyy-MM-ddTHH:mm:ss(ZZZZZZ)?| max-date-time)))
199
                (when max-name `(:max-name ,(revision-symbol max-name)))
200
                (when max-timestamp `(:max-timestamp ,(rlmdb:make-temporal-location :timeline-location (parse-integer max-timestamp))))
201
                (when max-ordinal `(:max-ordinal ,(parse-integer max-ordinal)))
202
                (when max-offset-indicator `(:max-offset-indicator t))
203
                (when max-offset-ordinal `(:max-offset-value ,(case (char max-offset-ordinal 0)
204
                                                                ((#\+ #\-) (parse-integer max-offset-ordinal))
205
                                                                (t (- (parse-integer max-offset-ordinal))))))
206
                (when max-offset-duration `(:max-offset-value ,(spocq.i::|PnDTnHnMnS| max-offset-duration)))
207
                (when interval-date-time `(:interval-date-time ,(spocq.i::|-yyyy-MM-ddTHH:mm:ss(ZZZZZZ)?| interval-date-time)))
208
                (when interval-duration `(:interval-duration ,(spocq.i::|PnDTnHnMnS| interval-duration)))
209
                (when interval-ordinal `(:interval-ordinal ,(parse-integer interval-ordinal)))
210
                (when repeat-duration `(:repeat-duration ,(spocq.i::|PnDTnHnMnS| repeat-duration)))
211
                (when repeat-ordinal `(:repeat-ordinal ,(parse-integer repeat-ordinal))))))
212
 
213
 (defun rlmdb:parse-compound-revision-designator (designator)
214
    "Deconstruct a compound revision designator and return four component values:
215
  - the base revision, as uuid, date-time, name or ordinal
216
  - the end revision, as for the base, or nil
217
  - the interval as day-time-duration or ordinal offset, or nil
218
  - the repeat as day-time-duration or ordinal offset, or nil
219
 
220
  Allow forms which either combine simple revision designators or specifiy a rfc1123 date, but none which mix the two.
221
   "
222
   (let ((designator-combinations (compound-revision-designator-plist designator)))
223
     (if designator-combinations
224
         (destructuring-bind (&key min-uuid min-date-time min-name min-timestamp min-ordinal min-offset-indicator min-offset-value
225
                                   max-uuid max-date-time max-name max-timestamp max-ordinal max-offset-indicator max-offset-value
226
                                   interval-date-time interval-duration interval-ordinal
227
                                   repeat-count repeat-duration repeat-ordinal)
228
                             designator-combinations
229
           (values (or min-uuid min-date-time min-name min-timestamp min-ordinal)
230
                   (or min-offset-value (if min-offset-indicator -1))
231
                   (or max-uuid max-date-time max-name max-timestamp max-ordinal)
232
                   (or max-offset-value (if max-offset-indicator -1))
233
                   (or interval-date-time interval-duration interval-ordinal)
234
                   (or repeat-duration repeat-ordinal)
235
                   repeat-count))
236
         (let ((universal-time (spocq.i::parse-rfc1123 designator :junk-allowed t)))
237
           (when universal-time
238
             (spocq.i::universal-time-date-time universal-time))))))
239
 
240
 
241
 ����