(module iso8601-parse
    (iso8601-parse)

(import chicken scheme)

(use (srfi 1 13)
     extras
     regex)

(define iso8601-extended-format-regexp
  (regexp
   '(: ($ (? ("+-")) (= 4 numeric))
       (or (: (? #\- ($ (= 2 numeric)))
              (? #\- ($ (= 2 numeric))))
           (: #\- #\W ($ (= 2 numeric))
              (? #\- ($ numeric)))
           (: #\- ($ (= 3 numeric))))
       (? (or ($ (",.") (+ numeric))
              (: #\T ($ (= 2 numeric))
                 (? #\: ($ (= 2 numeric)))
                 (? #\: ($ (= 2 numeric)))
                 (? ($ (",.") (+ numeric)))
                 (? (or ($ #\Z)
                        (: ($ ("+-"))
                           ($ (= 2 numeric))
                           (? #\: ($ (= 2 numeric))))))))))))

(define iso8601-basic-format-regexp
  (regexp
   '(: ($ (? ("+-")) (= 4 numeric))
       (or (: ($ (= 2 numeric))
              ($ (= 2 numeric)))
           (: #\W ($ (= 2 numeric))
              (? ($ numeric)))
           ($ (= 3 numeric)))
       (? (or ($ (",.") (+ numeric))
              (: #\T ($ (= 2 numeric))
                 (? ($ (= 2 numeric)))
                 (? ($ (= 2 numeric)))
                 (? ($ (",.") (+ numeric)))
                 (? (or ($ #\Z)
                        (: ($ ("+-"))
                           ($ (= 2 numeric))
                           (? ($ (= 2 numeric))))))))))))

(define (iso8601-parse str)
  (and-let* ((m (or (string-match iso8601-extended-format-regexp str)
                    (string-match iso8601-basic-format-regexp str))))
    (apply
     (lambda (year month day week weekday ordinal-date date-frac
              hours minutes seconds time-frac
              z? offset-sign offset-hours offset-minutes)
       (cond
        ((and hours (or (not month) (not day)))
         #f)
        (else
         (list year month day week weekday ordinal-date date-frac
               hours minutes seconds time-frac
               z? offset-sign offset-hours offset-minutes))))
     (map
      (lambda (x)
        (cond
         ((not x) x)
         ((member x '("+" "-" "Z")) (string->symbol x))
         ((eqv? #\, (string-ref x 0))
          (string->number (string-append "." (string-drop x 1))))
         (else (string->number x))))
      (cdr m)))))

)