basis/io/directories/search/search.factor

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