blob: 8d0f233b4250ad5a49bdab296f377f6ee15d6c05 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(.require
[library
[lux (.except Module)
[type (.only sharing)]
[abstract
["[0]" monad (.only do)]]
[control
["[0]" try (.only Try)]]
[data
["[0]" product]
["[0]" binary (.only Binary)
["[1]" \\format]]
["[0]" text (.only)
["%" \\format (.only format)]
["[0]" encoding]]
[collection
["[0]" sequence]
["[0]" list (.use "[1]#[0]" functor mix)]
["[0]" dictionary (.only Dictionary)]
["[0]" set]]
[format
["[0]" tar]]]
[target
["_" scheme]]
[time
["[0]" instant (.only Instant)]]
[world
["[0]" file]]]]
[program
[compositor
["[0]" static (.only Static)]]]
["[0]" // (.only Packager)
[//
["[0]" archive (.only Output)
["[0]" descriptor (.only Module Descriptor)]
["[0]" artifact]
["[0]" document (.only Document)]]
[cache
["[0]" dependency]]
["[0]" io
["[1]" archive]]
[//
[language
["$" lux (.only)
[generation (.only Context)]]]]]])
... TODO: Delete ASAP
(type (Action ! a)
(! (Try a)))
(def (then pre post)
(-> _.Expression _.Expression _.Expression)
(_.manual (format (_.code pre)
text.new_line
(_.code post))))
(def bundle_module
(-> Output (Try _.Expression))
(|>> sequence.list
(list#each product.right)
(monad.mix try.monad
(function (_ content so_far)
(|> content
(at encoding.utf8 decoded)
(at try.monad each
(|>> as_expected
(is declaration)
(sharing [declaration]
(is declaration
so_far))
(..then so_far)))))
(is _.Expression (_.manual "")))))
(def module_file
(-> archive.ID file.Path)
(|>> %.nat (text.suffix ".scm")))
(def mode
tar.Mode
(all tar.and
tar.read_by_group
tar.read_by_owner
tar.write_by_other
tar.write_by_group
tar.write_by_owner))
(def owner
tar.Owner
[tar.#name tar.anonymous
tar.#id tar.no_id])
(def ownership
[tar.#user ..owner
tar.#group ..owner])
(def (write_module now mapping [module [module_id [descriptor document output]]])
(-> Instant (Dictionary Module archive.ID)
[Module [archive.ID [Descriptor (Document .Module) Output]]]
(Try tar.Entry))
(do [! try.monad]
[bundle (is (Try _.Expression)
(..bundle_module output))
entry_content (is (Try tar.Content)
(|> descriptor
(the descriptor.#references)
set.list
(list.all (function (_ module) (dictionary.value module mapping)))
(list#each (|>> ..module_file _.string _.load_relative/1))
(list#mix ..then bundle)
(is _.Expression)
_.code
(at encoding.utf8 encoded)
tar.content))
module_file (tar.path (..module_file module_id))]
(in {tar.#Normal [module_file now ..mode ..ownership entry_content]})))
(def .public (package now)
(-> Instant Packager)
(function (package host_dependencies archive program)
(do [! try.monad]
[order (dependency.load_order $.key archive)
.let [mapping (|> order
(list#each (function (_ [module [module_id [descriptor document output]]])
[module module_id]))
(dictionary.of_list text.hash)
(is (Dictionary Module archive.ID)))]
entries (monad.each ! (..write_module now mapping) order)]
(in (|> entries
sequence.of_list
(binary.result tar.format))))))
|
