factor/extra/io/paths/paths.factor

50 lines
1.4 KiB
Factor
Raw Normal View History

2008-10-02 19:26:56 -04:00
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
2008-03-20 16:30:59 -04:00
USING: io.files kernel sequences accessors
2008-10-02 19:26:56 -04:00
dlists deques arrays ;
IN: io.paths
TUPLE: directory-iterator path bfs queue ;
: qualified-directory ( path -- seq )
2008-10-19 14:11:10 -04:00
dup directory-files [ append-path ] with map ;
: push-directory ( path iter -- )
2008-10-02 19:26:56 -04:00
[ qualified-directory ] dip [
dup queue>> swap bfs>>
[ push-front ] [ push-back ] if
] curry each ;
: <directory-iterator> ( path bfs? -- iterator )
<dlist> directory-iterator boa
dup path>> over push-directory ;
: next-file ( iter -- file/f )
2008-08-19 15:06:20 -04:00
dup queue>> deque-empty? [ drop f ] [
2008-10-19 14:11:10 -04:00
dup queue>> pop-back dup link-info directory?
[ over push-directory next-file ] [ nip ] if
] if ;
: iterate-directory ( iter quot -- obj )
2008-10-02 19:26:56 -04:00
over next-file [
over call
[ 2drop ] [ iterate-directory ] if
] [
2008-10-02 19:26:56 -04:00
2drop f
] if* ; inline recursive
: find-file ( path bfs? quot -- path/f )
2008-10-02 19:26:56 -04:00
[ <directory-iterator> ] dip
2008-02-26 19:47:05 -05:00
[ keep and ] curry iterate-directory ; inline
: each-file ( path bfs? quot -- )
2008-10-02 19:26:56 -04:00
[ <directory-iterator> ] dip
2008-02-26 19:47:05 -05:00
[ f ] compose iterate-directory drop ; inline
: find-all-files ( path bfs? quot -- paths )
2008-10-02 19:26:56 -04:00
[ <directory-iterator> ] dip
pusher [ [ f ] compose iterate-directory drop ] dip ; inline
: recursive-directory ( path bfs? -- paths )
2008-10-02 19:26:56 -04:00
[ ] accumulator [ each-file ] dip ;