]> gitweb.factorcode.org Git - factor.git/blob - basis/vocabs/refresh/monitor/monitor.factor
io.files: using some of the new file-exists combinators
[factor.git] / basis / vocabs / refresh / monitor / monitor.factor
1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors command-line continuations fry init io
4 io.backend io.files io.monitors io.pathnames kernel namespaces
5 prettyprint sequences splitting threads tr vocabs vocabs.cache
6 vocabs.loader vocabs.refresh ;
7 IN: vocabs.refresh.monitor
8
9 TR: convert-separators "/\\" ".." ;
10
11 : vocab-dir>vocab-name ( path -- vocab )
12     trim-head-separators
13     trim-tail-separators
14     convert-separators ;
15
16 : path>vocab-parent-dir ( path -- path' )
17     dup ".factor" tail? [ parent-directory ] when ;
18
19 : chop-vocab-root ( path -- path' )
20     "resource:" prepend-path normalize-path
21     dup vocab-roots get
22     [ [ normalize-path ] map ]
23     [ [ resolve-symlinks ] map ] bi append
24     [ head? ] with find nip
25     ?head drop ;
26
27 : path>vocab-name ( path -- vocab-name )
28     chop-vocab-root path>vocab-parent-dir vocab-dir>vocab-name ;
29
30 : monitor-loop ( monitor -- )
31     ! On OS X, monitors give us the full path, so we chop it
32     ! off if its there.
33     [
34         next-change path>>
35         [
36             path>vocab-name
37             [ changed-vocab ] [ reset-cache ] bi
38         ] [
39             [
40                 [ "monitor-loop warning for path ``" "``:" surround write ]
41                 [ . ] bi* flush
42             ] with-global
43         ] recover
44     ] [ monitor-loop ] bi ;
45
46 : (start-vocab-monitor) ( vocab-root -- )
47     [ [ t <monitor> monitor-loop ] with-monitors ] when-file-exists ;
48
49 : start-vocab-monitor ( vocab-root -- )
50     [
51         dup '[
52             [ _ (start-vocab-monitor) ]
53             [
54                 [
55                     _ "fatal error for monitor root ``" "``: " surround write
56                     . flush
57                 ] with-global
58             ] recover
59         ]
60     ] [ "Root monitor: " prepend ]
61     bi spawn drop ;
62
63 : init-vocab-monitor ( -- )
64     HS{ } clone changed-vocabs set-global
65     loaded-vocab-names [ changed-vocab ] each ;
66
67 STARTUP-HOOK: [
68     "-no-monitors" (command-line) member? [
69         [ drop ] add-vocab-root-hook set-global
70         f changed-vocabs set-global
71     ] [
72         init-vocab-monitor
73         vocab-roots get [ start-vocab-monitor ] each
74         [ start-vocab-monitor ] add-vocab-root-hook set-global
75     ] if
76 ]