64 lines
2.5 KiB
Scheme
64 lines
2.5 KiB
Scheme
(import (chicken file))
|
|
(import (chicken file ))
|
|
|
|
(include "paths.scm")
|
|
|
|
(define (file-operations-initialize-directories)
|
|
(print "Initializing directories")
|
|
;; The trick is that this will create parent directories
|
|
;; So this will also create paths-appdealer-path
|
|
(create-directory paths-app-path #t)
|
|
(create-directory paths-trash-path))
|
|
|
|
(define (file-operations-copy-app file-path file-name)
|
|
;; TODO: this is the result of hacky paths-append
|
|
;; you really should improve it
|
|
(define target-path (paths-append paths-app-path
|
|
(string-append "/" file-name)))
|
|
(print "Copying " file-path " to " paths-app-path)
|
|
(copy-file file-path target-path))
|
|
|
|
(define (file-operations-make-link file-name link-name)
|
|
;; TODO: this is the second time you make this construct
|
|
;; make it separate
|
|
(let* ((file-name-prepared (string-append "/" file-name))
|
|
(link-name-prepared (string-append "/" link-name))
|
|
(file-path (paths-append paths-app-path file-name-prepared))
|
|
(link-path (paths-append paths-exec-path link-name-prepared)))
|
|
(print "Making a symbolic link located at " link-path " that points to a file located at " file-path)
|
|
(create-symbolic-link file-path link-path)
|
|
(set-file-permissions! link-path #o755)))
|
|
|
|
(define (file-operations-remove-link link-name)
|
|
(let* ((link-name-prepared (string-append "/" link-name))
|
|
(link-path (paths-append paths-exec-path link-name-prepared)))
|
|
;; this will signal an error on empty file
|
|
;; TODO: this is ok for now, but later we have to show our own errors, not tracebacks
|
|
(print "Removing a symbolic link located at " link-path)
|
|
(delete-file link-path)))
|
|
|
|
(define (file-operations-move-app-to-trash file-name)
|
|
(let* ((file-name-prepared (string-append "/" file-name))
|
|
(file-path (paths-append paths-app-path file-name-prepared))
|
|
(trashed-file-path (paths-append paths-trash-path file-name-prepared)))
|
|
(print "Moving " file-name " to trash ")
|
|
(move-file file-path trashed-file-path)))
|
|
|
|
(define (file-operations-clean-trash)
|
|
(print "Purging trash files")
|
|
(define trash-files (glob (paths-append paths-trash-path "/*")))
|
|
|
|
(define (delete-routine path)
|
|
(print "Deleting " path)
|
|
(if (not (delete-file* path))
|
|
(print "WARN: Cannot delete " path))
|
|
#t)
|
|
|
|
(define (iter paths)
|
|
(if (null? paths)
|
|
#t
|
|
(and (delete-routine (car paths))
|
|
(iter (cdr paths)))))
|
|
|
|
(iter trash-files)
|
|
(print "Done"))
|