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

io.directories.search: simplify interface. 

Now we use a ``traversal-method`` variable that controls whether
we do a depth-first or breadth-first search rather than a stack
argument or a fixed default specified in each word.

This also fixes an issue where breadth-first traversal would
iterate across children in reverse order, now it does the normal
ordering which is typically alphabetical.
char-rename
John Benediktsson 2017-03-05 09:16:00 -08:00
parent 9e4b0c10ae
commit 368e1c8e47
3 changed files with 161 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,63 +1,73 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel quotations sequences ; USING: help.markup help.syntax io.directories kernel quotations
sequences ;
IN: io.directories.search IN: io.directories.search
HELP: +depth-first+
{ $description "Method of directory traversal that fully recurses as far as possible before backtracking." } ;
HELP: +breadth-first+
{ $description "Method of directory traversal that explores each level of graph fully before moving to the next level." } ;
HELP: traversal-method
{ $var-description "Determines directory traversal method, either " { $link +depth-first+ } " or " { $link +breadth-first+ } "." } ;
HELP: each-file HELP: each-file
{ $values { $values
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "path" "a pathname string" } { "quot" quotation }
} }
{ $description "Performs a directory traversal, breadth-first or depth-first, and calls the quotation on the full pathname of each file." } { $description "Traverses a directory path recursively and calls the quotation on the full pathname of each file, in a breadth-first or depth-first " { $link traversal-method } "." }
{ $examples { $examples
{ $unchecked-example "USING: sequences io.directories.search ;" { $unchecked-example "USING: sequences io.directories.search ;"
"\"resource:misc\" t [ . ] each-file" "\"resource:misc\" [ . ] each-file"
"! Recursive directory listing prints here" "! Recursive directory listing prints here"
} }
} ; } ;
HELP: recursive-directory-files HELP: recursive-directory-files
{ $values { $values
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "path" "a pathname string" }
{ "paths" "a sequence of pathname strings" } { "paths" { $sequence "pathname strings" } }
} }
{ $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ; { $description "Traverses a directory path recursively and returns a sequence of files, in a breadth-first or depth-first " { $link traversal-method } "." } ;
HELP: recursive-directory-entries HELP: recursive-directory-entries
{ $values { $values
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "path" "a pathname string" }
{ "directory-entries" "a sequence of directory-entries" } { "directory-entries" { $sequence directory-entry } }
} }
{ $description "Traverses a directory path recursively and returns a sequence of directory-entries in a breadth-first or depth-first manner." } ; { $description "Traverses a directory path recursively and returns a sequence of directory-entries, in a breadth-first or depth-first " { $link traversal-method } "." } ;
HELP: find-file HELP: find-file
{ $values { $values
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "path" "a pathname string" } { "quot" quotation }
{ "path/f" "a pathname string or f" } { "path/f" { $maybe "pathname string" } }
} }
{ $description "Finds the first file in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; { $description "Finds the first file in the input directory matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
HELP: find-in-directories HELP: find-file-in-directories
{ $values { $values
{ "directories" "a sequence of pathnames" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "directories" "a sequence of pathnames" } { "quot" quotation }
{ "path'/f" "a pathname string or f" } { "path'/f" { $maybe "pathname string" } }
} }
{ $description "Finds the first file in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; { $description "Finds the first file in the input directories matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
HELP: find-all-files HELP: find-files
{ $values { $values
{ "path" "a pathname string" } { "quot" quotation } { "path" "a pathname string" } { "quot" quotation }
{ "paths" "a sequence of pathname strings" } { "paths" { $sequence "pathname strings" } }
} }
{ $description "Recursively finds all files in the input directory matching the predicate quotation." } ; { $description "Recursively finds all files in the input directory matching the predicate quotation, in a breadth-first or depth-first " { $link traversal-method } "." } ;
HELP: find-all-in-directories HELP: find-files-in-directories
{ $values { $values
{ "directories" "a sequence of directory paths" } { "quot" quotation } { "directories" { $sequence "directory paths" } } { "quot" quotation }
{ "paths/f" "a sequence of pathname strings or f" } { "paths/f" { $maybe "a sequence of pathname strings" } }
} }
{ $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 " { $link traversal-method } "." } ;
HELP: find-by-extension HELP: find-files-by-extension
{ $values { $values
{ "path" "a pathname string" } { "extension" "a file extension" } { "path" "a pathname string" } { "extension" "a file extension" }
{ "seq" sequence } { "seq" sequence }
@ -70,20 +80,20 @@ HELP: find-by-extension
} }
} ; } ;
HELP: find-by-extensions HELP: find-files-by-extensions
{ $values { $values
{ "path" "a pathname string" } { "extensions" "a sequence of file extensions" } { "path" "a pathname string" } { "extensions" { $sequence "file extensions" } }
{ "seq" sequence } { "seq" sequence }
} }
{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." } { $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
{ $examples { $examples
{ $code { $code
"USING: io.directories.search ;" "USING: io.directories.search ;"
"\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-by-extensions" "\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-files-by-extensions"
} }
} ; } ;
{ find-file find-all-files find-in-directories find-all-in-directories } related-words { find-file find-files find-file-in-directories find-files-in-directories } related-words
ARTICLE: "io.directories.search" "Searching directories" ARTICLE: "io.directories.search" "Searching directories"
"The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl "The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
@ -92,18 +102,19 @@ ARTICLE: "io.directories.search" "Searching directories"
recursive-directory-files recursive-directory-files
recursive-directory-entries recursive-directory-entries
each-file each-file
each-directory-entry
} }
"Finding files by name:" "Finding files by name:"
{ $subsections { $subsections
find-file find-file
find-all-files find-files
find-in-directories find-file-in-directories
find-all-in-directories find-files-in-directories
} }
"Finding files by extension:" "Finding files by extension:"
{ $subsections { $subsections
find-by-extension find-files-by-extension
find-by-extensions find-files-by-extensions
} ; } ;
ABOUT: "io.directories.search" ABOUT: "io.directories.search"

80
basis/io/directories/search/search-tests.factor
View File

@ -1,28 +1,27 @@
USING: combinators io.directories io.directories.hierarchy USING: combinators fry io.directories io.directories.hierarchy
io.directories.search io.files.unique io.pathnames kernel io.directories.search io.files.unique io.pathnames kernel
sequences sorting strings tools.test ; namespaces sequences sorting splitting strings tools.test ;
{ t } [ { t } [
[ [
10 [ "io.paths.test" "gogogo" unique-file ] replicate 10 [ "io.paths.test" "gogogo" unique-file ] replicate
"." [ ] find-all-files [ natural-sort ] same? "." [ ] find-files [ natural-sort ] same?
] with-test-directory ] with-test-directory
] unit-test ] unit-test
{ f } [ { f } [
{ "omg you shoudnt have a directory called this" "or this" } { "omg you shoudnt have a directory called this" "or this" }
t [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
[ "asdfasdfasdfasdfasdf" tail? ] find-in-directories
] unit-test ] unit-test
{ f } [ { f } [
{ } t [ "asdfasdfasdfasdfasdf" tail? ] find-in-directories { } [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
] unit-test ] unit-test
{ t } [ { t } [
[ [
"the-head" "" unique-file drop "the-head" "" unique-file drop
"." t [ file-name "the-head" head? ] find-file string? "." [ file-name "the-head" head? ] find-file string?
] with-test-directory ] with-test-directory
] unit-test ] unit-test
@ -31,7 +30,7 @@ sequences sorting strings tools.test ;
{ "foo" "bar" } { { "foo" "bar" } {
[ [ make-directory ] each ] [ [ make-directory ] each ]
[ [ "abcd" append-path touch-file ] each ] [ [ "abcd" append-path touch-file ] each ]
[ [ file-name "abcd" = ] find-all-in-directories length 2 = ] [ [ file-name "abcd" = ] find-files-in-directories length 2 = ]
[ [ delete-tree ] each ] [ [ delete-tree ] each ]
} cleave } cleave
] with-test-directory ] with-test-directory
@ -46,3 +45,68 @@ sequences sorting strings tools.test ;
"resource:core/math/integers/integers.factor" "resource:core/math/integers/integers.factor"
[ drop f ] find-up-to-root [ drop f ] find-up-to-root
] unit-test ] unit-test
{
V{
"/a"
"/a/a"
"/a/a/a"
"/a/b"
"/a/b/a"
"/b"
"/b/a"
"/b/a/a"
"/b/b"
"/b/b/a"
"/c"
"/c/a"
"/c/a/a"
"/c/b"
"/c/b/a"
}
V{
"/a"
"/b"
"/c"
"/a/a"
"/a/b"
"/b/a"
"/b/b"
"/c/a"
"/c/b"
"/a/a/a"
"/a/b/a"
"/b/a/a"
"/b/b/a"
"/c/a/a"
"/c/b/a"
}
} [
[
"a" make-directory
"a/a" make-directory
"a/a/a" touch-file
"a/b" make-directory
"a/b/a" touch-file
"b" make-directory
"b/a" make-directory
"b/a/a" touch-file
"b/b" make-directory
"b/b/a" touch-file
"c" make-directory
"c/a" make-directory
"c/a/a" touch-file
"c/b" make-directory
"c/b/a" touch-file
+depth-first+ traversal-method [
"." recursive-directory-files
current-directory get '[ _ ?head drop ] map
] with-variable
+breadth-first+ traversal-method [
"." recursive-directory-files
current-directory get '[ _ ?head drop ] map
] with-variable
] with-test-directory
] unit-test

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

@ -1,11 +1,17 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs continuations deques dlists fry USING: accessors arrays assocs combinators continuations deques
io.backend io.directories io.files.info io.pathnames kernel dlists fry io.backend io.directories io.files.info io.pathnames
kernel.private locals math sequences sequences.extras sorting kernel kernel.private locals math namespaces sequences sorting
strings system unicode vocabs ; strings system unicode vocabs ;
IN: io.directories.search IN: io.directories.search
SYMBOL: traversal-method
SYMBOLS: +depth-first+ +breadth-first+ ;
traversal-method [ +depth-first+ ] initialize
<PRIVATE <PRIVATE
TUPLE: directory-iterator TUPLE: directory-iterator
@ -15,12 +21,11 @@ TUPLE: directory-iterator
: push-directory-entries ( path iter -- ) : push-directory-entries ( path iter -- )
{ directory-iterator } declare { directory-iterator } declare
[ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[ [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip
_ [ queue>> ] [ bfs>> ] bi [ bfs>> [ [ <reversed> ] unless ] keep ]
[ push-front ] [ push-back ] if [ queue>> swap '[ _ _ [ push-front ] [ push-back ] if ] each ] bi ;
] each ;
: <directory-iterator> ( path bfs? -- iterator ) : <directory-iterator> ( path bfs? -- iter )
<dlist> directory-iterator boa <dlist> directory-iterator boa
dup path>> over push-directory-entries ; dup path>> over push-directory-entries ;
@ -44,52 +49,35 @@ TUPLE: directory-iterator
: iterate-directory ( iter quot -- path/f ) : iterate-directory ( iter quot -- path/f )
[ name>> ] prepose iterate-directory-entries ; inline [ name>> ] prepose iterate-directory-entries ; inline
: setup-traversal ( path bfs quot -- iterator quot' ) : bfs? ( -- bfs? )
[ <directory-iterator> ] dip [ f ] compose ; inline traversal-method get {
{ +breadth-first+ [ t ] }
{ +depth-first+ [ f ] }
} case ; inline
: setup-traversal ( path quot -- iter quot' )
[ bfs? <directory-iterator> ] dip [ f ] compose ; inline
PRIVATE> PRIVATE>
: each-file ( path bfs? quot -- ) : each-file ( ... path quot: ( ... name -- ... ) -- ... )
setup-traversal iterate-directory drop ; inline setup-traversal iterate-directory drop ; inline
: each-file-breadth ( path quot -- ) : each-directory-entry ( path quot: ( ... entry -- ... ) -- )
t swap each-file ; inline
: each-file-depth ( path quot -- )
f swap each-file ; inline
: filter-files-by-depth ( quot -- seq )
selector* [ each-file-depth ] dip ; inline
: filter-files-by-breadth ( quot -- seq )
selector* [ each-file-breadth ] dip ; inline
: all-files-by-depth ( quot -- seq )
collector [ each-file-depth ] dip ; inline
: all-files-by-breadth ( quot -- seq )
collector [ each-file-breadth ] dip ; inline
: each-directory-entry ( path bfs? quot: ( ... entry -- ... ) -- )
setup-traversal iterate-directory-entries drop ; inline setup-traversal iterate-directory-entries drop ; inline
: recursive-directory-files ( path bfs? -- paths ) : recursive-directory-files ( path -- paths )
[ ] collector [ each-file ] dip ; [ ] collector [ each-file ] dip ;
: recursive-directory-entries ( path bfs? -- directory-entries ) : recursive-directory-entries ( path -- directory-entries )
[ ] collector [ each-directory-entry ] dip ; [ ] collector [ each-directory-entry ] dip ;
: find-file ( path bfs? quot: ( ... name -- ... ? ) -- path/f ) : find-file ( path quot: ( ... name -- ... ? ) -- path/f )
[ <directory-iterator> ] dip [ bfs? <directory-iterator> ] dip
[ keep and ] curry iterate-directory ; inline [ keep and ] curry iterate-directory ; inline
: find-all-files ( path quot: ( ... name -- ... ? ) -- paths ) : find-files ( path quot: ( ... name -- ... ? ) -- paths )
f swap selector [ each-file ] dip ; inline selector [ each-file ] dip ; inline
ERROR: file-not-found path bfs? quot ;
: find-file-throws ( path bfs? quot -- path )
3dup find-file [ 2nip nip ] [ file-not-found ] if* ; inline
ERROR: sequence-expected obj ; ERROR: sequence-expected obj ;
@ -97,23 +85,19 @@ ERROR: sequence-expected obj ;
dup string? [ 1array ] when dup string? [ 1array ] when
dup sequence? [ sequence-expected ] unless ; dup sequence? [ sequence-expected ] unless ;
! Can't make this generic# on string/sequence because of combinators : find-file-in-directories ( directories quot: ( ... name -- ... ? ) -- path'/f )
: find-in-directories ( directories bfs? quot -- path'/f ) [ ensure-sequence-of-directories ] dip
[ ensure-sequence-of-directories ] 2dip '[ _ find-file ] map-find drop ; inline
'[ _ [ _ _ find-file-throws ] attempt-all ]
[ drop f ] recover ; inline
: find-all-in-directories ( directories quot -- paths/f ) : find-files-in-directories ( directories quot: ( ... name -- ... ? ) -- paths/f )
'[ _ find-all-files ] map concat ; inline [ ensure-sequence-of-directories ] dip
'[ _ find-files ] map concat ; inline
: ?parent-directory ( path -- path'/f ) : ?parent-directory ( path -- path'/f )
dup parent-directory 2dup = [ 2drop f ] [ nip ] if ; dup parent-directory 2dup = [ 2drop f ] [ nip ] if ;
: ?file-info ( path -- file-info/f )
[ file-info ] [ 2drop f ] recover ;
: containing-directory ( path -- path' ) : containing-directory ( path -- path' )
dup ?file-info directory? [ parent-directory ] unless ; dup file-info directory? [ parent-directory ] unless ;
: ?qualified-directory-files ( path -- seq ) : ?qualified-directory-files ( path -- seq )
[ qualified-directory-files ] [ qualified-directory-files ]
@ -127,14 +111,14 @@ ERROR: sequence-expected obj ;
[ (find-up-to-root) ] [ 2drop f ] if [ (find-up-to-root) ] [ 2drop f ] if
] if ; inline recursive ] if ; inline recursive
: find-up-to-root ( path quot -- obj ) : find-up-to-root ( path quot: ( path -- ? ) -- obj )
[ normalize-path containing-directory ] dip (find-up-to-root) ; inline [ normalize-path containing-directory ] dip (find-up-to-root) ; inline
: link-size/0 ( path -- n ) : link-size/0 ( path -- n )
[ link-info size-on-disk>> ] [ 2drop 0 ] recover ; [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
: directory-size ( path -- n ) : directory-size ( path -- n )
0 swap t [ link-size/0 + ] each-file ; 0 swap [ link-size/0 + ] each-file ;
: directory-usage ( path -- assoc ) : directory-usage ( path -- assoc )
[ [
@ -144,15 +128,12 @@ ERROR: sequence-expected obj ;
] { } map>assoc ] { } map>assoc
] with-qualified-directory-entries sort-values ; ] with-qualified-directory-entries sort-values ;
: find-by-extensions ( path extensions -- seq ) : find-files-by-extensions ( path extensions -- seq )
[ >lower ] map [ >lower ] map
'[ >lower _ [ tail? ] with any? ] find-all-files ; '[ >lower _ [ tail? ] with any? ] find-files ;
: find-by-extension ( path extension -- seq ) : find-files-by-extension ( path extension -- seq )
1array find-by-extensions ; 1array find-files-by-extensions ;
: find-files-larger-than ( path size -- seq ) : find-files-larger-than ( path size -- seq )
'[ file-info size>> _ > ] filter-files-by-depth ; '[ file-info size>> _ > ] find-files ;
: file-info-recursive ( path -- seq )
[ dup ?file-info [ 2array ] [ drop f ] if* ] filter-files-by-depth ;