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
parent
9e4b0c10ae
commit
368e1c8e47
|
|
@ -1,63 +1,73 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! 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
|
||||
|
||||
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
|
||||
{ $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
|
||||
{ $unchecked-example "USING: sequences io.directories.search ;"
|
||||
"\"resource:misc\" t [ . ] each-file"
|
||||
"\"resource:misc\" [ . ] each-file"
|
||||
"! Recursive directory listing prints here"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: recursive-directory-files
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
|
||||
{ "paths" "a sequence of pathname strings" }
|
||||
{ "path" "a pathname string" }
|
||||
{ "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
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
|
||||
{ "directory-entries" "a sequence of directory-entries" }
|
||||
{ "path" "a pathname string" }
|
||||
{ "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
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
|
||||
{ "path/f" "a pathname string or f" }
|
||||
{ "path" "a pathname string" } { "quot" quotation }
|
||||
{ "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
|
||||
{ "directories" "a sequence of pathnames" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
|
||||
{ "path'/f" "a pathname string or f" }
|
||||
{ "directories" "a sequence of pathnames" } { "quot" quotation }
|
||||
{ "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
|
||||
{ "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
|
||||
{ "directories" "a sequence of directory paths" } { "quot" quotation }
|
||||
{ "paths/f" "a sequence of pathname strings or f" }
|
||||
{ "directories" { $sequence "directory paths" } } { "quot" quotation }
|
||||
{ "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
|
||||
{ "path" "a pathname string" } { "extension" "a file extension" }
|
||||
{ "seq" sequence }
|
||||
|
|
@ -70,20 +80,20 @@ HELP: find-by-extension
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: find-by-extensions
|
||||
HELP: find-files-by-extensions
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "extensions" "a sequence of file extensions" }
|
||||
{ "path" "a pathname string" } { "extensions" { $sequence "file extensions" } }
|
||||
{ "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." }
|
||||
{ $examples
|
||||
{ $code
|
||||
"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"
|
||||
"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-entries
|
||||
each-file
|
||||
each-directory-entry
|
||||
}
|
||||
"Finding files by name:"
|
||||
{ $subsections
|
||||
find-file
|
||||
find-all-files
|
||||
find-in-directories
|
||||
find-all-in-directories
|
||||
find-files
|
||||
find-file-in-directories
|
||||
find-files-in-directories
|
||||
}
|
||||
"Finding files by extension:"
|
||||
{ $subsections
|
||||
find-by-extension
|
||||
find-by-extensions
|
||||
find-files-by-extension
|
||||
find-files-by-extensions
|
||||
} ;
|
||||
|
||||
ABOUT: "io.directories.search"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
sequences sorting strings tools.test ;
|
||||
namespaces sequences sorting splitting strings tools.test ;
|
||||
|
||||
{ t } [
|
||||
[
|
||||
10 [ "io.paths.test" "gogogo" unique-file ] replicate
|
||||
"." [ ] find-all-files [ natural-sort ] same?
|
||||
"." [ ] find-files [ natural-sort ] same?
|
||||
] with-test-directory
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
{ "omg you shoudnt have a directory called this" "or this" }
|
||||
t
|
||||
[ "asdfasdfasdfasdfasdf" tail? ] find-in-directories
|
||||
[ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
{ } t [ "asdfasdfasdfasdfasdf" tail? ] find-in-directories
|
||||
{ } [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
[
|
||||
"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
|
||||
] unit-test
|
||||
|
||||
|
|
@ -31,7 +30,7 @@ sequences sorting strings tools.test ;
|
|||
{ "foo" "bar" } {
|
||||
[ [ make-directory ] 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 ]
|
||||
} cleave
|
||||
] with-test-directory
|
||||
|
|
@ -46,3 +45,68 @@ sequences sorting strings tools.test ;
|
|||
"resource:core/math/integers/integers.factor"
|
||||
[ drop f ] find-up-to-root
|
||||
] 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
|
||||
|
|
|
|||
|
|
@ -1,11 +1,17 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs continuations deques dlists fry
|
||||
io.backend io.directories io.files.info io.pathnames kernel
|
||||
kernel.private locals math sequences sequences.extras sorting
|
||||
USING: accessors arrays assocs combinators continuations deques
|
||||
dlists fry io.backend io.directories io.files.info io.pathnames
|
||||
kernel kernel.private locals math namespaces sequences sorting
|
||||
strings system unicode vocabs ;
|
||||
IN: io.directories.search
|
||||
|
||||
SYMBOL: traversal-method
|
||||
|
||||
SYMBOLS: +depth-first+ +breadth-first+ ;
|
||||
|
||||
traversal-method [ +depth-first+ ] initialize
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: directory-iterator
|
||||
|
|
@ -15,12 +21,11 @@ TUPLE: directory-iterator
|
|||
|
||||
: push-directory-entries ( path iter -- )
|
||||
{ directory-iterator } declare
|
||||
[ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[
|
||||
_ [ queue>> ] [ bfs>> ] bi
|
||||
[ push-front ] [ push-back ] if
|
||||
] each ;
|
||||
[ [ qualified-directory-entries ] [ 2drop f ] recover ] dip
|
||||
[ bfs>> [ [ <reversed> ] unless ] keep ]
|
||||
[ queue>> swap '[ _ _ [ push-front ] [ push-back ] if ] each ] bi ;
|
||||
|
||||
: <directory-iterator> ( path bfs? -- iterator )
|
||||
: <directory-iterator> ( path bfs? -- iter )
|
||||
<dlist> directory-iterator boa
|
||||
dup path>> over push-directory-entries ;
|
||||
|
||||
|
|
@ -44,52 +49,35 @@ TUPLE: directory-iterator
|
|||
: iterate-directory ( iter quot -- path/f )
|
||||
[ name>> ] prepose iterate-directory-entries ; inline
|
||||
|
||||
: setup-traversal ( path bfs quot -- iterator quot' )
|
||||
[ <directory-iterator> ] dip [ f ] compose ; inline
|
||||
: bfs? ( -- bfs? )
|
||||
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>
|
||||
|
||||
: each-file ( path bfs? quot -- )
|
||||
: each-file ( ... path quot: ( ... name -- ... ) -- ... )
|
||||
setup-traversal iterate-directory drop ; inline
|
||||
|
||||
: each-file-breadth ( path quot -- )
|
||||
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 -- ... ) -- )
|
||||
: each-directory-entry ( path quot: ( ... entry -- ... ) -- )
|
||||
setup-traversal iterate-directory-entries drop ; inline
|
||||
|
||||
: recursive-directory-files ( path bfs? -- paths )
|
||||
: recursive-directory-files ( path -- paths )
|
||||
[ ] collector [ each-file ] dip ;
|
||||
|
||||
: recursive-directory-entries ( path bfs? -- directory-entries )
|
||||
: recursive-directory-entries ( path -- directory-entries )
|
||||
[ ] collector [ each-directory-entry ] dip ;
|
||||
|
||||
: find-file ( path bfs? quot: ( ... name -- ... ? ) -- path/f )
|
||||
[ <directory-iterator> ] dip
|
||||
: find-file ( path quot: ( ... name -- ... ? ) -- path/f )
|
||||
[ bfs? <directory-iterator> ] dip
|
||||
[ keep and ] curry iterate-directory ; inline
|
||||
|
||||
: find-all-files ( path quot: ( ... name -- ... ? ) -- paths )
|
||||
f swap 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
|
||||
: find-files ( path quot: ( ... name -- ... ? ) -- paths )
|
||||
selector [ each-file ] dip ; inline
|
||||
|
||||
ERROR: sequence-expected obj ;
|
||||
|
||||
|
|
@ -97,23 +85,19 @@ ERROR: sequence-expected obj ;
|
|||
dup string? [ 1array ] when
|
||||
dup sequence? [ sequence-expected ] unless ;
|
||||
|
||||
! Can't make this generic# on string/sequence because of combinators
|
||||
: find-in-directories ( directories bfs? quot -- path'/f )
|
||||
[ ensure-sequence-of-directories ] 2dip
|
||||
'[ _ [ _ _ find-file-throws ] attempt-all ]
|
||||
[ drop f ] recover ; inline
|
||||
: find-file-in-directories ( directories quot: ( ... name -- ... ? ) -- path'/f )
|
||||
[ ensure-sequence-of-directories ] dip
|
||||
'[ _ find-file ] map-find drop ; inline
|
||||
|
||||
: find-all-in-directories ( directories quot -- paths/f )
|
||||
'[ _ find-all-files ] map concat ; inline
|
||||
: find-files-in-directories ( directories quot: ( ... name -- ... ? ) -- paths/f )
|
||||
[ ensure-sequence-of-directories ] dip
|
||||
'[ _ find-files ] map concat ; inline
|
||||
|
||||
: ?parent-directory ( path -- path'/f )
|
||||
dup parent-directory 2dup = [ 2drop f ] [ nip ] if ;
|
||||
|
||||
: ?file-info ( path -- file-info/f )
|
||||
[ file-info ] [ 2drop f ] recover ;
|
||||
|
||||
: 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 ]
|
||||
|
|
@ -127,14 +111,14 @@ ERROR: sequence-expected obj ;
|
|||
[ (find-up-to-root) ] [ 2drop f ] if
|
||||
] 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
|
||||
|
||||
: link-size/0 ( path -- n )
|
||||
[ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
|
||||
|
||||
: directory-size ( path -- n )
|
||||
0 swap t [ link-size/0 + ] each-file ;
|
||||
0 swap [ link-size/0 + ] each-file ;
|
||||
|
||||
: directory-usage ( path -- assoc )
|
||||
[
|
||||
|
|
@ -144,15 +128,12 @@ ERROR: sequence-expected obj ;
|
|||
] { } map>assoc
|
||||
] with-qualified-directory-entries sort-values ;
|
||||
|
||||
: find-by-extensions ( path extensions -- seq )
|
||||
: find-files-by-extensions ( path extensions -- seq )
|
||||
[ >lower ] map
|
||||
'[ >lower _ [ tail? ] with any? ] find-all-files ;
|
||||
'[ >lower _ [ tail? ] with any? ] find-files ;
|
||||
|
||||
: find-by-extension ( path extension -- seq )
|
||||
1array find-by-extensions ;
|
||||
: find-files-by-extension ( path extension -- seq )
|
||||
1array find-files-by-extensions ;
|
||||
|
||||
: find-files-larger-than ( path size -- seq )
|
||||
'[ file-info size>> _ > ] filter-files-by-depth ;
|
||||
|
||||
: file-info-recursive ( path -- seq )
|
||||
[ dup ?file-info [ 2array ] [ drop f ] if* ] filter-files-by-depth ;
|
||||
'[ file-info size>> _ > ] find-files ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue