steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactor io.directories.search

db4
Doug Coleman 2009-04-24 14:49:31 -05:00
parent b1c790da41
commit 33743c1a3d
2 changed files with 58 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/io/directories/search/search-docs.factor
View File

@ -41,11 +41,11 @@ HELP: find-all-files
{ "path" "a pathname string" } { "quot" quotation } { "path" "a pathname string" } { "quot" quotation }
{ "paths/f" "a sequence of pathname strings or f" } { "paths/f" "a sequence of pathname strings or f" }
} }
{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; { $description "Recursively finds all files in the input directory matching the predicate quotation." } ;
HELP: find-all-in-directories HELP: find-all-in-directories
{ $values { $values
{ "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "directories" "a sequence of directory paths" } { "quot" quotation }
{ "paths/f" "a sequence of pathname strings or f" } { "paths/f" "a sequence of pathname strings or f" }
} }
{ $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; { $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;

98
basis/io/directories/search/search.factor
View File

@ -3,7 +3,7 @@
USING: accessors arrays continuations deques dlists fry USING: accessors arrays continuations deques dlists fry
io.directories io.files io.files.info io.pathnames kernel io.directories io.files io.files.info io.pathnames kernel
sequences system vocabs.loader locals math namespaces sequences system vocabs.loader locals math namespaces
sorting assocs calendar threads ; sorting assocs calendar threads io math.parser ;
IN: io.directories.search IN: io.directories.search
: qualified-directory-entries ( path -- seq ) : qualified-directory-entries ( path -- seq )
@ -13,12 +13,17 @@ IN: io.directories.search
: qualified-directory-files ( path -- seq ) : qualified-directory-files ( path -- seq )
dup directory-files [ append-path ] with map ; dup directory-files [ append-path ] with map ;
: with-qualified-directory-files ( path quot -- )
'[ "" qualified-directory-files @ ] with-directory ; inline
: with-qualified-directory-entries ( path quot -- )
'[ "" qualified-directory-entries @ ] with-directory ; inline
<PRIVATE <PRIVATE
TUPLE: directory-iterator path bfs queue ; TUPLE: directory-iterator path bfs queue ;
: push-directory ( path iter -- ) : push-directory-entries ( path iter -- )
[ dup directory-entry? [ name>> ] when ] dip
[ qualified-directory-entries ] dip '[ [ qualified-directory-entries ] dip '[
_ [ queue>> ] [ bfs>> ] bi _ [ queue>> ] [ bfs>> ] bi
[ push-front ] [ push-back ] if [ push-front ] [ push-back ] if
@ -26,77 +31,86 @@ TUPLE: directory-iterator path bfs queue ;
: <directory-iterator> ( path bfs? -- iterator ) : <directory-iterator> ( path bfs? -- iterator )
<dlist> directory-iterator boa <dlist> directory-iterator boa
dup path>> over push-directory ; dup path>> over push-directory-entries ;
: next-file ( iter -- file/f ) : next-directory-entry ( iter -- directory-entry/f )
dup queue>> deque-empty? [ drop f ] [ dup queue>> deque-empty? [ drop f ] [
dup queue>> pop-back dup directory? dup queue>> pop-back
[ over push-directory next-file ] dup directory?
[ nip name>> ] if [ name>> over push-directory-entries next-directory-entry ]
] if ; [ nip ] if
] if ; recursive
:: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) :: iterate-directory-entries ( iter quot -- directory-entry/f )
iter next-file [ iter next-directory-entry [
quot call [ iter quot iterate-directory ] unless* quot call( obj -- obj ) [ iter quot iterate-directory-entries ] unless*
] [ ] [
f f
] if* ; inline recursive ] if* ; inline recursive
: iterate-directory ( iter quot -- path/f )
[ name>> ] prepose iterate-directory-entries ;
: setup-traversal ( path bfs quot -- iterator quot' )
[ <directory-iterator> ] dip [ f ] compose ;
PRIVATE> PRIVATE>
: each-file ( path bfs? quot: ( obj -- ) -- ) : each-file ( path bfs? quot -- )
[ <directory-iterator> ] dip setup-traversal [ name>> ] prepose
[ f ] compose iterate-directory drop ; inline iterate-directory-entries drop ; inline
: recursive-directory ( path bfs? -- paths ) : each-directory-entry ( path bfs? quot -- )
setup-traversal iterate-directory-entries drop ;
: recursive-directory-files ( path bfs? -- paths )
[ ] accumulator [ each-file ] dip ; [ ] accumulator [ each-file ] dip ;
: find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) : recursive-directory-entries ( path bfs? -- paths )
[ ] accumulator [ each-directory-entry ] dip ;
: find-file ( path bfs? quot -- path/f )
'[ '[
_ _ _ [ <directory-iterator> ] dip _ _ _ [ <directory-iterator> ] dip
[ keep and ] curry iterate-directory [ keep and ] curry iterate-directory
] [ drop f ] recover ; inline ] [ drop f ] recover ;
: find-all-files ( path quot: ( obj -- ? ) -- paths/f ) : find-all-files ( path quot -- paths/f )
f swap
'[ '[
_ _ _ [ <directory-iterator> ] dip _ _ [ f <directory-iterator> ] dip
pusher [ [ f ] compose iterate-directory drop ] dip pusher [ [ f ] compose iterate-directory drop ] dip
] [ drop f ] recover ; inline ] [ drop f ] recover ;
ERROR: file-not-found ; ERROR: file-not-found path bfs? quot ;
: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f ) : find-file-throws ( path bfs? quot -- path )
3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ;
: find-in-directories ( directories bfs? quot -- path'/f )
'[ '[
_ [ _ _ find-file [ file-not-found ] unless* ] attempt-all _ [ _ _ find-file-throws ] attempt-all
] [ ] [
drop f drop f
] recover ; inline ] recover ;
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f ) : find-all-in-directories ( directories quot -- paths/f )
'[ _ _ find-all-files ] map concat ; inline '[ _ find-all-files ] map concat ;
: with-qualified-directory-files ( path quot -- ) : link-size/0 ( path -- n )
'[ "" qualified-directory-files @ ] with-directory ; inline [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
: with-qualified-directory-entries ( path quot -- )
'[ "" qualified-directory-entries @ ] with-directory ; inline
: directory-size ( path -- n ) : directory-size ( path -- n )
0 swap t [ 0 swap t [ link-size/0 + ] each-file ;
[ link-info size-on-disk>> + ] [ 2drop ] recover
] each-file ;
: path>usage ( directory-entry -- name size ) : path>usage ( directory-entry -- name size )
[ name>> dup ] [ directory? ] bi [ [ name>> dup ] [ directory? ] bi
directory-size [ directory-size ] [ link-size/0 ] if ;
] [
[ link-info size-on-disk>> ] [ 2drop 0 ] recover
] if ;
: directory-usage ( path -- assoc ) : directory-usage ( path -- assoc )
[ [
[ [ path>usage ] [ drop name>> 0 ] recover ] { } map>assoc [
[ path>usage ] [ drop name>> 0 ] recover
] { } map>assoc
] with-qualified-directory-entries sort-values ; ] with-qualified-directory-entries sort-values ;
os windows? [ "io.directories.search.windows" require ] when os windows? [ "io.directories.search.windows" require ] when