add find-file-breadth, find-file-depth

redo walk-dir

extra/io/paths/paths.factor

@@ -1,24 +1,49 @@
-USING: assocs io.files kernel namespaces sequences ;
+USING: arrays assocs combinators.lib dlists io.files
+kernel namespaces sequences shuffle vectors ;
 IN: io.paths
 
-: find-file ( seq str -- path/f )
+! HOOK: library-roots io-backend ( -- seq )
-    [
+! HOOK: binary-roots io-backend ( -- seq )
-        [ path+ exists? ] curry find nip
-    ] keep over [ path+ ] [ drop ] if ;
 
 <PRIVATE
 : append-path ( path files -- paths )
-    [ path+ ] with map ;
+    [ >r path+ r> ] with* assoc-map ;
 
 : get-paths ( dir -- paths )
-    dup directory keys append-path ;
+    dup directory append-path ;
 
 : (walk-dir) ( path -- )
-    dup directory? [
+    first2 [
-        get-paths dup % [ (walk-dir) ] each
+        get-paths dup keys % [ (walk-dir) ] each
     ] [
         drop
     ] if ;
 PRIVATE>
 
-: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;
+: walk-dir ( path -- seq )
+    dup directory? 2array [ (walk-dir) ] { } make ;
+
+GENERIC# find-file* 1 ( obj quot -- path/f )
+
+M: dlist find-file* ( dlist quot -- path/f )
+    over dlist-empty? [ 2drop f ] [
+        2dup >r pop-front get-paths dup r> assoc-find
+        [ drop 3nip ]
+        [ 2drop [ nip ] assoc-subset keys pick push-all-back find-file* ] if
+    ] if ;
+
+M: vector find-file* ( vector quot -- path/f )
+    over empty? [ 2drop f ] [
+        2dup >r pop get-paths dup r> assoc-find
+        [ drop 3nip ]
+        [ 2drop [ nip ] assoc-subset keys pick push-all find-file* ] if
+    ] if ;
+
+: prepare-find-file ( quot -- quot )
+    [ drop ] swap compose ;
+
+: find-file-depth ( path quot -- path/f )
+    prepare-find-file >r 1vector r> find-file* ;
+
+: find-file-breadth ( path quot -- path/f )
+    prepare-find-file >r 1dlist r> find-file* ;