#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do report-zonkables)' -s $0 "$@" # -*-scheme-*-
!#
;;; report-zonkables

;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010,
;;   2011 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; Usage: report-zonkables [options] [ZONKABLES-TEXT-DB-TABLE-FILE]
;;
;; Read text db table file ZONKABLES-TEXT-DB-TABLE-FILE and display to
;; stdout status of the entries listed therein.  Consult file NEWS in
;; the current directory to map release number to calendar date (rn2cd).
;; If ZONKABLES-TEXT-DB-TABLE-FILE is omitted, use ".USER.zonkables",
;; where USER is the result of ‘(passwd:name (getpwuid (getuid)))’.
;; Recognized options:
;;
;;     --init         -- display the db header form to stdout (see below)
;; -n, --news FILE    -- scan FILE for rn2cd mapping [NEWS]
;; -x, --exit-count   -- exit value is the count of zonkables
;;
;; The NEWS file should contain lines of the form (note hyphen and bar):
;;
;; - VERSION | YYYY-MM-DD
;;
;; If the YYYY-MM-DD pattern is not found, the current date is used.
;; The ZONKABLES-TEXT-DB-TABLE-FILE must start with the following form:
;;
;; (text-db-table-config
;;  (delim . "\n")
;;  (fields (#:announced sexp)             ; version
;;          (#:execution sexp)             ; quarters (each 3 months)
;;          (#:type sexp)
;;          (#:name rest-lines-trim)))
;;
;; You can use the ‘--init’ option to write this form to stdout instead
;; of the normal report.  In the normal report, each entry is displayed
;; on its own line with the general format:
;;
;; VERSION (DATE) QUARTERS (EXPIRE-DATE) -- TYPE ‘NAME’ STATUS
;;
;; where STATUS is "planned", "(immediately) zonkable!", "not yet" or
;; "weird!".  The latter occurs if report-zonkables gets confused.
;; VERSION is from #:announced, DATE is from the NEWS file, QUARTERS
;; is from #:execution, EXPIRE-DATE is computed from DATE and QUARTERS,
;; TYPE is from #:type, and NAME is from #:name.

;;; Code:

(define-module (ttn-do report-zonkables)
  #:export (report-zonkables! main)
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((ttn-do zzz personally) #:select (FE fs fso))
  #:use-module ((ttn-do zzz various-db) #:select (read-text-db-table))
  #:use-module ((ttn-do mogrify) #:select (find-file-read-only
                                           editing-buffer)))

(define X 0)
(define NEWS "NEWS")

;; Scan @var{filename}, which must name a file in zonkables text db table
;; format, and display current zonkables analysis to the current output port.
;;
(define (report-zonkables! filename)
  (let* ((zonkables (read-text-db-table filename))
         (buf (and (< 0 (length zonkables))
                   (find-file-read-only NEWS)))
         (rels (make-hash-table 5))
         (now (current-time))
         (count 0))

    (define (date<-rel rel)
      (cond ((hash-ref rels rel))
            ((editing-buffer buf
               (goto-char (point-min))
               (and (search-forward (string-append "\n- " rel " | ")
                                    (point-max) #t)
                    (looking-at "[0-9][-0-9]*")))
             (editing-buffer buf
               (let* ((raw (match-string 0))
                      (tem1 (strptime "%Y-%m-%d" raw))
                      (tem2 (strftime "%s" (car tem1))))
                 (hash-set! rels rel (string->number tem2)))))
            (else
             (hash-set! rels rel now))))

    (define (Ymd seconds)
      (strftime "%F" (localtime seconds)))

    (define (report-one zonkable)
      (define (? field)
        (assq-ref zonkable field))
      (let* ((ann (? #:announced))
             (exe (? #:execution))
             (a (date<-rel ann))
             (z (+ a (* (/ 365 4) 24 60 60 exe))))
        (fso "~A (~A) +~A (~A) -- ~A ‘~A’ ~A~%"
             ann (Ymd a)
             exe (Ymd z)
             (? #:type) (? #:name)
             (cond ((= a now)   "planned")
                   ((< a now z) "not yet")
                   ((< a z now) (set! count (1+ count)) "zonkable!")
                   ((= a z)     "immediately zonkable!")
                   (else        "weird!!")))))

    ;; do it!
    (and buf (editing-buffer buf (toggle-read-only)))
    (FE zonkables report-one)
    (* X count)))

(define *init-boilerplate* ";; -*-scheme-*-

(text-db-table-config
 (delim . \"\\n\")
 (fields (#:announced sexp)             ; version
         (#:execution sexp)             ; quarters (each 3 months)
         (#:type sexp)
         (#:name rest-lines-trim)))")

(define (main/qop qop)
  (cond ((qop 'init)
         (display *init-boilerplate*)
         (newline))
        (else
         (and (qop 'exit-count) (set! X 1))
         (qop 'news (lambda (filename) (set! NEWS filename)))
         (report-zonkables! (or (false-if-exception (car (qop '())))
                                (fs ".~A.zonkables"
                                    (passwd:name (getpwuid (getuid)))))))))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "1.3")
                   ;; 1.3 -- say "planned", use nice single-quotes
                   ;; 1.2 -- handle non-existent YYYY-MM-DD
                   ;; 1.1 -- ZONKABLES-TEXT-DB-TABLE-FILE optional
                   ;; 1.0 -- initial release
                   (help . commentary)))
  (main/qop
   (qop<-args
    args '((init)
           (exit-count (single-char #\x))
           (news (single-char #\n) (value #t))))))

;;; report-zonkables ends here