40ants-doc-locative-extension.lisp

(ql:quickload :40ants-doc-full)
(ql:quickload :polymorphic-functions)

(use-package :polymorphic-functions)
(define-polymorphic-function my= (a b)
  :documentation "Test polymorphic function.")

(uiop:define-package #:40ants-doc-full/locatives/polymorphic-function
  (:use #:cl)
  (:import-from #:polymorphic-functions
                #:polymorphic-function)
  (:import-from #:40ants-doc/locatives/base
                #:locate-error
                #:locate-object
                #:define-locative-type)
  (:import-from #:swank-backend)
  (:import-from #:40ants-doc/reference-api
                #:canonical-reference)
  (:import-from #:40ants-doc/reference)
  (:import-from #:40ants-doc-full/args)
  (:import-from #:40ants-doc-full/commondoc/builder)
  (:import-from #:40ants-doc-full/commondoc/bullet)
  (:import-from #:40ants-doc/docstring)
  (:import-from #:40ants-doc-full/commondoc/markdown))
(in-package #:40ants-doc-full/locatives/polymorphic-function)


(define-locative-type 40ants-doc/locatives::polymorphic-function ())

;; (defmethod locate-object (symbol (locative-type (eql 'polymorphic-function)) locative-args)
;;   (declare (ignore locative-args))
;;   (when (macro-function symbol)
;;     (locate-error "~S is a macro, not a function." symbol))
;;   (let ((function (symbol-function symbol)))
;;     (when (typep function 'generic-function)
;;       (locate-error "~S is a generic function, not a plain function." symbol))
;;     function))

(defmethod locate-object (symbol (locative-type (eql '40ants-doc/locatives::polymorphic-function)) locative-args)
  (declare (ignore locative-args))
  (when (macro-function symbol)
    (locate-error "~S is a macro, not a function." symbol))
  (let ((function (symbol-function symbol)))
    function))


(defmethod canonical-reference ((function polymorphic-function))
  (let ((name (polymorphic-functions::polymorphic-function-name function)))
    (40ants-doc/reference::make-reference name
                                          '40ants-doc/locatives::polymorphic-function)))


(defmethod 40ants-doc-full/commondoc/builder::to-commondoc ((obj polymorphic-function))
  (let* ((arglist (swank-backend:arglist obj))
         (docstring (40ants-doc/docstring:get-docstring obj 'function))
         (children (when docstring
                     (40ants-doc-full/commondoc/markdown:parse-markdown docstring)))
         (reference (canonical-reference obj))
         (dislocated (40ants-doc-full/args::function-arg-names arglist)))

    (40ants-doc-full/commondoc/bullet:make-bullet reference
                                                  :arglist arglist
                                                  :children children
                                                  :dislocated-symbols dislocated)))


(uiop:define-package #:foo-random
  (:nicknames #:40ants-doc-full/tutorial)
  (:documentation "This package provides various utilities for
                   random. See @FOO-RANDOM-MANUAL.")
  (:use #:common-lisp
        #:40ants-doc
        #:40ants-doc-full/locatives/polymorphic-function
        #:polymorphic-functions)
  (:import-from #:40ants-doc/ignored-words
                #:ignore-words-in-package)
  (:export #:foo-random-state
           #:state
           #:*foo-state*
           #:gaussian-random
           #:uniform-random))

(in-package foo-random)

(define-polymorphic-function my= (a b)
  :documentation "Test polymorphic function.")

(defpolymorph my= ((a string) (b string)) boolean
  (string= a b))

;; (documentation 'my= 'function)


(defsection @foo-random-manual (:title "Foo Random manual"
                                :ignore-words ("FOO"))
  "Here you describe what's common to all the referenced (and
   exported) functions that follow. They work with *FOO-STATE*,
   and have a :RANDOM-STATE keyword arg. Also explain when to
   choose which."
  ;; (foo-random-state class)
  ;; (state (reader foo-random-state))

  "Hope I get docs for polymorphic function:"
  ;; (my= polymorphic-function)

  "Or at least that:"
  (my= polymorphic-function)
  
  "Hey we can also print states!"
  
  (@foo-random-examples section))


(defsection @foo-random-examples (:title "Examples")
  "Let's see the transcript of a real session of someone working
   with FOO:

   ```cl-transcript
   (values (princ :hello) (list 1 2))
   .. HELLO
   => :HELLO
   => (1 2)

   (make-instance 'foo-random-state)
   ==> #<FOO-RANDOM-STATE >
   ```")

(40ants-doc-full/builder:render-to-string
  @foo-random-manual
  :format :markdown)

;; There is no applicable method for the generic function
;;   #<STANDARD-GENERIC-FUNCTION 40ANTS-DOC/LOCATIVES/BASE:LOCATE-OBJECT (27)>
;; when called with arguments
;;   (MY= 40ANTS-DOC/LOCATIVES::POLYMORPHIC-FUNCTION NIL).
;;    [Condition of type SB-PCL::NO-APPLICABLE-METHOD-ERROR]