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

View File

@ -1,35 +1,43 @@
! Copyright (C) 2018 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: 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
locals math namespaces sequences sequences.extras splitting ;
USING: base85 combinators 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 locals math namespaces sequences
sequences.extras splitting ;
IN: tools.directory-to-file
: file-is-binary? ( path -- ? )
binary file-contents [ 127 <= ] all? ;
: file-is-text? ( path -- ? )
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 )
path normalize-path
[ path-separator = ] trim-tail "/" append
[ recursive-directory-files [ file-info directory? ] reject ] keep
[ recursive-directory-files ] 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
[
{
{ [ dup file-info directory? ] [ directory-repr ] }
{ [ dup file-is-text? ] [ dup utf8 file-contents escape-string file-repr ] }
[
dup binary file-contents >base85
"" like escape-string
"base85" prepend file-repr
]
} cond
] map
] with-directory
[
first2
[ escape-simplest "FILE:: " prepend ] dip " " glue
] map "\n\n" join
"\n\n" join
"<DIRECTORY: " path escape-simplest "\n\n" 3append
"\n\nDIRECTORY>" surround ;
"\n\n;DIRECTORY>" surround ;
: directory-to-file ( path -- )
[ directory-to-string ] keep ".modern" append

View File

@ -1,6 +1,6 @@
! Copyright (C) 2018 Doug Coleman.
! 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
kernel modern modern.out namespaces sequences splitting strings ;
IN: tools.file-to-directory
@ -12,15 +12,20 @@ ERROR: expected-modern-path got ;
[ ".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
_ first second rest [
dup first "DIRECTORY:" head?
[ second first second >string make-directories ]
[
second first2
[ second >string ] [
first3 nip swap "base85" head? [
base85> binary
] [
utf8
] if
] bi* swapd
[ dup parent-directory make-directories ] dip set-file-contents
] if
] each
] with-directory ;