(module web-services racket
  (require net/cgi
           net/url
           (rename-in xml
                      [struct:element struct:xelement]
                      [element xelement]
                      [make-element make-xelement]
                      [element-name xelement-name]
                      [element-attributes xelement-attributes]
                      [element-content xelement-content]
                      [element? xelement?]
                      [struct:attribute struct:xattribute]
                      [attribute xattribute]
                      [make-attribute make-xattribute]
                      [attribute-name xattribute-name]
                      [attribute-value xattribute-value]
                      [attribute? xattribute?]
                      [struct:pcdata struct:xpcdata?]
                      [pcdata xpcdata]
                      [make-pcdata make-xpcdata]
                      [pcdata-string xpcdata-string]
                      [pcdata? xpcdata?]
                      [xml->xexpr old-xml->xexpr])
           racket/gui/base
           (only-in lang/htdp-beginner-abbr [cons student-cons]
                    [cons? student-cons?]))
  
  
  
  ;; Constants:
  
  (define debug #f)
  
  
  (define EBAY-APP-ID "Universi-6f31-46da-b1de-005829958052")
  
  
  (define EBAY-REQUEST-URL
    "http://svcs.ebay.com/services/search/FindingService/v1")
  
  (define GOOGLE-REQUEST-URL
    "http://maps.google.com/maps/api/staticmap?")
  
  
  
  ;(define OPERATION-KEYWORDS "findItemsByKeywords")
  ;(define VERSION "1.0.0")
  ;(define POSTAL-CODE "V6T1Z4")
  ;(define MAX-DISTANCE "25")
  ;(define HARRY "harry potter")
  
  
  
  ;; Caches:
  (define CACHE (make-hash))
  
  ;; Hash functions just map via equal? (since key is string)
  
  
  
  ;; Structures:
  
  (define-struct ebay-item
    (title
     price
     pcode
     location)
    #:transparent)
  ;; EbayItem is (make-ebay-item String String String String)
  ;; interp. the title, price in USD, postal code, and state and country
  ;; information of an item listed on eBay
  
  
  (define-struct element (name attributes contents)
    #:transparent)
  
  (define-struct pcdata (string)
    #:transparent)
  
  (define-struct attribute (name value)
    #:transparent)
  
  
  ;; Data definitions AS SEEN BY STUDENTS:
  
  
  ;; Element is (make-element String ListOfAttribute ListOfContent)
  
  #;(define (fn-for-element e)
      (... (element-name e) (element-attributes e) (element-contents e)))
  
  
  ;; Attribute is (make-attribute String String)
  
  #;(define (fn-for-attribute att)
      (... (attribute-name att) (attribute-value att)))
  
  ;; ListOfAttribute is one of:
  ;;   - empty
  ;;   - (cons Attribute ListOfAttribute)
  
  #;(define (fn-for-loa loa)
      (cond [(empty? loa) (...)]
            [else (... (fn-for-attribute (first loa))
                       (fn-for-loa (rest loa)))]))
  
  
  ;; Content is one of:
  ;; - Element
  ;; - PCData
  
  #;(define (fn-for-content cont)
      (cond [(element? cont) (fn-for-element cont)]
            [(pcdata? cont) (fn-for-pcdata cont)]))
  
  ;; ListOfContent is one of:
  ;;  - empty
  ;;  - (cons Content ListOfContent)
  
  #;(define (fn-for-loc loc)
      (cond [(empty? loc) (...)]
            [else (... (fn-for-content (first c))
                       (fn-for-loc (rest c)))]))
  
  
  ;; PCData is (make-pcdata (string))
  
  #;(define (fn-for-pcdata pcd)
      (... (pcdata-string pcd)))
  
  
  
  ;;-------------------------------------------------------------------
  
  
  
  ;; Request sending and processing functions:
  
  ;; string -> (void)
  ;; logs all url request strings to current output port
  (define (debug-msg msg)
    (if debug
        (begin (display msg) (newline))
        #f))
  
  
  ;; string -> port
  ;; Consumes a request url string and returns a pure port of the response
  ;; !!! from old teachpack, vs. string-get-request-port?
  (define (send-request-port req-str)
    (debug-msg req-str)
    (get-pure-port (string->url req-str)))
  
  
  ;; string -> element
  ;; Consumes a request url string and returns the xml response of it as an element
  ;; [fixme] should catch exceptions
  (define (send-request-xml req-str)
    (hash-ref-or-new CACHE req-str
                     (lambda ()
                       (let ([result
                              (xelement->element
                               (document-element
                                (read-xml 
                                 (send-request-port req-str))))])
                         result))))
  
  
  ;; string -> png-image
  ;; Consumes a request url string and returns the png file it should point to
  (define (send-request-png req-str)
    (hash-ref-or-new CACHE req-str
                     (lambda ()
                       (load-image-from-port (send-request-port req-str)))))
  
  ;; PNG Image loading from port [HACK HACK HACK]
  (define (load-image-from-port port)
    ;; First we write the image to disk, then load it with image-snip%
    (let ([file (make-temporary-file)])
      (call-with-output-file file
        (lambda (out)
          (let loop ((b (read-byte port)))
            (if (eof-object? b)
                'done
                (begin
                  (write-byte b out)
                  (loop (read-byte port))))))
        #:mode 'binary
        #:exists 'replace)
      
      ;; Now re-read it from disk, ugh.
      (begin0 
        (make-object image-snip%
          file)
        (delete-file file))))
  
  
  
  ;;-------------------------------------------------------------------
  
  
  
  ;; XML processing functions, AS STUDENTS WOULD WRITE:
  
  
  ;; Element String -> Element or false
  ;; returns a single Element matching str from elt, or false if such an
  ;; Element is not found
  (define (get-elt-element elt str)
    (if (string=? (element-name elt) str)
        elt
        (get-elt-loc (element-contents elt) str)))
  
  ;; ListOfContent String -> Element or false
  ;; returns a single Element matching str from loc, or false if such an
  ;; Element is not found
  (define (get-elt-loc loc str)
    (cond [(empty? loc) false]
          [else (if (not (false? (get-elt-content (first loc) str)))
                    (get-elt-content (first loc) str)
                    (get-elt-loc (rest loc) str))]))
  
  ;; Content String -> Element or false
  ;; returns a single Element matching str from cont, or false if such an
  ;; Element is not found
  (define (get-elt-content cont str)
    (cond [(element? cont) (get-elt-element cont str)]
          [(pcdata? cont) false]))
  
  
  
  ;; Element String -> String
  ;; returns a single PCData String from an Element matching str
  ;; and contained in elt, or "" if such an Element is not found
  (define (get-pcdata-element elt str)
    (if (not (false? (get-elt-element elt str)))
        (get-pcdata-loc (element-contents (get-elt-element elt str)))
        ""))
  
  ;; ListOfContent -> String
  ;; returns a single PCData String from loc, or "" if loc contains
  ;; no PCData
  (define (get-pcdata-loc loc)
    (cond [(empty? loc) ""]
          [else (if (not (string=? "" (get-pcdata-content (first loc))))
                    (get-pcdata-content (first loc))
                    (get-pcdata-loc (rest loc)))]))
  
  ;; Content -> String
  ;; returns a single PCData String from cont, or "" if cont is not PCData
  (define (get-pcdata-content cont)
    (cond [(element? cont) ""]
          [(pcdata? cont) (pcdata-string cont)]))
  
  
  
  ;; Element -> ListOfContent
  ;; returns all Elements named "item" contained in the "searchResult" Element
  ;; returned from the eBay Finding API
  (define (get-search-result elt)
    (if (not (false? (get-elt-element elt "searchResult")))
        (element-contents (get-elt-element elt "searchResult"))
        empty))
  
  
  
  ;;-------------------------------------------------------------------
  
  
  
  ;; XElement -> Element functions:
  
  
  ;; XElement -> Element
  (define (xelement->element xe)
    (make-element (symbol->string (xelement-name xe))
                  (xatts->atts (xelement-attributes xe))
                  (loxc->loc (xelement-content xe))))
  
  ;; (listof XAttribute) -> (listof Attribute)
  (define (xatts->atts loxa)
    (map (lambda (xa) (xatt->att xa)) loxa))
  
  ;; XAttribute -> Attribute
  (define (xatt->att xa)
    (make-attribute (symbol->string (xattribute-name xa)) (xattribute-value xa)))
  
  ;; (listof XContent) -> (listof Content)
  (define (loxc->loc loxc)
    (map (lambda (xc) (xcontent->content xc)) loxc))
  
  ;; XContent -> Content
  (define (xcontent->content xc)
    (cond [(xelement? xc)
           (xelement->element xc)]
          [(xpcdata? xc)
           (xpcdata->pcdata xc)]))
  
  ;; XPCData -> PCData
  (define (xpcdata->pcdata xpcd)
    (make-pcdata (xpcdata-string xpcd)))
  
  
  
  
  ;;-------------------------------------------------------------------
  
  
  
  ;; Request url forming functions:
  
  
  ;; string string (listof NameValuePair) -> string
  ;; creates a google request url based on the given list of markers
  (define (make-query-url host path args)
    (let ([urlstr
           (url->string 
            (make-url "http" #f host #f #t
                      
                      (map (lambda (n) (make-path/param n empty))
                           (regexp-split "/" path))
                      
                      (massage-args args)
                      
                      #f))])
      urlstr))
  
  
  (define (massage-args listof-nvp)
    (local [;; (list (list n v)) -> (list (cons n v))
            (define (lonvp l)
              (map nvp l))
            ;; (list n v) -> (cons n v)
            (define (nvp n)
              (cons (string->symbol (car n))
                    (cadr n)))]
      (lonvp listof-nvp)))
  
  
  
  
  ;; ListOfNameValuePair -> ListOfNameValuePair
  (define (label-marker-pairs lonvp)
    (let loop ([lst lonvp]
               [n 65])
      (cond [(empty? lst) empty]
            [else (student-cons (label-marker-pair (car lst) n)
                                (loop (cdr lst) (add1 n)))])))
  
  ;; NameValuePair Number -> NameValuePair
  (define (label-marker-pair nvp n)
    (student-cons (car nvp)
                  (student-cons (string-append "label:"
                                               (string (integer->char n))
                                               "|"
                                               (cadr nvp))
                                empty)))
  
  
  
  
  ;;-------------------------------------------------------------------
  
  
  
  ;; Query functions AS WRITTEN BY STUDENTS:
  
  
  ;; ListOfNameValuePairs -> Image
  (define (get-map lonvp)
    (send-request-png  ;caching is in send-request-png/xml
     (make-query-url "maps.google.com" 
                     "maps/api/staticmap"
                     (student-cons (student-cons "size" (student-cons "256x256" empty))
                                   (student-cons (student-cons "sensor" (student-cons "false" empty))
                                                 lonvp)))))
  
  
  ;; ListOfEbayItems -> ListOfNameValuePair
  (define (convert-to-marker-pairs loei)
    (cond [(empty? loei) empty]
          [else (student-cons (convert-to-marker-pair (first loei))
                              (convert-to-marker-pairs (rest loei)))]))
  
  
  ;; EbayItem -> NameValuePair
  (define (convert-to-marker-pair ebi)
    (student-cons "markers"
                  (student-cons (string-append (ebay-item-pcode ebi)
                                               ","
                                               (ebay-item-location ebi))
                                empty)))
  
  
  ;; String -> Image
  (define (get-ebi-map str)
    (get-map (convert-to-marker-pairs (get-ebay-items str))))
  
  
  ;; String -> Image
  (define (get-labeled-ebi-map str)
    (get-map (label-marker-pairs (convert-to-marker-pairs (get-ebay-items str)))))
  
  
  
  
  ;; String -> Image
  (define (get-ebay-element s)
    (send-request-xml  ;caching is in send-request-png/xml
     (make-query-url "svcs.ebay.com" 
                     "services/search/FindingService/v1"
                     (append (list (student-cons "OPERATION-NAME" (student-cons "findItemsByKeywords" empty))
                                   (student-cons "SERVICE-VERSION" (student-cons "1.0.0" empty))
                                   (student-cons "GLOBAL-ID" (student-cons "EBAY-ENCA" empty))
                                   (student-cons "SECURITY-APPNAME" (student-cons "Universi-6f31-46da-b1de-005829958052" empty))
                                   (student-cons "RESPONSE-DATA-FORMAT" (student-cons "XML" empty))
                                   (student-cons "REST-PAYLOAD" (student-cons "true" empty))
                                   (student-cons "paginationInput.entriesPerPage" (student-cons "26" empty))
                                   (student-cons "paginationInput.pageNumber" (student-cons "1" empty))
                                   (student-cons "buyerPostalCode" (student-cons "V6T1Z4" empty))
                                   (student-cons "itemFilter(0).name" (student-cons "MaxDistance" empty))
                                   (student-cons "itemFilter(0).value" (student-cons "25" empty))
                                   (student-cons "itemFilter(1).name" (student-cons "Currency" empty))
                                   (student-cons "itemFilter(1).value" (student-cons "USD" empty)))
                             (student-cons (student-cons "keywords" (student-cons s empty))
                                           empty)))))
  
  
  
  
  ;;-------------------------------------------------------------------
  
  
  
  ;; Structure handling functions:
  
  
  
  ;; element -> (listof ebayitem)
  (define (element->ebay-items e)
    ;!!! assumes get-element-e will not be false
    (map (lambda (e) 
           (make-ebay-item
            (get-pcdata-element e "title")
            (get-pcdata-element e "currentPrice")
            (get-pcdata-element e "postalCode")
            (get-pcdata-element e "location")))
         (get-search-result e)))
  
  
  ;; string -> (listof ebayitems)
  ;; obtain a list of specific structures, given for first part
  (define (get-ebay-items keyword) 
    (element->ebay-items (get-ebay-element keyword)))
  
  
  
  
  (define (hash-ref-or-new hash key fn)
    (if (hash-has-key? hash key)
        (hash-ref hash key)
        (let ([new (fn)])
          (hash-set! hash key new)
          new)))
  
  
  
  ;;-------------------------------------------------------------------
  
  
  
  ;; Wrapped functions to export:
  
  
  (define (number->decimal-string n)
    (real->decimal-string n 2))
  
  (define (test1 keyword) ;!!! remove later
    (get-ebi-map keyword))
  
  (define (test2 keyword) ;!!! remove later
    (get-labeled-ebi-map keyword))
  
  
  
  ;; Exported Functions:
  
  (provide
   get-ebay-items
   number->decimal-string
   send-request-png
   send-request-xml
   make-query-url
   label-marker-pairs
   (struct-out ebay-item)
   (struct-out element)
   (struct-out attribute)
   (struct-out pcdata))
  
  
  )