1 ! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators combinators.short-circuit
4 io.directories io.files io.files.info io.pathnames kernel
5 make peg.ebnf regexp regexp.combinators sequences strings system
9 : not-path-separator ( -- sep )
10 os windows? R/ [^\/\\]/ R/ [^\/]/ ? ; foldable
12 : wild-path-separator ( -- sep )
13 os windows? R/ [^\/\\][\/\\]|[^\/\\]/ R/ [^\/][\/]|[^\/]/ ? ; foldable
17 Character = "\\" .:c => [[ c 1string <literal> ]]
18 | !(","|"}") . => [[ 1string <literal> ]]
20 RangeCharacter = !("]") .
22 Range = RangeCharacter:a "-" RangeCharacter:b => [[ a b <char-range> ]]
23 | RangeCharacter => [[ 1string <literal> ]]
25 StartRange = .:a "-" RangeCharacter:b => [[ a b <char-range> ]]
26 | . => [[ 1string <literal> ]]
28 Ranges = StartRange:s Range*:r => [[ r s prefix ]]
30 CharClass = "^"?:n Ranges:e => [[ e <or> n [ <not> ] when ]]
32 AlternationBody = Concatenation:c "," AlternationBody:a => [[ a c prefix ]]
33 | Concatenation => [[ 1array ]]
35 Element = "**" => [[ wild-path-separator <zero-or-more> ]]
36 | "*" => [[ not-path-separator <zero-or-more> ]]
37 | "?" => [[ not-path-separator ]]
38 | "[" CharClass:c "]" => [[ c ]]
39 | "{" AlternationBody:b "}" => [[ b <or> ]]
42 Concatenation = Element* => [[ <sequence> ]]
46 Main = Concatenation End
50 : glob-matches? ( input glob -- ? )
51 [ >case-fold ] bi@ <glob> matches? ;
53 : glob-pattern? ( string -- ? )
54 [ "\\*?[{" member? ] any? ;
59 ! TODO: handle two more test cases
60 ! TODO: make case-fold an option, off by default
61 ! TODO: maybe make case-fold an option on regexp
65 : glob-entries ( path -- entries )
66 directory-entries [ name>> "." head? ] reject ;
68 : ?glob% ( root remaining entry -- )
72 directory? [ glob% ] [ 2drop ] if
75 :: glob-wildcard% ( root globs -- )
76 globs ?second :> next-glob
77 next-glob dup pair? [ second ] [ drop f ] if :> next-glob-regexp
79 root glob-entries [| entry |
80 root entry name>> append-path
82 { [ next-glob not ] [ dup , ] }
83 { [ next-glob empty? ] [ entry directory? [ dup , ] when ] }
86 entry name>> >case-fold next-glob-regexp matches?
90 [ entry name>> next-glob = ]
106 { [ entry directory? ] [ next-glob ] } 0&& [
113 :: glob-pattern% ( root globs -- )
114 globs unclip second :> ( remaining glob )
116 root glob-entries [| entry |
117 entry name>> >case-fold glob matches? [
118 root entry name>> append-path
119 remaining entry ?glob%
123 :: glob-literal% ( root globs -- )
124 globs unclip :> ( remaining glob )
126 root glob append-path [
127 remaining over file-info ?glob%
130 : glob% ( root globs -- )
133 { "**" [ glob-wildcard% ] }
134 [ pair? [ glob-pattern% ] [ glob-literal% ] if ]
137 : split-glob ( glob -- path globs )
142 dup [ path-separator? ] find-last drop
143 [ cut rest ] [ "" swap ] if*
147 : glob-path ( glob -- path globs )
149 dup { [ "**" = not ] [ glob-pattern? ] } 1&& [
150 dup >case-fold <glob> 2array
156 : glob ( glob -- files )
158 [ 1array f swap ] when-empty glob%