#! /bin/sh
#| Hey Emacs, this is -*-scheme-*- code!
PATH=$PATH:/c/Program\ Files/PLT-FULL-299.107
exec mzscheme -qu "$0" ${1+"$@"}
|#

;; ultimately the plan is to help me to keep the Mozilla/Firefox
;; bookmarks.html under control of Subversion.

;; I do so already, but it's a pain: that file is frequently in
;; conflict, and the reason is the "last_visit" attributes.  So
;; eventually this code will resolve such conflicts by simply keeping
;; the later of the two attribute values.

;; in the meantime, I'll see how far I get by simply filtering out
;; that attribute -- I suspect I won't miss it.

(module filter-firefox-bookmarks mzscheme
  (require 
   (planet "htmlprag.ss" ("neil" "htmlprag.plt" 1 1))
   (lib "file.ss")
   (lib "pretty.ss")
   (rename (lib "etc.ss") this-expression-source-directory this-expression-source-directory)

   ;; with new enough versions of mzscheme, this works ...
   ;;;(only (lib "1.ss" "srfi") filter first second remove))

   ;; but failing that, we gotta do this
   (rename (lib "1.ss" "srfi") filter filter)
   (rename (lib "1.ss" "srfi")  first first)
   (rename (lib "1.ss" "srfi")  second second)
   (rename (lib "1.ss" "srfi")  remove remove)
   (rename (lib "1.ss" "srfi")  find find))

  ;; guess where I keep my bookmarks file.
  (define bookmark-path
    (let ((args (current-command-line-arguments)))
      (if (= 1 (vector-length args))
          (string->path (vector-ref args 0))
        (find file-exists?
              (map (lambda (dir) (build-path dir "bookmarks.html"))
                   (list
                    (find-system-path 'home-dir)
                    (simplify-path (build-path (this-expression-source-directory) 'up 'up 'up))))))))
  
  ;; write to a file, overwriting any existing one with the same name.

  ;; TODO -- make this safer: write to a temp file, then atomically
  ;; rename the temp file to the original.  That way if the writing
  ;; somehow fails, the original won't be trashed.
  (define (mit-clobbering fn proc)
    (when (file-exists? fn) (delete-file fn))
    (begin0
      (call-with-output-file fn proc)
      (printf "Wrote ~s~n" fn)))

  ;; apply the procedure to each atom.  Useful for side-effects.
  (define (tree-map proc tree)
    (cond
     ((pair? tree)
      (let ((transformed (proc tree)))
        (cons (tree-map proc (car transformed))
              (tree-map proc (cdr transformed)))))
     (#t tree)))

  ;; Firefox creates its bookmarks file using upper-case for _most_,
  ;; but not all, of the HTML elements.  I try to duplicate that here,
  ;; to avoid spurious differences.
  (define (upcase-most-symbols thing)
    (cond
     ((and (symbol? thing)
           (not (eq? 'p thing)))
      (string->symbol (string-locale-upcase (symbol->string thing))))
     ((pair? thing)
      (cons (upcase-most-symbols (car thing))
            (upcase-most-symbols (cdr thing))))
     (#t
      thing)))

  (let ((sans-attrs
         (tree-map 

          ;; remove some attributes that I dislike.
          (lambda (thing) 
            (if (eq? (first thing) '@) 
                (remove
                 (lambda (x) (and (pair? x) (memq (first x) '(last_visit last_modified))))
                 thing)
              thing))
                     
          (call-with-input-file bookmark-path
            (lambda (source) (html->shtml source) )))))

    (mit-clobbering bookmark-path (lambda (p) (write-shtml-as-html (upcase-most-symbols sans-attrs) p)))))

;;; TODO: figure out how to run this nicely on Windows, without having
;;; to hard-code too much knowledge.
;;;
;;; Here's some of what I mean: to run this on Windows, first we need
;;; to find the mzscheme executable.  That could be anywhere, and
;;; isn't likely to be on the system PATH.  Then, we need to find
;;; _this_ file.  It typically lives in local/bin, under my Subversion
;;; enlistment, but where is that, exactly?  Then, once this file is
;;; running, it needs to find the bookmarks file (although I've
;;; already got a reasonable bunch of guesses coded in, in the code
;;; that sets <<bookmark-path>>).

;;; So: I guess I should indeed put mzscheme on the system path.  Then
;;; put a shortcut to this file in my home directory; then teach this
;;; file to look two levels up from where it is.