src/lib/glob.slate

   1 define: #Glob &parents: {Cloneable} &slots: {}.
   2
   3 Glob traits define: #Pattern &parents: {Glob} &slots: {
   4   #components -> ExtensibleArray new
   5 }.
   6 Glob traits define: #PatternMatcher &parents: {Glob} &slots: {#reader. #maskPattern}.
   7
   8 Glob traits define: #PatternFailure.
   9
  10 Glob traits define: #PatternComponent &parents: {Glob}.
  11 Glob traits define: #PatternLiteral &parents: {Glob PatternComponent} &slots: {#string -> ''}.
  12 Glob traits define: #PatternRange &parents: {Glob PatternComponent} &slots: {
  13   #ranges -> ExtensibleArray new.
  14   #negate -> False
  15 }.
  16 Glob traits define: #PatternAny &parents: {Glob PatternComponent}.
  17 Glob traits define: #PatternAnyOne &parents: {Glob PatternComponent}.
  18
  19 glob@(Glob traits) newOn: s
  20 [glob Pattern newOn: s].
  21
  22 glob@(Glob Pattern traits) newOn: s@(String traits)
  23 [
  24   glob components := glob components new.
  25   glob readFrom: s reader.
  26   glob
  27 ].
  28
  29 glob@(Glob Pattern traits) readFrom: s@(ReadStream traits)
  30 [| prev |
  31   prev := '' writer.
  32   glob components :=
  33     [| :matcher |
  34      s do:
  35        [| :token |
  36         (#{$*. $?. $\[. } includes: token) /\ [prev contents isEmpty not]
  37           ifTrue: [matcher nextPut: (glob PatternLiteral new `>> [string := prev contents. ]).
  38                    prev := '' writer].
  39         token caseOf: {
  40           $*  -> [matcher nextPut: glob PatternAny].
  41           $?  -> [matcher nextPut: glob PatternAnyOne].
  42           $\[ -> [matcher nextPut: (glob readRange := s upTo: $\])]
  43         } otherwise: [prev nextPut: token]].
  44      prev contents isEmpty ifFalse: [matcher nextPut: (glob PatternLiteral new `>> [string := prev contents. ])]] writingAs: glob components.
  45 ].
  46
  47 glob@(Glob Pattern traits) readRange: str@(String traits)
  48 [| p char2 s |
  49   s := str reader.
  50   p := glob PatternRange new `>>
  51     [| :p |
  52      ranges := p ranges new.
  53      negate := '^!' includes: (char2 := s peek). ].
  54   s do:
  55     [| :char |
  56      (char2 := s peek) = $-
  57        ifTrue: [s next. p ranges addLast: char -> s next]
  58        ifFalse: [p ranges addLast: char]].
  59   p
  60 ].
  61
  62 glob@(Glob Pattern traits) match: str@(String traits) from: pos
  63 [
  64   (glob PatternMatcher new `>> [maskPattern := glob. reader := glob components reader. ]) match: str from: pos
  65 ].
  66
  67 glob@(Glob PatternMatcher traits) match: str@(String traits) from: pos
  68 [
  69   "inform: 'match reader: ' ; glob reader printString ;  ' pos: ' ; pos printString."
  70   glob reader do:
  71     [| :token |
  72      (token isSameAs: glob PatternAny)
  73        ifTrue: [str size downTo: pos do:
  74                   [| :start | ((glob new `>> [reader := glob reader clone. ]) match: str from: start) = str size
  75                                ifTrue: [^ str size]]]
  76        ifFalse: [(pos := (token match: str from: pos))
  77                    == glob PatternFailure ifTrue: [^ pos]]].
  78   pos
  79 ].
  80
  81 glob@(Glob Pattern traits) matches: str@(String traits)
  82 [
  83   (match ::= glob match: str from: 0) ~== glob PatternFailure /\ [match = str size]
  84 ].
  85
  86 glob@(Glob PatternAny traits) match: str@(String traits) from: pos
  87 [
  88   (pos to: str size - pos)
  89 ].
  90
  91 glob@(Glob PatternAnyOne traits) match: str@(String traits) from: pos
  92 [
  93   pos >= str size ifTrue: [glob PatternFailure] ifFalse: [pos + 1]
  94 ].
  95
  96 glob@(Glob PatternRange traits) match: str@(String traits) from: pos
  97 [
  98   pos >= str size \/ [glob matches: (str at: pos)] ifTrue: [glob PatternFailure] ifFalse: [pos + 1]
  99 ].
 100
 101 glob@(Glob PatternLiteral traits) match: str@(String traits) from: pos
 102 [
 103   pos + glob string size > str size
 104     ifTrue: [glob PatternFailure]
 105     ifFalse: [(str copyFrom: pos to: pos + glob string size - 1) = glob string
 106                 ifTrue: [pos + glob string size]
 107                 ifFalse: [glob PatternFailure]]
 108 ].
 109
 110 glob@(Glob PatternRange traits) matches: c@(String Character traits)
 111 [
 112   glob ranges detect:
 113     [| :range | ((range isSameAs: c) /\ [range = c]) \/
 114                   [c code between: range key code and: c code]]
 115 ].
 116
 117 d@(File Locator traits) maskedEntries: mask@(String traits) do: block
 118 [
 119   d maskedEntries: (Glob newOn: mask) do: block
 120 ].
 121
 122 l@(File Locator traits) maskedEntries: mask do: block
 123 [
 124   (Directory new `>> [locator := l. ]) maskedEntries: mask do: block
 125 ].
 126
 127 l@(File Locator traits) collectMasked: mask
 128 [
 129   [| :result | l maskedEntries: mask do: #(result nextPut: _) `er]
 130     writingAs: #{}
 131 ].
 132
 133 d@(File Locator traits) /* mask
 134 [d collectMasked: mask].
 135
 136 d@(Directory traits) /* mask
 137 [d locator collectMasked: mask].
 138
 139 d@(Directory traits) maskedEntries: mask do: block
 140 [
 141   d sessionDo:
 142     [| :d |
 143      (d reader do:
 144         [| :each | (mask matches: each) ifTrue:
 145            [block applyWith: (File Locator new `>> [readFilenameFrom: each. ])]])].
 146 ].
 147
 148 d@(Directory traits) find: block &maxDepth
 149 [
 150   maxDepth `defaultsTo: PositiveInfinity.
 151   result ::= Set new writer.
 152   d select: block into: result depth: maxDepth.
 153   result contents
 154 ].
 155
 156 d@(Directory traits) select: block into: result depth: maxDepth
 157 [
 158   maxDepth isZero ifFalse:
 159     [entries ::= d entries collect:
 160        [| :each | (File RelativeLocator newFrom: d) `>> [readPathElementsFrom: each reader. ]].
 161      ((reader ::= entries reader) select: block) >> result.
 162      entries do:
 163        [| :each info |
 164         (info := each fileInfo) isNotNil /\ [info isDirectory] /\ [info isLink not]
 165           /\ [each name ~= '..'] /\ [each name ~= '.']
 166           ifTrue: [(d childNamed: each name) select: block into: result depth: maxDepth - 1]]]
 167 ].