6BQ6COFB5IBOX7THMPJ7FTGU6XKYKJI3BGSJF6ZUEWEREDDOAHIQC
#!/usr/bin/env -S sbcl --script
(load "~/quicklisp/setup.lisp")
(ql:quickload '(:yason :uiop :cl-ppcre :serapeum
:data-lens/transducers :fwoar-lisputils))
(defpackage :fwoar.nix-helper
(:use :cl )
(:export ))
(in-package :fwoar.nix-helper)
(defun replace-regexes (from to str)
(assert (= (length from) (length to)))
(if (null from)
str
(replace-regexes
(rest from)
(rest to)
(cl-ppcre:regex-replace-all (first from) str (first to)))))
(defun nixify-symbol (string)
(flet ((fix-special-chars (str)
(replace-regexes '("[_]" "[+]$" "[+][/]" "[+]" "[.]" "[/]")
'("__" "_plus" "_plus/" "_plus_" "_dot_" "_slash_")
str)))
(if (ppcre:scan "^[0-9]" string)
(serapeum:concat "_" (fix-special-chars string))
(fix-special-chars string))))
(defun find-subsystems (system)
(funcall (data-lens:include
(data-lens:regex-match
(string-downcase system)))
(asdf:registered-systems)))
(defun eliminate-requires (deps)
(labels ((handle-dep (dep)
(typecase dep
(cons (case (car dep)
(:feature (when (uiop:featurep (cadr dep))
(handle-dep (caddr dep))))
(t nil)))
(string (list dep)))))
(mapcan #'handle-dep
deps)))
(defun transitive-dependencies (system)
(loop with stack = (list system)
for next = (pop stack)
for old-deps = (list system) then (append old-deps new)
for next-deps = (asdf:system-depends-on (asdf:find-system next))
for new = (eliminate-requires (set-difference next-deps old-deps :test #'equal))
do (setf stack (append stack new))
while stack
append new))
(defun get-dependencies (system)
(list system
(coerce (mapcar #'nixify-symbol
(clean-deps (transitive-dependencies system)))
'vector)))
(defun serialize-dependencies (s dependency-map)
(yason:with-output (s :indent t)
(yason:with-object ()
(loop for (system dependencies) in dependency-map
do (yason:with-object-element (system)
(yason:encode dependencies))))))
(defun clean-deps (deps)
(remove-duplicates
(remove-if (lambda (it)
(or (serapeum:string-prefix-p "sb-" (string-downcase it))
(member it '("uiop"
"sb-posix")
:test #'equal)))
(mapcar (lambda (it)
(first (fwoar.string-utils:partition #\/ it)))
deps))
:test #'equal))
(defun serialize-primary-and-secondary-system-deps (s system)
(serialize-dependencies s
(mapcar #'get-dependencies
(find-subsystems system))))
(defun doit (output-fn system)
(alexandria:with-output-to-file (s output-fn :if-exists :supersede)
(serialize-primary-and-secondary-system-deps s system)))
(progn
(format t "NOTICE ME: ~s~%" (truename (caddr (uiop:command-line-arguments))))
(asdf:load-asd (truename (caddr (uiop:command-line-arguments))))
(format t "NOTICE ME: ~s~%" (asdf:find-system (cadr (uiop:command-line-arguments))))
;; (ql:quickload (cadr (uiop:command-line-arguments)))
(doit (car (uiop:command-line-arguments))
(cadr (uiop:command-line-arguments)))
)
{
"fwoar-tools":[],
"fwoar-tools/zenburn":[
"serapeum",
"net_dot_didierverna_dot_clon",
"alexandria",
"trivial-macroexpand-all",
"trivial-file-size",
"global-vars",
"trivial-cltl2",
"introspect-environment",
"parse-declarations-1_dot_0",
"bordeaux-threads",
"trivial-garbage",
"parse-number",
"string-case",
"split-sequence",
"trivia",
"net_dot_didierverna_dot_clon_dot_termio",
"net_dot_didierverna_dot_clon_dot_core",
"trivial-features",
"trivia_dot_balland2006",
"net_dot_didierverna_dot_clon_dot_setup",
"cl-ppcre",
"dufy",
"iterate",
"type-i",
"trivia_dot_trivial",
"named-readtables",
"lisp-namespace",
"trivia_dot_level2",
"mgl-pax-bootstrap",
"closer-mop",
"trivia_dot_level1",
"trivia_dot_level0"
],
"fwoar-tools/cls":[
"yason",
"net_dot_didierverna_dot_clon",
"local-time",
"data-lens",
"alexandria",
"trivial-gray-streams",
"net_dot_didierverna_dot_clon_dot_termio",
"net_dot_didierverna_dot_clon_dot_core",
"cl-ppcre",
"net_dot_didierverna_dot_clon_dot_setup",
"named-readtables",
"mgl-pax-bootstrap"
],
"fwoar-tools/json-formatter":[
"net_dot_didierverna_dot_clon",
"com_dot_inuoe_dot_jzon",
"serapeum",
"alexandria",
"net_dot_didierverna_dot_clon_dot_termio",
"net_dot_didierverna_dot_clon_dot_core",
"trivial-gray-streams",
"float-features",
"flexi-streams",
"closer-mop",
"trivial-macroexpand-all",
"trivial-file-size",
"global-vars",
"trivial-cltl2",
"introspect-environment",
"parse-declarations-1_dot_0",
"bordeaux-threads",
"trivial-garbage",
"parse-number",
"string-case",
"split-sequence",
"trivia",
"net_dot_didierverna_dot_clon_dot_setup",
"documentation-utils",
"trivial-features",
"trivia_dot_balland2006",
"named-readtables",
"trivial-indent",
"iterate",
"type-i",
"trivia_dot_trivial",
"mgl-pax-bootstrap",
"lisp-namespace",
"trivia_dot_level2",
"trivia_dot_level1",
"trivia_dot_level0"
],
"fwoar-tools/git-pick-patch":[
"cl-ppcre",
"serapeum",
"alexandria",
"trivial-macroexpand-all",
"trivial-file-size",
"global-vars",
"trivial-cltl2",
"introspect-environment",
"parse-declarations-1_dot_0",
"bordeaux-threads",
"trivial-garbage",
"parse-number",
"string-case",
"split-sequence",
"trivia",
"trivial-features",
"trivia_dot_balland2006",
"iterate",
"type-i",
"trivia_dot_trivial",
"lisp-namespace",
"trivia_dot_level2",
"closer-mop",
"trivia_dot_level1",
"trivia_dot_level0"
]
}
#!/usr/bin/env -S sbcl --script
(load "~/quicklisp/setup.lisp")
(ql:quickload '(:yason :uiop :cl-ppcre :serapeum
:data-lens/transducers :fwoar-lisputils))
(defpackage :fwoar.nix-helper
(:use :cl )
(:export ))
(in-package :fwoar.nix-helper)
(defun replace-regexes (from to str)
(assert (= (length from) (length to)))
(if (null from)
str
(replace-regexes
(rest from)
(rest to)
(cl-ppcre:regex-replace-all (first from) str (first to)))))
(defun nixify-symbol (string)
(flet ((fix-special-chars (str)
(replace-regexes '("[_]" "[+]$" "[+][/]" "[+]" "[.]" "[/]")
'("__" "_plus" "_plus/" "_plus_" "_dot_" "_slash_")
str)))
(if (ppcre:scan "^[0-9]" string)
(serapeum:concat "_" (fix-special-chars string))
(fix-special-chars string))))
(defun find-subsystems (system)
(funcall (data-lens:include
(data-lens:regex-match
(string-downcase system)))
(asdf:registered-systems)))
(defun eliminate-requires (deps)
(labels ((handle-dep (dep)
(typecase dep
(cons (case (car dep)
(:feature (when (uiop:featurep (cadr dep))
(handle-dep (caddr dep))))
(t nil)))
(string (list dep)))))
(mapcan #'handle-dep
deps)))
(defun transitive-dependencies (system)
(loop with stack = (list system)
for next = (pop stack)
for old-deps = (list system) then (append old-deps new)
for next-deps = (asdf:system-depends-on (asdf:find-system next))
for new = (eliminate-requires (set-difference next-deps old-deps :test #'equal))
do (setf stack (append stack new))
while stack
append new))
(defun get-dependencies (system)
(list system
(coerce (mapcar #'nixify-symbol
(clean-deps (transitive-dependencies system)))
'vector)))
(defun serialize-dependencies (s dependency-map)
(yason:with-output (s :indent t)
(yason:with-object ()
(loop for (system dependencies) in dependency-map
do (yason:with-object-element (system)
(yason:encode dependencies))))))
(defun clean-deps (deps)
(remove-duplicates
(remove-if (lambda (it)
(or (serapeum:string-prefix-p "sb-" (string-downcase it))
(member it '("uiop"
"sb-posix")
:test #'equal)))
(mapcar (lambda (it)
(first (fwoar.string-utils:partition #\/ it)))
deps))
:test #'equal))
(defun serialize-primary-and-secondary-system-deps (s system)
(serialize-dependencies s
(mapcar #'get-dependencies
(find-subsystems system))))
(defun doit (output-fn system)
(alexandria:with-output-to-file (s output-fn :if-exists :supersede)
(serialize-primary-and-secondary-system-deps s system)))
(progn
(format t "NOTICE ME: ~s~%" (truename (caddr (uiop:command-line-arguments))))
(asdf:load-asd (truename (caddr (uiop:command-line-arguments))))
(format t "NOTICE ME: ~s~%" (asdf:find-system (cadr (uiop:command-line-arguments))))
;; (ql:quickload (cadr (uiop:command-line-arguments)))
(doit (car (uiop:command-line-arguments))
(cadr (uiop:command-line-arguments)))
)
{
"fwoar-tools":[],
"fwoar-tools/zenburn":[
"serapeum",
"net_dot_didierverna_dot_clon",
"alexandria",
"trivial-macroexpand-all",
"trivial-file-size",
"global-vars",
"trivial-cltl2",
"introspect-environment",
"parse-declarations-1_dot_0",
"bordeaux-threads",
"trivial-garbage",
"parse-number",
"string-case",
"split-sequence",
"trivia",
"net_dot_didierverna_dot_clon_dot_termio",
"net_dot_didierverna_dot_clon_dot_core",
"trivial-features",
"trivia_dot_balland2006",
"net_dot_didierverna_dot_clon_dot_setup",
"cl-ppcre",
"dufy",
"iterate",
"type-i",
"trivia_dot_trivial",
"named-readtables",
"lisp-namespace",
"trivia_dot_level2",
"mgl-pax-bootstrap",
"closer-mop",
"trivia_dot_level1",
"trivia_dot_level0"
],
"fwoar-tools/cls":[
"yason",
"net_dot_didierverna_dot_clon",
"local-time",
"data-lens",
"alexandria",
"trivial-gray-streams",
"net_dot_didierverna_dot_clon_dot_termio",
"net_dot_didierverna_dot_clon_dot_core",
"cl-ppcre",
"net_dot_didierverna_dot_clon_dot_setup",
"named-readtables",
"mgl-pax-bootstrap"
],
"fwoar-tools/json-formatter":[
"net_dot_didierverna_dot_clon",
"com_dot_inuoe_dot_jzon",
"serapeum",
"alexandria",
"net_dot_didierverna_dot_clon_dot_termio",
"net_dot_didierverna_dot_clon_dot_core",
"trivial-gray-streams",
"float-features",
"flexi-streams",
"closer-mop",
"trivial-macroexpand-all",
"trivial-file-size",
"global-vars",
"trivial-cltl2",
"introspect-environment",
"parse-declarations-1_dot_0",
"bordeaux-threads",
"trivial-garbage",
"parse-number",
"string-case",
"split-sequence",
"trivia",
"net_dot_didierverna_dot_clon_dot_setup",
"documentation-utils",
"trivial-features",
"trivia_dot_balland2006",
"named-readtables",
"trivial-indent",
"iterate",
"type-i",
"trivia_dot_trivial",
"mgl-pax-bootstrap",
"lisp-namespace",
"trivia_dot_level2",
"trivia_dot_level1",
"trivia_dot_level0"
],
"fwoar-tools/git-pick-patch":[
"cl-ppcre",
"serapeum",
"alexandria",
"trivial-macroexpand-all",
"trivial-file-size",
"global-vars",
"trivial-cltl2",
"introspect-environment",
"parse-declarations-1_dot_0",
"bordeaux-threads",
"trivial-garbage",
"parse-number",
"string-case",
"split-sequence",
"trivia",
"trivial-features",
"trivia_dot_balland2006",
"iterate",
"type-i",
"trivia_dot_trivial",
"lisp-namespace",
"trivia_dot_level2",
"closer-mop",
"trivia_dot_level1",
"trivia_dot_level0"
]
}