basis/io/paths/paths.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays deques dlists io.files
   4 kernel sequences system vocabs.loader fry continuations ;
   5 IN: io.paths
   6
   7 TUPLE: directory-iterator path bfs queue ;
   8
   9 <PRIVATE
  10
  11 : qualified-directory ( path -- seq )
  12     dup directory-files [ append-path ] with map ;
  13
  14 : push-directory ( path iter -- )
  15     [ qualified-directory ] dip [
  16         dup queue>> swap bfs>>
  17         [ push-front ] [ push-back ] if
  18     ] curry each ;
  19
  20 : <directory-iterator> ( path bfs? -- iterator )
  21     <dlist> directory-iterator boa
  22     dup path>> over push-directory ;
  23
  24 : next-file ( iter -- file/f )
  25     dup queue>> deque-empty? [ drop f ] [
  26         dup queue>> pop-back dup link-info directory?
  27         [ over push-directory next-file ] [ nip ] if
  28     ] if ;
  29
  30 : iterate-directory ( iter quot: ( obj -- ? ) -- obj )
  31     over next-file [
  32         over call
  33         [ 2nip ] [ iterate-directory ] if*
  34     ] [
  35         2drop f
  36     ] if* ; inline recursive
  37
  38 PRIVATE>
  39
  40 : find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
  41     [ <directory-iterator> ] dip
  42     [ keep and ] curry iterate-directory ; inline
  43
  44 : each-file ( path bfs? quot: ( obj -- ? ) -- )
  45     [ <directory-iterator> ] dip
  46     [ f ] compose iterate-directory drop ; inline
  47
  48 : find-all-files ( path bfs? quot: ( obj -- ? ) -- paths )
  49     [ <directory-iterator> ] dip
  50     pusher [ [ f ] compose iterate-directory drop ] dip ; inline
  51
  52 : recursive-directory ( path bfs? -- paths )
  53     [ ] accumulator [ each-file ] dip ;
  54
  55 : find-in-directories ( directories bfs? quot -- path' )
  56     '[ _ _ find-file ] attempt-all ; inline
  57
  58 os windows? [ "io.paths.windows" require ] when