unmaintained/tangle/path/path.factor

   1 ! Copyright (C) 2008 Alex Chapman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel semantic-db sequences sequences.lib splitting ;
   4 IN: tangle.path
   5
   6 RELATION: has-filename
   7 RELATION: in-directory
   8
   9 : create-root ( -- node ) "" create-node ;
  10
  11 : get-root ( -- node )
  12     in-directory-relation ultimate-objects ?1node-result ;
  13
  14 : ensure-root ( -- node ) get-root [ create-root ] unless* ;
  15
  16 : create-file ( parent name -- node )
  17     create-node swap dupd in-directory ;
  18
  19 : files-in-directory ( node -- nodes ) in-directory-subjects ;
  20
  21 : file-in-directory ( name node -- node )
  22     in-directory-relation subjects-with-cor ?1node-result ;
  23
  24 : parent-directory ( file-node -- dir-node )
  25     in-directory-objects ?first ;
  26
  27 : (path>node) ( node name -- node )
  28     swap [ file-in-directory ] [ drop f ] if* ;
  29
  30 : path>node ( path -- node )
  31     ensure-root swap [ (path>node) ] each ;
  32
  33 : path>file ( path -- file )
  34     path>node [ has-filename-subjects ?first ] [ f ] if* ;
  35
  36 : (node>path) ( root seq node -- seq )
  37     pick over node= [
  38         drop nip
  39     ] [
  40         dup node-content pick push
  41         parent-directory [
  42             (node>path)
  43         ] [
  44             2drop f
  45         ] if*
  46     ] if ;
  47
  48 : node>path* ( root node -- path )
  49     V{ } clone swap (node>path) dup empty?
  50     [ drop f ] [ <reversed> ] if ;
  51
  52 : node>path ( node -- path )
  53     ensure-root swap node>path* ;
  54
  55 : file>path ( node -- path )
  56     has-filename-objects ?first [ node>path ] [ f ] if* ;