tools.directory-to-file: Add a command-line program to make a directory into a file and restore it.
parent
9b97da0658
commit
8a8399e633
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -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
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -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
|
Loading…
Reference in New Issue