#lang racket/base
;; Copyright Neil Van Dyke.  See file "info.rkt".

(require net/url
         (planet neil/mcfly))

(module+ test
  (require (planet neil/overeasy:3)))

(doc (section "Introduction")

     (para "This package provides a Racket interface for accessing the precious
metal market spot prices published on the Web by Kitco Metals, Inc.  The
information is represented in Racket as either Racket objects (structs), or as
SXML (for writing as XML).")

     (para "This is useful for research, for hobby experimentation, and for
prototyping Web apps.  Please note that this is "
           (italic "not")
           " for mission-critical use; once your app is advancing from
prototype to production use, you normally will want to have a contract with a
data service that can offer guarantees about reliability and correctness.")

     (para "For example, here is a use of this package to fetch the information
and return it in SXML format (using dummy information, and with some parts

     (racketinput (current-kitco-user-agent "Mozilla (my app) Firefox/NOT"))
     (racketinput (get-kitco-market-sxml))
      (market (spot (@ (name      "newyork")
                       (timestamp "2000-12-25T12:34:56")
                       (status    "open"))
                    (pm (@ (name           "gold")
                           (bid            "900.0")
                           (ask            "909.09")
                           (change         "10.0")
                           (change-percent "1.0")
                           (low            "888.88")
                           (high           "999.99")))
                    (pm (@ (name           "silver")
                           (bid            "50.0")
                           (ask            "50.01")
                           (change         "-5.5")
                           (change-percent "-10.10")
                           (low            "49.49")
                           (high           "51.50")))
                    (pm (@ (name "platinum")
                           #,(italic "...attributes...")))
                    (pm (@ (name "palladium")
                           #,(italic "...attributes..."))))
              (spot (@ (name      "eurasia")
                       (timestamp "2000-12-25T12:34:56")
                       (status    "closed"))
                    (pm (@ (name              "gold")
                           (bid               "901.0")
                           (ask               "902.0")
                           (ny-change         "1.0")
                           (ny-change-percent "0.5")))
                    #,(italic "...pms..."))))

     (para "(See the documentation for "
           (racket current-kitco-user-agent)
           " for why we say ``Mozilla'' and ``Firefox'' here.)")

     (para "For another example, here is getting the information into a graph
of objects and navigating the graph to get the New York Gold bid and ask

     (racketinput (current-kitco-user-agent "Mozilla (my app) Firefox/NOT"))
     (racketinput (define km   (get-kitco-market)))
     (racketinput (define spot (kitco-market-newyork-spot km)))
     (racketinput (define pms  (kitco-spot-pm-hash spot)))
     (racketinput (define gold (hash-ref pms 'gold)))
     (racketinput (kitco-pm-bid gold)
                  #,(racketresult 900.05))
     (racketinput (kitco-pm-ask gold)
                  #,(racketresult 900.10))

     (para "Please note that you should not rely on this package, nor on this
data feed.  If someday it says silver is back up to 50, double-check with
authoritative sources before you quit your job.  And don't assume that this
data feed won't suddenly stop working without warning.  And under no
circumstances should you even think of suing the author of this package.")

     (para "This package is independent of Kitco Metals, Inc., and they are not
responsible in any way for this package, nor are we aware that they offer any
guarantees about the data that this package accesses."))

(define-logger kitco)

(doc (section "Objects"))

(doc (defstruct* kitco-pm
         ((name              symbol?)
          (bid               number?)
          (ask               number?)
          (change            (or/c #f number?))
          (change-percent    (or/c #f number?))
          (low               (or/c #f number?))
          (high              (or/c #f number?))
          (ny-change         (or/c #f number?))
          (ny-change-percent (or/c #f number?)))
       (para "This struct represents information about a single precious metal, and is associated with a single "
             (racket kitco-spot)
             ".  The "
             (tt "name")
             " field value is a symbol such as "
             (racket 'gold)
             ".  Note that New York data will not use the "
             (tt "ny-change")
             " and "
             (tt "ny-change-percent")
             " fields, but Europe/Asia data currently does.")))
(provide (rename-out
          (kitco-pm-struct?                  kitco-pm?)
          (kitco-pm-struct-name              kitco-pm-name)
          (kitco-pm-struct-bid               kitco-pm-bid)
          (kitco-pm-struct-ask               kitco-pm-ask)
          (kitco-pm-struct-change            kitco-pm-change)
          (kitco-pm-struct-change-percent    kitco-pm-change-percent)
          (kitco-pm-struct-low               kitco-pm-low)
          (kitco-pm-struct-high              kitco-pm-high)
          (kitco-pm-struct-ny-change         kitco-pm-ny-change)
          (kitco-pm-struct-ny-change-percent kitco-pm-ny-change-percent)))
(define-struct kitco-pm-struct
   ;; newyork
   ;; eurasia

(doc (defstruct* kitco-spot
         ((name             symbol?)
          (timestamp-string string?)
          (status           (or/c 'open 'closed))
          (pm-hash          (hash/c symbol? kitco-pm?)))
       (para "This struct represents spot prices on a particular region's exchange(s).  The "
             (tt "name")
             " field is a symbol -- either "
             (racket 'newyork)
             " or "
             (racket 'eurasia)
             ".  "
             (tt "timestamp-string")
             " is in human-readable ISO 8601 format.  "
             (tt "pm-hash")
             " is a hash of symbols (e.g., "
             (racket 'gold)
             ", like the "
             (tt "name")
             " field of "
             (racket kitco-pm)
             ") to "
             (racket kitco-pm)
             " objects.")))
(provide (rename-out
          (kitco-spot-struct?                 kitco-spot?)
          (kitco-spot-struct-name             kitco-spot-name)
          (kitco-spot-struct-timestamp-string kitco-spot-timestamp-string)
          (kitco-spot-struct-status           kitco-spot-status)
          (kitco-spot-struct-pm-hash          kitco-spot-pm-hash)))
(define-struct kitco-spot-struct

(doc (defstruct* kitco-market
         ((newyork-spot (or/c #f kitco-spot?))
          (eurasia-spot (or/c #f kitco-spot?)))
       (para "This struct represents the entirety of the market data received
from a request, such as by "
             (racket get-kitco-market)
(provide (rename-out
          (kitco-market-struct?             kitco-market?)
          (kitco-market-struct-newyork-spot kitco-market-newyork-spot)
          (kitco-market-struct-eurasia-spot kitco-market-eurasia-spot)))
(define-struct kitco-market-struct

(doc (section "SXML"))

(define (%kitco-status->sxml status)
  (if status
      (symbol->string status)

(doc (defproc* (((kitco-pm->sxml     (x kitco-pm?))     sxml?)
                ((kitco-spot->sxml   (x kitco-spot?))   sxml?)
                ((kitco-market->sxml (x kitco-market?)) sxml?))
       (para "Convert the object to SXML format.")
       (para "Note that the ordering of the XML "
             (tt "pm")
             " elements within a "
             (tt "spot")
             " element is undefined.")))
(provide kitco-pm->sxml
(define kitco-pm->sxml
  (let ((optional-numeric (lambda (name number)
                            (if number
                                `((,name ,(number->string number)))
    (lambda (x)
      `(pm (@ (name ,(symbol->string (kitco-pm-struct-name x)))
              ,@(optional-numeric 'bid               (kitco-pm-struct-bid               x))
              ,@(optional-numeric 'ask               (kitco-pm-struct-ask               x))
              ,@(optional-numeric 'change            (kitco-pm-struct-change            x))
              ,@(optional-numeric 'change-percent    (kitco-pm-struct-change-percent    x))
              ,@(optional-numeric 'low               (kitco-pm-struct-low               x))
              ,@(optional-numeric 'high              (kitco-pm-struct-high              x))
              ,@(optional-numeric 'ny-change         (kitco-pm-struct-ny-change         x))
              ,@(optional-numeric 'ny-change-percent (kitco-pm-struct-ny-change-percent x)))))))
(define (kitco-spot->sxml spot)
  `(spot (@ (name      ,(symbol->string (kitco-spot-struct-name spot)))
            (timestamp ,(or (kitco-spot-struct-timestamp-string spot)
            (status    ,(%kitco-status->sxml (kitco-spot-struct-status spot))))
         ;; TODO: Sort by canonical order or by name.
         ,@(map kitco-pm->sxml
                (hash-values (kitco-spot-struct-pm-hash spot)))))
(provide kitco-market->sxml)
(define (kitco-market->sxml x)
  `(market ,(kitco-spot->sxml (kitco-market-struct-newyork-spot x))
           ,(kitco-spot->sxml (kitco-market-struct-eurasia-spot x))))

(doc (section "Parsing"))

(define multiline-whitespace-rxs "[ \t\r\n]+")
(define minuses-line-rxs " *--------+ *\r?\n")
(define immediate-minuses-line-rx (regexp (string-append "^" minuses-line-rxs)))
(define newline-rxs " *\r?\n")
(define ignored-nonnewline-rxs "[^\r\n]*")

(define %kitco:unsigned-fractional-rxs "[0-9]+\\.[0-9]+")
(define %kitco:signed-fractional-rxs "[-+]?[0-9]+\\.[0-9]+")

(define (%kitco:bytes->number bstr)
  (string->number (bytes->string/latin-1 bstr)))

(define (%kitco-last-update-timestamp-bytes-decode bstr)
  (log-kitco-debug "(%kitco-last-update-timestamp-bytes-decode ~S)" bstr)
  ;; Note: We assume that the "." in the real-world example of, e.g., "19:26.02" is a programming error and supposed to be a ":".
  (cond ((regexp-match #rx#"^ *([A-Z][a-z]+) ([0-9]+), ([0-9]+) at ([0-9]+):([0-9]+)[.:]([0-9]+) *$"
         => (lambda (m)
              (apply (lambda (all month mday year hours minutes seconds)
                       (cond ((hash-ref #hash((#"Jan" . #"01")
                                              (#"Feb" . #"02")
                                              (#"Mar" . #"03")
                                              (#"Apr" . #"04")
                                              (#"May" . #"05")
                                              (#"Jun" . #"06")
                                              (#"Jul" . #"07")
                                              (#"Aug" . #"08")
                                              (#"Sep" . #"09")
                                              (#"Oct" . #"10")
                                              (#"Nov" . #"11")
                                              (#"Dec" . #"12"))
                              => (lambda (month)
                                   (bytes->string/latin-1 (bytes-append year
                             (else #f)))
        (else #f)))

(module+ test
  (test-section '%kitco-last-update-timestamp-bytes-decode
    (test 'decodeable
          (%kitco-last-update-timestamp-bytes-decode #"Sep 26, 2013 at 19:26.02")
    (test 'non-decodeable
          (%kitco-last-update-timestamp-bytes-decode #"26 Sep 2013 19:26.02")

(define %parse-kitco-spot-html
  (let ((%kitco-market-header-status-bytes->status
         (lambda (str)
           (case str
             ((#"CLOSED") 'closed)
             ((#"OPEN")   'open)
             (else        #f))))
         (regexp (string-append "^[ \t]+Last Update on *([^\r\n]*)"
    (lambda (#:name name
                    #:header-rx      header-rx
                    #:pm-rx          pm-rx
                    #:pm-decode-proc pm-decode-proc
                    #:in             in)
      (let* ((status  (let ((m (or (regexp-match header-rx in)
                                   (error '%parse-kitco-market-section
                                          "could not match ~S header"
                        (%kitco-market-header-status-bytes->status (list-ref m 1))))
             (pm-hash (let loop ((pm-hash (make-immutable-hasheq)))
                        ;; TODO: Get rid of "regexp-try-match", by reading the
                        ;; entire page HTML into one string and then do
                        ;; regexp-match or regexp-match-positions on that, and
                        ;; keeping track of our position.
                        (cond ((regexp-try-match pm-rx in)
                               => (lambda (m)
                                    (let-values (((name pm) (pm-decode-proc m)))
                                      (loop (hash-set pm-hash
                              ((regexp-try-match immediate-minuses-line-rx in)
                               (error '%parse-kitco-market-section
                                      "problem while matching ~S pms. hash=~S"
             (timestamp-string (let* ((m (or (regexp-match last-update-rx in)
                                             (error '%parse-kitco-market-section
                                                    "could not match ~S last update line"
                                 (%kitco-last-update-timestamp-bytes-decode (list-ref m 1))))
             (m (or (regexp-match? immediate-minuses-line-rx in)
                    (error '%parse-kitco-market-section
                           "could not match minuses after ~S last update line"
        (log-kitco-debug "%parse-kitco-spot-html: timestamp-string=~S" timestamp-string)
        (make-kitco-spot-struct name

(doc (defproc (parse-kitco-market-html (in input-port?))
       (para "Parses HTML from the Kitco Market Web page, from input port "
             (racket in)
             ".  Note that usually you will call "
             (racket get-kitco-market)
             " or "
             (racket get-kitco-market-sxml)
             " rather than calling this parsing procedure directly.")))
(provide parse-kitco-market-html)
(define parse-kitco-market-html
  (let* ((market-status-rxs
           "[ \t]+MARKET IS +"
           "([^ \r\n]+)" ; 1 = status
           "[ \t]+Will (?:close|open) in"
           (string-append "New York Spot Price"
                          "[ \t]*Metals +Bid +Ask +Change +Low +High"
           (string-append "Asia / Europe Spot Price"
                          "[ \t]*Metals +Bid +Ask +Change from NY close"
          (lambda (bstr)
            (or (hash-ref #hash((#"Gold"      . gold)
                                (#"Silver"    . silver)
                                (#"Platinum"  . platinum)
                                (#"Palladium" . palladium))
                (string->symbol (string-downcase (bytes->string/latin-1 bstr))))))
          (regexp (string-append "^[ \t]+([A-Za-z]+)" ; 1 = name
                                 "[ \t]+("
                                 %kitco:unsigned-fractional-rxs ; 2 = bid
                                 ")[ \t]+("
                                 %kitco:unsigned-fractional-rxs ; 3 = ask
                                 ")[ \t]+("
                                 %kitco:signed-fractional-rxs ; 4 = change
                                 ")[ \t]+("
                                 %kitco:signed-fractional-rxs ; 5 = change-percent
                                 ")%[ \t]+("
                                 %kitco:unsigned-fractional-rxs ; 6 = low
                                 ")[ \t]+("
                                 %kitco:unsigned-fractional-rxs ; 7 = high

          (lambda (m)
            (apply (lambda (all name bid ask change change-percent low high)
                     (let ((name (pm-bytes->name name)))
                       (values name
                               (make-kitco-pm-struct name
                                                     (%kitco:bytes->number bid)
                                                     (%kitco:bytes->number ask)
                                                     (%kitco:bytes->number change)
                                                     (%kitco:bytes->number change-percent)
                                                     (%kitco:bytes->number low)
                                                     (%kitco:bytes->number high)

          (regexp (string-append "^[ \t]+([A-Za-z]+)" ; 1 = name
                                 "[ \t]+("
                                 %kitco:unsigned-fractional-rxs ; 2 = bid
                                 ")[ \t]+("
                                 %kitco:unsigned-fractional-rxs ; 3 = ask
                                 ")[ \t]+("
                                 %kitco:signed-fractional-rxs ; 4 = ny-change
                                 ")[ \t]+("
                                 %kitco:signed-fractional-rxs ; 5 = ny-change-percent

          (lambda (m)
            (apply (lambda (all name bid ask ny-change ny-change-percent)
                     (let ((name (pm-bytes->name name)))
                       (values name
                               (make-kitco-pm-struct name
                                                     (%kitco:bytes->number bid)
                                                     (%kitco:bytes->number ask)
                                                     (%kitco:bytes->number ny-change)
                                                     (%kitco:bytes->number ny-change-percent)))))
    (lambda (in)
      (or (regexp-match? #rx"<pre>" in)
          (error 'parse-kitco-market-html
                 "could not find pre html tag"))
      (let* ((newyork-spot (%parse-kitco-spot-html #:name          'newyork
                                                   #:header-rx      newyork-header-rx
                                                   #:pm-rx          newyork-pm-rx
                                                   #:pm-decode-proc newyork-pm-decode
                                                   #:in             in))
             (eurasia-spot (%parse-kitco-spot-html #:name           'eurasia
                                                   #:header-rx      eurasia-header-rx
                                                   #:pm-rx          eurasia-pm-rx
                                                   #:pm-decode-proc eurasia-pm-decode
                                                   #:in             in)))
        (make-kitco-market-struct newyork-spot

(doc (defproc (parse-kitco-market-html-string (str string?))
       (para "Like "
             (racket parse-kitco-market-html)
             " but takes a string rather than an input port.")))
(provide parse-kitco-market-html-string)
(define (parse-kitco-market-html-string str)
  (call-with-input-string str parse-kitco-market-html))

(module+ test
  (test-section 'parsing-and-sxml
        "<title>Text Only Market Page</title>\r\n"
        "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">\r\n"
        "<body bgcolor=\"#FFFFFF\">\r\n"
        "<b><font size=6>\r\n"
        "  Kitco Inc.\r\n"
        "  Text Only Market Page</font></b>\r\n"
        "\t   \r\n"
        "    <a href=\"\">Graphic version of this page</a>\r\n"
        "\t  \r\n"
        "    <a href=\"\">Precious Metals Lease Rates</a>  \r\n"
        "    <a href=\"\">Historical Price Data</a>  \r\n"
        "    <a href=\"\">Precious Metals News Headlines</a>\r\n"
        "\t   \r\n"
        "    <font size=4><b><a href=\"\">Buy gold and silver online direct from Kitco!</a> \r\n"
        "   Live quotes for all bullion products.</b></font>\r\n"
        "   --------------------------------------------------------------------------------\r\n"
        "   London Fix          GOLD          SILVER       PLATINUM           PALLADIUM\r\n"
        "                   AM       PM                  AM       PM         AM       PM\r\n"
        "   --------------------------------------------------------------------------------\r\n"
        "   Sep 27,2013   1321.50   1341.00   21.6100   1411.00   1416.00   720.00   725.00  \r\n"
        "   Sep 26,2013   1332.50   1333.00   21.9700   1432.00   1424.00   725.00   724.00  \r\n"
        "   --------------------------------------------------------------------------------\r\n"
        "\t\t\t      New York Spot Price\r\n"
        "\t\t\t\tMARKET IS CLOSED\r\n"
        "\t\t\t    Will open in \r\n"
        "   ----------------------------------------------------------------------\r\n"
        "   Metals          Bid        Ask           Change        Low       High \r\n"
        "   ----------------------------------------------------------------------\r\n"
        "   Gold         1336.20     1337.20    +12.40  +0.94%\t 1332.90  1345.30 \r\n"
        "   Silver         21.78       21.88     +0.05  +0.25%\t   21.67    22.25 \r\n"
        "   Platinum     1415.00     1425.00     +9.00  +0.64%\t 1409.00  1428.00 \r\n"
        "   Palladium     728.00      733.00     +9.00  +1.25%\t  722.00   738.00 \r\n"
        "   ----------------------------------------------------------------------\r\n"
        "   Last Update on Sep 27, 2013 at 17:14.57\r\n"
        "   ----------------------------------------------------------------------\r\n"
        "\t\t\t    Asia / Europe Spot Price\r\n"
        "\t\t\t\tMARKET IS CLOSED\r\n"
        "\t\t\tWill open in 17 hours  \r\n"
        "   ----------------------------------------------------------------------\r\n"
        "   Metals                      Bid          Ask      Change from NY close\r\n"
        "   ----------------------------------------------------------------------\r\n"
        "   Gold                      1336.20      1337.20    +12.40   +0.94%\r\n"
        "   Silver                      21.78        21.88     +0.05   +0.25%\r\n"
        "   Platinum                  1415.00      1425.00     +9.00   +0.64%\r\n"
        "   Palladium                  728.00       733.00     +9.00   +1.25%\r\n"
        "   ----------------------------------------------------------------------\r\n"
        "   Last Update on Sep 27, 2013 at 17:14.57\r\n"
        "   ----------------------------------------------------------------------\r\n"
        "<b>   File created on Sun Sep 29 00:21:35 2013</b>\r\n"
        "\t\t<style type=\"text/css\"><!--\r\n"
        " #main_container_footer {width:100%;text-align: center;}\r\n"
        "\t#main_container_footer #footer_container {width:auto; margin:25px auto 25px auto;}\r\n"
        "\t#main_container_footer #footer_container ul {margin:0; padding:0;}\r\n"
        "\t#main_container_footer #footer_container ul li {float:left; display:inline; list-style:none; padding:0 8px; font-family:Verdana, Arial, Helvetica, sans-serif; font-size:12px; color:#000; border-right:1px #000 solid;}\r\n"
        "\t#main_container_footer #footer_container ul li a {font-family:Verdana, Arial, Helvetica, sans-serif; font-size:12px; color:#000; text-decoration:underline; font-weight:normal;}\r\n"
        "\t#main_container_footer #footer_container ul li a:hover {color:#ac1a2f; text-decoration:none; font-weight:normal;}\r\n"
        "\t#main_container_footer #footer_container ul li.no_border {border:0px;}\r\n"
        "  <table border=\"0\" cellspacing=\"0\" cellpadding=\"0\"><tr><td>\r\n"
        " <div id=\"main_container_footer\">\r\n"
        "    \t<div id=\"footer_container\">\r\n"
        "        \t<ul>\r\n"
        "            \t<li class=\"no_border\"><script type=\"text/javascript\">\r\n"
        "copyright=new Date();\r\n"
        "document.write(\"&copy; \"+ update + \" Kitco Metals Inc.\");\r\n"
        "                <li><a href=\"\">About Us</a></li>\r\n"
        "                <li><a href=\"\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Website Terms of Use</a></li>\r\n"
        "                <li><a href=\"\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Privacy Policy</a></li>\r\n"
        "                <li><a href=\"\">Advertise With Us</a></li>\r\n"
        "                <li><a href=\"\">Careers</a></li>\r\n"
        "                <li><a href=\"\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Contact Us</a></li>\r\n"
        "                <li class=\"no_border\"><a href=\"\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Feedback</a></li>\r\n"
        "        </div>\r\n"
        "    </div>\t\r\n"
        "\t</td></tr></table><br /><br />\r\n"
        "<script language=\"JavaScript\" type=\"text/javascript\">\r\n"
        "function Window_open (Address) {\r\n"
        "  NewWindow =, \"Popup\", \"width=695,height=600,left=100,top=200,resizable=yes,scrollbars=yes\");\r\n"
        "  NewWindow.focus();\r\n"
        "// -->\r\n"
        " <!-- img src=\"\" width=\"1\" height=\"1\" -->\r\n"
        "<!-- Google-Analytics Code-->\r\n"
        "<script type=\"text/javascript\">\r\n"
        "  var _gaq = _gaq || [];\r\n"
        "  _gaq.push(['_setAccount', 'UA-4074364-3']);\r\n"
        "  _gaq.push(['_trackPageview']);\r\n"
        "  (function() {\r\n"
        "    var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;\r\n"
        "    ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '';\r\n"
        "    var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);\r\n"
        "  })();\r\n"
     '(market (spot (@ (name      "newyork")
                       (timestamp "2013-09-27T17:14:57")
                       (status    "closed"))
                    (pm (@ (name "gold")      (bid "1336.2") (ask "1337.2") (change "12.4") (change-percent "0.94") (low "1332.9") (high "1345.3")))
                    (pm (@ (name "silver")    (bid "21.78")  (ask "21.88")  (change "0.05") (change-percent "0.25") (low "21.67")  (high "22.25")))
                    (pm (@ (name "platinum")  (bid "1415.0") (ask "1425.0") (change "9.0")  (change-percent "0.64") (low "1409.0") (high "1428.0")))
                    (pm (@ (name "palladium") (bid "728.0")  (ask "733.0")  (change "9.0")  (change-percent "1.25") (low "722.0")  (high "738.0"))))
              (spot (@ (name      "eurasia")
                       (timestamp "2013-09-27T17:14:57")
                       (status    "closed"))
                    (pm (@ (name "gold")      (bid "1336.2") (ask "1337.2") (ny-change "12.4") (ny-change-percent "0.94")))
                    (pm (@ (name "silver")    (bid "21.78")  (ask "21.88")  (ny-change "0.05") (ny-change-percent "0.25")))
                    (pm (@ (name "platinum")  (bid "1415.0") (ask "1425.0") (ny-change "9.0")  (ny-change-percent "0.64")))
                    (pm (@ (name "palladium") (bid "728.0")  (ask "733.0")  (ny-change "9.0")  (ny-change-percent "1.25"))))))))

(doc (section "Network"))

(doc (defparam current-kitco-market-url url url?
       (para "A URL used internally by "
             (racket get-kitco-market)
             " and "
             (racket get-kitco-market-sxml)
             ".  You should not normally change this except for testing or
(provide current-kitco-market-url)
(define current-kitco-market-url
  (make-parameter (string->url "")))

(doc (defparam current-kitco-user-agent str string?
       (para "String for the default value of HTTP header "
             (tt "User-Agent")
       (para "In general, you should use a different user agent string for each
app that you make.  For example, if your app is named NW-O-Matic, do something
        (define km
          (parameterize ((current-kitco-user-agent
                          "Mozilla (NW-O-Matic) Firefox/NOT"))
        (current-kitco-user-agent "Mozilla (NW-O-Matic) Firefox/NOT")
        (define km (get-kitco-market)))
       (para "or use a "
             (racket "#:user-agent")
             " command-line argument instead of the parameter:")
        (define km
          (get-kitco-market #:user-agent "Mozilla (NW-O-Matic) Firefox/NOT")))
       (para "The reason for including keywords like ``Mozilla'' and
``Firefox'' is historical: in the early days of Web browsers, a very small
number of Web sites used the user agent string to detect Netscape (nee Mosaic
Communications) Navigator (based on ``Mozilla'', the publicly-known internal
name for Navigator, in the user agent string) and send different HTML to it
than for other browsers; browsers like Microsoft Internet Explorer began
sending user agent strings that also included the string ``Mozilla''.  This
remains a convention, even after a well-known Netscape spinoff eventually
adopted the internal ``Mozilla'' name as its corporate name.")))
(provide current-kitco-user-agent)
(define current-kitco-user-agent
  (make-parameter "Mozilla (kitco.rkt) Firefox/NOT"))

(doc (defproc (get-kitco-market (#:user-agent user-agent string? #f))
       (para "Get a "
             (racket kitco-market)
             " object by making an HTTP request and parsing the result.")
       (para "If "
             (racket user-agent)
             " is "
             (racket #f)
             ", the value of the "
             (racket current-kitco-user-agent)
             " parameter is used.  See the documentation for that parameter for
why you should specify a user agent specific to your app.")
       (para "Please note that, since this procedure makes HTTP requests of an
external server operated by someone else, it is important not to abuse the
server with requests that are too frequent.")))
(provide get-kitco-market)
(define (get-kitco-market #:user-agent (user-agent #f))
  (call/input-url (current-kitco-market-url)
                  (list (string-append "User-Agent: "

(doc (defproc (get-kitco-market-sxml (#:user-agent user-agent string? #f))
       (para "Like "
             (racket get-kitco-market)
             ", but returns SXML rather than a "
             (racket kitco-market)
             " object.  See the documentation for "
             (racket get-kitco-market)
(provide get-kitco-market-sxml)
(define (get-kitco-market-sxml #:user-agent (user-agent #f))
  (kitco-market->sxml (get-kitco-market #:user-agent user-agent)))

(doc (section "Known Issues")


      (item "Find out for-pay sources of same information, with some service
guarantees, and perhaps offer an interface to those, too.")

      (item "Parse London Fix section, and add it to market struct.")

      (item "Pull timestamp out of any ``"
            (tt "File created on")
            "'' towards bottom of page, and add it to the market struct.")

      (item "Add custom-writers for structs.")

      (item "In SXML format, sort the PMs, either alphabetically, or in the default Kitco order.")))

(doc history

     (#:planet 1:1 #:date "2013-09-30"
                (item "Documentation fix.")))
     (#:planet 1:0 #:date "2013-09-30"
                (item "Initial release."))))