119 lines
3.7 KiB
Factor
119 lines
3.7 KiB
Factor
! 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 sorting strings system
|
|
unicode.case vocabs vocabs.loader ;
|
|
IN: io.directories.search
|
|
|
|
: qualified-directory-entries ( path -- seq )
|
|
absolute-path
|
|
dup directory-entries [ [ append-path ] change-name ] with map! ;
|
|
|
|
: qualified-directory-files ( path -- seq )
|
|
absolute-path
|
|
dup directory-files [ append-path ] with map! ;
|
|
|
|
: with-qualified-directory-files ( path quot -- )
|
|
'[ "" qualified-directory-files @ ] with-directory ; inline
|
|
|
|
: with-qualified-directory-entries ( path quot -- )
|
|
'[ "" qualified-directory-entries @ ] with-directory ; inline
|
|
|
|
<PRIVATE
|
|
|
|
TUPLE: directory-iterator
|
|
{ path string }
|
|
{ bfs boolean }
|
|
{ queue dlist } ;
|
|
|
|
: push-directory-entries ( path iter -- )
|
|
{ directory-iterator } declare
|
|
[ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[
|
|
_ [ queue>> ] [ bfs>> ] bi
|
|
[ push-front ] [ push-back ] if
|
|
] each ;
|
|
|
|
: <directory-iterator> ( path bfs? -- iterator )
|
|
<dlist> directory-iterator boa
|
|
dup path>> over push-directory-entries ;
|
|
|
|
: next-directory-entry ( iter -- directory-entry/f )
|
|
{ directory-iterator } declare
|
|
dup queue>> deque-empty? [ drop f ] [
|
|
dup queue>> pop-back
|
|
dup directory?
|
|
[ [ name>> swap push-directory-entries ] keep ]
|
|
[ nip ] if
|
|
] if ;
|
|
|
|
:: iterate-directory-entries ( ... iter quot: ( ... obj -- ... obj ) -- ... directory-entry/f )
|
|
iter next-directory-entry [
|
|
quot call
|
|
[ iter quot iterate-directory-entries ] unless*
|
|
] [
|
|
f
|
|
] if* ; inline recursive
|
|
|
|
: 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
|
|
|
|
PRIVATE>
|
|
|
|
: each-file ( path bfs? quot: ( ... name -- ... ) -- )
|
|
setup-traversal iterate-directory drop ; inline
|
|
|
|
: each-directory-entry ( path bfs? quot: ( ... entry -- ... ) -- )
|
|
setup-traversal iterate-directory-entries drop ; inline
|
|
|
|
: recursive-directory-files ( path bfs? -- paths )
|
|
[ ] collector [ each-file ] dip ;
|
|
|
|
: recursive-directory-entries ( path bfs? -- directory-entries )
|
|
[ ] collector [ each-directory-entry ] dip ;
|
|
|
|
: find-file ( path bfs? quot: ( ... name -- ... ? ) -- path/f )
|
|
[ <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 dup [ 2nip nip ] [ drop file-not-found ] if ; inline
|
|
|
|
: find-in-directories ( directories bfs? quot -- path'/f )
|
|
'[ _ [ _ _ find-file-throws ] attempt-all ]
|
|
[ drop f ] recover ; inline
|
|
|
|
: find-all-in-directories ( directories quot -- paths/f )
|
|
'[ _ find-all-files ] map concat ; 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 ;
|
|
|
|
: directory-usage ( path -- assoc )
|
|
[
|
|
[
|
|
[ name>> dup ] [ directory? ] bi
|
|
[ directory-size ] [ link-size/0 ] if
|
|
] { } map>assoc
|
|
] with-qualified-directory-entries sort-values ;
|
|
|
|
: find-by-extensions ( path extensions -- seq )
|
|
[ >lower ] map
|
|
'[ >lower _ [ tail? ] with any? ] find-all-files ;
|
|
|
|
: find-by-extension ( path extension -- seq )
|
|
1array find-by-extensions ;
|
|
|
|
os windows? [ "io.directories.search.windows" require ] when
|