git.fiddlerwoaroof.com
Browse code

Round-trip parser working...

fiddlerwoaroof authored on 19/02/2016 17:26:16
Showing 4 changed files
mvc.lisp
History View file @ 9ba1ff1
... ... 
@@ -1,3 +1,4 @@
1 
+#|
1 2
2 3 
 (in-package :timesheet.mvc)
3 4
... ... 
@@ -124,3 +125,4 @@
124 125 
 (defmethod display (model view (output (eql nil)))
125 126 
   (with-output-to-string (s)
126 127 
     (display model view s)))
128 
+|#
package.lisp
History View file @ 9ba1ff1
... ... 
@@ -1,8 +1,13 @@
1 1 
 ;;;; package.lisp
2 2
3 
+(defpackage #:timesheet.parser
4 
+  (:use #:cl #:anaphora #:alexandria #:serapeum #:fwoar.lisputils #:smug)
5 
+  )
6 
+
3 7 
 (defpackage #:timesheet
4 
-  (:use #:cl))
8 
+  (:use #:cl #:anaphora #:alexandria #:serapeum #:fwoar.lisputils)
9 
+  )
5 10
6 11 
 (defpackage #:timesheet.mvc
7 
-  (:use #:cl #:anaphora #:alexandria #:serapeum)
12 
+  (:use #:cl #:anaphora #:alexandria #:serapeum #:fwoar.lisputils)
8 13 
   (:export #:model #:view #:controller #:display #:operate #:has-changed))
parser.lisp
History View file @ 9ba1ff1
9 14 
new file mode 100644
... ... 
@@ -0,0 +1,573 @@
1 
+(in-package #:timesheet.parser)
2 
+
3 
+(defgeneric == (a b)
4 
+  (:method (a b) (eql a b))
5 
+  (:method ((a list) (b list))
6 
+   (if (or (null a) (null b))
7 
+     (and (null a) (null b))
8 
+     (and (== (car a) (car b))
9 
+          (== (cdr a) (cdr b)))))
10 
+  (:method ((a vector) (b vector)) (every #'identity (map 'vector #'== a b))))
11 
+
12 
+(defmacro make-equality (class &body test-defs &environment env)
13 
+  `(defmethod == ((a ,class) (b ,class))
14 
+     (declare (optimize (speed 3)))
15 
+     (and ,@(loop for (slot . test) in test-defs
16 
+                  with test-val = (or (car test) 'eql)
17 
+                  collect `(,test-val (slot-value a ',slot)
18 
+                                  (slot-value b ',slot))))))
19 
+
20 
+(defmacro make-simple-equality (class &key (test 'eql) &environment env)
21 
+  (let ((class-def (find-class class t env)))
22 
+    `(defmethod == ((a ,class) (b ,class))
23 
+       (declare (optimize (speed 3)))
24 
+       (and ,@(loop for slot in (closer-mop:class-direct-slots class-def)
25 
+                    collect (let ((slot (closer-mop:slot-definition-name slot)))
26 
+                              `(,test (slot-value a ',slot)
27 
+                                      (slot-value b ',slot))))))))
28 
+
29 
+#|(defmacro make-equalities (&body defs)                        |#
30 
+#|  `(progn                                                     |#
31 
+#|     ,@(loop for (name test)  in defs                         |#
32 
+#|             collect (list 'make-equality name :test test)))) |#
33 
+
34 
+(eval-when (:compile-toplevel :load-toplevel :execute)
35 
+
36 
+  (defclass day-entry ()
37 
+    ((date :initarg :date)
38 
+     (records :initarg :records)))
39 
+
40 
+  (defclass time-record ()
41 
+    ((client :initarg :client)
42 
+     (ranges :initarg :ranges)
43 
+     (memo :initarg :memo)))
44 
+
45 
+  (defclass time-obj ()
46 
+    ((hour :initarg :hour)
47 
+     (minute :initarg :minute)
48 
+     (second :initarg :second)))
49 
+
50 
+  (defclass date-obj ()
51 
+    ((day-of-week :initarg :day-of-week)
52 
+     (year :initarg :year)
53 
+     (month :initarg :month)
54 
+     (day :initarg :day)))
55 
+
56 
+  (defclass time-mod ()
57 
+    ((amount :initarg :amount)
58 
+     (unit :initarg :unit))))
59 
+
60 
+(defgeneric unparse (token &optional stream)
61 
+  (:method ((token time-mod) &optional stream)
62 
+   (with-slots (amount unit) token
63 
+     (format stream "~@d~a" amount unit)))
64 
+  (:method ((token date-obj)  &optional stream)
65 
+   (with-slots (day-of-week year month day) token
66 
+     (format stream "~a ~2,'0d-~2,'0d-~2,'0d" day-of-week year month day)))
67 
+  (:method ((token time-obj) &optional stream)
68 
+   (with-slots (hour minute second) token
69 
+     (format stream "~2,'0d:~2,'0d:~2,'0d" hour minute second)))
70 
+  (:method ((token time-record) &optional stream)
71 
+   (with-slots (client ranges memo) token
72 
+     (format stream "~&   start@~{~a~^,~}~%   ~a: ~a~%"
73 
+             (loop for (start . rest) in ranges
74 
+                   for end = (car rest)
75 
+                   for mod = (cadr rest)
76 
+                   collect (format nil "~a--~a~a"
77 
+                                   (unparse start)
78 
+                                   (if end (unparse end) "")
79 
+                                   (if mod (unparse mod) "")))
80 
+             client memo)))
81 
+  (:method ((token day-entry) &optional stream)
82 
+   (with-slots (date records) token
83 
+     (format stream "~&-- ~a~&~{~a~}~%"
84 
+             (unparse date)
85 
+             (mapcar #'unparse records)))))
86 
+
87 
+
88 
+(make-simple-equality day-entry :test ==)
89 
+(make-simple-equality time-record :test ==)
90 
+(make-simple-equality time-obj :test eql)
91 
+(make-simple-equality date-obj :test eql)
92 
+(make-simple-equality time-mod :test equal)
93 
+
94 
+
95 
+(st:deftest == ()
96 
+  (st:should be eql t (== #\1 #\1))
97 
+  (st:should be eql t (== 1 1))
98 
+  (st:should be eql t (== "1" "1"))
99 
+  (st:should be eql t (== '("1") '("1")))
100 
+  (st:should be eql t (== #("1") #("1")))
101 
+  (st:should be eql t (== '(1 . 2) '(1 . 2)))
102 
+  (st:should be eql t (== '((1 . 2)) '((1 . 2))))
103 
+  (st:should be eql t
104 
+             (== (make-time-mod 3 "mins")
105 
+                 (make-time-mod 3 "mins")))
106 
+  (st:should be eql t
107 
+             (== (list (make-time-mod 3 "mins"))
108 
+                 (list (make-time-mod 3 "mins"))))
109 
+  (st:should be eql t
110 
+             (== #((make-time-mod 3 "mins"))
111 
+                 #((make-time-mod 3 "mins")))))
112 
+
113 
+
114 
+
115 
+(defun make-day-entry (date records)
116 
+  (make-instance 'day-entry :date date :records records))
117 
+
118 
+(defun make-time-record (ranges memo)
119 
+  (make-instance 'time-record :client (car memo) :ranges ranges :memo (cadr memo)))
120 
+
121 
+(defun make-time-mod (amnt unt)
122 
+  (setf unt (string-downcase unt))
123 
+  (when (string= "min" unt)
124 
+    (setf unt "mins"))
125 
+  (when (string= "hr" unt)
126 
+    (setf unt "hours"))
127 
+  (alet (make-instance 'time-mod)
128 
+    (with-slots (amount unit) it
129 
+      (setf amount amnt unit unt)
130 
+      it)))
131 
+
132 
+(defun make-date-obj (day-of-week year month day)
133 
+  (make-instance 'date-obj :day-of-week day-of-week :year year :month month :day day))
134 
+
135 
+(defun make-time-obj (hour minute &optional second)
136 
+  (make-instance 'time-obj :hour hour :minute minute :second second))
137 
+
138 
+(defmacro defmethod-and-inverse (name (arga argb) &body body)
139 
+  `(progn
140 
+     (defmethod ,name (,arga ,argb)
141 
+       (declare (optimize (speed 3)))
142 
+       ,@body)
143 
+     (defmethod ,name (,argb ,arga)
144 
+       (declare (optimize (speed 3)))
145 
+       ,@body)))
146 
+
147 
+(defmethod-and-inverse == ((date-obj date-obj) (list list))
148 
+  (with-slots (day-of-week year month day) date-obj
149 
+    (every #'== (list day-of-week year month day) list)))
150 
+
151 
+(defmethod-and-inverse == ((time-obj time-obj) (list list))
152 
+  (with-slots (hour minute second) time-obj
153 
+    (every #'== (list hour minute second) list)))
154 
+
155 
+(defmacro define-printer ((obj stream &key (type t) (identity t)) &body body)
156 
+  `(defmethod print-object ((,obj ,obj) ,stream)
157 
+     (print-unreadable-object (,obj ,stream :type ,type :identity ,identity)
158 
+       ,@body)))
159 
+
160 
+(define-printer (date-obj s)
161 
+  (with-slots (day-of-week year month day) date-obj
162 
+    (format s "~a, ~2,'0d/~2,'0d/~2,'0d" (subseq
163 
+                                           (string-capitalize day-of-week)
164 
+                                           0 3)
165 
+            year month day)))
166 
+
167 
+(define-printer (time-obj s)
168 
+  (with-slots (hour minute second) time-obj
169 
+    (format s "~2,'0d:~2,'0d:~2,'0d"  hour minute second)))
170 
+
171 
+(defmethod print-object ((obj day-entry) s)
172 
+  (print-unreadable-object (obj s :type t :identity t)
173 
+    (with-slots (date records) obj
174 
+      (format s "~d records for ~s" (length records) date))))
175 
+
176 
+(defmethod print-object ((obj time-record) s)
177 
+  (print-unreadable-object (obj s :type t :identity t)
178 
+    (with-slots (client) obj
179 
+      (format s "For ~s" client))))
180 
+
181 
+(defmethod print-object ((obj time-mod) s)
182 
+  (print-unreadable-object (obj s :type t :identity t)
183 
+    (with-slots (amount unit) obj
184 
+      (format s "~s ~s" amount unit))))
185 
+
186 
+;; Time:
187 
+;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
188 
+;; [0-2][0-9]:[0-6][0-8]:[0-6][0-6]
189 
+
190 
+(defun .digit ()
191 
+  (.is #'digit-char-p))
192 
+
193 
+(defun .first-hour-char ()
194 
+  (.is (lambda (x)
195 
+         (member x '(#\0 #\1 #\2)))))
196 
+
197 
+(defun .first-minute-char ()
198 
+  (.is (lambda (x)
199 
+         (member x '(#\0 #\1 #\2 #\3 #\4 #\5)))))
200 
+
201 
+(defun .time-separator ()
202 
+  (.char= #\:))
203 
+
204 
+(defun .hour ()
205 
+  (.let* ((f (.first-hour-char))
206 
+          (s (.digit)))
207 
+    (if (or (char/= f #\2) (member s '(#\0 #\1 #\2 #\3))) ;; make sure we don't get 24
208 
+      (.identity (parse-integer (coerce (vector f s) 'string)))
209 
+      (.fail))))
210 
+
211 
+(defun .minute-or-second ()
212 
+  (.let* ((f (.first-minute-char))
213 
+          (s (.digit)))
214 
+    (.identity (parse-integer (coerce (vector f s) 'string)))))
215 
+
216 
+(defun .time-range-separator ()
217 
+  (.string= "--"))
218 
+
219 
+(defun .time ()
220 
+  (.let* ((hour (.hour))
221 
+          (_ (.time-separator))
222 
+          (minute (.minute-or-second))
223 
+          #|(_ (.time-separator))|#
224 
+          (second (.optional
225 
+                    (.progn (.time-separator)
226 
+                            (.minute-or-second)))))
227 
+    (.identity (make-time-obj hour minute (or second 0)))))
228 
+
229 
+(defun .time-unit ()
230 
+  (.or
231 
+    (.string= "mins")
232 
+    (.string= "hrs")
233 
+    (.string= "min")
234 
+    (.string= "hr")))
235 
+
236 
+(defun .time-mod ()
237 
+  (.let* ((sign (.or (.char= #\+) (.char= #\-)))
238 
+          (num (.first (.map 'string (.digit))))
239 
+          (unit (.time-unit)))
240 
+    (.identity
241 
+      (make-time-mod
242 
+        (parse-integer
243 
+          (with-output-to-string (s)
244 
+            (princ sign s)
245 
+            (princ num s)))
246 
+        unit))))
247 
+
248 
+(defun .peek (parser)
249 
+  (lambda (input)
250 
+    (if (run parser input)
251 
+      (list (cons t input))
252 
+      (run (.fail) input))))
253 
+
254 
+(defun .time-range ()
255 
+  (.let* ((start (.time))
256 
+          (_ (.prog1
257 
+               (.time-range-separator)
258 
+               (.peek (.not (.char= #\,)))))
259 
+          (done (.optional (.time)))
260 
+          (mod (.optional (.time-mod))))
261 
+    (when (and mod (not done))
262 
+      (.fail))
263 
+    (if done
264 
+      (if mod
265 
+        (.identity
266 
+          (list start done mod))
267 
+        (.identity (list start done)))
268 
+      (.identity (list start)))))
269 
+
270 
+(defun .zero-or-more (parser)
271 
+  (.plus (.let* ((x parser)
272 
+                 (xs (.zero-or-more parser)))
273 
+           (.identity (cons x xs)))
274 
+         (.identity ())))
275 
+
276 
+(defun .range-list-separator ()
277 
+  (.char= #\,))
278 
+
279 
+(defun .range-list ()
280 
+  (.let*
281 
+    ((ranges (.prog1
282 
+               (.map 'list
283 
+                     (.prog1 (.time-range)
284 
+                             (.optional (.progn (.range-list-separator)
285 
+                                                (.zero-or-more (.char= #\Space))))))
286 
+               (.char= #\Newline))))
287 
+    (let ((lengths (map 'vector #'length ranges)))
288 
+      (if (/= 0 (elt lengths (1- (length lengths))))
289 
+        (.identity ranges)
290 
+        (.fail)))))
291 
+
292 
+(defun .initial-space ()
293 
+  (.string= "   "))
294 
+
295 
+(defun .time-line-start ()
296 
+  (.progn (.initial-space)
297 
+          (.string= "start@")))
298 
+
299 
+(defun .time-line ()
300 
+  (.progn
301 
+    (.time-line-start)
302 
+    (.range-list)))
303 
+
304 
+(defun .client-separator ()
305 
+  (.char= #\:))
306 
+
307 
+(defun .client-name ()
308 
+  (.prog1
309 
+    (.map 'string (.and (.not (.client-separator)) (.item)) :at-least 0)
310 
+    (.client-separator)))
311 
+
312 
+(defun .memo ()
313 
+  (.prog2
314 
+    (.map 'string (.char= #\Space))
315 
+    (.first
316 
+      (.map 'string
317 
+          (.and (.not (.char= #\Newline))
318 
+                (.item))))
319 
+    (.optional (.not (.item)))))
320 
+
321 
+(defun .memo-line ()
322 
+  (.progn
323 
+    (.initial-space)
324 
+    (.let* ((client (.client-name))
325 
+            (memo (.memo)))
326 
+      (.identity (list client memo)))))
327 
+
328 
+(defun .record ()
329 
+  (.let* ((time-line (.time-line))
330 
+          (memo-line (.memo-line)))
331 
+    (.identity (make-time-record time-line memo-line))))
332 
+
333 
+(defun .records ()
334 
+  (.first
335 
+    (.map 'list (.prog1 (.record)
336 
+                        (.or (.map 'string (.char= #\Newline))
337 
+                             (.progn
338 
+                               (.char= #\Newline)
339 
+                               (.not (.item)))
340 
+                             (.not (.item)))))))
341 
+
342 
+(defun .weekday ()
343 
+  (.or (.string-equal "Sunday")
344 
+       (.string-equal "Monday")
345 
+       (.string-equal "Tuesday")
346 
+       (.string-equal "Wednesday")
347 
+       (.string-equal "Thursday")
348 
+       (.string-equal "Friday")
349 
+       (.string-equal "Saturday")))
350 
+
351 
+(defun .year ()
352 
+  (.let* ((fi (.digit))
353 
+          (se (.digit))
354 
+          (th (.digit))
355 
+          (fo (.digit)))
356 
+    (.identity (coerce (list fi se th fo) 'string))))
357 
+
358 
+(defun .first-month-char ()
359 
+  (.or (.char= #\0) (.char= #\1)))
360 
+
361 
+(defun .first-day-char ()
362 
+  (.or (.char= #\0) (.char= #\1) (.char= #\2) (.char= #\3)))
363 
+
364 
+(defun .month ()
365 
+  (.let* ((fi (.first-month-char))
366 
+          (se (.digit)))
367 
+    (when (and (char= fi #\1) (not (member se '(#\1 #\2))))
368 
+      (.fail))
369 
+    (.identity (coerce (list fi se) 'string))) )
370 
+
371 
+(defun .day ()
372 
+  (.let* ((fi (.first-month-char))
373 
+          (se (.digit)))
374 
+    (when (and (char= fi #\3) (not (member se '(#\0 #\1))))
375 
+      (.fail))
376 
+    (.identity (coerce (list fi se) 'string))) )
377 
+
378 
+(defun .date-separator ()
379 
+  (.char= #\-))
380 
+
381 
+(defun .date ()
382 
+  (.let* ((dow (.weekday))
383 
+          (_ (.char= #\Space))
384 
+          (year (.year))
385 
+          (_ (.date-separator))
386 
+          (month (.month))
387 
+          (_ (.date-separator))
388 
+          (day (.day)))
389 
+    (.identity (make-date-obj dow year month day))))
390 
+
391 
+(defun .date-start ()
392 
+  (.string= "-- "))
393 
+
394 
+(defun .date-line ()
395 
+  (.prog2 (.date-start)
396 
+          (.date)
397 
+          (.char= #\Newline)))
398 
+
399 
+(defun .date-record ()
400 
+  (.let* ((date (.date-line))
401 
+         (records (.records)))
402 
+    (.identity (make-day-entry date records))))
403 
+
404 
+(defun .date-records ()
405 
+  (.first (.map 'list (.date-record))))
406 
+
407 
+(defun .parse-all-records ()
408 
+  (.prog1 (.date-records) (.not (.item))))
409 
+
410 
+(defun parse (data)
411 
+  (alet (run (.date-records) data)
412 
+    (values (caar it) (cdar it))))
413 
+
414 
+;; This will help make sure everything is consumed when
415 
+;; we don't care about the parser's output.
416 
+(defun cdar-equal (a b) (== (cdar a) (cdar b)))
417 
+
418 
+(st:deftest memo-test ()
419 
+  (st:should be == '(("asdf" . ""))
420 
+             (run (.client-name) "asdf:"))
421 
+
422 
+  (st:should be == '(("asdf" . ""))
423 
+             (run (.memo) (format nil " asdf")))
424 
+
425 
+  (st:should be == '((("asdf" "asdf") . ""))
426 
+             (run (.memo-line) (format nil "   asdf: asdf"))))
427 
+
428 
+(st:deftest time-line-test ()
429 
+  (st:should be cdar-equal '(("   start@" . ""))
430 
+             (run (.time-line-start) "   start@"))
431 
+
432 
+  (st:should be == '(((((0 0 0))) . ""))
433 
+             (run (.time-line) (format nil "   start@00:00:00--~%")))
434 
+
435 
+  (st:should be == '(((((0 0 0) (1 0 0))) . ""))
436 
+             (run (.time-line) (format nil "   start@00:00:00--01:00:00~%")))
437 
+
438 
+  (st:should be == '(((((0 0 0) (1 0 0))
439 
+                          ((2 0 0)))
440 
+                         . ""))
441 
+             (run (.time-line) (format nil "   start@00:00:00--01:00:00,02:00:00--~%")))
442 
+
443 
+  (st:should be == '(((((0 0 0) (1 0 0))
444 
+                          ((2 0 0) (3 0 0)))
445 
+                         . ""))
446 
+             (run (.time-line) (format nil "   start@00:00:00--01:00:00,02:00:00--03:00:00~%")))
447 
+
448 
+  (st:should be == '(((((0 0 0) (1 0 0))
449 
+                          ((2 0 0)))
450 
+                         . ""))
451 
+             (run (.time-line) (format nil "   start@00:00:00--01:00:00, 02:00:00--~%"))))
452 
+
453 
+(should-test:deftest range-list-test ()
454 
+  (st:should be == '((#\, . ""))
455 
+             (run (.range-list-separator) ","))
456 
+
457 
+  (st:should be == nil
458 
+             (run (.range-list) "30:00:00"))
459 
+
460 
+  (st:should be == nil
461 
+             (run (.range-list) "00:00:00"))
462 
+
463 
+  (st:should be == nil
464 
+             (run (.range-list) "00:00:00--,00:00:00"))
465 
+
466 
+  (st:should be == '(((((0 0 0))) . ""))
467 
+             (run (.range-list) (format nil "00:00:00--~%")))
468 
+
469 
+  (st:should be == '(((((0 0 0) (1 0 0))) . ""))
470 
+             (run (.range-list) (format nil "00:00:00--01:00:00~%")))
471 
+
472 
+  (st:should be == '(((((0 0 0) (1 0 0))
473 
+                          ((2 0 0)))
474 
+                         . ""))
475 
+             (run (.range-list) (format nil "00:00:00--01:00:00,02:00:00--~%")))
476 
+
477 
+  (st:should be == '(((((0 0 0) (1 0 0))
478 
+                          ((2 0 0) (3 0 0)))
479 
+                         . ""))
480 
+             (run (.range-list) (format nil "00:00:00--01:00:00,02:00:00--03:00:00~%")))
481 
+
482 
+  (st:should be == '(((((0 0 0) (1 0 0))
483 
+                          ((2 0 0)))
484 
+                         . ""))
485 
+             (run (.range-list) (format nil "00:00:00--01:00:00, 02:00:00--~%")))) ;; space allowed between ranges
486 
+
487 
+(should-test:deftest time-range-test ()
488 
+  (st:should be == '(("--" . ""))
489 
+             (run (.time-range-separator) "--"))
490 
+
491 
+  (st:should be == nil
492 
+       (run (.time-range) "30:00:00"))
493 
+
494 
+  (st:should be == nil
495 
+       (run (.time-range) "00:00:00"))
496 
+
497 
+  (st:should be == nil
498 
+       (run (.time-range) "00:00:00--,01:00:00--"))
499 
+
500 
+  (st:should be == '((((0 0 0)) . ""))
501 
+       (run (.time-range) "00:00:00--"))
502 
+
503 
+  (st:should be == '((((0 0 0) (1 0 0)) . ""))
504 
+       (run (.time-range) "00:00:00--01:00:00")))
505 
+
506 
+(should-test:deftest time-test ()
507 
+  (st:should be == '((#\: . ""))
508 
+             (run (.time-separator) ":"))
509 
+
510 
+  (st:should be == nil
511 
+       (run (.time) "30:00:00"))
512 
+
513 
+  (st:should be == '(((0 0 0) . ""))
514 
+       (run (.time) "00:00:00")))
515 
+
516 
+(should-test:deftest digit-test ()
517 
+  (loop for char in '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
518 
+        do (st:should be == `((,char . ""))
519 
+                      (run (.digit) (make-string 1 :initial-element char)))) )
520 
+
521 
+(should-test:deftest minute-test ()
522 
+  (st:should be == nil
523 
+             (run (.first-minute-char) "a"))
524 
+  (st:should be == nil
525 
+             (run (.first-minute-char) "6"))
526 
+  (st:should be == nil
527 
+             (run (.first-minute-char) "-1"))
528 
+  (loop for char in '(#\0 #\1 #\2 #\3 #\4 #\5)
529 
+        do (st:should be == `((,char . ""))
530 
+                      (run (.first-minute-char) (make-string 1 :initial-element char))))
531 
+
532 
+  (st:should be == nil
533 
+             (run (.minute-or-second) "61"))
534 
+
535 
+  (st:should be == nil
536 
+             (run (.minute-or-second) "71"))
537 
+
538 
+  (st:should be == nil
539 
+             (run (.minute-or-second) "0"))  ;; one digit
540 
+
541 
+  (st:should be == nil
542 
+             (run (.minute-or-second) "aa"))
543 
+
544 
+  (st:should be == `((1 . ""))
545 
+             (run (.minute-or-second) "01")))
546 
+
547 
+
548 
+(should-test:deftest hour-test ()
549 
+  (st:should be == nil
550 
+             (run (.first-hour-char) "a"))
551 
+  (st:should be == nil
552 
+             (run (.first-hour-char) "3"))
553 
+  (st:should be == nil
554 
+             (run (.first-hour-char) "-1"))
555 
+
556 
+  (loop for char in '(#\0 #\1 #\2)
557 
+        do (st:should be == `((,char . ""))
558 
+                      (run (.first-hour-char) (make-string 1 :initial-element char))))
559 
+
560 
+  (st:should be == nil
561 
+             (run (.hour) "24"))
562 
+
563 
+  (st:should be == nil
564 
+             (run (.hour) "71"))
565 
+
566 
+  (st:should be == nil
567 
+             (run (.hour) "0"))
568 
+
569 
+  (st:should be == nil
570 
+             (run (.hour) "aa"))
571 
+
572 
+  (st:should be == `((1 . ""))
573 
+             (run (.prog1 (.hour) (.not (.item))) "01")))
timesheet.asd
History View file @ 9ba1ff1
... ... 
@@ -1,3 +1,4 @@
1 
+(in-package :asdf-user)
1 2 
 ;;;; timesheet.asd
2 3
3 4 
 (asdf:defsystem #:timesheet
... ... 
@@ -9,9 +10,14 @@
9 10 
                #:anaphora
10 11 
                #:ningle
11 12 
                #:spinneret
12 
-               )
13 
+               #:should-test
14 
+               #:fwoar.lisputils
15 
+               #:smug
16 
+               #:cells
17 
+               #:manardb)
13 18 
   :serial t
14 19 
   :components ((:file "package")
20 
+               (:file "parser")
15 21 
                (:file "mvc")
16 22 
                (:file "timesheet")))
17 23