doc.lisp

(in-package :cl-mongo)

;;
;; This uses documentation-template to generate reasonably useful 
;; documentation. Some of the edi weitz specific stuff is replaced.

(defvar *REPO-ROOT* nil "root of the repository; used for documentation generation")

(defun string-replace*(sep new str)
  (let ((l ()))
    (do ((pos  (search sep str :test #'string=)
	       (search sep str :test #'string=)))
	((or (null pos) (eql 0 pos)))
      (push (subseq str 0 pos) l)
      (push new l)
      (setf str (subseq str (+ pos (length sep) ))))
    (nreverse (cons str l))))

(defun string-replace(sep new str)
  (let ((L (string-replace* sep new str)))
    (reduce (lambda (s1 s2) (concatenate 'string s1 s2)) L :initial-value "")))

(defun slurp-stream(stream)
  ;;from
  ;;www.emmett.ca/~sabetts/slurp.html
  ;;
  (let ((seq (make-string (file-length stream))))
    (read-sequence seq stream)
    seq))

(defun write-file(path str)
  (handler-case 
      (with-open-file (stream path :direction :output
			      :if-exists :supersede :if-does-not-exist :create)
	(write-sequence str stream))
    (error(c) 
      (format t "error [~A] on writing to ~A" c path))))

(defun load-file(path)
  (handler-case 
      (with-open-file (stream path :direction :input)
	(slurp-stream stream))
    (error(c) 
      (format t "error [~A] on reading from ~A" c path))))

(defun customize (str) 
  (labels ((customize* (lst str)
	     (if (null lst)
		 str
		 (customize* (cdr lst) 
			     (string-replace (car (car lst)) (cadr (car lst)) str)))))
    (let* ((lst ()))
      (push (list "BSD-style" "MIT-style") lst)
      (push (list "weitz.de/index.html" "www.mohegan-skunkworks.com/index.html") lst)
      (push (list "weitz.de/files/cl-mongo.tar.gz" "github.com/fons/cl-mongo")   lst)
      (customize* lst str))))

(defun segment* (str accum)
  (let* ((start-token "<!--")
	 (end-token   "-->")
	 (start-comment (search start-token str))
	 (end-comment   (search end-token str) )
	 (piece     (subseq str 0 start-comment)))
    (if end-comment
	(segment* (subseq str (+ (length end-token) end-comment)) (cons piece accum))
	(nreverse (cons str accum)))))

(defun rebuild* (l accum)
  (if l
      (rebuild* (cdr l) (concatenate 'string accum (car l)))
      accum))

(defun select-body (str) 
  (let* ((body-start-token "<body")
	 (body-end-token   "</body>")
	 (start-body (search body-start-token str))
	 (end-body   (search body-end-token str))
	 (piece     (subseq str start-body (+ (length body-start-token) 2 end-body))))
    piece))

(defun strip-comments (str)
  (rebuild* (segment* str () ) ""))

(defun gendoc (target) 
  (progn
    (documentation-template:create-template :cl-mongo :subtitle "api reference"
					    :target target
					    :maybe-skip-methods-p t)
    (write-file target (customize (load-file target)))))


(defun generate-readme (&key (path *REPO-ROOT*) ) 
" This function generates a README.md file with the latest api description.
The :path keyword specifies the location. It expects a sub-directory <path>/doc. 
Api documentation is generated on the fly, by extracting comments from the classes, 
generics and fuctions exported in the packages file. 
The resulting file is <path>/doc/index.html. <path>/README.md is generated by  
appending the api documentation to <path>/doc/readme-base.md.
:path or *REPO-ROOT* are typically set to the root of the repository.
"
(handler-case 
     (let* ((index-path  (format nil "~A~A" (make-pathname :directory path) "/doc/index.html"))
	    (readme-path (format nil "~A~A" (make-pathname :directory path) "/doc/readme-base.md"))
	    (target      (format nil "~A~A" (make-pathname :directory path) "README.md")))
	(progn 
	  (gendoc index-path)
	  (write-file target (concatenate 'string (load-file readme-path)
					  (select-body (strip-comments (load-file index-path)))))))
    (error(c) 
      (format t "error [~A] on writing the readme to ~A. Is *REPO-ROOT* [~A] set ok ?" c path *REPO-ROOT*))))
  
;----