steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tools: Fix some issues and use base85.

freebsd-work
Doug Coleman 2019-01-26 05:49:03 -06:00
parent 82ad6cec2e
commit 16a79f1397
2 changed files with 43 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
basis/tools/directory-to-file/directory-to-file.factor
View File

@ -1,35 +1,43 @@
! Copyright (C) 2018 Doug Coleman. ! Copyright (C) 2018 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: base64 command-line escape-strings fry io.backend USING: base85 combinators command-line escape-strings fry
io.directories io.directories.search io.encodings.binary io.backend io.directories io.directories.search
io.encodings.utf8 io.files io.files.info io.pathnames kernel io.encodings.binary io.encodings.utf8 io.files io.files.info
locals math namespaces sequences sequences.extras splitting ; io.pathnames kernel locals math namespaces sequences
sequences.extras splitting ;
IN: tools.directory-to-file IN: tools.directory-to-file
: file-is-binary? ( path -- ? ) : file-is-text? ( path -- ? )
binary file-contents [ 127 <= ] all? ; binary file-contents [ 127 < ] all? ;
: directory-repr ( path -- obj )
escape-simplest
"DIRECTORY: " prepend ;
: file-repr ( path string -- obj )
[ escape-simplest "FILE:: " prepend ] dip " " glue ;
:: directory-to-string ( path -- string ) :: directory-to-string ( path -- string )
path normalize-path path normalize-path
[ path-separator = ] trim-tail "/" append [ path-separator = ] trim-tail "/" append
[ recursive-directory-files [ file-info directory? ] reject ] keep [ recursive-directory-files ] keep
dup '[ dup '[
[ _ ?head drop ] map [ _ ?head drop ] map
[ [
dup file-is-binary? [ {
utf8 file-contents escape-string { [ dup file-info directory? ] [ directory-repr ] }
] [ { [ dup file-is-text? ] [ dup utf8 file-contents escape-string file-repr ] }
binary file-contents >base64 "" like escape-string [
"base64" prepend dup binary file-contents >base85
] if "" like escape-string
] map-zip "base85" prepend file-repr
]
} cond
] map
] with-directory ] with-directory
[ "\n\n" join
first2
[ escape-simplest "FILE:: " prepend ] dip " " glue
] map "\n\n" join
"<DIRECTORY: " path escape-simplest "\n\n" 3append "<DIRECTORY: " path escape-simplest "\n\n" 3append
"\n\nDIRECTORY>" surround ; "\n\n;DIRECTORY>" surround ;
: directory-to-file ( path -- ) : directory-to-file ( path -- )
[ directory-to-string ] keep ".modern" append [ directory-to-string ] keep ".modern" append

25
basis/tools/file-to-directory/file-to-directory.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2018 Doug Coleman. ! Copyright (C) 2018 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: base64 command-line fry io.directories USING: base85 combinators command-line fry io.directories
io.encodings.binary io.encodings.utf8 io.files io.pathnames io.encodings.binary io.encodings.utf8 io.files io.pathnames
kernel modern modern.out namespaces sequences splitting strings ; kernel modern modern.out namespaces sequences splitting strings ;
IN: tools.file-to-directory IN: tools.file-to-directory
@ -12,15 +12,20 @@ ERROR: expected-modern-path got ;
[ ".modern" ?tail drop dup make-directories ] [ ".modern" ?tail drop dup make-directories ]
[ path>literals ] bi [ path>literals ] bi
'[ '[
_ [ _ first second rest [
second first2 [ third >string ] dip dup first "DIRECTORY:" head?
[ second first second >string make-directories ]
[ third ] [ [
first "base64" head? second first2
[ [ >string ] [ base64> ] bi* swap binary ] [ second >string ] [
[ [ >string ] bi@ swap utf8 ] if first3 nip swap "base85" head? [
] bi base85> binary
[ dup parent-directory make-directories ] dip set-file-contents ] [
utf8
] if
] bi* swapd
[ dup parent-directory make-directories ] dip set-file-contents
] if
] each ] each
] with-directory ; ] with-directory ;