diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor index 622af47f57..e0ef7cc476 100644 --- a/basis/io/directories/search/search-docs.factor +++ b/basis/io/directories/search/search-docs.factor @@ -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" diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index 411af1666c..2ed2b0311d 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -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 diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 04f82f7344..3431081dc8 100644 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -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 + > ] [ bfs>> ] bi - [ push-front ] [ push-back ] if - ] each ; + [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip + [ bfs>> [ [ ] unless ] keep ] + [ queue>> swap '[ _ _ [ push-front ] [ push-back ] if ] each ] bi ; -: ( path bfs? -- iterator ) +: ( path bfs? -- iter ) 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' ) - [ ] dip [ f ] compose ; inline +: bfs? ( -- bfs? ) + traversal-method get { + { +breadth-first+ [ t ] } + { +depth-first+ [ f ] } + } case ; inline + +: setup-traversal ( path quot -- iter quot' ) + [ bfs? ] 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 ) - [ ] dip +: find-file ( path quot: ( ... name -- ... ? ) -- path/f ) + [ bfs? ] 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,29 +85,25 @@ 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 ] [ drop ?parent-directory [ ?qualified-directory-files ] [ f ] if* ] recover ; -: (find-up-to-root) ( path quot: ( path -- ? ) -- obj ) +: (find-up-to-root) ( path quot: ( path -- ? ) -- obj ) [ [ ?qualified-directory-files ] dip find swap ] 2keep rot [ 2drop ] [ @@ -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 ;