Commit 60e5a029 authored by Eric Timmons's avatar Eric Timmons
Browse files

Remove dead (mostly commented out) code

parent 725208db
......@@ -6,7 +6,6 @@
(uiop:define-package #:clpm/clpm
(:use #:cl
#:clpm/cli/bundle
;;#:clpm/cli/client
#:clpm/cli/config
#:clpm/cli/context
#:clpm/cli/entry
......
......@@ -128,53 +128,6 @@ clpmfile is located."
;; * Deserializing
;; (defun parse-clpmfile-forms (clpmfile forms)
;; "Given a list of ~forms~, parse them and register them appropriately with
;; ~clpmfile~ based on the ~:api-version~ which must be specified first in
;; ~forms~."
;; ;; Try reading the first form to get the api version
;; (unless (listp (first forms))
;; (error "The first form must be a list"))
;; (unless (eql :api-version (first (first forms)))
;; (error "The first form must specify the api version"))
;; (unless (equal '(:api-version "0.2") (first forms))
;; (error "This only supports api version 0.2"))
;; (pop forms)
;; ;; Now that we know we're using api version 0.2, let's make sure everything
;; ;; left is a list.
;; (unless (every #'listp forms)
;; (error "Every form must be a list."))
;; (iter
;; ;; Sources are only allowed immediately following the :api-version
;; (with source-allowed-p := t)
;; (for form :in forms)
;; (for (type . args) := form)
;; (when (and (eql type :source)
;; (not source-allowed-p))
;; (error "Global sources must be specified immediately after the api declaration"))
;; (when (and
;; source-allowed-p
;; (not (eql type :source)))
;; (nreversef (clpmfile-user-global-sources clpmfile))
;; (setf source-allowed-p nil))
;; (ecase type
;; (:source
;; (apply #'parse-source-statement clpmfile args))
;; (:gitlab
;; (push form (clpmfile/user-raw-requirements clpmfile))
;; (apply #'parse-gitlab-statement clpmfile args))
;; (:system
;; (push form (clpmfile/user-raw-requirements clpmfile))
;; (apply #'parse-system-statement clpmfile args))
;; (:project
;; (push form (clpmfile/user-raw-requirements clpmfile))
;; (apply #'parse-project-statement clpmfile args))
;; (:asd
;; (apply #'parse-asd-statement clpmfile args))))
;; (nreversef (clpmfile-user-asd-files clpmfile))
;; (nreversef (clpmfile-user-requirements clpmfile))
;; clpmfile)
(defun find-source-or-error (sources source-name)
"Given a list of sources, return the source that is named source-name or raise
an error if it does not exist."
......@@ -314,350 +267,3 @@ instance."
(prin1 :user-requirements stream)
(write-char #\Space stream)
(write (clpmfile-user-requirements obj) :stream stream)))
;; (defun find-source-or-error (sources source-name)
;; "Given a list of ~sources~, return the source that has is named ~source-name~
;; or raise an error if it does not exist."
;; (or (find source-name sources
;; :key #'source-name
;; :test #'string-equal)
;; (error "Unable to find source ~S" source-name)))
;; (defun parse-req-statement (clpmfile name
;; &key (type :project) version source
;; systems)
;; "Parse a ~:req~ statement from a ~clpmfile~ into a ~requirement~ instance."
;; (assert (null systems))
;; (let ((req nil))
;; (setf req
;; (make-instance (ecase type
;; (:project 'project-requirement)
;; (:system 'system-requirement))
;; :name (string-downcase (string name))
;; :source (when source
;; (find-source-or-error (clpmfile-user-global-sources clpmfile)
;; source))
;; :version-spec (when version
;; (cons (first version)
;; (second version)))))
;; (push req (clpmfile-user-requirements clpmfile))))
;; (defun parse-project-statement (clpmfile name
;; &key source vcs version
;; systems)
;; (if vcs
;; (destructuring-bind (&key branch commit tag)
;; vcs
;; (push (make-instance 'vcs-project-requirement
;; :name (string-downcase (string name))
;; :source (when source
;; (find-source-or-error (clpmfile-user-global-sources clpmfile)
;; source))
;; :branch branch
;; :commit commit
;; :tag tag
;; :systems systems)
;; (clpmfile-user-requirements clpmfile)))
;; (push (make-instance 'project-requirement
;; :name (string-downcase (string name))
;; :source (when source
;; (find-source-or-error (clpmfile-user-global-sources clpmfile)
;; source))
;; :version-spec (when version
;; (cons (first version)
;; (second version))))
;; (clpmfile-user-requirements clpmfile))))
;; (defun parse-system-statement (clpmfile name &key source)
;; "Parse a ~:system~ statement from a ~clpmfile~ into a ~system-requirement~
;; instance."
;; (push (make-instance 'system-requirement
;; :name (string-downcase (string name))
;; :source (when source
;; (find-source-or-error (clpmfile-user-global-sources clpmfile)
;; source)))
;; (clpmfile-user-requirements clpmfile)))
;; (defun parse-gitlab-statement (clpmfile name
;; &key (host "gitlab.com") path branch commit tag systems)
;; "Parse a ~:gitlab~ statement from a ~clpmfile~ into a
;; ~vcs-project-requirement~ instance."
;; (let ((source (clpmfile/vcs-source clpmfile))
;; (repo (make-repo-from-description (list :gitlab :host host :path path))))
;; ;; Register the git project.
;; (vcs-source-register-project! source repo name)
;; (assert (xor branch commit tag))
;; (push (make-instance 'vcs-project-requirement
;; :systems systems
;; :name name
;; :source source
;; :repo repo
;; :branch branch
;; :commit commit
;; :tag tag)
;; (clpmfile-user-requirements clpmfile))))
;; (defun parse-source-statement (clpmfile &rest args)
;; "Load a ~:source~ statement from a ~clpmfile~ and add it to the list of
;; sources."
;; (unless (stringp (first args))
;; (error "The first argument to :SOURCE must be a string"))
;; (push (load-source-from-form args)
;; (clpmfile-user-global-sources clpmfile)))
;; (defun parse-clpmfile-forms (clpmfile forms)
;; "Given a list of ~forms~, parse them and register them appropriately with
;; ~clpmfile~ based on the ~:api-version~ which must be specified first in
;; ~forms~."
;; ;; Try reading the first form to get the api version
;; (unless (listp (first forms))
;; (error "The first form must be a list"))
;; (unless (eql :api-version (first (first forms)))
;; (error "The first form must specify the api version"))
;; (unless (equal '(:api-version "0.2") (first forms))
;; (error "This only supports api version 0.2"))
;; (pop forms)
;; ;; Now that we know we're using api version 0.2, let's make sure everything
;; ;; left is a list.
;; (unless (every #'listp forms)
;; (error "Every form must be a list."))
;; (iter
;; ;; Sources are only allowed immediately following the :api-version
;; (with source-allowed-p := t)
;; (for form :in forms)
;; (for (type . args) := form)
;; (when (and (eql type :source)
;; (not source-allowed-p))
;; (error "Global sources must be specified immediately after the api declaration"))
;; (when (and
;; source-allowed-p
;; (not (eql type :source)))
;; (nreversef (clpmfile-user-global-sources clpmfile))
;; (setf source-allowed-p nil))
;; (ecase type
;; (:source
;; (apply #'parse-source-statement clpmfile args))
;; (:gitlab
;; (push form (clpmfile/user-raw-requirements clpmfile))
;; (apply #'parse-gitlab-statement clpmfile args))
;; (:system
;; (push form (clpmfile/user-raw-requirements clpmfile))
;; (apply #'parse-system-statement clpmfile args))
;; (:project
;; (push form (clpmfile/user-raw-requirements clpmfile))
;; (apply #'parse-project-statement clpmfile args))
;; (:asd
;; (apply #'parse-asd-statement clpmfile args))))
;; (nreversef (clpmfile-user-asd-files clpmfile))
;; (nreversef (clpmfile-user-requirements clpmfile))
;; clpmfile)
;; (defgeneric parse-system-file-statement (lockfile type &key &allow-other-keys)
;; (:documentation
;; "Parse a system file statement from a lockfile."))
;; (defmethod parse-system-file-statement (lockfile (type (eql :project))
;; &key name source version system-files)
;; (let* ((source (find source (clpmfile-user-global-sources (lockfile/clpmfile lockfile))
;; :key #'source-name
;; :test #'equal))
;; (release (source-project-release source name version)))
;; (dolist (system-file-name system-files)
;; (push (release-system-file release system-file-name) (lockfile/system-files lockfile)))
;; lockfile))
;; (defmethod parse-system-file-statement (lockfile (type (eql :local-asd))
;; &key path)
;; (fs-source-register-asd (clpmfile-fs-source (lockfile/clpmfile lockfile)) path)
;; (let* ((source (clpmfile-fs-source (lockfile/clpmfile lockfile)))
;; (project (source-project source "all"))
;; (release (project-release project "newest"))
;; (system-file (release-system-file release path)))
;; (assert system-file)
;; (push system-file (lockfile/system-files lockfile))
;; lockfile))
;; (defmethod parse-system-file-statement (lockfile (statement-type (eql :gitlab))
;; &key host path commit system-files
;; name)
;; ;; First, look for a local override.
;; (let ((local (config-value :bundle :local name :path)))
;; (if local
;; ;; A local override exists.
;; (error "local overrides currently broken.")
;; (let* ((source (clpmfile/vcs-source (lockfile/clpmfile lockfile)))
;; (repo (make-repo-from-description `(:gitlab :host ,host :path ,path)))
;; (project (vcs-source-register-project! source repo name))
;; (release (project-release project `(:commit ,commit)))
;; (system-files (mapcar (curry #'release-system-file release) system-files)))
;; (setf (lockfile/system-files lockfile)
;; (append system-files (lockfile/system-files lockfile))))))
;; lockfile)
;; (defun parse-lockfile-forms (lockfile forms)
;; "Given a list of ~forms~, parse them and register them appropriately with
;; ~lockfile~ based on the ~:api-version~ which must be specified first in
;; ~forms~."
;; ;; Try reading the first form to get the api version
;; (unless (listp (first forms))
;; (error "The first form must be a list"))
;; (unless (eql :api-version (first (first forms)))
;; (error "The first form must specify the api version"))
;; (unless (equal '(:api-version "0.2") (first forms))
;; (error "This version of CLPM only supports api version 0.2"))
;; (pop forms)
;; ;; Now that we know we're using API version 0.2, let's make sure everything
;; ;; left is a list.
;; (unless (every #'listp forms)
;; (error "every form must be a list."))
;; (let ((clpmfile (make-instance 'clpmfile
;; :pathname (lockfile-clpmfile-pathname (lockfile/pathname lockfile))))
;; (sources-form (find :user-global-sources forms :key #'car))
;; ;;(user-asd-files-form (find :user-asd-files forms :key #'car))
;; ;;(user-reqs-form (find :user-reqs forms :key #'car))
;; (all-system-files-form (find :all-system-files forms :key #'car)))
;; (setf (lockfile/clpmfile lockfile) clpmfile)
;; (setf (clpmfile-user-global-sources clpmfile)
;; (mapcar #'load-source-from-form (cdr sources-form)))
;; (mapc (lambda (x)
;; (apply #'parse-system-file-statement
;; lockfile (first x)
;; (rest x)))
;; (cdr all-system-files-form))))
;; (defun lockfile-system-file-sexps (lockfile)
;; "Return a list of system file statements from ~lockfile~ suitable for writing
;; to a file."
;; (let* ((all-system-files (lockfile/system-files lockfile)))
;; (iter
;; (for system-file := (pop all-system-files))
;; (while system-file)
;; (for release := (system-file-release system-file))
;; (for system-files-in-release := (list* system-file
;; (remove-if-not (lambda (x)
;; (eql release (system-file-release x)))
;; all-system-files)))
;; (setf all-system-files (remove-if (lambda (x)
;; (eql release (system-file-release x)))
;; all-system-files))
;; (cond
;; ((typep release 'fs-release)
;; (dolist (file system-files-in-release)
;; (collect `(:local-asd
;; :path ,(system-file-asd-enough-namestring file)))))
;; ;; TODO: Make this handle local vs remote git repos
;; ((typep release 'vcs-release)
;; (let* ((version (release-version release))
;; (project (release-project release))
;; (repo (project-repo project)))
;; (assert (listp version))
;; (assert (eql :commit (first version)))
;; (assert (stringp (second version)))
;; (collect `(,(etypecase repo
;; (gitlab-repo
;; :gitlab))
;; :name ,(project-name (release-project release))
;; :host ,(gitlab-repo-host repo)
;; :path ,(gitlab-repo-path repo)
;; :commit ,(second version)
;; :system-files ,(mapcar #'system-file-asd-enough-namestring system-files-in-release)))))
;; (t
;; (collect `(:project
;; :name ,(project-name (release-project release))
;; :version ,(release-version release)
;; :source ,(source-name (release-source release))
;; :system-files ,(mapcar #'system-file-asd-enough-namestring system-files-in-release))))))))
;; (defun write-lockfile-to-stream (lockfile stream)
;; "Write ~lockfile~ to ~stream~."
;; (uiop:with-safe-io-syntax ()
;; (let ((*print-case* :downcase)
;; (clpmfile (lockfile/clpmfile lockfile)))
;; (write-string ";;; -*- mode: common-lisp -*-" stream)
;; (terpri stream)
;; (write '(:api-version "0.2") :stream stream)
;; (terpri stream)
;; (write `(:user-global-sources ,@(mapcar #'source-to-form (clpmfile-user-global-sources clpmfile)))
;; :stream stream)
;; (terpri stream)
;; (write `(:user-asd-files ,@(clpmfile-user-asd-files clpmfile))
;; :stream stream)
;; (terpri stream)
;; (write `(:user-reqs ,@(clpmfile/user-raw-requirements clpmfile))
;; :stream stream
;; :pretty t
;; :right-margin 120)
;; (terpri stream)
;; (write `(:all-system-files
;; ,@(lockfile-system-file-sexps lockfile))
;; :stream stream
;; :pretty t
;; :right-margin 120)
;; (terpri stream))))
;; (defun clpmfile/lockfile-pathname (clpmfile)
;; "The pathname to the lockfile associated with this clpmfile."
;; (merge-pathnames (make-pathname :type "lock")
;; (clpmfile-pathname clpmfile)))
;; (defun lockfile-clpmfile-pathname (lockfile-pathname)
;; "The pathname to the clpmfile associated with this lockfile pathname."
;; (make-pathname :type nil :defaults lockfile-pathname))
;; (defun clpmfile/lockfile (clpmfile)
;; "Return the lockfile object associated with this clpmfile."
;; (read-lockfile (clpmfile/lockfile-pathname clpmfile)))
;; (defun clpmfile-asd-file-requirements (clpmfile)
;; "Return a list of requirements gathered from the ~:asd~ statements in
;; ~clpmfile~."
;; (let ((fs-source (clpmfile-fs-source clpmfile)))
;; (mapcan (lambda (x)
;; (destructuring-bind (asd-file &key systems)
;; x
;; (if systems
;; (mapcar (lambda (system-name)
;; (make-instance 'fs-system-requirement
;; :name system-name
;; :source fs-source))
;; systems)
;; (list (make-instance 'fs-system-file-requirement
;; :source fs-source
;; :name (merge-pathnames asd-file
;; (clpmfile-pathname clpmfile)))))))
;; (clpmfile-user-asd-files clpmfile))))
;; (defun clpmfile/all-requirements (clpmfile)
;; "Return a list of all requirements specified by ~clpmfile~."
;; (append
;; (clpmfile-asd-file-requirements clpmfile)
;; (clpmfile-user-requirements clpmfile)))
;; (defun read-clpmfile (pathname)
;; "Read a ~clpmfile~ instance from ~pathname~."
;; (let* ((*default-pathname-defaults* (uiop:pathname-directory-pathname pathname))
;; (forms (uiop:with-safe-io-syntax ()
;; (uiop:read-file-forms pathname)))
;; (clpmfile (make-instance 'clpmfile
;; :pathname pathname)))
;; (parse-clpmfile-forms clpmfile forms)
;; clpmfile))
;; (defun read-lockfile (pathname)
;; "Read a ~lockfile~ instance from ~pathname~."
;; (let* ((*default-pathname-defaults* (uiop:pathname-directory-pathname pathname))
;; (forms (uiop:with-safe-io-syntax ()
;; (uiop:read-file-forms pathname)))
;; (lockfile (make-instance 'lockfile
;; :pathname pathname)))
;; (parse-lockfile-forms lockfile forms)
;; lockfile))
......@@ -16,8 +16,7 @@
#:clpm/log
#:clpm/repos
#:clpm/requirement
#:clpm/sources/defs
#:clpm/sources/semantic-versioned-project)
#:clpm/sources/defs)
(:export #:*vcs-project-override-fun*
#:ensure-vcs-release-installed!
#:make-vcs-release
......
......@@ -117,139 +117,3 @@ for process to confine build artifacts to CLPM's cache. Use
(uiop:delete-directory-tree (sub-lisp-process-asdf-fasl-cache-dir sub-lisp)
:validate t
:if-does-not-exist :ignore))))
;; (defun start-grovel-process ()
;; "Start and return a process (using ~launch-sub-lisp~) that contains an
;; instance of SBCL or CCL with the groveling code loaded."
;; (ensure-deps-system-in-cache!)
;; (let* ((proc-info (launch-sub-lisp))
;; (in-stream (uiop:process-info-input proc-info))
;; (out-stream (uiop:process-info-output proc-info))
;; (asd-pathname (clpm-cache-pathname
;; (list "deps-groveler-system"
;; (deps-version-string)
;; "clpm-deps.asd"))))
;; (uiop:with-safe-io-syntax ()
;; (format in-stream "(progn (require :sb-sprof) (values))~%")
;; (format in-stream "(progn (require :asdf) (values))~%")
;; ;; Nuke any existing asdf configuration
;; (format in-stream "(progn (asdf:clear-configuration) (values))~%")
;; ;; Make sure if ASDF reinitializes its configuration that it ignores
;; ;; everything but the default (implementation specific) systems.
;; (format in-stream "(progn (setf asdf:*default-source-registries* nil) (values))~%")
;; (format in-stream "(progn (asdf:load-asd ~S) (values))~%" asd-pathname)
;; (format in-stream "(progn (asdf:load-system :clpm-deps) (values))~%")
;; (format in-stream "(progn (print \"ready\") (values))~%")
;; (format in-stream "(progn (finish-output) (values))~%")
;; (finish-output in-stream)
;; ;; Wait until the process reports that it is ready.
;; (loop
;; :for val := (read out-stream)
;; :until (equal val "ready")))
;; proc-info))
;; (defun safe-load-asd-in-process (proc-info asd-pathname)
;; "Load the .asd file at ~asd-pathname~ into the ~proc-info~'s lisp process."
;; (let* ((in-stream (uiop:process-info-input proc-info))
;; (out-stream (uiop:process-info-output proc-info)))
;; (log:error "Starting ~S" asd-pathname)
;; (setf *trace-output* *error-output*)
;; (progn
;; (uiop:with-safe-io-syntax ()
;; (format in-stream "(progn (print (multiple-value-list (clpm-deps/main::safe-load-asd ~S))) (values))~%"
;; asd-pathname)
;; (format in-stream "(progn (finish-output) (values))~%")
;; (finish-output in-stream)
;; (values-list (read out-stream))))))
;; (defun determine-system-deps-in-process (proc-info system-name)
;; "Query and return a list of the dependencies of ~system-name~."
;; (let* ((in-stream (uiop:process-info-input proc-info))
;; (out-stream (uiop:process-info-output proc-info)))
;; (log:error "Starting ~S" system-name)
;; (setf *trace-output* *error-output*)
;; (progn
;; (uiop:with-safe-io-syntax ()
;; (format in-stream "(progn (print (clpm-deps/main::system-direct-deps (asdf:find-system ~S))) (values))~%"
;; system-name)
;; (format in-stream "(progn (finish-output) (values))~%")
;; (finish-output in-stream)
;; (read out-stream)))))
;; (defun determine-systems-from-file-in-process (proc-info system-pathname)
;; "Return a list of systems defined in the .asd file located at
;; ~system-pathname~."
;; (let* ((in-stream (uiop:process-info-input proc-info))
;; (out-stream (uiop:process-info-output proc-info)))
;; (log:error "Starting ~S" system-pathname)
;; (setf *trace-output* *error-output*)
;; (progn
;; (uiop:with-safe-io-syntax ()
;; (format in-stream "(progn (print (clpm-deps/main::determine-systems-from-file ~S)) (values))~%"
;; system-pathname)
;; (format in-stream "(progn (finish-output) (values))~%")
;; (finish-output in-stream)
;; (read out-stream)))))
;; (defun ensure-process-ready! (proc-info asd-pathname dependency-asd-files)
;; "Ensures that the process has asd-pathname successfully loaded. Establishes a
;; ~add-asd-and-retry~ restart."
;; (tagbody
;; start
;; (dolist (file (append dependency-asd-files (list asd-pathname)))
;; (multiple-value-bind (success-p unknown-error-backtrace missing-system)
;; (safe-load-asd-in-process proc-info file)
;; (unless success-p
;; (when unknown-error-backtrace
;; ;; Uh-oh something happened that we don't know how to recover from
;; ;; here. First, kill the process, then signal an error.
;; (kill-groveler-process! proc-info asd-pathname)
;; (error 'groveler-unknown-error
;; :backtrace unknown-error-backtrace))
;; ;; We can provide a way to recover from this!
;; (restart-case
;; (error 'groveler-dependency-missing :system missing-system)
;; (add-asd-and-retry (asd)
;; :report "Add an asd file to preload and try again."
;; :interactive read-asd-path
;; (push asd dependency-asd-files)
;; (go start))))))))
;; (defun kill-groveler-process! (proc-info asd-file)
;; "Terminate the sublisp."
;; (when (uiop:process-alive-p proc-info)
;; (uiop:terminate-process proc-info :urgent t))
;; (remhash (truename asd-file) *running-grovelers*)
;; (uiop:wait-process proc-info))
;; (defun kill-groveler-process-for-file! (asd-file)
;; "Kill the groveler process associated with ~asd-file~."
;; (when-let ((proc-info (gethash (truename asd-file) *running-grovelers*)))
;; (kill-groveler-process! proc-info asd-file)))
;; (defun get-groveler-process (asd-file dependency-asd-files)
;; "Get the groveler process that has asd-file loaded and ready to be queried."
;; (ensure-gethash (truename asd-file) *running-grovelers*
;; (aprog1 (start-grovel-process)
;; (ensure-process-ready! it asd-file dependency-asd-files))))
;; (defun grovel-system-info (asd-file system-name)
;; "Grovel for the dependencies of ~system-name~ in ~asd-file~."
;; (determine-system-deps-in-process (get-groveler-process asd-file nil) system-name))
;; (defun grovel-systems-in-file (asd-file)
;; "Grovel for the systems defined in ~asd-file~."
;; (determine-systems-from-file-in-process (get-groveler-process asd-file nil)
;; (uiop:truename* asd-file)))
;; (defun exit-hook ()
;; "Terminates all groveler processes."
;; (maphash-keys (lambda (k)
;; (kill-groveler-process-for-file! k))
;; *running-grovelers*))
;; (add-exit-hook 'exit-hook)
;; (defun read-asd-path ()
;; (format t "Enter a path to an asd file (not evaluated): ")
;; (list (read-line)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment