ambrevar: Replace `file' by `fof'.
Pierre Neidhardt
parent
f4639999df
commit
ea9c0552c1
|
|
@ -5,6 +5,7 @@
|
|||
(:import-from #:trivia #:match #:guard)
|
||||
;; TODO: Use alexandria and serapeum? cmd? fset?
|
||||
(:use #:alexandria #:serapeum)
|
||||
(:use #:fof #:fof/mediafile)
|
||||
;; Packages we want available at all times:
|
||||
(:import-from #:alexandria)
|
||||
(:import-from #:bordeaux-threads)
|
||||
|
|
@ -46,12 +47,9 @@
|
|||
(:use-reexport
|
||||
#:ambrevar/debug
|
||||
#:ambrevar/emacs
|
||||
;; #:ambrevar/ffprobe ; Implementation detail?
|
||||
#:ambrevar/file
|
||||
#:ambrevar/guix
|
||||
#:ambrevar/shell
|
||||
#:ambrevar/syspack
|
||||
#:ambrevar/patches/cmd)
|
||||
#:ambrevar/syspack)
|
||||
;; No need to `use' this the readtable:
|
||||
(:import-from #:ambrevar/syntax))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,162 +0,0 @@
|
|||
(uiop:define-package ambrevar/ffprobe
|
||||
(:nicknames #:ffprobe)
|
||||
(:documentation "FFprobe abstraction.")
|
||||
(:use #:common-lisp)
|
||||
(:use #:trivia)
|
||||
(:import-from #:hu.dwim.defclass-star #:defclass*)
|
||||
(:import-from #:serapeum #:export-always))
|
||||
(in-package ambrevar/ffprobe)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
|
||||
(trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
|
||||
|
||||
(sera:eval-always
|
||||
(defun name-identity (name definition)
|
||||
(declare (ignore definition))
|
||||
name))
|
||||
|
||||
;; TODO: Should leave unspecified fields unbound?
|
||||
|
||||
(defclass* disposition ()
|
||||
((default 0)
|
||||
(dub 0)
|
||||
(original 0)
|
||||
(comment 0)
|
||||
(lyrics 0)
|
||||
(karaoke 0)
|
||||
(forced 0)
|
||||
(hearing-impaired 0)
|
||||
(visual-impaired 0)
|
||||
(clean-effects 0)
|
||||
(attached-pic 0)
|
||||
(timed-thumbnails 0))
|
||||
(:accessor-name-transformer #'name-identity)
|
||||
(:export-accessor-names-p t)
|
||||
(:export-class-name-p t))
|
||||
|
||||
(defclass* media-stream () ; REVIEW: `stream' is reserved by CL.
|
||||
((index 0)
|
||||
(codec-name "")
|
||||
(codec-long-name "")
|
||||
(profile "")
|
||||
(codec-type "")
|
||||
(width 0)
|
||||
(height 0)
|
||||
(coded-width 0)
|
||||
(coded-height 0)
|
||||
(closed-captions 0)
|
||||
(has-b-frames 0)
|
||||
(pix-fmt "")
|
||||
(level 0)
|
||||
(color-range "")
|
||||
(color-space "")
|
||||
(color-transfer "")
|
||||
(color-primaries "")
|
||||
(chroma-location "")
|
||||
(field-order "")
|
||||
(refs 0)
|
||||
(id "")
|
||||
(quarter-sample nil
|
||||
:type boolean)
|
||||
(divx-packed nil
|
||||
:type boolean)
|
||||
(sample-aspect-ratio "")
|
||||
(display-aspect-ratio "")
|
||||
(codec-time-base "") ; TODO: Ratio?
|
||||
(codec-tag-string "")
|
||||
(codec-tag "") ; TODO: Hex?
|
||||
(sample-fmt "")
|
||||
(sample-rate 0)
|
||||
(channels 2)
|
||||
(channel-layout "")
|
||||
(bits-per-sample 0)
|
||||
(dmix-mode 0)
|
||||
(ltrt-cmixlev 0.0)
|
||||
(ltrt-surmixlev 0.0)
|
||||
(loro-cmixlev 0.0)
|
||||
(loro-surmixlev 0.0)
|
||||
(is-avc nil
|
||||
:type boolean)
|
||||
(nal-length-size 0)
|
||||
(r-frame-rate "") ; TODO: Ratio?
|
||||
(avg-frame-rate "") ; TODO: Ratio?
|
||||
(time-base "")
|
||||
(start-pts 0)
|
||||
(start-time 0.0)
|
||||
(duration-ts 0.0)
|
||||
(duration 0.0)
|
||||
(bit-rate 0)
|
||||
(bits-per-raw-sample 0)
|
||||
(nb-frames 0)
|
||||
(max-bit-rate 0)
|
||||
(disposition nil
|
||||
:type (or null disposition))
|
||||
(side-data-list '())
|
||||
(tags '()))
|
||||
(:accessor-name-transformer #'name-identity)
|
||||
(:export-accessor-names-p t)
|
||||
(:export-class-name-p t))
|
||||
|
||||
(defclass* media-format () ; REVIEW: `format' is reserved by CL.
|
||||
((filename "")
|
||||
(nb-streams 0)
|
||||
(nb-programs 0)
|
||||
(format-name "")
|
||||
(format-long-name "")
|
||||
(start-time 0.0)
|
||||
(duration 0.0)
|
||||
(size 0)
|
||||
(bit-rate 0)
|
||||
(probe-score 0)
|
||||
(tags '()))
|
||||
(:accessor-name-transformer #'name-identity)
|
||||
(:export-accessor-names-p t)
|
||||
(:export-class-name-p t))
|
||||
|
||||
(defun normalize-cl-json-keywords (sym)
|
||||
"Turn '--' to '-' and remove '+' from keywords."
|
||||
(if (keywordp sym)
|
||||
(intern (str:replace-all
|
||||
"+" ""
|
||||
(str:replace-all "--" "-" (symbol-name sym)))
|
||||
"KEYWORD")
|
||||
sym))
|
||||
|
||||
(defun normalize-cl-json-scalar (value)
|
||||
"Turn non-ratio number string to numbers."
|
||||
(if (stringp value)
|
||||
(match value
|
||||
("true" t)
|
||||
("false" nil)
|
||||
(_ (let ((result (ignore-errors (parse-number:parse-number value))))
|
||||
(if (and result
|
||||
(not (typep result 'ratio)))
|
||||
result
|
||||
value))))
|
||||
value))
|
||||
|
||||
(defun json->media-args (json)
|
||||
(alex:mappend (lambda-match
|
||||
((cons key value)
|
||||
(list (normalize-cl-json-keywords key)
|
||||
(if (listp value)
|
||||
(json->media-args value)
|
||||
(normalize-cl-json-scalar value)))))
|
||||
json))
|
||||
|
||||
(export-always 'ffprobe)
|
||||
(defun ffprobe (path)
|
||||
"Return a list of (MEDIA-FORMAT MEDIA-STREAMS...)."
|
||||
(let* ((json-string
|
||||
(ignore-errors
|
||||
(cmd:$cmd "ffprobe -v quiet -print_format json -show_format -show_streams -- "
|
||||
(write-to-string path)))))
|
||||
(when json-string
|
||||
(let* ((json (cl-json:decode-json-from-string json-string))
|
||||
(format-args (json->media-args (alex:assoc-value json :format)))
|
||||
(format (apply #'make-instance 'media-format format-args)))
|
||||
(cons format
|
||||
(mapcar (lambda (s)
|
||||
(let ((stream-args (json->media-args s)))
|
||||
(apply #'make-instance 'media-stream stream-args)))
|
||||
(alex:assoc-value json :streams)))))))
|
||||
|
|
@ -1,385 +0,0 @@
|
|||
(uiop:define-package ambrevar/file
|
||||
(:documentation "File class.")
|
||||
(:use #:common-lisp)
|
||||
(:use #:trivia)
|
||||
(:import-from #:hu.dwim.defclass-star #:defclass*)
|
||||
(:import-from #:serapeum #:export-always)
|
||||
(:import-from #:ambrevar/ffprobe))
|
||||
(in-package ambrevar/file)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
|
||||
(trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
|
||||
|
||||
;; TODO: Allow some slots to modify file on disk. Transaction?
|
||||
;; Could we edit files virtually nonetheless? Does that even make sense?
|
||||
|
||||
;; TODO: Only expose readers for slots that cannot be modified, such as `path'.
|
||||
|
||||
;; TODO: Implement disk-usage for directories.
|
||||
|
||||
;; TODO: Replace magicffi with trivial-mime once we can get MIME encoding
|
||||
;; (https://github.com/Shinmera/trivial-mimes/issues/8), description, and fix
|
||||
;; the probe-file issue.
|
||||
|
||||
(sera:eval-always
|
||||
(defun name-identity (name definition)
|
||||
(declare (ignore definition))
|
||||
name))
|
||||
|
||||
(defclass* file ()
|
||||
((path (error "Path required")
|
||||
:type string
|
||||
;; :reader path
|
||||
)
|
||||
(inode 0)
|
||||
(link-count 0)
|
||||
(kind :regular-file ; "kind" because `type' is reserved by CL.
|
||||
:type (member :directory
|
||||
:character-device
|
||||
:block-device
|
||||
:regular-file
|
||||
:symbolic-link
|
||||
:socket
|
||||
:pipe)
|
||||
;; :reader kind
|
||||
)
|
||||
(size 0
|
||||
;; :reader size
|
||||
)
|
||||
(user-id 0)
|
||||
(group-id 0)
|
||||
;; TODO: Include blocks?
|
||||
(creation-date (local-time:unix-to-timestamp 0))
|
||||
(modification-date (local-time:unix-to-timestamp 0))
|
||||
(access-date (local-time:unix-to-timestamp 0))
|
||||
(permissions '()
|
||||
:type (or null
|
||||
(cons #.(cons 'member (mapcar #'first osicat::+permissions+))))))
|
||||
(:accessor-name-transformer #'name-identity)
|
||||
(:export-accessor-names-p t)
|
||||
(:export-class-name-p t))
|
||||
|
||||
(defmethod path ((s string))
|
||||
"Useful so that `path' can be called both on a `file' or a `string'."
|
||||
s)
|
||||
|
||||
(defmethod path ((p pathname))
|
||||
"Useful so that `path' can be called both on a `file' or a `pathname'."
|
||||
(namestring p))
|
||||
|
||||
(export-always 'extension)
|
||||
(defmethod extension ((file file))
|
||||
"Return the file extension.
|
||||
If none, return the empty string unlike `pathname-type'."
|
||||
(or (pathname-type (path file))
|
||||
""))
|
||||
|
||||
(export-always 'directory?)
|
||||
(defmethod directory? ((file file))
|
||||
(eq (kind file) :directory))
|
||||
|
||||
(export-always 'file?)
|
||||
(defmethod file? ((file file))
|
||||
(eq (kind file) :regular-file))
|
||||
|
||||
(export-always 'file=?)
|
||||
(defun file=? (file1 file2)
|
||||
"Return true if FILE1 and FILE2 point to the same file.
|
||||
They might not be the same objects."
|
||||
(and (file? file1) (file? file2)
|
||||
(string= (path file1)
|
||||
(path file2))))
|
||||
|
||||
(defun separator (&optional char?)
|
||||
(if char?
|
||||
(uiop:directory-separator-for-host)
|
||||
(string (uiop:directory-separator-for-host))))
|
||||
|
||||
(export-always 'basename)
|
||||
(defmethod basename ((file file))
|
||||
"Return the file basename (including the extension).
|
||||
This returns the directory name for directories."
|
||||
(let* ((path (path file))
|
||||
(path (if (str:ends-with? (separator) path)
|
||||
(subseq path 0 (1- (length path)))
|
||||
path))
|
||||
(last-separator (position (separator :char)
|
||||
path :from-end t)))
|
||||
(subseq path
|
||||
(1+ last-separator))))
|
||||
|
||||
(export-always 'relative-path)
|
||||
(defmethod relative-path ((file file) &optional (parent-directory *default-pathname-defaults*))
|
||||
"Return PATH relative to PARENT-DIRECTORY.
|
||||
If PARENT-DIRECTORY is not a parent of PATH, return PATH."
|
||||
(setf parent-directory (path (uiop:ensure-directory-pathname parent-directory)))
|
||||
(if (str:starts-with? parent-directory
|
||||
(path file))
|
||||
(subseq (path file) (length parent-directory))
|
||||
(path file)))
|
||||
|
||||
;; TODO: Support `*print-pretty*'?
|
||||
;; TODO: `*print-readably*'?
|
||||
(defmethod print-object ((file file) stream)
|
||||
(print-unreadable-object (file stream :type t :identity t)
|
||||
(write-string (str:concat (basename file)
|
||||
(when (directory? file) "/"))
|
||||
stream)))
|
||||
|
||||
(export-always 'file)
|
||||
(defmethod initialize-instance :after ((file file) &key)
|
||||
(let* ((path (path file))
|
||||
(native-path (uiop:truename* (if (pathnamep path)
|
||||
path
|
||||
(uiop:parse-native-namestring path)))))
|
||||
(unless (or (uiop:file-exists-p native-path)
|
||||
(uiop:directory-exists-p native-path))
|
||||
(error "~s is not a file path" (or native-path path)))
|
||||
;; TODO: What do we do with non-existent files (e.g. unsaved emacs buffers)? Just return nil?
|
||||
(let ((stat (ignore-errors (osicat-posix:stat native-path))))
|
||||
(when stat
|
||||
;; From Osicat's `file-permissions':
|
||||
(flet ((stat-permissions (stat)
|
||||
(let ((mode (osicat-posix:stat-mode stat)))
|
||||
(loop for (name . value) in osicat::+permissions+
|
||||
when (plusp (logand mode value))
|
||||
collect name))))
|
||||
(setf
|
||||
(path file) (uiop:unix-namestring native-path)
|
||||
(inode file) (osicat-posix:stat-ino stat)
|
||||
(link-count file) (osicat-posix:stat-nlink stat)
|
||||
(kind file) (osicat:file-kind native-path) ; TODO: Don't recall `stat'.
|
||||
(size file) (osicat-posix:stat-size stat)
|
||||
(user-id file) (osicat-posix:stat-uid stat)
|
||||
(group-id file) (osicat-posix:stat-gid stat)
|
||||
(creation-date file) (local-time:unix-to-timestamp (osicat-posix:stat-ctime stat))
|
||||
(modification-date file) (local-time:unix-to-timestamp (osicat-posix:stat-mtime stat))
|
||||
(access-date file) (local-time:unix-to-timestamp (osicat-posix:stat-atime stat))
|
||||
(permissions file) (stat-permissions stat)))))))
|
||||
|
||||
(defun file (path)
|
||||
(make-instance 'file :path path))
|
||||
|
||||
(export-always 'list-directory)
|
||||
(defun list-directory (&optional (path *default-pathname-defaults*) sort)
|
||||
"Return entries in PATH.
|
||||
By default, directories come first.
|
||||
If SORT is non nil, sort them alphabetically.
|
||||
Second value is the list of directories, third value is the non-directories."
|
||||
;; TODO: Use locale to sort?
|
||||
(let* ((subdirs (mapcar #'file (uiop:subdirectories path)))
|
||||
(subfiles (mapcar #'file (uiop:directory-files path)))
|
||||
(result (append subdirs subfiles)))
|
||||
(values
|
||||
(if sort
|
||||
(sort result #'string< :key #'path)
|
||||
result)
|
||||
subdirs
|
||||
subfiles)))
|
||||
|
||||
(export-always '*finder-include-directories*)
|
||||
(defvar *finder-include-directories* t
|
||||
"When non-nil `walk' include directories.")
|
||||
|
||||
(export-always '*finder-constructor*)
|
||||
(defvar *finder-constructor* #'file
|
||||
"Function that takes a path and returns a `file'-like object.")
|
||||
|
||||
(export-always 'walk)
|
||||
(defun walk (root &rest predicates)
|
||||
"List FILES (including directories) that satisfy all PREDICATES.
|
||||
Without PREDICATES, list all files."
|
||||
(let ((result '()))
|
||||
(uiop:collect-sub*directories
|
||||
(uiop:ensure-directory-pathname root)
|
||||
(constantly t) (constantly t)
|
||||
(lambda (subdirectory)
|
||||
(setf result (nconc result
|
||||
(let ((subfiles (mapcar *finder-constructor*
|
||||
(append (if *finder-include-directories* (list subdirectory) nil)
|
||||
(uiop:directory-files subdirectory)))))
|
||||
(if predicates
|
||||
(delete-if (lambda (file)
|
||||
(notany (lambda (pred) (funcall pred file))
|
||||
predicates))
|
||||
subfiles)
|
||||
subfiles))))))
|
||||
result))
|
||||
|
||||
(export-always 'finder)
|
||||
(defun finder (root &rest predicates)
|
||||
"List files in ROOT that satisfy all PREDICATES.
|
||||
Without PREDICATES, list all files."
|
||||
(let ((*finder-include-directories* nil))
|
||||
(apply #'walk root predicates)))
|
||||
|
||||
(defun match-date< (timestamp)
|
||||
"Return a file predicate that matches on modification time #'< than timestamp."
|
||||
(lambda (file)
|
||||
(local-time:timestamp< (modification-date file) timestamp)))
|
||||
|
||||
(defun match-date> (timestamp)
|
||||
"Return a file predicate that matches on modification time #'> than timestamp."
|
||||
(lambda (file)
|
||||
(local-time:timestamp> (modification-date file) timestamp)))
|
||||
|
||||
(export-always 'match-extension)
|
||||
(defun match-extension (extension &rest more-extensions)
|
||||
"Return a predicate for files that match on of the provided extensions.
|
||||
Useful for `finder'."
|
||||
(lambda (file)
|
||||
(some (lambda (ext)
|
||||
(string= ext (extension file)))
|
||||
(cons extension more-extensions))))
|
||||
|
||||
(export-always 'match-name)
|
||||
(defun match-name (name &rest more-names)
|
||||
"Return a predicate that matches when one of the names is contained in the
|
||||
file basename.
|
||||
Basename includes the extension. Useful for `finder'."
|
||||
(lambda (file)
|
||||
(some (lambda (name)
|
||||
(str:contains? name (basename file)))
|
||||
(cons name more-names))))
|
||||
|
||||
;; TODO: Better control to filter in/out directories?
|
||||
;; (export-always 'match-directory)
|
||||
;; (defun match-directory (&key (empty? t) (non-empty? t) (files? t))
|
||||
;; "Return a predicate that matches on directories.
|
||||
;; If target is a file, return FILES?.
|
||||
;; Useful for `walk'."
|
||||
;; (lambda (directory)
|
||||
;; (if (uiop:directory-exists-p directory)
|
||||
;; (let ((files-or-dirs? (or (uiop:directory-files directory)
|
||||
;; (uiop:subdirectories directory))))
|
||||
;; (or (and empty?
|
||||
;; (not files-or-dirs?))
|
||||
;; (and non-empty?
|
||||
;; files-or-dirs?)))
|
||||
;; files?)))
|
||||
|
||||
(export-always 'match-executable)
|
||||
(defun match-executable ()
|
||||
(lambda (file)
|
||||
(intersection
|
||||
(permissions file)
|
||||
'(:user-exec :group-exec :other-exec))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(defparameter %magic-cookie-mime nil
|
||||
"Internal storage for `magic-cookie-mime'.")
|
||||
(defun magic-cookie-mime ()
|
||||
"Return internal, persistent MIME cookie for `magicffi' calls.
|
||||
Benchmark on thousands of files shows that
|
||||
keeping the same cookie saves about 15% of time. "
|
||||
(when (or (not %magic-cookie-mime)
|
||||
(not (magicffi:open-magic-p %magic-cookie-mime)))
|
||||
(setf %magic-cookie-mime (magicffi:magic-open '(:symlink :mime)))
|
||||
(magicffi:magic-load %magic-cookie-mime))
|
||||
%magic-cookie-mime)
|
||||
|
||||
(defparameter %magic-cookie-description nil
|
||||
"Internal storage for `magic-cookie-description'.")
|
||||
(defun magic-cookie-description ()
|
||||
"Same as `magic-cooke-mime' but for `file' descriptions.
|
||||
See `%description'."
|
||||
(when (or (not %magic-cookie-description)
|
||||
(not (magicffi:open-magic-p %magic-cookie-description)))
|
||||
(setf %magic-cookie-description (magicffi:magic-open '(:symlink)))
|
||||
(magicffi:magic-load %magic-cookie-description))
|
||||
%magic-cookie-description)
|
||||
|
||||
(defun %mime-type+encoding (path)
|
||||
"Return a pair of MIME type and MIME encoding for PATH."
|
||||
(str:split "; "
|
||||
(magicffi:magic-file (magic-cookie-mime) path)))
|
||||
|
||||
(defun %description (path)
|
||||
"Return the PATH description as per the `file' UNIX command."
|
||||
(magicffi:magic-file (magic-cookie-description) path))
|
||||
|
||||
;; TODO: Include the description or do it in another class? Could be slower. Benchmark.
|
||||
(defclass* file+mime (file)
|
||||
((mime-type "")
|
||||
(mime-encoding "")
|
||||
(description ""))
|
||||
(:accessor-name-transformer #'name-identity)
|
||||
(:export-accessor-names-p t)
|
||||
(:export-class-name-p t))
|
||||
|
||||
(defmethod initialize-instance :after ((file file+mime) &key)
|
||||
(let ((mime-type+encoding (%mime-type+encoding (path file))))
|
||||
(setf (mime-type file) (first mime-type+encoding)
|
||||
(mime-encoding file) (second mime-type+encoding)
|
||||
(description file) (%description (path file)))))
|
||||
|
||||
(defun file+mime (path)
|
||||
(make-instance 'file+mime :path path))
|
||||
|
||||
(defun walk+mime (root &rest predicates)
|
||||
(let ((*finder-constructor* #'file+mime))
|
||||
(apply #'walk root predicates)))
|
||||
|
||||
(defun finder+mime (root &rest predicates)
|
||||
(let ((*finder-constructor* #'file+mime))
|
||||
(apply #'finder root predicates)))
|
||||
|
||||
(export-always 'match-elf-binary)
|
||||
(defun match-elf-binary ()
|
||||
(lambda (file)
|
||||
(and (slot-boundp file 'mime-type)
|
||||
(string= "application/x-executable" (mime-type file)))))
|
||||
|
||||
(export-always 'match-elf-library)
|
||||
(defun match-elf-library ()
|
||||
(lambda (file)
|
||||
(and (slot-boundp file 'mime-type)
|
||||
(ppcre:scan "application/x-sharedlib" (first (mime-type file))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defclass* mediafile (file+mime) ; REVIEW: Include MIME?
|
||||
((media-format nil
|
||||
:type (or null ambrevar/ffprobe:media-format))
|
||||
(media-streams '()
|
||||
:type (or null
|
||||
(cons ambrevar/ffprobe:media-stream))))
|
||||
(:accessor-name-transformer #'name-identity)
|
||||
(:export-accessor-names-p t)
|
||||
(:export-class-name-p t))
|
||||
|
||||
(defmethod initialize-instance :after ((file mediafile) &key)
|
||||
(let ((probe (ambrevar/ffprobe:ffprobe (path file))))
|
||||
(setf (media-format file) (first probe)
|
||||
(media-streams file) (rest probe))))
|
||||
|
||||
(export-always 'mediafile)
|
||||
(defun mediafile (path)
|
||||
(make-instance 'mediafile :path path))
|
||||
|
||||
(export-always 'mediawalk)
|
||||
(defun mediawalk (root &rest predicates)
|
||||
(let ((*finder-constructor* #'mediafile))
|
||||
(apply #'walk root predicates)))
|
||||
|
||||
(export-always 'mediafinder)
|
||||
(defun mediafinder (root &rest predicates)
|
||||
(let ((*finder-constructor* #'mediafile))
|
||||
(apply #'finder root predicates)))
|
||||
|
||||
(export-always 'width)
|
||||
(defmethod width ((file mediafile))
|
||||
(ambrevar/ffprobe:width
|
||||
(find-if #'plusp (media-streams file)
|
||||
:key #'ambrevar/ffprobe:width)))
|
||||
|
||||
(export-always 'height)
|
||||
(defmethod height ((file mediafile))
|
||||
(ambrevar/ffprobe:height
|
||||
(find-if #'plusp (media-streams file)
|
||||
:key #'ambrevar/ffprobe:height)))
|
||||
|
||||
(export-always 'tags)
|
||||
(defmethod tags ((file mediafile))
|
||||
;; TODO: Get tags from streams too?
|
||||
(ambrevar/ffprobe:tags (media-format file)))
|
||||
|
|
@ -3,7 +3,7 @@
|
|||
(:use #:common-lisp)
|
||||
(:use #:trivia)
|
||||
(:import-from #:serapeum #:export-always)
|
||||
(:import-from #:ambrevar/file)
|
||||
(:import-from #:fof)
|
||||
(:import-from #:ambrevar/shell))
|
||||
(in-package ambrevar/guix)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
|
|
@ -68,7 +68,7 @@
|
|||
(sort (mapcar #'pair-item-with-disk-usage
|
||||
(if dead?
|
||||
(alex:flatten (ambrevar/shell:tokenize (cmd:$cmd "guix" "gc" "--list-dead")))
|
||||
(ambrevar/file:list-directory "/gnu/store" :sort)))
|
||||
(fof:list-directory "/gnu/store" :sort)))
|
||||
#'> :key #'second)))))
|
||||
|
||||
(export-always 'delete-store-items)
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
(uiop:define-package ambrevar/shell
|
||||
(:documentation "Shell-like utilities.")
|
||||
;; (:nicknames #:$)
|
||||
(:use #:common-lisp)
|
||||
(:use #:trivia)
|
||||
(:import-from #:ambrevar/file)
|
||||
(:import-from #:fof)
|
||||
(:import-from #:serapeum #:export-always))
|
||||
(in-package ambrevar/shell)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
|
|
@ -292,20 +291,6 @@ returning the new list of commands.")
|
|||
(make-string-input-stream result)
|
||||
result)))
|
||||
|
||||
(export-always 'disk-usage)
|
||||
(defun disk-usage (files)
|
||||
"Return disk usage of FILES in octets.
|
||||
As a second value, return a list of (FILE SIZE) pairs, biggest file first."
|
||||
(let ((pairs (mapcar (lambda (f)
|
||||
(list f (or (trivial-file-size:file-size-in-octets f)
|
||||
0)))
|
||||
files)))
|
||||
(values
|
||||
(reduce #'+ (mapcar #'second pairs))
|
||||
(sort
|
||||
pairs
|
||||
#'> :key #'second))))
|
||||
|
||||
(export-always 'tokenize)
|
||||
(defun tokenize (string)
|
||||
"Return list of STRING lines, where each line is a list of each word."
|
||||
|
|
@ -344,9 +329,11 @@ Return process name as second value."
|
|||
process-name)))
|
||||
|
||||
(export-always 'sha1)
|
||||
(defun sha1 (file) ; TODO: Use pure CL / FFI version?
|
||||
(defun sha1 (file)
|
||||
;; TODO: Use pure CL / FFI version?
|
||||
;; There is (ironclad:digest-file 'ironclad:sha1 _) but it seems about 60% slower.
|
||||
"Return checksum of FILE."
|
||||
(first (first (tokenize (cmd:$cmd "sha1sum" (write-to-string (ambrevar/file:path file)))))))
|
||||
(first (first (tokenize (cmd:$cmd "sha1sum" (write-to-string (fof:path file)))))))
|
||||
|
||||
(export-always 'move-file)
|
||||
(defun move-file (source destination)
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@
|
|||
(:use #:common-lisp)
|
||||
(:use #:trivia)
|
||||
(:import-from #:ambrevar/shell)
|
||||
(:import-from #:ambrevar/file)
|
||||
(:import-from #:serapeum #:export-always))
|
||||
(in-package ambrevar/syntax)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
|
|
@ -40,11 +39,6 @@
|
|||
(ambrevar/shell:sh (str:concat (string next-char)
|
||||
(read-until stream #\newline)))))))
|
||||
|
||||
(defun file-reader (stream char1 char2)
|
||||
(declare (ignore char1 char2))
|
||||
(read-until stream #\")
|
||||
(ambrevar/file:file (read-until stream #\")))
|
||||
|
||||
(export-always 'syntax)
|
||||
(named-readtables:defreadtable ambrevar/syntax::syntax
|
||||
(:merge :standard)
|
||||
|
|
@ -52,4 +46,5 @@
|
|||
(:dispatch-macro-char #\# #\$ #'$cmd-reader)
|
||||
(:dispatch-macro-char #\# #\! #'cmd-reader)
|
||||
(:dispatch-macro-char #\# #\? #'interpol:interpol-reader)
|
||||
(:dispatch-macro-char #\# #\f #'file-reader))
|
||||
(:dispatch-macro-char #\# #\f #'fof/file::file-reader)
|
||||
(:dispatch-macro-char #\# #\m #'fof/mediafile::mediafile-reader))
|
||||
|
|
|
|||
Loading…
Reference in New Issue