]> gitweb.factorcode.org Git - factor.git/commitdiff
tools: Fix some issues and use base85.
authorDoug Coleman <doug.coleman@gmail.com>
Sat, 26 Jan 2019 11:49:03 +0000 (05:49 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Sat, 26 Jan 2019 18:12:18 +0000 (12:12 -0600)
basis/tools/directory-to-file/directory-to-file.factor
basis/tools/file-to-directory/file-to-directory.factor

index 1ac9df9a5f3c5b8acd5d5d7887f03db7b890344e..aaab9e17e894d398a15b565e29fde5683ee3c8b1 100644 (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
index ead612c0f9a85ad56ae967172639131775bfad15..c19ced5e0b85fd78b654ada1c926538720c11487 100644 (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 ;