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 TUPLE: directory-iterator path bfs queue ;
   9
  10 <PRIVATE
  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         dup queue>> swap bfs>>
  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 : find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
  42     [ <directory-iterator> ] dip
  43     [ keep and ] curry iterate-directory ; inline
  44
  45 : each-file ( path bfs? quot: ( obj -- ? ) -- )
  46     [ <directory-iterator> ] dip
  47     [ f ] compose iterate-directory drop ; inline
  48
  49 : find-all-files ( path bfs? quot: ( obj -- ? ) -- paths )
  50     [ <directory-iterator> ] dip
  51     pusher [ [ f ] compose iterate-directory drop ] dip ; inline
  52
  53 : recursive-directory ( path bfs? -- paths )
  54     [ ] accumulator [ each-file ] dip ;
  55
  56 : find-in-directories ( directories bfs? quot -- path' )
  57     '[ _ _ find-file ] attempt-all ; inline
  58
  59 os windows? [ "io.paths.windows" require ] when