]> gitweb.factorcode.org Git - factor.git/blob - extra/file-trees/file-trees.factor
788291c0a23bdc3a0d77a0f3c64db6fb04e9962f
[factor.git] / extra / file-trees / file-trees.factor
1 USING: accessors delegate delegate.protocols io.pathnames
2 kernel locals namespaces sequences vectors
3 tools.annotations prettyprint ;
4 IN: file-trees
5
6 TUPLE: tree node children ;
7 CONSULT: sequence-protocol tree children>> [ node>> ] map ;
8
9 : <tree> ( start -- tree ) V{ } clone
10    [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
11
12 DEFER: (tree-insert)
13
14 : tree-insert ( path tree -- ) [ unclip <tree> ] [ children>> ] bi* (tree-insert) ;
15 :: (tree-insert) ( path-rest path-head tree-children -- )
16    tree-children [ node>> path-head node>> = ] find nip
17    [ path-rest swap tree-insert ]
18    [ 
19       path-head tree-children push
20       path-rest [ path-head tree-insert ] unless-empty
21    ] if* ;
22 : create-tree ( file-list -- tree ) [ path-components ] map
23    t <tree> [ [ tree-insert ] curry each ] keep ;