Racket XML query with match

band-example.rkt

#lang racket

(require xml)


;;
;; Helper functions to deal with multiple strings in an xexpr node
;;
(define (xe->string xe)
  (string-append* (filter string? xe)))

(define (xe-string=? xe str)
  (string=? str (xe->string xe)))

;;
;; Parse functions
;;

(struct band (name members) #:transparent)
(struct member (name instruments) #:transparent)

(define (parse-member xe)
  (match xe
    [`(member () ,name (instruments () ,instruments ...)) (member (xe->string name)
                                                                  (map xe->string instruments))]))

(define (parse-band xe)
  (match xe
    [`(band () ,name (members () ,members ...)) (band (xe->string name)
                                                      (map parse-member members))]))

(define (parse-bands xe)
  (match xe
    [`(bands () ,band ...) (map parse-band band)]))

;;
;; Query functions
;;

;; Return a list of band names
;; xmllint -xpath '//band/name' bands.xml
(define (band-names bands)
  (map band-name bands))

;; Given a musician name, find the band where he or she belongs
;; xmllint -xpath '//member/name[text() = "Eric Clapton"]/ancestor::band/name' bands.xml
(define (query/member/band bands musician)
  (filter (λ (band)
            (match (band)
              [`(band _ '(list-no-order (member ,musician ,_) ... )) #t]
              [else #f]))
          bands))

;; Given an instrument name and a band name, return the musicians that play that instrument in that band.
;; xmllint -xpath '//band[name/text() = "Derek & the Dominos"]//member[descendant::instrument/text() = "Bass guitar"]/name' bands.xml
(define (query/instrument-band/member bands iname bname)
  (define selected-bands (filter (by=? band-name bname)
                                 bands))
  (define members (flatten (map band-members selected-bands)))
  (filter (by=? instrument-name iname) members))


(module+ test
  (require rackunit)

  (define FILENAME "bands.xml")

  (define bands:xml (document-element (read-xml (open-input-file FILENAME))))

  ;; Can't find a way to handle whitespace with match, so get rid of it
  (define bands:xml:no-ws ((eliminate-whitespace '(bands band members member instruments)) bands:xml))
  (define bands:xe (xml->xexpr bands:xml:no-ws))
  (define bands (parse-bands bands:xe))

  ;; Test helper functions
  (check-true (xe-string=? '(name () "Derek " "&" " the Dominos")
                           "Derek & the Dominos"))
  (check-true (xe-string=? '(instruments () (instrument () "Violin") (instrument () "Mandolin") (instrument () "Accordion"))
                           ""))

  ;; Test parse functions
  (check-equal? bands (list
                       (band
                        "Derek & the Dominos"
                        (list
                         (member "Eric Clapton" '("Guitar" "Vocals"))
                         (member "Bobby Whitlock" '("Piano" "Keyboards" "Rhythm guitar" "Vocals"))
                         (member "Jim Gordon" '("Piano" "Drums" "Percussion"))
                         (member "Carl Radle" '("Bass guitar" "Percussion"))))
                       (band
                        "Nick Cave & the Bad Seeds"
                        (list
                         (member "Nick Cave" '("Vocals" "Piano" "Organ"))
                         (member "Thomas Wydler" '("Drums" "Percussion" "Vocals"))
                         (member "Martyn P. Casey" '("Bass" "Vocals"))
                         (member "Conway Savage" '("Piano" "Organ" "Vocals"))
                         (member "Jim Sclavunos" '("Percussion" "Drums"))
                         (member "Warren Ellis" '("Violin" "Mandolin" "Accordion"))))))

  ;; Test query functions
  (check-equal? (band-names bands)
                '("Derek & the Dominos" "Nick Cave & the Bad Seeds"))
  (check-equal? (map band-name (query/member/band bands "Eric Clapton"))
                '("Derek & the Dominos"))
  #;(check-equal? (map member-name (query/instrument-band/member bands "Piano" "Nick Cave & the Bad Seeds"))
                  '("Nick Cave" "Conway Savage")))

bands.xml

<?xml version="1.0"?>
<!-- source: en.wikipedia -->
<bands>
  <band>
    <name>Derek &amp; the Dominos</name>
    <members>
      <member>
        <name>Eric Clapton</name>
        <instruments>
          <instrument>Guitar</instrument>
          <instrument>Vocals</instrument>
        </instruments>
      </member>
      <member>
        <name>Bobby Whitlock</name>
        <instruments>
          <instrument>Piano</instrument>
          <instrument>Keyboards</instrument>
          <instrument>Rhythm guitar</instrument>
          <instrument>Vocals</instrument>
        </instruments>
      </member>
      <member>
        <name>Jim Gordon</name>
        <instruments>
          <instrument>Piano</instrument>
          <instrument>Drums</instrument>
          <instrument>Percussion</instrument>
        </instruments>
      </member>
      <member>
        <name>Carl Radle</name>
        <instruments>
          <instrument>Bass guitar</instrument>
          <instrument>Percussion</instrument>
        </instruments>
      </member>
    </members>
  </band>
  <band>
    <name>Nick Cave &amp; the Bad Seeds</name>
    <members>
      <member>
        <name>Nick Cave</name>
        <instruments>
          <instrument>Vocals</instrument>
          <instrument>Piano</instrument>
          <instrument>Organ</instrument>
        </instruments>
      </member>
      <member>
        <name>Thomas Wydler</name>
        <instruments>
          <instrument>Drums</instrument>
          <instrument>Percussion</instrument>
          <instrument>Vocals</instrument>
        </instruments>
      </member>
      <member>
        <name>Martyn P. Casey</name>
        <instruments>
          <instrument>Bass</instrument>
          <instrument>Vocals</instrument>
        </instruments>
      </member>
      <member>
        <name>Conway Savage</name>
        <instruments>
          <instrument>Piano</instrument>
          <instrument>Organ</instrument>
          <instrument>Vocals</instrument>
        </instruments>
      </member>
      <member>
        <name>Jim Sclavunos</name>
        <instruments>
          <instrument>Percussion</instrument>
          <instrument>Drums</instrument>
        </instruments>
      </member>
      <member>
        <name>Warren Ellis</name>
        <instruments>
          <instrument>Violin</instrument>
          <instrument>Mandolin</instrument>
          <instrument>Accordion</instrument>
        </instruments>
      </member>
    </members>
  </band>
</bands>