Browse Source

Finished datecode parser

Samuel W. Flint 9 years ago
parent
commit
6a309ba461
1 changed files with 21 additions and 17 deletions
  1. 21 17
      isodate.lisp

+ 21 - 17
isodate.lisp

@@ -154,17 +154,18 @@
 (defun parse-date (date)
   (declare (string date))
   (let ((date (parse 'whole date)))
-    (multiple-value-bind (second minute hour date month year day daylight-p zone) (decode-universal-time date)
-      (declare (ignorable day daylight-p zone))
+    (multiple-value-bind (second minute hour day month year day-of-year daylight-p zone) (decode-universal-time date)
+      (declare (ignorable day-of-year daylight-p zone))
       (values date
-              (list second minute hour date month year)))))
+              (list second minute hour day month year)))))
 
 (defun print-date (date)
   (declare (integer date))
-  (multiple-value-bind (second minute hour date month year day daylight-p zone) (decode-universal-time date)
+  (multiple-value-bind (second minute hour day-of-month month year day daylight-p zone)
+      (decode-universal-time date)
     (declare (ignorable day daylight-p zone))
     (values (format nil "~4,'0d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0d"
-                    year month date
+                    year month day-of-month
                     hour minute second)
             date)))
 
@@ -173,22 +174,25 @@
           (get-universal-time)))
 
 (defrule minidate
-    (and year (? (and month (? (and day (? (and hour minute second)))))))
-  (:destructure (year (month (day (&optinal hour minute second))))
-                (declare (ignorable month day hour minute second))
-                (if (null month)
-                    (encode-universal-time 0 0 0 1 1 year)
-                    (if (null day)
-                        (encode-universal-time 0 0 0 1 month year)
-                        (if (null hour)
-                            (encode-universal-time 0 0 0 day month year)
-                            (encode-universal-time second minute hour day month year))))))
+    (and year month day (? (and hour minute second)))
+  (:destructure (year month day (&optional hour minute second))
+                (let ((hour (if (null hour) 0 hour))
+                      (minute (if (null minute) 0 minute))
+                      (second (if (null second) 0 second)))
+                  (encode-universal-time second minute hour day month year))))
 
 (defun parse-mini-date (date)
   (declare (string date))
   (values (parse 'minidate date)
           date))
 
-(defun print-mini-date (date))
+(defun print-mini-date (date)
+  (multiple-value-bind (second minute hour day-of-month month year day daylight-p zone)
+      (decode-universal-time date)
+    (declare (ignorable day daylight-p zone))
+    (format nil "~4,'0d~2,'0d~2,'0d~2,'0d~2,'0d~2,'0d"
+            year month day-of-month
+            hour minute second)))
 
-(defun mini-date-stamp ())
+(defun mini-date-stamp ()
+  (print-mini-date (get-universal-time)))