tools.directory-to-file: Add a command-line program to make a directory into a file and restore it.

vm-warnings
Doug Coleman 2018-07-09 01:33:26 -05:00
parent 9b97da0658
commit 8a8399e633
4 changed files with 76 additions and 0 deletions

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1,40 @@
! Copyright (C) 2018 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs base64 command-line escape-strings fry io.backend
io.directories io.directories.search io.encodings.binary
io.encodings.utf8 io.files io.files.info io.pathnames kernel
math namespaces sequences sequences.extras splitting ;
IN: tools.directory-to-file
: file-is-binary? ( path -- ? )
binary file-contents [ 127 <= ] all? ;
: directory-to-string ( path -- string )
normalize-path
[ path-separator = ] trim-tail "/" append
[ recursive-directory-files [ file-info directory? ] reject ] keep
dup '[
[ _ ?head drop ] map
[
dup file-is-binary? [
utf8 file-contents escape-string
] [
binary file-contents >base64 "" like escape-string
"base64" prepend
] if
] map-zip
] with-directory
[
first2
[ escape-string "FILE: " prepend ] dip " " glue
] map "\n\n" join ;
: directory-to-file ( path -- )
[ directory-to-string ] keep ".modern" append
utf8 set-file-contents ;
: directory-to-file-main ( -- )
command-line get dup length 1 = [ "oops" throw ] unless first
directory-to-file ;
MAIN: directory-to-file-main

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1,34 @@
! Copyright (C) 2018 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: base64 command-line fry io.directories
io.encodings.binary io.encodings.utf8 io.files io.pathnames
kernel modern modern.out namespaces sequences splitting strings ;
IN: tools.file-to-directory
ERROR: expected-one-path got ;
ERROR: expected-modern-path got ;
: write-directory-files ( path -- )
[ ".modern" ?tail drop dup make-directories ]
[ path>literals ] bi
'[
_ [
second first2 [ third >string ] dip
[ third ] [
first "base64" head?
[ [ >string ] [ base64> ] bi* swap binary ]
[ [ >string ] bi@ swap utf8 ] if
] bi
[ dup parent-directory make-directories ] dip set-file-contents
] each
] with-directory ;
: get-file-to-directory-path ( array -- path )
dup length 1 = [ expected-one-path ] unless
first dup ".modern" tail? [ expected-modern-path ] unless ;
: file-to-directory ( -- )
command-line get get-file-to-directory-path write-directory-files ;
MAIN: file-to-directory