(define-module (vcomponent timezone)
  :use-module (vcomponent base)
  :use-module ((srfi srfi-1) :select (find))
  :use-module (srfi srfi-19)
  :use-module (srfi srfi-19 util)
  :use-module (srfi srfi-41)
  :use-module (srfi srfi-41 util)
  :use-module (util)
  :use-module ((vcomponent recurrence generate) :select (generate-recurrence-set))
  :use-module ((vcomponent datetime) :select (ev-time<?))
  )

;;@begin example
;; <VTIMEZONE> :: "#<vcomponent 558c5da80fc0>"
;;                  TZID: Europe/Stockholm
;;        X-LIC-LOCATION: Europe/Stockholm
;; : <DAYLIGHT> :: "#<vcomponent 558c5e11e7c0>"
;; :                RRULE: FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU
;; :              DTSTART: 19700329T020000
;; :               TZNAME: CEST
;; :           TZOFFSETTO: +0200
;; :         TZOFFSETFROM: +0100
;; : <STANDARD> :: "#<vcomponent 558c5e11e7e0>"
;; :                RRULE: FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU
;; :              DTSTART: 19701025T030000
;; :               TZNAME: CET
;; :           TZOFFSETTO: +0100
;; :         TZOFFSETFROM: +0200
;; @end example

;;; GENERAL INFINITE EXTRAPOLATION OF TIMEZONE DATA IS IMPOSSIBLE, SINCE TIMEZONES
;;; DON'T CHANGE THAT PREDICTABLY

;; @begin example
;; BEGIN:VTIMEZONE
;;  TZID:Europe/Stockholm
;;  BEGIN:STANDARD
;;   DTSTART;VALUE=DATE-TIME:20181028T020000
;;   TZNAME:CET
;;   TZOFFSETFROM:+0200
;;   TZOFFSETTO:+0100
;;  END:STANDARD
;;  BEGIN:DAYLIGHT
;;   DTSTART;VALUE=DATE-TIME:20190331T030000
;;   TZNAME:CEST
;;   TZOFFSETFROM:+0100
;;   TZOFFSETTO:+0200
;;  END:DAYLIGHT
;; END:VTIMEZONE
;; @end example
;; This should really be parsed as:
;; STANDARD : [2018-10-28 02:00, 2019-03-31 03:00)
;; DAYLIGHT : [2019-03-21 03:00, ∞)

;; Given a tz stream of length 2, takes the time difference between the DTSTART
;; of those two. And creates a new VTIMEZONE with that end time.
;; TODO set remaining properties, and type of the newly created component.
(define (extrapolate-tz-stream strm)
  (let ((nevent (copy-vcomponent (stream-car strm))))
    (set! (attr nevent 'DTSTART)
      ))


  ;; old code fails since (length standard) ≠ (length summer)
  ;; Also, it copies the summmer time, making the alternation
  ;; break (but that wasn't the primary problem)

  #;
  (let ((nevent (copy-vcomponent (stream-ref strm 1))))
    (mod! (attr nevent 'DTSTART)
          = (add-duration (time-difference
                           (attr (stream-ref strm 1) 'DTSTART)
                           (attr (stream-ref strm 0) 'DTSTART))))
    (stream-append strm (stream nevent))))

;; The RFC requires that at least one DAYLIGHT or STANDARD component is present.
;; Any number of both can be present. This should handle all these cases well,
;; as long as noone has multiple overlapping timezones, which depend on some
;; further condition. That feels like something that should be impossible, but
;; this is (human) time we are talking about.
(define-public (make-tz-set tz)
  (let ((strm (interleave-streams
               ev-time<?
               ;; { DAYLIGHT, STANDARD }
               (map generate-recurrence-set (children tz)))))

    (cond [(stream-null? strm) stream-null]

          [(stream-null? (stream-drop 2 strm))
           (let ((strm (extrapolate-tz-stream strm)))
             (stream-zip strm (stream-cdr strm)))]

          [else (stream-zip strm (stream-cdr strm))])))

;; str ::= ±[0-9]{4}
;; str → int seconds
(define (parse-offset str)
  (let* (((± h1 h0 m1 m0) (string->list str)))
    ((primitive-eval (symbol ±))
     (+ (* 60    (string->number (string m1 m0)))
        (* 60 60 (string->number (string h1 h0)))))))

;; Finds the VTIMEZONE with id @var{tzid} in calendar.
;; Crashes on error.
(define (find-tz cal tzid)
  (let ((ret (find (lambda (tz) (string=? tzid (attr tz 'TZID)))
                   (filter (lambda (o) (eq? 'VTIMEZONE (type o)))
                           (children cal)))))
    ret))

;; Takes a VEVENT.
;; Assumes that DTSTART has a TZID property, and that that TZID is available as
;; a direct child of the parent of @var{ev}.
(define-public (get-tz-offset ev)
  (let ((ret (stream-find
              (lambda (z)
                (let* (((start end) (map (extract 'DTSTART) z)))
                  (and (time<=? start (attr ev 'DTSTART))
                       (time<? (attr ev 'DTSTART) end))))
              (attr (find-tz (parent ev)
                             (car (prop (attr* ev 'DTSTART) 'TZID)))
                    'X-HNH-TZSET))))
    (if (not ret)
        0 (parse-offset (attr (car ret) 'TZOFFSETTO)))))