changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: light printing

changeset 509: 4963e69e226d
parent 508: e2d577f31866
child 510: 607f80be99ca
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 04 Jul 2024 22:03:45 -0400
files: lisp/lib/pod/containerfile.lisp lisp/lib/skel/comp/cargo.lisp lisp/lib/skel/comp/container.lisp lisp/lib/skel/core/obj.lisp
description: light printing
     1.1--- a/lisp/lib/pod/containerfile.lisp	Thu Jul 04 21:03:47 2024 -0400
     1.2+++ b/lisp/lib/pod/containerfile.lisp	Thu Jul 04 22:03:45 2024 -0400
     1.3@@ -50,6 +50,18 @@
     1.4 (defun containerfile-arg-p (str)
     1.5   (starts-with-subseq "ARG" str))
     1.6 
     1.7+(defun format-containerfile-arg (arg)
     1.8+  (with-output-to-string (s)
     1.9+    (etypecase arg
    1.10+      (atom (write arg :stream s))
    1.11+      (cons (format s "~A=~A" (car arg) (cdr arg))))))
    1.12+      
    1.13+(defun write-containerfile-arg (arg stream)
    1.14+  (format stream "ARG ~A~%" (format-containerfile-arg arg)))
    1.15+
    1.16+(defun write-containerfile-from (base stream)
    1.17+  (format stream "FROM ~A~%" base))
    1.18+
    1.19 ;; first instruction must be FROM or ARG
    1.20 (defun read-containerfile-start (stream)
    1.21   (let ((args))
    1.22@@ -62,13 +74,17 @@
    1.23 
    1.24 ;;; Obj
    1.25 (defclass containerfile ()
    1.26-  ((path :type pathname :initarg :path :accessor containerfile-path)
    1.27+  ((path :initform (pathname *default-containerfile*) :type pathname :initarg :path :accessor containerfile-path)
    1.28    (base :type string :initarg :base :accessor containerfile-base)
    1.29    (args :initform nil :type list :initarg :args :accessor containerfile-args)
    1.30-   (steps :type (vector cons) :initarg :steps :accessor containerfile-steps)))
    1.31+   (steps :initform (make-array 0 :element-type 'cons :adjustable t) :type (vector cons) :initarg :steps :accessor containerfile-steps)))
    1.32 
    1.33 (defmethod dat/proto:serde ((from containerfile) (to pathname))
    1.34   (with-open-file (file to :direction :output)
    1.35+    (when-let ((base (containerfile-base from)))
    1.36+      (write-containerfile-from base file))
    1.37+    (loop for arg in (containerfile-args from)
    1.38+          do (write-containerfile-arg arg file))
    1.39     (loop for step across (containerfile-steps from)
    1.40           do (write-containerfile-line step file))))
    1.41 
     2.1--- a/lisp/lib/skel/comp/cargo.lisp	Thu Jul 04 21:03:47 2024 -0400
     2.2+++ b/lisp/lib/skel/comp/cargo.lisp	Thu Jul 04 22:03:45 2024 -0400
     2.3@@ -15,9 +15,13 @@
     2.4 (defclass sk-rust-system (sk-module)
     2.5   ())
     2.6 
     2.7-(defclass sk-rust-component (skel)
     2.8+(defclass sk-rust-component (sk-component)
     2.9   (type value))
    2.10 
    2.11+(defmethod print-object ((object sk-rust-system) stream)
    2.12+  (print-unreadable-object (object stream :type t)
    2.13+    (format stream ":ID ~A" (format-sxhash (obj/id:id object)))))
    2.14+
    2.15 (defun parse-sk-rust-system (path)
    2.16   path)
    2.17 
     3.1--- a/lisp/lib/skel/comp/container.lisp	Thu Jul 04 21:03:47 2024 -0400
     3.2+++ b/lisp/lib/skel/comp/container.lisp	Thu Jul 04 22:03:45 2024 -0400
     3.3@@ -14,6 +14,10 @@
     3.4 (defclass sk-containerfile (sk-component containerfile)
     3.5   ())
     3.6 
     3.7+(defmethod print-object ((object sk-containerfile) stream)
     3.8+  (print-unreadable-object (object stream :type t)
     3.9+    (format stream "~A :ID ~A" (file-namestring (containerfile-path object)) (format-sxhash (id object)))))
    3.10+
    3.11 (defmethod sk-convert ((self containerfile))
    3.12   (let ((self (change-class self 'sk-containerfile)))
    3.13     (update-id self)
    3.14@@ -26,4 +30,4 @@
    3.15                :containerfile)))
    3.16 
    3.17 (defmethod sk-write-file ((self sk-containerfile) &key path)
    3.18-  (serde self path))
    3.19+  (serde self (pathname (or path (containerfile-path self)))))
     4.1--- a/lisp/lib/skel/core/obj.lisp	Thu Jul 04 21:03:47 2024 -0400
     4.2+++ b/lisp/lib/skel/core/obj.lisp	Thu Jul 04 22:03:45 2024 -0400
     4.3@@ -12,7 +12,7 @@
     4.4 
     4.5 (defmethod print-object ((self skel) stream)
     4.6   (print-unreadable-object (self stream :type t)
     4.7-    (format stream "~S ~A" :id (format-sxhash (id self)))))
     4.8+    (format stream ":ID ~A" (format-sxhash (id self)))))
     4.9 
    4.10 (defmethod initialize-instance :around ((self skel) &rest initargs &key &allow-other-keys)
    4.11   ;; TODO 2023-09-10: make fast 
    4.12@@ -364,7 +364,7 @@
    4.13           :initform (make-array 0 :element-type 'sk-rule :adjustable t)
    4.14           :accessor sk-rules
    4.15           :type (vector sk-rule))
    4.16-   (components :initarg :components :accessor sk-components :type (vector (cons keyword pathname)))
    4.17+   (components :initform #() :initarg :components :accessor sk-components :type (vector (cons keyword pathname)))
    4.18    (bind :initarg :bind :initform nil :accessor sk-bind :type list)
    4.19    (env :initarg :env :initform nil :accessor sk-env :type list)
    4.20    (scripts :initarg :scripts
    4.21@@ -378,6 +378,16 @@
    4.22             :accessor sk-include
    4.23             :type (vector pathname))))
    4.24 
    4.25+(defmethod print-object ((self sk-project) stream)
    4.26+  (print-unreadable-object (self stream :type t)
    4.27+    (format stream "~A [c=~A;i=~A;r=~A;s=~A] :id ~A"
    4.28+            (sk-name self)
    4.29+            (length (sk-components self))
    4.30+            (length (sk-include self))
    4.31+            (length (sk-rules self))
    4.32+            (length (sk-scripts self))
    4.33+            (format-sxhash (id self)))))
    4.34+
    4.35 (defmethod sk-new ((self (eql :project)) &rest args)
    4.36   (declare (ignore self))
    4.37   (apply #'sk-new 'sk-project args))