extra/io/paths/paths.factor

   1 USING: io.files kernel sequences accessors
   2 dlists dequeues arrays sequences.lib ;
   3 IN: io.paths
   4
   5 TUPLE: directory-iterator path bfs queue ;
   6
   7 : qualified-directory ( path -- seq )
   8     dup directory [ first2 >r append-path r> 2array ] with map ;
   9
  10 : push-directory ( path iter -- )
  11     >r qualified-directory r> [
  12         dup queue>> swap bfs>>
  13         [ push-front ] [ push-back ] if
  14     ] curry each ;
  15
  16 : <directory-iterator> ( path bfs? -- iterator )
  17     <dlist> directory-iterator boa
  18     dup path>> over push-directory ;
  19
  20 : next-file ( iter -- file/f )
  21     dup queue>> dequeue-empty? [ drop f ] [
  22         dup queue>> pop-back first2
  23         [ over push-directory next-file ] [ nip ] if
  24     ] if ;
  25
  26 : iterate-directory ( iter quot -- obj )
  27     2dup >r >r >r next-file dup [
  28         r> call dup [
  29             r> r> 2drop
  30         ] [
  31             drop r> r> iterate-directory
  32         ] if
  33     ] [
  34         drop r> r> r> 3drop f
  35     ] if ; inline
  36
  37 : find-file ( path bfs? quot -- path/f )
  38     >r <directory-iterator> r>
  39     [ keep and ] curry iterate-directory ; inline
  40
  41 : each-file ( path bfs? quot -- )
  42     >r <directory-iterator> r>
  43     [ f ] compose iterate-directory drop ; inline
  44
  45 : find-all-files ( path bfs? quot -- paths )
  46     >r <directory-iterator> r>
  47     pusher >r [ f ] compose iterate-directory drop r> ; inline
  48
  49 : recursive-directory ( path bfs? -- paths )
  50     [ ] accumulator >r each-file r> ;