Commit 01dd1431 authored by Eric Timmons's avatar Eric Timmons
Browse files

Simplify config files

parent 4f464e26
...@@ -12,12 +12,39 @@ directories separated by your OS's conventional directory separator. If any ...@@ -12,12 +12,39 @@ directories separated by your OS's conventional directory separator. If any
entry in the list is empty. The default search locations will be spliced into entry in the list is empty. The default search locations will be spliced into
the list. the list.
The contents of =clpm.conf= must be a single list that starts with ~clpm-config~ Logically, CLPM is configured by a series of nested tables. The config file
and the rest must be a plist. Each key in the plist names either a value or a describes these tables using a series of forms. It is recommended (and will
section. If it names a section, the value must be another plist. If it names a likely be required in the future) that the first form in the config file
value, the value is read according to the rules for that value. declares the version of the config file API being used, such as the
following. The described version API is 0.1.
The following describe the configuration options for clpm. #+begin_src common-lisp
(version "0.1")
#+end_src
Each subsequent form must describe a table. Each subsequent form must start
with ~table~ or ~(table &rest path)~. The body of the form then contains a
plist describing key/value pairs for that table. Tables can be nested by either
declaring toplevel tables with overlapping paths or by embedding a table
(without a path) as a value inside another table.
For example, the following config would force CLPM to use curl as its HTTP
client and use the primary quicklisp destribution as a source.
#+begin_src common-lisp
(version "0.1")
((table :http-client)
:method :curl)
((table :sources "quicklisp")
:type :quicklisp
:url "https://beta.quicklisp.org/dist/quicklisp.txt")
#+end_src
The following describes the available configuration tables for CLPM. Each
header describes a table (or sub table). The lists in each section describe
that tables keys.
* ~:archives~ * ~:archives~
...@@ -63,11 +90,11 @@ The following describe the configuration options for clpm. ...@@ -63,11 +90,11 @@ The following describe the configuration options for clpm.
+ ~:secure-only-p~ :: If non-NIL, send this header only on secure + ~:secure-only-p~ :: If non-NIL, send this header only on secure
connections. connections.
+ ~:value~ :: The value to send for the header. If a string, the contents + ~:value~ :: The value to send for the header. Must be a string.
of the string are used literally. If a pathname naming an executable + ~:exec~ :: A path to a file that, when executed, prints the header value
file, that file is executed and whatever it prints to its standard output to its standard output. Must be a string or pathname.
is used as the value. If a pathname naming a non-executable file, the + ~:contents~ :: A path to a file that contains the value to use for the
contents of the file are sent. header. Must be a string or pathname.
* ~:http-client~ * ~:http-client~
+ ~:method~ :: The default method to use to as an HTTP client. Defaults to + ~:method~ :: The default method to use to as an HTTP client. Defaults to
......
...@@ -33,10 +33,7 @@ The type of every source must be specified with a keyword. ...@@ -33,10 +33,7 @@ The type of every source must be specified with a keyword.
Quicklisp distribution. Quicklisp distribution.
#+begin_src common-lisp #+begin_src common-lisp
(clpm-config ((table :sources "quicklisp")
:sources :type :quicklisp
("quicklisp" :url "https://beta.quicklisp.org/dist/quicklisp.txt")
(:type :quicklisp
:url "https://beta.quicklisp.org/dist/quicklisp.txt"
:force-https t)))
#+end_src #+end_src
...@@ -80,19 +80,24 @@ directory in ~*clpm-config-directories*~." ...@@ -80,19 +80,24 @@ directory in ~*clpm-config-directories*~."
;; * Configuration variables and merging configs ;; * Configuration variables and merging configs
(defparameter *default-config* (defparameter *default-config*
`(clpm-config '(progn
:grovel (version "0.1")
(:sandbox
(:method :auto)) ((table :grovel :sandbox)
:archives :method :auto)
(:tar-method :auto
:tar ((table :archives)
(:path "tar")) :tar-method :auto)
:http-client
(:curl ((table :archives :tar)
(:path "curl") :path "tar")
:method :auto))
"Default configuration of clpm") ((table :http-client)
:method :auto)
((table :http-client :curl)
:path "curl"))
"Default configuration of clpm.")
(defvar *config* nil (defvar *config* nil
"Active configuration. Computed at program execution time.") "Active configuration. Computed at program execution time.")
...@@ -140,94 +145,50 @@ overwrites the value from ~default-ht~." ...@@ -140,94 +145,50 @@ overwrites the value from ~default-ht~."
;; * Parsing configs ;; * Parsing configs
(defun names-path-p (path-1 path-2) (defgeneric parse-config-value (value))
"Returns T if ~path-1~ is named by ~path-2~. ~path-2~ can have
wildcards (~'*~) in it."
(or (equal path-1 path-2)
(and (eql '* (first path-2))
(names-path-p (rest path-1)
(rest path-2)))))
(defun path-table-p (path)
"Returns T if ~path~ is a path to a configuration value that contains a
table."
(switch (path :test #'names-path-p)
('(:archives)
t)
('(:tar :archives)
t)
('(:bundle)
t)
('(:local :bundle)
t)
('(* :local :bundle)
t)
('(:git)
t)
('(:remotes :git)
t)
('(* :remotes :git)
t)
('(:http)
t)
('(:headers :http)
t)
('(* :headers :http)
t)
('(* * :headers :http)
t)
('(:http-client)
t)
('(:curl :http-client)
t)
('(:grovel)
t)
('(:sandbox :grovel)
t)
('(:sources)
t)
('(* :sources)
t)))
(defun parse-table (path table)
"Given the ~path~ to the table and the ~table~ represented as a plist, return
a hash table representing the ~table~."
(let ((out (make-hash-table :test 'equalp)))
(iter
(for (key value) :on table :by #'cddr)
(for new-path := (list* key path))
(for value-table-p := (path-table-p new-path))
(if value-table-p
(setf (gethash key out) (parse-table new-path value))
(setf (gethash key out) value)))
out))
(defun %parse-config-form (form) (defmethod parse-config-value ((value t))
"Given a top level config represented as a plist, return a hash table value)
representing the config."
(let ((out (make-hash-table :test 'equalp))) (defmethod parse-config-value ((value list))
(iter (assert (eql 'table (first value)))
(for (key value) :on form :by #'cddr) (parse-config-form value))
(for path := (list key))
(for table-p := (path-table-p path)) (defgeneric %parse-config-form (first rest table))
(if table-p
(let ((existing-table (gethash key out (make-hash-table :test 'equalp)))) (defmethod %parse-config-form ((first (eql 'table)) rest table)
(setf (gethash key out) (merge-hts (parse-table path value) existing-table))) (loop
(setf (gethash key out) value))) :for key :in rest :by #'cddr
out)) :for value :in (rest rest) :by #'cddr
:do (setf (gethash key table) (parse-config-value value))))
(defun parse-config-form (form) (defmethod %parse-config-form ((first list) rest table)
(destructuring-bind (first &rest path) first
(assert (eql 'table first))
(let ((sub-table (make-hash-table :test 'equalp)))
(%parse-config-form 'table rest sub-table)
(setf (gethashes* table path) sub-table))))
(defmethod %parse-config-form ((first (eql 'progn)) rest table)
(mapc (rcurry #'parse-config-form table) rest)
table)
(defmethod %parse-config-form ((first (eql 'version)) rest table)
(assert (equal (first rest) "0.1")))
(defun parse-config-form (form &optional (table (make-hash-table :test 'equalp)))
"Given a top level config represented as a ~(clpm-config plist)~, return a "Given a top level config represented as a ~(clpm-config plist)~, return a
hash table representing the config." hash table representing the config."
(assert (listp form)) (assert (listp form))
(assert (string-equal 'clpm-config (first form))) (%parse-config-form (first form) (rest form) table)
(%parse-config-form (rest form))) table)
(defun merge-file-into-config! (pathname) (defun merge-file-into-config! (pathname)
"Read a config form from ~pathname~ and merge it into the currently active "Read a config form from ~pathname~ and merge it into the currently active
config." config."
(uiop:with-safe-io-syntax () (uiop:with-safe-io-syntax (:package :clpm/config)
(merge-ht-into-config! (parse-config-form (uiop:read-file-form pathname))))) (dolist (subform (uiop:read-file-forms pathname))
(merge-ht-into-config! (parse-config-form subform)))))
(defun load-global-config () (defun load-global-config ()
"Seed ~*config*~ with ~*default-config*~ and merge the primary CLPM config "Seed ~*config*~ with ~*default-config*~ and merge the primary CLPM config
...@@ -242,9 +203,6 @@ file (clpm.conf) into ~*active*~." ...@@ -242,9 +203,6 @@ file (clpm.conf) into ~*active*~."
"Clear the ~*config*~ variable." "Clear the ~*config*~ variable."
(setf *config* nil)) (setf *config* nil))
(uiop:register-clear-configuration-hook 'clear-global-config)
(uiop:register-image-restore-hook 'load-global-config)
;; * Querying the config ;; * Querying the config
...@@ -260,7 +218,7 @@ file (clpm.conf) into ~*active*~." ...@@ -260,7 +218,7 @@ file (clpm.conf) into ~*active*~."
"Modify the value in ~hash-table~ addressed by the list of ~keys~." "Modify the value in ~hash-table~ addressed by the list of ~keys~."
(if (rest keys) (if (rest keys)
(setf (gethashes* (ensure-gethash (first keys) hash-table (setf (gethashes* (ensure-gethash (first keys) hash-table
(make-hash-table :test 'equal)) (make-hash-table :test 'equalp))
(rest keys)) (rest keys))
value) value)
(setf (gethash (first keys) hash-table) value))) (setf (gethash (first keys) hash-table) value)))
...@@ -286,6 +244,43 @@ file (clpm.conf) into ~*active*~." ...@@ -286,6 +244,43 @@ file (clpm.conf) into ~*active*~."
(collect (flatten-hts value)) (collect (flatten-hts value))
(collect value)))) (collect value))))
(defun print-table (table path stream)
(let ((tables nil)
(values nil))
(maphash (lambda (k v)
(if (hash-table-p v)
(push (cons (append path (list k)) v) tables)
(push (cons k v) values)))
table)
(when values
(let ((*print-pretty* t)
(*print-case* :downcase))
(pprint-logical-block (stream values :prefix "(" :suffix ")")
(format stream "(table ~{~S~^ ~})" path)
(pprint-exit-if-list-exhausted)
(pprint-newline :mandatory stream)
(loop
(let* ((pair (pprint-pop))
(key (car pair))
(value (cdr pair)))
(prin1 key stream)
(write-char #\Space stream)
(prin1 value stream)
(pprint-exit-if-list-exhausted)
(pprint-newline :mandatory stream))))
(pprint-newline :mandatory stream)
(terpri stream)
(terpri stream)))
(dolist (sub-table tables)
(print-table (cdr sub-table) (car sub-table) stream))))
(defun print-config (stream) (defun print-config (stream)
"Flatte ~*config*~ using ~flatten-hts~ and print it to ~stream~." "Print the configuration to ~stream~."
(format stream "~S~%" (flatten-hts *config*))) (format stream "(version \"0.1\")~%~%")
(maphash (lambda (k v)
(assert (hash-table-p v))
(print-table v (list k) stream))
*config*))
(uiop:register-clear-configuration-hook 'clear-global-config)
(uiop:register-image-restore-hook 'load-global-config)
Supports Markdown
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