(define-module (src reader)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (json)
  #:use-module (commonmark)
  #:use-module (haunt reader)
  #:use-module (haunt post)
  #:use-module (sxml simple)
  #:use-module (src date-utils)
  #:use-module (src urls)
  #:export (post-reader

            compare-data-filename-for-week))

(define %placeholder-content
  '("No specific news this week, if you know of something happening \
related to Guix, please submit it for the next issue!"))

(define %filename-regexp
  (make-regexp "^posts\\/([0-9]{4})\\/([0-9]{2})/(.*)\\.md$"))

;;; Comparison function data handling

(define (compare-data-filename-for-week year week)
  (format #f "data/~d/~2'0d/compare.json" year week))

(define (lookup-compare-data-for-week year week)
  (let ((filename
         (compare-data-filename-for-week year week)))
    (if (file-exists? filename)
        (call-with-input-file filename json->scm)
        #f)))

(define (get-compare-data-packages-list compare-data key)
  (stable-sort
   (map
    (lambda (package-data)
      (assoc-ref package-data "name"))
    (vector->list
     (or (assoc-ref compare-data key)
         (vector))))
   string<=?))

(define (lookup-news-text target-locale news-entry name type)
  (cdr
   (xml->sxml
    (any (lambda (locale)
           (assoc-ref
            (assoc-ref
             (assoc-ref news-entry name)
             locale)
            type))
         (list target-locale
               (first (string-split target-locale #\_))
               "en"))
    #:entities '((nbsp . "\xa0")
                 (hellip . "…")))))


;;; Post reader

(define post-reader
  (make-reader
   (make-file-extension-matcher "md")
   (lambda (file)
     (call-with-input-file file
       (lambda (port)
         (let ((filename-match
                (regexp-exec %filename-regexp file)))
           (unless filename-match
             (error "Unknown file " file))
           (let* ((year (string->number
                         (match:substring filename-match 1)))
                  (week (string->number
                         (match:substring filename-match 2)))
                  (locale (match:substring filename-match 3))
                  (start-date (lookup-start-date-for-week year week))
                  (end-date (lookup-end-date-for-week year week)))
             (values
              `((slug . ,(weekly-news-post-slug year week
                                                #:locale locale))
                (title . ,(format #f "Week ~2'0d, ~d"
                                  week year))
                (year . ,year)
                (week . ,week)
                (date . ,end-date)
                (start-date . ,start-date)
                (end-date . ,end-date)
                ,@(let ((metadata (read-metadata-headers port)))
                    (if (assoc-ref metadata 'synopsis)
                        metadata
                        `(,@metadata
                          (synopsis
                           . ,(string-append
                               (date->string start-date "~1")
                               " to "
                               (date->string end-date "~1")))))))
              (let* ((compare-data
                      (lookup-compare-data-for-week year week))
                     (news
                      (and=> (assoc-ref compare-data "channel-news")
                             (lambda (news)
                               (if (eq? 0 (vector-length news))
                                   #f
                                   news)))))
                (append
                 (let ((content (commonmark->sxml port)))
                   (if (null? content)
                       (if news
                           `((h3 "News")
                             ,@(map (lambda (news-entry)
                                      `(div
                                        (h4
                                         ,(lookup-news-text locale
                                                            news-entry
                                                            "title-text"
                                                            "html"))
                                        ,(lookup-news-text locale
                                                           news-entry
                                                           "body-text"
                                                           "html")))
                                    (vector->list news)))
                           %placeholder-content)
                       `(,@content
                         ,@(if news
                               (map (lambda (news-entry)
                                      `(div
                                        (h4
                                         ,(lookup-news-text locale
                                                            news-entry
                                                            "title-text"
                                                            "html"))
                                        ,(lookup-news-text locale
                                                           news-entry
                                                           "body-text"
                                                           "html")))
                                    (vector->list news))
                               '()))))
                 `((h3 "Package changes")
                   (h4 "New packages")
                   ,@(match (get-compare-data-packages-list compare-data
                                                            "new-packages")
                       (()
                        '("None"))
                       ((packages ...)
                        (list
                         (string-join packages ", "))))
                   (h4 "Removed packages")
                   ,@(match (get-compare-data-packages-list compare-data
                                                            "removed-packages")
                       (()
                        '("None"))
                       ((packages ...)
                        (list
                         (string-join packages ", "))))
                   (h4 "Version changes")
                   ,@(match (get-compare-data-packages-list compare-data
                                                            "version-changes")
                       (()
                        '("None"))
                       ((packages ...)
                        (list
                         (string-join packages ", "))))
                   (p
                    (a (@ (href
                           ,(data-guix-gnu-org-compare-by-datetime-url
                             start-date
                             end-date)))
                       "View comparison data")))))))))))))