(import scheme)
(import (chicken base))
(import (chicken file))
(import (chicken format))
(import (chicken irregex))
(import (chicken pathname))
(import (chicken process-context))
(import (chicken string))
(import (chicken time))
(import html-parser)
(import http-client)
(import intarweb)
(import medea)
(import srfi-18)
(import sxpath)
(import uri-common)

(define stderr (current-error-port))

(define ie10-user-agent '("Mozilla" "5.0" "compatible; MSIE 10.0; Windows NT 6.1; Trident/6.0"))
(client-software (list ie10-user-agent))

(define api-token-url "https://open.spotify.com/get_access_token?reason=transport&productType=web_player")
(define api-playlist-url "https://api.spotify.com/v1/playlists/{id}/tracks?offset={offset}&limit=100&market=DE&locale=en&additional_types=track")

(define spotify-playlist-url-rx "https://open\\.spotify\\.com/playlist/([[:alnum:]]+)")

(define (xdg-path environment-variable fallback path)
  (let ((home (get-environment-variable environment-variable)))
    (if (and home (eqv? (string-ref home 0) #\/))
        (string-append home path)
        (string-append (get-environment-variable "HOME") fallback path))))

(define api-token-path
  (xdg-path "XDG_DATA_HOME" "/.local/share" "/spotify/access-token.sexp"))

(define (api-request url token)
  (if token
      (let* ((uri (uri-reference url))
             (auth `((authorization ,(vector (format "Bearer ~a" token) 'raw))))
             (request (make-request method: 'GET
                                    uri: uri
                                    headers: (headers auth))))
        (call-with-input-request request #f read-json))
      (call-with-input-request url #f read-json)))

(define (api-token-valid?)
  (and-let* (((file-exists? api-token-path))
             (meta (call-with-input-file api-token-path read))
             (token (alist-ref 'accessToken meta))
             (timestamp (alist-ref 'accessTokenExpirationTimestampMs meta))
             ((> (/ timestamp 1000) (current-seconds))))))

(define (api-token)
  (when (not (api-token-valid?))
    (create-directory (pathname-directory api-token-path) 'parents)
    (let ((json (api-request api-token-url #f)))
      (call-with-output-file api-token-path
        (lambda (out)
          (write json out)))))
  (alist-ref 'accessToken (call-with-input-file api-token-path read)))

(define (vector-for-each proc vec)
  (let ((len (vector-length vec)))
    (let loop ((i 0))
      (when (< i len)
        (proc (vector-ref vec i))
        (loop (add1 i))))))

(define (process playlist-url)
  (let ((match (irregex-match spotify-playlist-url-rx playlist-url)))
    (when (not match)
      (fprintf stderr "not a playlist url: ~a" (program-name))
      (exit 1))
    (let ((playlist-id (irregex-match-substring match 1)))
      (let loop ((offset 0))
        (let* ((url (string-translate* api-playlist-url
                                       `(("{id}" . ,playlist-id)
                                         ("{offset}" . ,(number->string offset)))))
               (json (api-request url (api-token)))
               (limit (alist-ref 'limit json))
               (total (alist-ref 'total json))
               (track-items (alist-ref 'items json)))
          (vector-for-each
           (lambda (item)
             (let* ((track (alist-ref 'track item))
                    (title (alist-ref 'name track))
                    (album (alist-ref 'album track))
                    (album-title (alist-ref 'name album))
                    (artists (map (lambda (artist)
                                    (alist-ref 'name artist))
                                  (vector->list (alist-ref 'artists album))))
                    (artist (string-intersperse artists ", ")))
               (display (format "~a - [~a] ~a\n" artist album-title title))))
           track-items)
          (when (< (+ offset limit) total)
            (thread-sleep! 1)
            (loop (+ offset limit))))))))

(define main
  (case-lambda
   ((playlist-url)
    (process playlist-url))
   (_
    (fprintf stderr "usage: ~a <playlist url>\n" (program-name))
    (exit 1))))

(apply main (command-line-arguments))