1 ! Copyright (C) 2007, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.libraries.finder assocs bootstrap.image
4 hashtables io io.directories io.encodings.utf8 io.files
5 io.files.temp io.launcher io.pathnames kernel locals make
6 namespaces prettyprint sequences splitting system
7 tools.deploy.config tools.deploy.config.editor
8 tools.deploy.embed vocabs.loader vocabs.metadata.resources
10 IN: tools.deploy.backend
12 : copy-vm ( executable bundle-name -- vm-path )
13 prepend-path vm-path over copy-file ;
15 TUPLE: vocab-manifest vocabs libraries ;
17 : copy-resources ( manifest name dir -- )
18 append-path swap vocabs>> [ copy-vocab-resources ] with each ;
20 ERROR: can't-deploy-library-file library ;
22 : copy-library ( dir library -- )
24 [ tuck file-name append-path copy-file ]
25 [ can't-deploy-library-file ] ?if ;
27 : copy-libraries ( manifest name dir -- )
28 append-path swap libraries>> [ copy-library ] with each ;
30 : deployed-image-name ( vocab -- str )
31 ".image" append temp-file ;
34 readln [ print flush copy-lines ] when* ;
36 : run-with-output ( arguments -- )
41 +low-priority+ >>priority
42 utf8 [ copy-lines ] with-process-reader ;
44 : make-boot-image ( -- )
45 ! If stage1 image doesn't exist, create one.
46 my-boot-image-name resource-path file-exists?
47 [ make-my-image ] unless ;
49 : staging-image-name ( profile -- name )
50 "-" join "." my-arch-name 3append
51 "staging." ".image" surround cache-file ;
53 : delete-staging-images ( -- )
55 [ "staging." head? ] filter
56 "." my-arch-name ".image" 3append [ tail? ] curry filter
58 ] with-directory-files ;
60 : input-image-name ( profile -- name )
61 but-last [ my-boot-image-name ] [ staging-image-name ] if-empty ;
63 : run-factor ( vm-path flags -- )
64 swap prefix dup . run-with-output ; inline
66 : staging-command-line ( profile -- flags )
69 "-staging" , "-no-user-init" , "-pic=0" ,
70 [ staging-image-name "-output-image=" prepend , ]
71 [ join-words "-include=" prepend , ] bi
73 input-image-name "-i=" prepend ,
74 "-resource-path=" "" resource-path append ,
75 "-run=tools.deploy.restage" ,
79 : make-staging-image ( profile -- )
80 { } [ suffix ] accumulate* [ staging-image-name file-exists? ] reject
81 [ staging-command-line ] map
82 [ vm-path swap run-factor ] each ;
84 : make-deploy-config ( vocab -- file )
85 [ deploy-config vocab-roots get vocab-roots associate assoc-union unparse-use ]
86 [ "deploy-config-" prepend temp-file ] bi
87 [ utf8 set-file-contents ] keep ;
89 : deploy-command-line ( image vocab manifest-file profile -- flags )
92 staging-image-name "-i=" prepend ,
93 "-vocab-manifest-out=" prepend ,
94 [ "-deploy-vocab=" prepend , ]
95 [ make-deploy-config "-deploy-config=" prepend , ] bi
96 "-output-image=" prepend ,
97 "-resource-path=" "" resource-path append ,
98 "-run=tools.deploy.shaker" ,
101 : parse-vocab-manifest-file ( path -- vocab-manifest )
102 utf8 file-lines [ "empty vocab manifest!" throw ] [
103 unclip-slice "VOCABS:" =
104 [ { "LIBRARIES:" } split1 vocab-manifest boa ]
105 [ "invalid vocab manifest!" throw ] if
108 :: make-deploy-image ( vm image vocab config -- manifest )
111 config config>profile :> profile
112 vocab "vocab-manifest-" prepend temp-file :> manifest-file
113 image vocab manifest-file profile deploy-command-line :> flags
115 profile make-staging-image
117 manifest-file parse-vocab-manifest-file ;
119 :: make-deploy-image-executable ( vm image vocab config -- manifest )
120 vm image vocab config make-deploy-image
121 image vm embed-image ;
123 SYMBOL: open-directory-after-deploy?
124 t open-directory-after-deploy? set-global
126 : maybe-open-deploy-directory ( directory -- )
127 absolute-path open-directory-after-deploy? get
128 [ open-item ] [ drop ] if ;
130 HOOK: deploy* os ( vocab -- )
132 HOOK: deploy-path os ( vocab -- path )