blob: a229c78a1038f074ef28a860a8a6d69cddbfbc0d (
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
132
|
(.module:
[library
[lux (#- Module)
[type (#+ :sharing)]
[abstract
["." monad (#+ do)]]
[control
["." try (#+ Try)]]
[data
[binary (#+ Binary)]
["." product]
["." text
["%" format (#+ format)]
["." encoding]]
[collection
["." row]
["." list ("#\." functor fold)]
["." dictionary (#+ Dictionary)]
["." set]]
[format
["." tar]
["." binary]]]
[target
["_" scheme]]
[time
["." instant (#+ Instant)]]
[world
["." file]]]]
[program
[compositor
["." static (#+ Static)]]]
["." // (#+ Packager)
[//
["." archive (#+ Output)
["." descriptor (#+ Module Descriptor)]
["." artifact]
["." document (#+ Document)]]
[cache
["." dependency]]
["." io #_
["#" archive]]
[//
[language
["$" lux
[generation (#+ 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))
(|>> row.list
(list\map product.right)
(monad.fold try.monad
(function (_ content so_far)
(|> content
(\ encoding.utf8 decode)
(\ try.monad map
(|>> :expected
(:sharing [directive]
directive
so_far
directive)
(..then so_far)))))
(: _.Expression (_.manual "")))))
(def: module_file
(-> archive.ID file.Path)
(|>> %.nat (text.suffix ".scm")))
(def: mode
tar.Mode
($_ 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 (: (Try _.Expression)
(..bundle_module output))
entry_content (: (Try tar.Content)
(|> descriptor
(value@ #descriptor.references)
set.list
(list.all (function (_ module) (dictionary.value module mapping)))
(list\map (|>> ..module_file _.string _.load_relative/1))
(list\fold ..then bundle)
(: _.Expression)
_.code
(\ encoding.utf8 encode)
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\map (function (_ [module [module_id [descriptor document output]]])
[module module_id]))
(dictionary.of_list text.hash)
(: (Dictionary Module archive.ID)))]
entries (monad.map ! (..write_module now mapping) order)]
(in (|> entries
row.of_list
(binary.result tar.writer))))))
|
