extra/tools/directory-to-file/directory-to-file.factor

   1 ! Copyright (C) 2018 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: base91 combinators command-line escape-strings io.backend
   4 io.directories io.encodings.binary io.encodings.utf8 io.files
   5 io.files.info io.pathnames kernel math namespaces sequences
   6 splitting ;
   7 IN: tools.directory-to-file
   8
   9 : file-is-text? ( path -- ? )
  10     binary file-contents [ 127 < ] all? ;
  11
  12 : directory-repr ( path -- obj )
  13     escape-simplest
  14     "DIRECTORY: " prepend ;
  15
  16 : file-repr ( path string -- obj )
  17     [ escape-simplest "FILE:: " prepend ] dip " " glue ;
  18
  19 :: directory-to-string ( path -- string )
  20     path normalize-path
  21     [ path-separator = ] trim-tail "/" append
  22     [ recursive-directory-files ] keep
  23     dup '[
  24         [ _  ?head drop ] map
  25         [
  26             {
  27                 { [ dup file-info directory? ] [ directory-repr ] }
  28                 { [ dup file-is-text? ] [ dup utf8 file-contents escape-string file-repr ] }
  29                 [
  30                     dup binary file-contents >base91
  31                     "" like escape-string
  32                     "base91" prepend file-repr
  33                 ]
  34             } cond
  35         ] map
  36     ] with-directory
  37     "\n\n" join
  38     "<DIRECTORY: " path escape-simplest "\n\n" 3append
  39     "\n\n;DIRECTORY>" surround ;
  40
  41 : directory-to-file ( path -- )
  42     [ directory-to-string ] keep ".modern" append
  43     utf8 set-file-contents ;
  44
  45 : directory-to-file-main ( -- )
  46     command-line get dup length 1 = [ "oops" throw ] unless first
  47     directory-to-file ;
  48
  49 MAIN: directory-to-file-main