;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; A CHICKEN Scheme interface to Yahoo Finance's stock quotes "API".
;;;
;;; This software is written by Evan Hanson <evhan@foldling.org> and
;;; placed in the Public Domain. All warranties are disclaimed.
;;;

(module yahoo-finance (fetch-quotes fetch-history)
  (import scheme chicken srfi-1 srfi-13 data-structures posix)
  (require-extension csv-xml uri-common intarweb http-client)

(define base-quote-uri
  (uri-reference "http://download.finance.yahoo.com/d/quotes.csv"))

(define base-historical-uri
  (uri-reference "http://ichart.finance.yahoo.com/table.csv"))

(define (invalid-format-error name)
  (error 'fetch-quotes "Invalid quote format specifier" name))

;;; http://www.gummy-stuff.org/Yahoo-data.htm
;;;
;;; Not all of these have been tested, and some of them are
;;; total crap (some include inline HTML tags, for example).

(define (format-unalias name)
  (case name
    ((ask)                    'a)
    ((average-daily-volume)   'a2)
    ((ask-size)               'a5)
    ((bid)                    'b)
    ((ask-realtime)           'b2)
    ((bid-realtime)           'b3)
    ((book book-value)        'b4)
    ((bid-size)               'b6)
    ((change-percent-change)  'c)
    ((change)                 'c1)
    ((commission)             'c3)
    ((change-realtime)        'c6)
    ((change-after-hours)     'c8)
    ((dividend-share)         'd)
    ((last-trade-date)        'd1)
    ((trade-date)             'd2)
    ((eps e/s earnings/share earnings-per-share) 'e)
    ((error)                  'e1)
    ((eps-estimate-current-year) 'e7)
    ((eps-estimate-next-year) 'e8)
    ((eps-estimate-next-quarter) 'e9)
    ((float-shares)           'f6)
    ((low day-low)            'g)
    ((percent-holdings-gain) 'g1)
    ((annualized-gain)        'g3)
    ((holdings-gain)          'g4)
    ((percent-holdings-gain-realtime) 'g5)
    ((holdings-gain-realtime) 'g6)
    ((high day-high)          'h)
    ((info)                   'i)
    ((order-book-realtime)    'i5)
    ((52-week-low)            'j)
    ((market-cap market-capitalization) 'j1)
    ((market-cap-realtime market-capitalization-realtime) 'j3)
    ((ebitda)                 'j4)
    ((percent-change-from-52-week-high) 'j5)
    ((percent-change-from-52-week-low) 'j6)
    ((52-week-high)           'k)
    ((last-trade-realtime)    'k1)
    ((percent-change-realtime) 'k2)
    ((last-trade-size)        'k3)
    ((change-from-52-week-high) 'k4)
    ((percent-change-from-52-week-high) 'k5)
    ((last-trade)             'l)
    ((price last-trade-price) 'l1)
    ((high-limit)             'l2)
    ((low-limit)              'l3)
    ((day-range range)       'm)
    ((day-range-realtime range-realtime) 'm2)
    ((50-day-moving-average 50-ma) 'm3)
    ((200-day-moving-average 200-ma) 'm4)
    ((200-day-moving-average-change 200-day-ma-change) 'm5)
    ((200-day-moving-average-percent-change 200-day-ma-percent-change) 'm6)
    ((50-day-moving-average-change 50-day-ma-change) 'm7)
    ((50-day-moving-average-percent-change 50-day-ma-percent-change) 'm8)
    ((name)                   'n)
    ((notes)                  'n4)
    ((open)                   'o)
    ((close previous-close)   'p)
    ; ((price-paid)             'p1)
    ((percent-change)         'p2)
    ((p/s price/sales)        'p5)
    ((p/b price/book)         'p6)
    ((ex-div-date)            'q)
    ((p/e price/earnings)     'r)
    ((div-date)               'r1)
    ((p/e-realtime price/earnings-realtime) 'r2)
    ((peg)                    'r5)
    ((price/eps-estimate-current-year) 'r6)
    ((price/eps-estimate-next-year) 'r7)
    ((symbol)                 's)
    ; ((shares-owned)           's1)
    ((short-ratio)            's7)
    ((last-trade-time)        't1)
    ((trade-links)            't6)
    ((ticket-trend)           't7)
    ((one-year-target-price)  't8)
    ((vol volume)             'v)
    ((52-week-range)          'w)
    ((day-value-change)       'w1)
    ((day-value-change-realtime) 'w4)
    ((exchange stock-exchange) 'x)
    ((div div-yield dividend-yield) 'y)
    (else (invalid-format-error name))))

;;; Fetch & parse an API request.
;;;
;;; The response is a CSV, whose cell values we convert
;;; to numbers where possible, leave as strings otherwise.

(define (yahoo-api-request uri type format)
  ;; Responses to HTTP 1.1 requests are chunked, which http-client
  ;; doesn't handle. So, we request minor version 0.
  (call-with-values
   (lambda ()
     (call-with-input-request
      (make-request minor: 0 method: 'GET uri: uri)
      #f
      (lambda (response)
        (map (lambda (row)
               (cons (car row)
                     (map (lambda (cell)
                            (list (car cell)
                                  (or (string->number (cadr cell))
                                      (cadr cell))))
                          (cdr row))))
             (condition-case
               (cdr (csv->sxml response type format))
               ((exn)
                (error "Malformed response from request"
                       (uri->string uri))))))))
     (lambda (result uri response)
       result)))

(define (build-quote-request-uri sym fmt)
  (parameterize ((form-urlencoded-separator "&"))
    (update-uri base-quote-uri
         query: `((s . ,(string-join (map ->string sym) "+"))
                  (f . ,(string-concatenate
                         (map ->string
                              (map format-unalias fmt))))))))

(define (build-historical-request-uri sym freq start end)
  (parameterize ((form-urlencoded-separator "&"))
    (update-uri base-historical-uri
         query: `((s . ,sym)
                  (a . ,(- (cadr start) 1))
                  (b . ,(caddr start))
                  (c . ,(car start))
                  (d . ,(- (cadr end) 1))
                  (e . ,(caddr end))
                  (f . ,(car end))
                  (g . ,(case freq
                          ((d day daily) 'd)
                          ((w week weekly) 'w)
                          ((m month monthly) 'm)
                          ((v div dividends) 'v)
                          (else (error 'fetch-history
                                       "Invalid frequency"
                                       freq))))))))

(define (fetch-quotes symbols format)
  (cond
    ((not (list? symbols))
     (fetch-quotes (list symbols) format))
    ((not (list? format))
     (fetch-quotes symbols (list format)))
    (else
     (yahoo-api-request
      (build-quote-request-uri symbols format)
      'stock
      format))))

(define (fetch-history symbol . args)
  (let-optionals args
    ((freq  'daily)
     (start (list 1900 1 1))
     (end   (let ((time (seconds->utc-time (current-seconds))))
              (list (+ (vector-ref time 5) 1900) ; year
                    (+ (vector-ref time 4) 1) ; month
                    (vector-ref time 3))))) ; day
    (cdr ; drop headers
     (yahoo-api-request
      (build-historical-request-uri symbol freq start end)
      'row ; arbitrary
      (if (member freq '(v div dividends))
          '(date dividend)
          '(date open high low close volume adjusted-close)))))))