<commit_before>;;;
;;; Copyright (C) 2008-2009 <NAME>. All rights reserved.
;;;
;;; This file is part of deoxybyte-systems.
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

(in-package :uk.co.deoxybyte-systems)

;; This works around an issue in ASDF where it raises an error when
;; finding timestamps. This occurs where the component pathname is a
;; directory that does not yet exist.
(defmethod operation-done-p :before ((op operation) (c component))
  (let ((path (component-pathname c)))
    (when (fad:directory-pathname-p path)
      (ensure-directories-exist path))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; LIFT unit testing ASDF extension
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass lift-test-config (static-file)
  ((target-system :initform nil
                  :initarg :target-system
                  :accessor target-system
                  :documentation "The system to be tested
   e.g. :cl-system-utilities"))
  (:documentation "An ASDF component that represents a LIFT unit
  testing configuration file."))

(defmethod source-file-type ((c lift-test-config) (s module))
  "config")

(defmethod input-files ((op test-op) (c lift-test-config))
  (component-pathname c))

(defmethod operation-done-p ((op test-op) (c lift-test-config))
  nil)

(defmethod perform ((op load-op) (c lift-test-config))
  nil)

(defmethod perform ((op compile-op) (c lift-test-config))
  nil)

(defmethod perform ((op test-op) (c lift-test-config))
  ;; Need to work relative to the root of the target system
  (let ((*default-pathname-defaults* (component-pathname
                                      (find-system (target-system c)))))    
    (lift:run-tests :config (component-pathname c))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CL-DOC ASDF extension
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass cldoc-config (static-file)
  ((target-system :initform nil
                  :initarg :target-system
                  :accessor target-system
                  :documentation "The system to be documented
                  e.g. :cl-system-utilities"))
  (:documentation "An ASDF component that represents a CLDOC
  documentation extraction configuration file."))

(defclass doc-op (operation)
  ()
  (:documentation "An ASDF operation that extracts docstring
  documentation from Lisp code using CL-DOC."))

(defmethod source-file-type ((c cldoc-config) (s module))
  ;; The cldoc pathname is a directory, so has pathname-type NIL
  nil)

(defmethod operation-done-p ((op doc-op) (c cldoc-config))
  nil)

(defmethod perform ((op doc-op) (c component))
  nil)

(defmethod perform ((op doc-op) (c cl-source-file))
  nil)

(defmethod perform ((op doc-op) (c cldoc-config))
  ;; Need to work relative to the root of the target system
  (let ((target (find-system (target-system c)))
        (path (component-pathname c)))
    (cldoc:extract-documentation 'cldoc:html (namestring path) target)))
<commit_msg>* Fixed typo.<commit_after>;;;
;;; Copyright (C) 2008-2009 <NAME>. All rights reserved.
;;;
;;; This file is part of deoxybyte-systems.
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

(in-package :uk.co.deoxybyte-systems)

;; This works around an issue in ASDF where it raises an error when
;; finding timestamps. This occurs where the component pathname is a
;; directory that does not yet exist.
(defmethod operation-done-p :before ((op operation) (c component))
  (let ((path (component-pathname c)))
    (when (fad:directory-pathname-p path)
      (ensure-directories-exist path))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; LIFT unit testing ASDF extension
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass lift-test-config (static-file)
  ((target-system :initform nil
                  :initarg :target-system
                  :accessor target-system
                  :documentation "The system to be tested
   e.g. :cl-system-utilities"))
  (:documentation "An ASDF component that represents a LIFT unit
  testing configuration file."))

(defmethod source-file-type ((c lift-test-config) (s module))
  "config")

(defmethod input-files ((op test-op) (c lift-test-config))
  (component-pathname c))

(defmethod operation-done-p ((op test-op) (c lift-test-config))
  nil)

(defmethod perform ((op load-op) (c lift-test-config))
  nil)

(defmethod perform ((op compile-op) (c lift-test-config))
  nil)

(defmethod perform ((op test-op) (c lift-test-config))
  ;; Need to work relative to the root of the target system
  (let ((*default-pathname-defaults* (component-pathname
                                      (find-system (target-system c)))))    
    (lift:run-tests :config (component-pathname c))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CLDOC ASDF extension
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass cldoc-config (static-file)
  ((target-system :initform nil
                  :initarg :target-system
                  :accessor target-system
                  :documentation "The system to be documented
                  e.g. :cl-system-utilities"))
  (:documentation "An ASDF component that represents a CLDOC
  documentation extraction configuration file."))

(defclass doc-op (operation)
  ()
  (:documentation "An ASDF operation that extracts docstring
  documentation from Lisp code using CLDOC."))

(defmethod source-file-type ((c cldoc-config) (s module))
  ;; The cldoc pathname is a directory, so has pathname-type NIL
  nil)

(defmethod operation-done-p ((op doc-op) (c cldoc-config))
  nil)

(defmethod perform ((op doc-op) (c component))
  nil)

(defmethod perform ((op doc-op) (c cl-source-file))
  nil)

(defmethod perform ((op doc-op) (c cldoc-config))
  ;; Need to work relative to the root of the target system
  (let ((target (find-system (target-system c)))
        (path (component-pathname c)))
    (cldoc:extract-documentation 'cldoc:html (namestring path) target)))

{'fraction_non_alphanumeric': 0.18734660485410418, 'fraction_numerical': 0.0024543223343332426, 'mean_word_length': 3.7506476683937824, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4299429', 'n_tokens_mistral': 2349, 'n_tokens_neox': 2127, 'n_words': 752}