; Dave Edwards
; CS6520 Project 1 - Weather Forecast Parser

; Require necessary libraries
(require (lib "list.ss"))
(require (lib "date.ss"))
(require (lib "url.ss" "net"))
(require (lib "xml.ss" "xml"))

; ---- DATATYPES ----

; A forecast is (make-forecast string (listof prediction))
(define-struct forecast (date predictions))

; A prediction is (make-prediction string num num)
(define-struct prediction (date minTemp maxTemp))


; ---- CONSTANTS ----

(define null-element (make-element 'x 'x 'null (list) (list)))
(define null-forecast (make-forecast (seconds->date 0) (list)))
(define null-prediction (make-prediction "" 0 0))
(define current-date (seconds->date (current-seconds)))
(define weather-url (string->url "http://www1.wrh.noaa.gov/cgi-bin/dwf?outFormat=xml&duration=120hr&interval=12&citylist=SLC+Airport%2C40.785%2C-111.9277&city=Go&siteID=SLC"))
(define weather-element ((eliminate-whitespace (list '|griddedForecast| '|forecastDay| '|period|) (lambda (x) x)) (document-element (read-xml (get-pure-port weather-url)))))


; ---- FUNCTIONS ----

; get-weather-forecast : element -> forecast
; Accepts an xml element (should be an element with tag "|griddedForecast|") and
; returns a forecast structure respresenting the weather forecast information
; present in the element.
;
; (get-weather-forecast null-element) "should be" null-forecast
; (get-weather-forecast weather-element) "should be" (make-forecast current-date (list predictions))
(define (get-weather-forecast e)
  (cond
    [(not (element-tag=? e '|griddedForecast|)) null-forecast]
    [else (let ((dateStr (get-element-string (car (get-sub-elements e '|forecastCreationTime|))))
                (predElemList (get-sub-elements e '|forecastDay|)))
            (make-forecast dateStr (map process-forecastDay-element predElemList)))]))

; process-forecastDay-element : element -> prediction
; Accepts an xml element (should be an element with tag "|forecastDay|") and
; returns a prediction structure representing the weather prediction information
; present in the element
;
; (process-forecastDay-element null-element) "should be" null-prediction
(define (process-forecastDay-element e)
  (cond
    [(not (element-tag=? e '|forecastDay|)) null-prediction]
    [else (let ((dateStr (get-element-string (car (get-sub-elements e '|validDate|))))
                (tempList (get-forecastDay-temperatures e)))
            (make-prediction dateStr (apply min tempList) (apply max tempList)))]))

; get-forecastDay-temperatures : element -> (list number)
; Accepts an xml element (should be an element with tag "|forecastDay|") and
; returns a list of all temperature data for that date.
;
; (get-forecastDay-temperatures null-element) "should be" (list)
(define (get-forecastDay-temperatures e)
  (cond
    [(not (element-tag=? e '|forecastDay|)) (list)]
    [else (map get-element-number (apply append (map (lambda (sym) (get-sub-elements e sym)) '(|temperature| |minTemp| |maxTemp|))))]))

; get-sub-elements : element symbol -> (listof element)
; Accepts an xml element and a symbol.  Returns a list of all descendant elements of
; the argument element (including itself) that have a tag equal to the argument symbol
;
; (get-sub-elements null-element 'null) "should be" null-element
; (get-sub-elements null-element 'test) "should be" empty
; (get-sub-elements weather-element '|griddedForecast|) "should be" weather-element
; (get-sub-elements weather-element '|temperature|) "should be" a list of 5 temperature elements
(define (get-sub-elements e s)
  (let ((rest (apply append (map (lambda (elem) (get-sub-elements elem s)) (filter element? (element-content e))))))
    (cond
      [(element-tag=? e s) (cons e rest)]
      [else rest])))

; content-tag=? : content symbol -> bool
; Accepts a content struct and a symbol.  Returns true if the content struct is
; an element and its name is the symbol, false otherwise.
;
; (content-tag=? null-element 'null) "should be" true
; (content-tag=? null-element 'test) "should be" false
; (content-tag=? weather-element '|griddedForecast|) "should be" true
; (content-tag=? (make-pcdata 'x 'x "Test") 'test) "should be" false
(define (content-tag=? c s)
  (cond
    [(pcdata? c) #f]
    [(element? c) (element-tag=? c s)]
    [(entity? c) #f]
    [(comment? c) #f]
    [(pi? c) #f]))

; element-tag=? : element symbol -> bool
; Accepts an xml element and a symbol.  Returns true if the element's name is the
; symbol, false otherwise.
;
; (element-tag=? null-element 'null) "should be" true
; (element-tag=? null-element 'test) "should be" false
; (element-tag=? weather-element '|griddedForecast|) "should be" true
(define (element-tag=? e s)
  (eq? s (element-name e)))

; get-element-number : element -> number
; Accepts an xml element, which should only contain a single sub-element of type
; pcdata, and returns the string contents of that pcdata struct interpreted as a
; number.
;
; (get-element-number null-element) "should be" #f
(define (get-element-number e)
  (let ((numStrList (regexp-match "[0-9]+" (get-element-string e))))
    (cond
      [(empty? numStrList) #f]
      [else (string->number (car numStrList))])))

; get-element-string : element -> string
; Accepts an xml element, which should only contain a single sub-element of type
; pcdata, and returns the string contents of that pcdata struct.
;
; (get-element-string null-element) "should be" ""
(define (get-element-string e)
  (cond
    [(empty? (element-content e)) ""]
    [else (let ((pe (car (element-content e))))
            (cond
              [(pcdata? pe) (pcdata-string pe)]
              [else ""]))]))

; forecast->element : forecast -> element
; Accepts a forecast struct and returns an xml element representing the struct.
;
; (forecast->element null-forecast) "should be" null-element
; (forecast->element (make-forecast "Jan 29" (list (make-prediction "Jan 30" 32 40))) "should be" (make-element 'x 'x (list (make-attribute 'date "Jan 29")) (list (prediction->element (make-prediction "Jan 30" 32 40))))
(define (forecast->element f)
  (make-element 'x
                'x
                'forecast
                (list (make-attribute 'x 'x 'date (forecast-date f)))
                (map prediction->element (forecast-predictions f))))

; prediction->element : prediction -> element
; Accepts a prediction struct and returns an xml element representing the struct.
;
; (prediction->element null-prediction) "should be" null-element
; (prediction->element (make-prediction "Jan 30" 32 40)) "should be" (make-element 'x 'x (list (make-attribute 'date "Jan 30") (make-attribute 'minTemp "32") (make-attribute 'maxTemp "40")) (list))
(define (prediction->element p)
  (make-element 'x
                'x
                'prediction
                (list (make-attribute 'x 'x 'date (prediction-date p))
                      (make-attribute 'x 'x 'minTemp (number->string (prediction-minTemp p)))
                      (make-attribute 'x 'x 'maxTemp (number->string (prediction-maxTemp p))))
                (list)))


; ---- PROGRAM ----

; Write xml-formatted data to output file
(define (weather-program)
  (let ((outPort (open-output-file "forecasts.xml" 'update)))
    (write-xml/content (forecast->element (get-weather-forecast weather-element)) outPort)
    (flush-output outPort)
    (close-output-port outPort)))

(weather-program)