#! /bin/sh 
string=? ; exec mzscheme -M errortrace -gr $0 $* 
; $Id: soccer-table.scm,v 1.1 2004/01/21 02:55:46 kl Exp kl $
;   http://pair.com/lisovsky/transform/examples/ 

(require (lib "sxml-tools.ss" "sxml")
	 (lib "sxpath.ss" "sxml")
	 (lib "1.ss" "srfi")
	 (lib "stx-engine.ss" "sxml")
	 (lib "fragments.ss" "sxml"))

; Source document
(define doc (read (open-input-file "soccer.sxml")))

(define (match-compare team-name match rel?)
  ; order: this other
  (let* ((teams ((sxpath '(team)) match))
	 (teams-ordered (cond 
			  ((string=? team-name (sxml:text (car teams))) teams)
			  ((string=? team-name (sxml:text (cadr teams))) 
			   (reverse teams))
			  (else '())))
	 (teams-score (map (lambda(t) (sxml:num-attr t 'score))
			   teams-ordered)))
    (and (not (null? teams-ordered))
    (apply rel? teams-score))
      ))

; w-d-l : > won, < lost, = drawn
(define (game team rezults w-d-l)
  `(td 
     ,(number->string
	(length
	  ((sxpath 
	     `(match ,(lambda(n v)
			(filter 
			  (lambda(x)
			    (match-compare team x w-d-l))
			  n)))) 
	   rezults)))))


; Transformation stylesheet
(define sst
(sxml:stylesheet
  (match 'results
	 (lambda (current-node stx:templates current-root $)
	   (let ((teams
		   (delete-duplicates
		      ((sxpath '(match team *text*)) current-node) 
		      string=?)))
           `(html
	     (head (title "Result of group " ,(sxml:attr current-node 'group)))
	     (body 
	       (h1 "Result of group " ,(sxml:attr current-node 'group))
	  (table (@ (cellpadding "5"))
	    (tr
	      (td "Team")
	      (td "Played")
	      (td "Won")
	      (td "Drawn")
	      (td "Lost")
	      (td "For")
	      (td "Against"))
            ,@(map
		(lambda(team)
		(let 
		 ((for ((sxpath 
			 `(match team 
				 ,(lambda(n v)
				    (apply +
					   (filter-map
					     (lambda(x)
					       (and
						 (string=? (sxml:text x) team)
						 (sxml:num-attr x 'score)))
					     n))))) 
		       current-node)))
		  `(tr (td ,team) 
		       (td 
			 ,(number->string
			   (length
			   ((sxpath 
			       `(match team 
				       ,(lambda(n v)
					  (filter 
					       (lambda(x)
						 (string=? team
							       (sxml:text x)))
					       n)))) 
			       current-node))))
		       ,(game team current-node >) ; win 
		       ,(game team current-node =) ; drawn
		       ,(game team current-node <) ; lost
                       (td ,(number->string for))  ; for
                       (td
			 ,(number->string
			    (-
			      ((sxpath 
				 `(match 
				    ,(lambda(n v)
				       (apply +
					      (filter-map
						(lambda(x)
						  (and
						    (member team 
							    ((sxpath 
							       '(team *text*)) x))
						    (apply +
							   (map
							     (lambda(s)
							       (sxml:num-attr 
								 s 'score))
							     ((sxpath 
								'(team)) x)))))
						n))))) 
			       current-node) for))))))
		teams)
	    
	    ))))))
  ))

; Do the transformation and print out HTML output 
(let ((doc1 (sxml:add-parents doc)))
  (sxml:display-fragments
    (sxml:sxml->html
  (stx:apply-templates
  doc1
  sst
  doc1
  '()))
    ))