code.consxy.com Git - sheep/blob - src/main/struc.lisp

   1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
   2 (in-package #:sheep-struc)
   3
   4 (defun fire-error (msg) (error (make-instance 'sheep:validation-failure :msg msg)))
   5
   6 (defun doc->ast (struc)
   7  (labels
   8   ((validate (strs)
   9     (mapcar
  10      (lambda (str)
  11       (cond
  12        ((< 120 (length str)) (fire-error (format nil "Structure description longer than 120 characters: ~A" str)))
  13        ((cl-ppcre:scan "^ " str) (fire-error (format nil "Structure description line started with space: ~A" str)))
  14        ((cl-ppcre:scan " $" str) (fire-error (format nil "Structure description line ended with space: ~A" str)))))
  15      strs))
  16    (combine (strs)
  17     (cond
  18      ((not strs) (list ""))
  19      ((string= "" (car strs)) (cons "" (combine (cdr strs))))
  20      (t
  21       (let
  22        ((rest (combine (cdr strs))))
  23        (cons (format nil "~A~A~A" (car strs) (if (string/= "" (car rest)) " " "") (car rest)) (cdr rest)))))))
  24   (let
  25    ((lines (cl-ppcre:split "\\n" (documentation struc 'structure))))
  26    (validate lines)
  27    (let
  28     ((paragraphs (combine lines)))
  29     (when (find "" paragraphs :test #'string=) (fire-error "Structure description has two empty lines in it"))
  30     (cons
  31      (cond
  32       ((typep (make-instance struc) 'condition) :condition)
  33       (t :struct))
  34      (cons struc paragraphs))))))
  35
  36 (defun ast->md (ast)
  37  (format nil "## ~@(~A~) ~A~%~%~{~A~%~^~%~}"
  38   (first ast)
  39   (second ast)
  40   (cddr ast)))
  41
  42 (defun ast->category-name (ast)
  43  (case (first ast)
  44   (:condition "condition")
  45   (t "structure")))
  46
  47 (defun ast->short-name (ast)
  48  (format nil "~(~A~)" (second ast)))
  49
  50 (defun ast->link (ast)
  51  (format nil "~(~A-~A~)" (first ast) (second ast)))
  52
  53 (defun ast->short-desc (ast)
  54  (third ast))