tools: Fix some issues and use base85.
							parent
							
								
									82ad6cec2e
								
							
						
					
					
						commit
						16a79f1397
					
				| 
						 | 
				
			
			@ -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
 | 
			
		||||
    ] with-directory
 | 
			
		||||
            {
 | 
			
		||||
                { [ dup file-info directory? ] [ directory-repr ] }
 | 
			
		||||
                { [ dup file-is-text? ] [ dup utf8 file-contents escape-string file-repr ] }
 | 
			
		||||
                [
 | 
			
		||||
        first2
 | 
			
		||||
        [ escape-simplest "FILE:: " prepend ] dip " " glue
 | 
			
		||||
    ] map "\n\n" join
 | 
			
		||||
                    dup binary file-contents >base85
 | 
			
		||||
                    "" like escape-string
 | 
			
		||||
                    "base85" prepend file-repr
 | 
			
		||||
                ]
 | 
			
		||||
            } cond
 | 
			
		||||
        ] map
 | 
			
		||||
    ] with-directory
 | 
			
		||||
    "\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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
        _ 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 ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue