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.loader ;
6 IN: io.directories.search
8 : qualified-directory-entries ( path -- seq )
10 dup directory-entries [ [ append-path ] change-name ] with map ;
12 : qualified-directory-files ( path -- seq )
14 dup directory-files [ append-path ] with map ;
16 : with-qualified-directory-files ( path quot -- )
17 '[ "" qualified-directory-files @ ] with-directory ; inline
19 : with-qualified-directory-entries ( path quot -- )
20 '[ "" qualified-directory-entries @ ] with-directory ; inline
24 TUPLE: directory-iterator path bfs queue ;
26 : push-directory-entries ( path iter -- )
27 [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[
28 _ [ queue>> ] [ bfs>> ] bi
29 [ push-front ] [ push-back ] if
32 : <directory-iterator> ( path bfs? -- iterator )
33 <dlist> directory-iterator boa
34 dup path>> over push-directory-entries ;
36 : next-directory-entry ( iter -- directory-entry/f )
37 dup queue>> deque-empty? [ drop f ] [
40 [ name>> over push-directory-entries next-directory-entry ]
44 :: iterate-directory-entries ( iter quot: ( obj -- obj ) -- directory-entry/f )
45 iter next-directory-entry [
47 [ iter quot iterate-directory-entries ] unless*
50 ] if* ; inline recursive
52 : iterate-directory ( iter quot -- path/f )
53 [ name>> ] prepose iterate-directory-entries ; inline
55 : setup-traversal ( path bfs quot -- iterator quot' )
56 [ <directory-iterator> ] dip [ f ] compose ; inline
60 : each-file ( path bfs? quot -- )
61 setup-traversal iterate-directory drop ; inline
63 : each-directory-entry ( path bfs? quot -- )
64 setup-traversal iterate-directory-entries drop ; inline
66 : recursive-directory-files ( path bfs? -- paths )
67 [ ] collector [ each-file ] dip ; inline
69 : recursive-directory-entries ( path bfs? -- directory-entries )
70 [ ] collector [ each-directory-entry ] dip ; inline
72 : find-file ( path bfs? quot -- path/f )
73 [ <directory-iterator> ] dip
74 [ keep and ] curry iterate-directory ; inline
76 : find-all-files ( path quot -- paths/f )
77 [ f <directory-iterator> ] dip selector
78 [ [ f ] compose iterate-directory drop ] dip ; inline
80 ERROR: file-not-found path bfs? quot ;
82 : find-file-throws ( path bfs? quot -- path )
83 3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ; inline
85 : find-in-directories ( directories bfs? quot -- path'/f )
86 '[ _ [ _ _ find-file-throws ] attempt-all ]
87 [ drop f ] recover ; inline
89 : find-all-in-directories ( directories quot -- paths/f )
90 '[ _ find-all-files ] map concat ; inline
92 : link-size/0 ( path -- n )
93 [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
95 : directory-size ( path -- n )
96 0 swap t [ link-size/0 + ] each-file ;
98 : path>usage ( directory-entry -- name size )
99 [ name>> dup ] [ directory? ] bi
100 [ directory-size ] [ link-size/0 ] if ;
102 : directory-usage ( path -- assoc )
105 [ path>usage ] [ drop name>> 0 ] recover
107 ] with-qualified-directory-entries sort-values ;
109 : find-by-extensions ( path extensions -- seq )
111 '[ >lower _ [ tail? ] with any? ] find-all-files ;
113 : find-by-extension ( path extension -- seq )
114 1array find-by-extensions ;
116 os windows? [ "io.directories.search.windows" require ] when