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 assocs continuations deques dlists fry
   4 io.backend io.directories io.files.info io.pathnames kernel
   5 locals math sequences sorting system unicode.case vocabs
   6 vocabs.loader ;
   7 IN: io.directories.search
   8
   9 : qualified-directory-entries ( path -- seq )
  10     absolute-path
  11     dup directory-entries [ [ append-path ] change-name ] with map ;
  12
  13 : qualified-directory-files ( path -- seq )
  14     absolute-path
  15     dup directory-files [ append-path ] with map ;
  16
  17 : with-qualified-directory-files ( path quot -- )
  18     '[ "" qualified-directory-files @ ] with-directory ; inline
  19
  20 : with-qualified-directory-entries ( path quot -- )
  21     '[ "" qualified-directory-entries @ ] with-directory ; inline
  22
  23 <PRIVATE
  24
  25 TUPLE: directory-iterator path bfs queue ;
  26
  27 : push-directory-entries ( path iter -- )
  28     [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[
  29         _ [ queue>> ] [ bfs>> ] bi
  30         [ push-front ] [ push-back ] if
  31     ] each ;
  32
  33 : <directory-iterator> ( path bfs? -- iterator )
  34     <dlist> directory-iterator boa
  35     dup path>> over push-directory-entries ;
  36
  37 : next-directory-entry ( iter -- directory-entry/f )
  38     dup queue>> deque-empty? [ drop f ] [
  39         dup queue>> pop-back
  40         dup directory?
  41         [ name>> over push-directory-entries next-directory-entry ]
  42         [ nip ] if
  43     ] if ;
  44
  45 :: iterate-directory-entries ( ... iter quot: ( ... obj -- ... obj ) -- ... directory-entry/f )
  46     iter next-directory-entry [
  47         quot call
  48         [ iter quot iterate-directory-entries ] unless*
  49     ] [
  50         f
  51     ] if* ; inline recursive
  52
  53 : iterate-directory ( iter quot -- path/f )
  54     [ name>> ] prepose iterate-directory-entries ; inline
  55
  56 : setup-traversal ( path bfs quot -- iterator quot' )
  57     [ <directory-iterator> ] dip [ f ] compose ; inline
  58
  59 PRIVATE>
  60
  61 : each-file ( path bfs? quot -- )
  62     setup-traversal iterate-directory drop ; inline
  63
  64 : each-directory-entry ( path bfs? quot -- )
  65     setup-traversal iterate-directory-entries drop ; inline
  66
  67 : recursive-directory-files ( path bfs? -- paths )
  68     [ ] collector [ each-file ] dip ; inline
  69
  70 : recursive-directory-entries ( path bfs? -- directory-entries )
  71     [ ] collector [ each-directory-entry ] dip ; inline
  72
  73 : find-file ( path bfs? quot -- path/f )
  74     [ <directory-iterator> ] dip
  75     [ keep and ] curry iterate-directory ; inline
  76
  77 : find-all-files ( path quot -- paths/f )
  78     [ f <directory-iterator> ] dip selector
  79     [ [ f ] compose iterate-directory drop ] dip ; inline
  80
  81 ERROR: file-not-found path bfs? quot ;
  82
  83 : find-file-throws ( path bfs? quot -- path )
  84     3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ; inline
  85
  86 : find-in-directories ( directories bfs? quot -- path'/f )
  87     '[ _ [ _ _ find-file-throws ] attempt-all ]
  88     [ drop f ] recover ; inline
  89
  90 : find-all-in-directories ( directories quot -- paths/f )
  91     '[ _ find-all-files ] map concat ; inline
  92
  93 : link-size/0 ( path -- n )
  94     [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
  95
  96 : directory-size ( path -- n )
  97     0 swap t [ link-size/0 + ] each-file ;
  98
  99 : path>usage ( directory-entry -- name size )
 100     [ name>> dup ] [ directory? ] bi
 101     [ directory-size ] [ link-size/0 ] if ;
 102
 103 : directory-usage ( path -- assoc )
 104     [
 105         [
 106             [ path>usage ] [ drop name>> 0 ] recover
 107         ] { } map>assoc
 108     ] with-qualified-directory-entries sort-values ;
 109
 110 : find-by-extensions ( path extensions -- seq )
 111     [ >lower ] map
 112     '[ >lower _ [ tail? ] with any? ] find-all-files ;
 113
 114 : find-by-extension ( path extension -- seq )
 115     1array find-by-extensions ;
 116
 117 os windows? [ "io.directories.search.windows" require ] when