# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1458754670 0
# Node ID ce6aa58d27da79399d60d767ab10485dcddc2db1
# Parent  59376ea596d4663a8faddc1e8aafa4e96a025968
Factor out the d/api crap

diff -r 59376ea596d4 -r ce6aa58d27da docs/api.lisp
--- a/docs/api.lisp	Wed Mar 23 16:23:52 2016 +0000
+++ b/docs/api.lisp	Wed Mar 23 17:37:50 2016 +0000
@@ -1,14 +1,11 @@
-(let ((*standard-output* (make-broadcast-stream)))
-  (ql:quickload "docparser"))
-
-(declaim (optimize (debug 3))) ; dammit sbcl
-
-(defparameter *index*
-  (docparser:parse :cl-ggp))
+(ql:quickload "cl-d-api")
 
 (defparameter *document-packages*
   (list "GGP"))
 
+(defparameter *output-path*
+  #p"docs/03-reference.markdown" )
+
 (defparameter *header*
   "The following is a list of all user-facing parts of `cl-ggp`.
 
@@ -20,140 +17,8 @@
 
 ")
 
-
-;;;; From the CL Cookbook
-(defun replace-all (string part replacement &key (test #'char=))
-  "Returns a new string in which all the occurences of the part
-is replaced with replacement."
-  (with-output-to-string (out)
-    (loop with part-length = (length part)
-          for old-pos = 0 then (+ pos part-length)
-          for pos = (search part string
-                            :start2 old-pos
-                            :test test)
-          do (write-string string out
-                           :start old-pos
-                           :end (or pos (length string)))
-          when pos do (write-string replacement out)
-          while pos)))
-
-
-;;;; Documentation Utils
-(defun get-doc (package-name symbol-name)
-  (let ((results (docparser:query *index*
-                                  :package-name package-name
-                                  :symbol-name symbol-name)))
-    (when (> (length results) 0)
-      (elt results 0))))
-
-(defun get-package-doc (package-name)
-  ;; good god, lemon
-  (docparser::find-package-index *index* package-name))
-
-
-;;;; Markdown Rendering
-(defun render-package-header (package-name)
-  (format t "## Package ~A~%~%"
-          (replace-all package-name "*" "\\*")))
-
-(defun render-package-docstring (package-name)
-  (let ((package-docstring
-         (docparser::package-index-docstring (get-package-doc package-name))))
-    (when package-docstring
-      (format t "~A~%~%" package-docstring))))
-
-(defun render-symbol-header (symbol-name extra)
-  (format t "### ~A~A~%~%"
-          (replace-all symbol-name "*" "\\*")
-          extra))
-
-(defun render-docstring (node)
-  (let ((documentation (docparser:node-docstring node)))
-    (when documentation
-      (format t "~A~%~%" documentation))))
-
-(defun render-lambda-list (node)
-  (format t "    ~A~%~%"
-          (cons (docparser:node-name node)
-                (docparser:operator-lambda-list node))))
-
-(defgeneric render-documentation (node symbol-name))
-
-(defun render-class-slot (node)
-  (let ((name (docparser:node-name node))
-        (type (docparser:slot-type node))
-        (readers (docparser:slot-readers node))
-        (writers (docparser:slot-writers node))
-        (accessors (docparser:slot-accessors node)))
-    (format t "#### Slot ~A~%~%" name )
-    (format t "* Allocation: ~A~%" (docparser:slot-allocation node))
-    (when type (format t "* Type: `~A`~%" type))
-    (when readers (format t "* Reader~p: ~{`~A`~^, ~}~%" (length readers) readers))
-    (when writers (format t "* Writer~p: ~{`~A`~^, ~}~%" (length writers) writers))
-    (when accessors (format t "* Accessor~p: ~{`~A`~^, ~}~%" (length accessors) accessors))
-    (format t "~%")
-    (render-docstring node)))
-
-
-(defmethod render-documentation ((node docparser:class-node) symbol-name)
-  (render-symbol-header symbol-name " (class)")
-  (render-docstring node)
-  (mapc #'render-class-slot (docparser:record-slots node)))
-
-(defmethod render-documentation ((node docparser:documentation-node) symbol-name)
-  (render-symbol-header symbol-name "")
-  (format t "`~A`~%~%" (class-of node))
-  (render-docstring node))
-
-(defmethod render-documentation ((node docparser:variable-node) symbol-name)
-  (render-symbol-header symbol-name " (variable)")
-  (render-docstring node))
-
-(defmethod render-documentation ((node docparser:function-node) symbol-name)
-  (render-symbol-header symbol-name " (function)")
-  (render-lambda-list node)
-  (render-docstring node))
-
-(defmethod render-documentation ((node docparser:generic-function-node) symbol-name)
-  (render-symbol-header symbol-name " (generic function)")
-  (render-lambda-list node)
-  (render-docstring node))
-
-(defmethod render-documentation ((node docparser:macro-node) symbol-name)
-  (render-symbol-header symbol-name " (macro)")
-  (render-lambda-list node)
-  (render-docstring node))
-
-
-;;;; Documentation Sections
-(defun document-symbol (package-name symbol)
-  (let* ((symbol-name (symbol-name symbol))
-         (doc-node (get-doc package-name symbol-name)))
-    (when doc-node (render-documentation doc-node symbol-name))))
-
-(defun document-package (package-name)
-  (render-package-header package-name)
-  (render-package-docstring package-name)
-  (let ((symbols (loop :for s :being :the external-symbol :of package-name
-                       :collect s)))
-    (mapc #'(lambda (symbol)
-             (document-symbol package-name symbol))
-          (sort symbols #'string-lessp :key #'symbol-name))))
-
-(defun document-header ()
-  (format t "# API Reference~%~%")
-  (format t *header*)
-  (format t "[TOC]~%~%"))
-
-
-;;;; Main
-(defun main ()
-  (with-open-file (*standard-output* #p"docs/03-reference.markdown"
-                                     :direction :output
-                                     :if-exists :supersede)
-    (document-header)
-    (mapc #'document-package *document-packages*)))
-
-
-(main)
-
+(d-api:generate-documentation
+  :cl-ggp
+  *output-path*
+  *document-packages*
+  *header*)